Move to AnyEvent-I3
Michael Stapelberg
6 years ago
| 0 | Revision history for AnyEvent-I3 | |
| 1 | ||
| 2 | 0.17 2017-04-09 | |
| 3 | ||
| 4 | * support the shutdown event | |
| 5 | * use lib '.' for Perl 5.25.11+ | |
| 6 | ||
| 7 | 0.16 2014-10-03 | |
| 8 | ||
| 9 | * support the barconfig_update and binding event | |
| 10 | ||
| 11 | 0.15 2013-02-18 | |
| 12 | ||
| 13 | * support the window event | |
| 14 | ||
| 15 | 0.14 2012-09-22 | |
| 16 | ||
| 17 | * support the mode event | |
| 18 | ||
| 19 | 0.13 2012-08-05 | |
| 20 | ||
| 21 | * support the GET_VERSION request with a fall-back to i3 --version | |
| 22 | ||
| 23 | 0.12 2012-07-11 | |
| 24 | ||
| 25 | * taint mode fix: remove relative directories from $ENV{PATH} | |
| 26 | ||
| 27 | 0.11 2012-07-10 | |
| 28 | ||
| 29 | * taint mode fix for FreeBSD | |
| 30 | ||
| 31 | 0.10 2012-07-09 | |
| 32 | ||
| 33 | * Use i3 --get-socketpath by default for determining the socket path | |
| 34 | * Bugfix: Also delete callbacks which are triggered due to an error | |
| 35 | ||
| 36 | 0.09 2011-10-12 | |
| 37 | ||
| 38 | * Implement GET_BAR_CONFIG request | |
| 39 | ||
| 40 | 0.08 2011-09-26 | |
| 41 | ||
| 42 | * Implement GET_MARKS request | |
| 43 | * The synopsis mentioned ->workspaces, but it’s ->get_workspaces | |
| 44 | ||
| 45 | 0.07 2010-11-21 | |
| 46 | ||
| 47 | * Implement GET_TREE request | |
| 48 | ||
| 49 | 0.06 2010-06-16 | |
| 50 | ||
| 51 | * Add check to Makefile to abort in a Windows environment (neither i3 nor | |
| 52 | unix sockets available) | |
| 53 | ||
| 54 | 0.05 2010-06-09 | |
| 55 | ||
| 56 | * use getpwuid() to resolve ~ in socket paths instead of glob() | |
| 57 | ||
| 58 | 0.04 2010-03-27 | |
| 59 | ||
| 60 | * use new default ipc-socket path, glob() path, bump version | |
| 61 | ||
| 62 | 0.03 2010-03-26 | |
| 63 | ||
| 64 | * fix MANIFEST | |
| 65 | ||
| 66 | 0.02 2010-03-23 | |
| 67 | ||
| 68 | * first upload to CPAN |
| 0 | Changes | |
| 1 | inc/Module/Install.pm | |
| 2 | inc/Module/Install/Base.pm | |
| 3 | inc/Module/Install/Can.pm | |
| 4 | inc/Module/Install/Fetch.pm | |
| 5 | inc/Module/Install/Makefile.pm | |
| 6 | inc/Module/Install/Metadata.pm | |
| 7 | inc/Module/Install/Win32.pm | |
| 8 | inc/Module/Install/WriteAll.pm | |
| 9 | lib/AnyEvent/I3.pm | |
| 10 | Makefile.PL | |
| 11 | MANIFEST | |
| 12 | MANIFEST.SKIP | |
| 13 | META.yml | |
| 14 | README | |
| 15 | t/00-load.t | |
| 16 | t/01-workspaces.t | |
| 17 | t/02-sugar.t | |
| 18 | t/boilerplate.t | |
| 19 | t/manifest.t | |
| 20 | t/pod-coverage.t | |
| 21 | t/pod.t |
| 0 | ^\.git/ | |
| 1 | \.bak$ | |
| 2 | blib/ | |
| 3 | ^Makefile$ | |
| 4 | ^Makefile.old$ | |
| 5 | Build | |
| 6 | Build.bat | |
| 7 | ^pm_to_blib | |
| 8 | \.tar\.gz$ | |
| 9 | ^pod2htm(.*).tmp$ | |
| 10 | ^AnyEvent-I3- |
| 0 | use lib '.'; | |
| 1 | use inc::Module::Install; | |
| 2 | ||
| 3 | name 'AnyEvent-I3'; | |
| 4 | all_from 'lib/AnyEvent/I3.pm'; | |
| 5 | author 'Michael Stapelberg'; | |
| 6 | ||
| 7 | requires 'AnyEvent'; | |
| 8 | requires 'AnyEvent::Handle'; | |
| 9 | requires 'AnyEvent::Socket'; | |
| 10 | requires 'JSON::XS'; | |
| 11 | ||
| 12 | if ($^O eq 'MSWin32') { | |
| 13 | die "AnyEvent::I3 cannot be used on win32 (unix sockets are missing)"; | |
| 14 | } | |
| 15 | ||
| 16 | WriteAll; |
| 0 | AnyEvent-I3 | |
| 1 | ||
| 2 | This module connects to the i3 window manager using the UNIX socket based | |
| 3 | IPC interface it provides (if enabled in the configuration file). You can | |
| 4 | then subscribe to events or send messages and receive their replies. | |
| 5 | ||
| 6 | INSTALLATION | |
| 7 | ||
| 8 | To install this module, run the following commands: | |
| 9 | ||
| 10 | perl Makefile.PL | |
| 11 | make | |
| 12 | make test | |
| 13 | make install | |
| 14 | ||
| 15 | SUPPORT AND DOCUMENTATION | |
| 16 | ||
| 17 | After installing, you can find documentation for this module with the | |
| 18 | perldoc command. | |
| 19 | ||
| 20 | perldoc AnyEvent::I3 | |
| 21 | ||
| 22 | You can also look for information at: | |
| 23 | ||
| 24 | RT, CPAN's request tracker | |
| 25 | http://rt.cpan.org/NoAuth/Bugs.html?Dist=AnyEvent-I3 | |
| 26 | ||
| 27 | The i3 window manager website | |
| 28 | http://i3.zekjur.net/ | |
| 29 | ||
| 30 | ||
| 31 | LICENSE AND COPYRIGHT | |
| 32 | ||
| 33 | Copyright (C) 2010 Michael Stapelberg | |
| 34 | ||
| 35 | This program is free software; you can redistribute it and/or modify it | |
| 36 | under the terms of either: the GNU General Public License as published | |
| 37 | by the Free Software Foundation; or the Artistic License. | |
| 38 | ||
| 39 | See http://dev.perl.org/licenses/ for more information. |
| 0 | package AnyEvent::I3; | |
| 1 | # vim:ts=4:sw=4:expandtab | |
| 2 | ||
| 3 | use strict; | |
| 4 | use warnings; | |
| 5 | use JSON::XS; | |
| 6 | use AnyEvent::Handle; | |
| 7 | use AnyEvent::Socket; | |
| 8 | use AnyEvent; | |
| 9 | use Encode; | |
| 10 | use Scalar::Util qw(tainted); | |
| 11 | ||
| 12 | =head1 NAME | |
| 13 | ||
| 14 | AnyEvent::I3 - communicate with the i3 window manager | |
| 15 | ||
| 16 | =cut | |
| 17 | ||
| 18 | our $VERSION = '0.17'; | |
| 19 | ||
| 20 | =head1 VERSION | |
| 21 | ||
| 22 | Version 0.17 | |
| 23 | ||
| 24 | =head1 SYNOPSIS | |
| 25 | ||
| 26 | This module connects to the i3 window manager using the UNIX socket based | |
| 27 | IPC interface it provides (if enabled in the configuration file). You can | |
| 28 | then subscribe to events or send messages and receive their replies. | |
| 29 | ||
| 30 | use AnyEvent::I3 qw(:all); | |
| 31 | ||
| 32 | my $i3 = i3(); | |
| 33 | ||
| 34 | $i3->connect->recv or die "Error connecting"; | |
| 35 | say "Connected to i3"; | |
| 36 | ||
| 37 | my $workspaces = $i3->message(TYPE_GET_WORKSPACES)->recv; | |
| 38 | say "Currently, you use " . @{$workspaces} . " workspaces"; | |
| 39 | ||
| 40 | ...or, using the sugar methods: | |
| 41 | ||
| 42 | use AnyEvent::I3; | |
| 43 | ||
| 44 | my $workspaces = i3->get_workspaces->recv; | |
| 45 | say "Currently, you use " . @{$workspaces} . " workspaces"; | |
| 46 | ||
| 47 | A somewhat more involved example which dumps the i3 layout tree whenever there | |
| 48 | is a workspace event: | |
| 49 | ||
| 50 | use Data::Dumper; | |
| 51 | use AnyEvent; | |
| 52 | use AnyEvent::I3; | |
| 53 | ||
| 54 | my $i3 = i3(); | |
| 55 | ||
| 56 | $i3->connect->recv or die "Error connecting to i3"; | |
| 57 | ||
| 58 | $i3->subscribe({ | |
| 59 | workspace => sub { | |
| 60 | $i3->get_tree->cb(sub { | |
| 61 | my ($tree) = @_; | |
| 62 | say "tree: " . Dumper($tree); | |
| 63 | }); | |
| 64 | } | |
| 65 | })->recv->{success} or die "Error subscribing to events"; | |
| 66 | ||
| 67 | AE::cv->recv | |
| 68 | ||
| 69 | =head1 EXPORT | |
| 70 | ||
| 71 | =head2 $i3 = i3([ $path ]); | |
| 72 | ||
| 73 | Creates a new C<AnyEvent::I3> object and returns it. | |
| 74 | ||
| 75 | C<path> is an optional path of the UNIX socket to connect to. It is strongly | |
| 76 | advised to NOT specify this unless you're absolutely sure you need it. | |
| 77 | C<AnyEvent::I3> will automatically figure it out by querying the running i3 | |
| 78 | instance on the current DISPLAY which is almost always what you want. | |
| 79 | ||
| 80 | =head1 SUBROUTINES/METHODS | |
| 81 | ||
| 82 | =cut | |
| 83 | ||
| 84 | use Exporter qw(import); | |
| 85 | use base 'Exporter'; | |
| 86 | ||
| 87 | our @EXPORT = qw(i3); | |
| 88 | ||
| 89 | use constant TYPE_COMMAND => 0; | |
| 90 | use constant TYPE_GET_WORKSPACES => 1; | |
| 91 | use constant TYPE_SUBSCRIBE => 2; | |
| 92 | use constant TYPE_GET_OUTPUTS => 3; | |
| 93 | use constant TYPE_GET_TREE => 4; | |
| 94 | use constant TYPE_GET_MARKS => 5; | |
| 95 | use constant TYPE_GET_BAR_CONFIG => 6; | |
| 96 | use constant TYPE_GET_VERSION => 7; | |
| 97 | ||
| 98 | our %EXPORT_TAGS = ( 'all' => [ | |
| 99 | qw(i3 TYPE_COMMAND TYPE_GET_WORKSPACES TYPE_SUBSCRIBE TYPE_GET_OUTPUTS | |
| 100 | TYPE_GET_TREE TYPE_GET_MARKS TYPE_GET_BAR_CONFIG TYPE_GET_VERSION) | |
| 101 | ] ); | |
| 102 | ||
| 103 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } ); | |
| 104 | ||
| 105 | my $magic = "i3-ipc"; | |
| 106 | ||
| 107 | # TODO: auto-generate this from the header file? (i3/ipc.h) | |
| 108 | my $event_mask = (1 << 31); | |
| 109 | my %events = ( | |
| 110 | workspace => ($event_mask | 0), | |
| 111 | output => ($event_mask | 1), | |
| 112 | mode => ($event_mask | 2), | |
| 113 | window => ($event_mask | 3), | |
| 114 | barconfig_update => ($event_mask | 4), | |
| 115 | binding => ($event_mask | 5), | |
| 116 | shutdown => ($event_mask | 6), | |
| 117 | _error => 0xFFFFFFFF, | |
| 118 | ); | |
| 119 | ||
| 120 | sub i3 { | |
| 121 | AnyEvent::I3->new(@_) | |
| 122 | } | |
| 123 | ||
| 124 | # Calls i3, even when running in taint mode. | |
| 125 | sub _call_i3 { | |
| 126 | my ($args) = @_; | |
| 127 | ||
| 128 | my $path_tainted = tainted($ENV{PATH}); | |
| 129 | # This effectively circumvents taint mode checking for $ENV{PATH}. We | |
| 130 | # do this because users might specify PATH explicitly to call i3 in a | |
| 131 | # custom location (think ~/.bin/). | |
| 132 | (local $ENV{PATH}) = ($ENV{PATH} =~ /(.*)/); | |
| 133 | ||
| 134 | # In taint mode, we also need to remove all relative directories from | |
| 135 | # PATH (like . or ../bin). We only do this in taint mode and warn the | |
| 136 | # user, since this might break a real-world use case for some people. | |
| 137 | if ($path_tainted) { | |
| 138 | my @dirs = split /:/, $ENV{PATH}; | |
| 139 | my @filtered = grep !/^\./, @dirs; | |
| 140 | if (scalar @dirs != scalar @filtered) { | |
| 141 | $ENV{PATH} = join ':', @filtered; | |
| 142 | warn qq|Removed relative directories from PATH because you | . | |
| 143 | qq|are running Perl with taint mode enabled. Remove -T | . | |
| 144 | qq|to be able to use relative directories in PATH. | . | |
| 145 | qq|New PATH is "$ENV{PATH}"|; | |
| 146 | } | |
| 147 | } | |
| 148 | # Otherwise the qx() operator wont work: | |
| 149 | delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; | |
| 150 | chomp(my $result = qx(i3 $args)); | |
| 151 | # Circumventing taint mode again: the socket can be anywhere on the | |
| 152 | # system and that’s okay. | |
| 153 | if ($result =~ /^([^\0]+)$/) { | |
| 154 | return $1; | |
| 155 | } | |
| 156 | ||
| 157 | warn "Calling i3 $args failed. Is DISPLAY set and is i3 in your PATH?"; | |
| 158 | return undef; | |
| 159 | } | |
| 160 | ||
| 161 | =head2 $i3 = AnyEvent::I3->new([ $path ]) | |
| 162 | ||
| 163 | Creates a new C<AnyEvent::I3> object and returns it. | |
| 164 | ||
| 165 | C<path> is an optional path of the UNIX socket to connect to. It is strongly | |
| 166 | advised to NOT specify this unless you're absolutely sure you need it. | |
| 167 | C<AnyEvent::I3> will automatically figure it out by querying the running i3 | |
| 168 | instance on the current DISPLAY which is almost always what you want. | |
| 169 | ||
| 170 | =cut | |
| 171 | sub new { | |
| 172 | my ($class, $path) = @_; | |
| 173 | ||
| 174 | $path = _call_i3('--get-socketpath') unless $path; | |
| 175 | ||
| 176 | # This is the old default path (v3.*). This fallback line can be removed in | |
| 177 | # a year from now. -- Michael, 2012-07-09 | |
| 178 | $path ||= '~/.i3/ipc.sock'; | |
| 179 | ||
| 180 | # Check if we need to resolve ~ | |
| 181 | if ($path =~ /~/) { | |
| 182 | # We use getpwuid() instead of $ENV{HOME} because the latter is tainted | |
| 183 | # and thus produces warnings when running tests with perl -T | |
| 184 | my $home = (getpwuid($<))[7]; | |
| 185 | die "Could not get home directory" unless $home and -d $home; | |
| 186 | $path =~ s/~/$home/g; | |
| 187 | } | |
| 188 | ||
| 189 | bless { path => $path } => $class; | |
| 190 | } | |
| 191 | ||
| 192 | =head2 $i3->connect | |
| 193 | ||
| 194 | Establishes the connection to i3. Returns an C<AnyEvent::CondVar> which will | |
| 195 | be triggered with a boolean (true if the connection was established) as soon as | |
| 196 | the connection has been established. | |
| 197 | ||
| 198 | if ($i3->connect->recv) { | |
| 199 | say "Connected to i3"; | |
| 200 | } | |
| 201 | ||
| 202 | =cut | |
| 203 | sub connect { | |
| 204 | my ($self) = @_; | |
| 205 | my $cv = AnyEvent->condvar; | |
| 206 | ||
| 207 | tcp_connect "unix/", $self->{path}, sub { | |
| 208 | my ($fh) = @_; | |
| 209 | ||
| 210 | return $cv->send(0) unless $fh; | |
| 211 | ||
| 212 | $self->{ipchdl} = AnyEvent::Handle->new( | |
| 213 | fh => $fh, | |
| 214 | on_read => sub { my ($hdl) = @_; $self->_data_available($hdl) }, | |
| 215 | on_error => sub { | |
| 216 | my ($hdl, $fatal, $msg) = @_; | |
| 217 | delete $self->{ipchdl}; | |
| 218 | $hdl->destroy; | |
| 219 | ||
| 220 | my $cb = $self->{callbacks}; | |
| 221 | ||
| 222 | # Trigger all one-time callbacks with undef | |
| 223 | for my $type (keys %{$cb}) { | |
| 224 | next if ($type & $event_mask) == $event_mask; | |
| 225 | $cb->{$type}->(); | |
| 226 | delete $cb->{$type}; | |
| 227 | } | |
| 228 | ||
| 229 | # Trigger _error callback, if set | |
| 230 | my $type = $events{_error}; | |
| 231 | return unless defined($cb->{$type}); | |
| 232 | $cb->{$type}->($msg); | |
| 233 | } | |
| 234 | ); | |
| 235 | ||
| 236 | $cv->send(1) | |
| 237 | }; | |
| 238 | ||
| 239 | $cv | |
| 240 | } | |
| 241 | ||
| 242 | sub _data_available { | |
| 243 | my ($self, $hdl) = @_; | |
| 244 | ||
| 245 | $hdl->unshift_read( | |
| 246 | chunk => length($magic) + 4 + 4, | |
| 247 | sub { | |
| 248 | my $header = $_[1]; | |
| 249 | # Unpack message length and read the payload | |
| 250 | my ($len, $type) = unpack("LL", substr($header, length($magic))); | |
| 251 | $hdl->unshift_read( | |
| 252 | chunk => $len, | |
| 253 | sub { $self->_handle_i3_message($type, $_[1]) } | |
| 254 | ); | |
| 255 | } | |
| 256 | ); | |
| 257 | } | |
| 258 | ||
| 259 | sub _handle_i3_message { | |
| 260 | my ($self, $type, $payload) = @_; | |
| 261 | ||
| 262 | return unless defined($self->{callbacks}->{$type}); | |
| 263 | ||
| 264 | my $cb = $self->{callbacks}->{$type}; | |
| 265 | $cb->(decode_json $payload); | |
| 266 | ||
| 267 | return if ($type & $event_mask) == $event_mask; | |
| 268 | ||
| 269 | # If this was a one-time callback, we delete it | |
| 270 | # (when connection is lost, all one-time callbacks get triggered) | |
| 271 | delete $self->{callbacks}->{$type}; | |
| 272 | } | |
| 273 | ||
| 274 | =head2 $i3->subscribe(\%callbacks) | |
| 275 | ||
| 276 | Subscribes to the given event types. This function awaits a hashref with the | |
| 277 | key being the name of the event and the value being a callback. | |
| 278 | ||
| 279 | my %callbacks = ( | |
| 280 | workspace => sub { say "Workspaces changed" } | |
| 281 | ); | |
| 282 | ||
| 283 | if ($i3->subscribe(\%callbacks)->recv->{success}) { | |
| 284 | say "Successfully subscribed"; | |
| 285 | } | |
| 286 | ||
| 287 | The special callback with name C<_error> is called when the connection to i3 | |
| 288 | is killed (because of a crash, exit or restart of i3 most likely). You can | |
| 289 | use it to print an appropriate message and exit cleanly or to try to reconnect. | |
| 290 | ||
| 291 | my %callbacks = ( | |
| 292 | _error => sub { | |
| 293 | my ($msg) = @_; | |
| 294 | say "I am sorry. I am so sorry: $msg"; | |
| 295 | exit 1; | |
| 296 | } | |
| 297 | ); | |
| 298 | ||
| 299 | $i3->subscribe(\%callbacks)->recv; | |
| 300 | ||
| 301 | =cut | |
| 302 | sub subscribe { | |
| 303 | my ($self, $callbacks) = @_; | |
| 304 | ||
| 305 | # Register callbacks for each message type | |
| 306 | for my $key (keys %{$callbacks}) { | |
| 307 | my $type = $events{$key}; | |
| 308 | $self->{callbacks}->{$type} = $callbacks->{$key}; | |
| 309 | } | |
| 310 | ||
| 311 | $self->message(TYPE_SUBSCRIBE, [ keys %{$callbacks} ]) | |
| 312 | } | |
| 313 | ||
| 314 | =head2 $i3->message($type, $content) | |
| 315 | ||
| 316 | Sends a message of the specified C<type> to i3, possibly containing the data | |
| 317 | structure C<content> (or C<content>, encoded as utf8, if C<content> is a | |
| 318 | scalar), if specified. | |
| 319 | ||
| 320 | my $reply = $i3->message(TYPE_COMMAND, "reload")->recv; | |
| 321 | if ($reply->{success}) { | |
| 322 | say "Configuration successfully reloaded"; | |
| 323 | } | |
| 324 | ||
| 325 | =cut | |
| 326 | sub message { | |
| 327 | my ($self, $type, $content) = @_; | |
| 328 | ||
| 329 | die "No message type specified" unless defined($type); | |
| 330 | ||
| 331 | die "No connection to i3" unless defined($self->{ipchdl}); | |
| 332 | ||
| 333 | my $payload = ""; | |
| 334 | if ($content) { | |
| 335 | if (not ref($content)) { | |
| 336 | # Convert from Perl’s internal encoding to UTF8 octets | |
| 337 | $payload = encode_utf8($content); | |
| 338 | } else { | |
| 339 | $payload = encode_json $content; | |
| 340 | } | |
| 341 | } | |
| 342 | my $message = $magic . pack("LL", length($payload), $type) . $payload; | |
| 343 | $self->{ipchdl}->push_write($message); | |
| 344 | ||
| 345 | my $cv = AnyEvent->condvar; | |
| 346 | ||
| 347 | # We don’t preserve the old callback as it makes no sense to | |
| 348 | # have a callback on message reply types (only on events) | |
| 349 | $self->{callbacks}->{$type} = | |
| 350 | sub { | |
| 351 | my ($reply) = @_; | |
| 352 | $cv->send($reply); | |
| 353 | undef $self->{callbacks}->{$type}; | |
| 354 | }; | |
| 355 | ||
| 356 | $cv | |
| 357 | } | |
| 358 | ||
| 359 | =head1 SUGAR METHODS | |
| 360 | ||
| 361 | These methods intend to make your scripts as beautiful as possible. All of | |
| 362 | them automatically establish a connection to i3 blockingly (if it does not | |
| 363 | already exist). | |
| 364 | ||
| 365 | =cut | |
| 366 | ||
| 367 | sub _ensure_connection { | |
| 368 | my ($self) = @_; | |
| 369 | ||
| 370 | return if defined($self->{ipchdl}); | |
| 371 | ||
| 372 | $self->connect->recv or die "Unable to connect to i3 (socket path " . $self->{path} . ")"; | |
| 373 | } | |
| 374 | ||
| 375 | =head2 get_workspaces | |
| 376 | ||
| 377 | Gets the current workspaces from i3. | |
| 378 | ||
| 379 | my $ws = i3->get_workspaces->recv; | |
| 380 | say Dumper($ws); | |
| 381 | ||
| 382 | =cut | |
| 383 | sub get_workspaces { | |
| 384 | my ($self) = @_; | |
| 385 | ||
| 386 | $self->_ensure_connection; | |
| 387 | ||
| 388 | $self->message(TYPE_GET_WORKSPACES) | |
| 389 | } | |
| 390 | ||
| 391 | =head2 get_outputs | |
| 392 | ||
| 393 | Gets the current outputs from i3. | |
| 394 | ||
| 395 | my $outs = i3->get_outputs->recv; | |
| 396 | say Dumper($outs); | |
| 397 | ||
| 398 | =cut | |
| 399 | sub get_outputs { | |
| 400 | my ($self) = @_; | |
| 401 | ||
| 402 | $self->_ensure_connection; | |
| 403 | ||
| 404 | $self->message(TYPE_GET_OUTPUTS) | |
| 405 | } | |
| 406 | ||
| 407 | =head2 get_tree | |
| 408 | ||
| 409 | Gets the layout tree from i3 (>= v4.0). | |
| 410 | ||
| 411 | my $tree = i3->get_tree->recv; | |
| 412 | say Dumper($tree); | |
| 413 | ||
| 414 | =cut | |
| 415 | sub get_tree { | |
| 416 | my ($self) = @_; | |
| 417 | ||
| 418 | $self->_ensure_connection; | |
| 419 | ||
| 420 | $self->message(TYPE_GET_TREE) | |
| 421 | } | |
| 422 | ||
| 423 | =head2 get_marks | |
| 424 | ||
| 425 | Gets all the window identifier marks from i3 (>= v4.1). | |
| 426 | ||
| 427 | my $marks = i3->get_marks->recv; | |
| 428 | say Dumper($marks); | |
| 429 | ||
| 430 | =cut | |
| 431 | sub get_marks { | |
| 432 | my ($self) = @_; | |
| 433 | ||
| 434 | $self->_ensure_connection; | |
| 435 | ||
| 436 | $self->message(TYPE_GET_MARKS) | |
| 437 | } | |
| 438 | ||
| 439 | =head2 get_bar_config | |
| 440 | ||
| 441 | Gets the bar configuration for the specific bar id from i3 (>= v4.1). | |
| 442 | ||
| 443 | my $config = i3->get_bar_config($id)->recv; | |
| 444 | say Dumper($config); | |
| 445 | ||
| 446 | =cut | |
| 447 | sub get_bar_config { | |
| 448 | my ($self, $id) = @_; | |
| 449 | ||
| 450 | $self->_ensure_connection; | |
| 451 | ||
| 452 | $self->message(TYPE_GET_BAR_CONFIG, $id) | |
| 453 | } | |
| 454 | ||
| 455 | =head2 get_version | |
| 456 | ||
| 457 | Gets the i3 version via IPC, with a fall-back that parses the output of i3 | |
| 458 | --version (for i3 < v4.3). | |
| 459 | ||
| 460 | my $version = i3->get_version()->recv; | |
| 461 | say "major: " . $version->{major} . ", minor = " . $version->{minor}; | |
| 462 | ||
| 463 | =cut | |
| 464 | sub get_version { | |
| 465 | my ($self) = @_; | |
| 466 | ||
| 467 | $self->_ensure_connection; | |
| 468 | ||
| 469 | my $cv = AnyEvent->condvar; | |
| 470 | ||
| 471 | my $version_cv = $self->message(TYPE_GET_VERSION); | |
| 472 | my $timeout; | |
| 473 | $timeout = AnyEvent->timer( | |
| 474 | after => 1, | |
| 475 | cb => sub { | |
| 476 | warn "Falling back to i3 --version since the running i3 doesn’t support GET_VERSION yet."; | |
| 477 | my $version = _call_i3('--version'); | |
| 478 | $version =~ s/^i3 version //; | |
| 479 | my $patch = 0; | |
| 480 | my ($major, $minor) = ($version =~ /^([0-9]+)\.([0-9]+)/); | |
| 481 | if ($version =~ /^[0-9]+\.[0-9]+\.([0-9]+)/) { | |
| 482 | $patch = $1; | |
| 483 | } | |
| 484 | # Strip everything from the © sign on. | |
| 485 | $version =~ s/ ©.*$//g; | |
| 486 | $cv->send({ | |
| 487 | major => int($major), | |
| 488 | minor => int($minor), | |
| 489 | patch => int($patch), | |
| 490 | human_readable => $version, | |
| 491 | }); | |
| 492 | undef $timeout; | |
| 493 | }, | |
| 494 | ); | |
| 495 | $version_cv->cb(sub { | |
| 496 | undef $timeout; | |
| 497 | $cv->send($version_cv->recv); | |
| 498 | }); | |
| 499 | ||
| 500 | return $cv; | |
| 501 | } | |
| 502 | ||
| 503 | =head2 command($content) | |
| 504 | ||
| 505 | Makes i3 execute the given command | |
| 506 | ||
| 507 | my $reply = i3->command("reload")->recv; | |
| 508 | die "command failed" unless $reply->{success}; | |
| 509 | ||
| 510 | =cut | |
| 511 | sub command { | |
| 512 | my ($self, $content) = @_; | |
| 513 | ||
| 514 | $self->_ensure_connection; | |
| 515 | ||
| 516 | $self->message(TYPE_COMMAND, $content) | |
| 517 | } | |
| 518 | ||
| 519 | =head1 AUTHOR | |
| 520 | ||
| 521 | Michael Stapelberg, C<< <michael at i3wm.org> >> | |
| 522 | ||
| 523 | =head1 BUGS | |
| 524 | ||
| 525 | Please report any bugs or feature requests to C<bug-anyevent-i3 at | |
| 526 | rt.cpan.org>, or through the web interface at | |
| 527 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AnyEvent-I3>. I will be | |
| 528 | notified, and then you'll automatically be notified of progress on your bug as | |
| 529 | I make changes. | |
| 530 | ||
| 531 | =head1 SUPPORT | |
| 532 | ||
| 533 | You can find documentation for this module with the perldoc command. | |
| 534 | ||
| 535 | perldoc AnyEvent::I3 | |
| 536 | ||
| 537 | You can also look for information at: | |
| 538 | ||
| 539 | =over 2 | |
| 540 | ||
| 541 | =item * RT: CPAN's request tracker | |
| 542 | ||
| 543 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=AnyEvent-I3> | |
| 544 | ||
| 545 | =item * The i3 window manager website | |
| 546 | ||
| 547 | L<http://i3wm.org> | |
| 548 | ||
| 549 | =back | |
| 550 | ||
| 551 | ||
| 552 | =head1 ACKNOWLEDGEMENTS | |
| 553 | ||
| 554 | ||
| 555 | =head1 LICENSE AND COPYRIGHT | |
| 556 | ||
| 557 | Copyright 2010-2012 Michael Stapelberg. | |
| 558 | ||
| 559 | This program is free software; you can redistribute it and/or modify it | |
| 560 | under the terms of either: the GNU General Public License as published | |
| 561 | by the Free Software Foundation; or the Artistic License. | |
| 562 | ||
| 563 | See http://dev.perl.org/licenses/ for more information. | |
| 564 | ||
| 565 | ||
| 566 | =cut | |
| 567 | ||
| 568 | 1; # End of AnyEvent::I3 |
| 0 | #!perl -T | |
| 1 | ||
| 2 | use Test::More tests => 1; | |
| 3 | ||
| 4 | BEGIN { | |
| 5 | use_ok( 'AnyEvent::I3' ) || print "Bail out! | |
| 6 | "; | |
| 7 | } | |
| 8 | ||
| 9 | diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" ); |
| 0 | #!perl -T | |
| 1 | # vim:ts=4:sw=4:expandtab | |
| 2 | ||
| 3 | use Test::More tests => 3; | |
| 4 | use AnyEvent::I3; | |
| 5 | use AnyEvent; | |
| 6 | ||
| 7 | my $i3 = i3(); | |
| 8 | my $cv = AnyEvent->condvar; | |
| 9 | ||
| 10 | # Try to connect to i3 | |
| 11 | $i3->connect->cb(sub { my ($v) = @_; $cv->send($v->recv) }); | |
| 12 | ||
| 13 | # But cancel if we are not connected after 0.5 seconds | |
| 14 | my $t = AnyEvent->timer(after => 0.5, cb => sub { $cv->send(0) }); | |
| 15 | my $connected = $cv->recv; | |
| 16 | ||
| 17 | SKIP: { | |
| 18 | skip 'No connection to i3', 3 unless $connected; | |
| 19 | ||
| 20 | my $workspaces = $i3->message(1)->recv; | |
| 21 | isa_ok($workspaces, 'ARRAY'); | |
| 22 | ||
| 23 | ok(@{$workspaces} > 0, 'More than zero workspaces found'); | |
| 24 | ||
| 25 | ok(defined(@{$workspaces}[0]->{num}), 'JSON deserialized'); | |
| 26 | } | |
| 27 | ||
| 28 | diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" ); |
| 0 | #!perl -T | |
| 1 | # vim:ts=4:sw=4:expandtab | |
| 2 | ||
| 3 | use Test::More tests => 3; | |
| 4 | use AnyEvent::I3; | |
| 5 | use AnyEvent; | |
| 6 | ||
| 7 | my $i3 = i3(); | |
| 8 | my $cv = AnyEvent->condvar; | |
| 9 | ||
| 10 | # Try to connect to i3 | |
| 11 | $i3->connect->cb(sub { my ($v) = @_; $cv->send($v->recv) }); | |
| 12 | ||
| 13 | # But cancel if we are not connected after 0.5 seconds | |
| 14 | my $t = AnyEvent->timer(after => 0.5, cb => sub { $cv->send(0) }); | |
| 15 | my $connected = $cv->recv; | |
| 16 | ||
| 17 | SKIP: { | |
| 18 | skip 'No connection to i3', 3 unless $connected; | |
| 19 | ||
| 20 | my $workspaces = i3->get_workspaces->recv; | |
| 21 | isa_ok($workspaces, 'ARRAY'); | |
| 22 | ||
| 23 | ok(@{$workspaces} > 0, 'More than zero workspaces found'); | |
| 24 | ||
| 25 | ok(defined(@{$workspaces}[0]->{num}), 'JSON deserialized'); | |
| 26 | } | |
| 27 | ||
| 28 | diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" ); |
| 0 | #!perl -T | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | use Test::More tests => 3; | |
| 5 | ||
| 6 | sub not_in_file_ok { | |
| 7 | my ($filename, %regex) = @_; | |
| 8 | open( my $fh, '<', $filename ) | |
| 9 | or die "couldn't open $filename for reading: $!"; | |
| 10 | ||
| 11 | my %violated; | |
| 12 | ||
| 13 | while (my $line = <$fh>) { | |
| 14 | while (my ($desc, $regex) = each %regex) { | |
| 15 | if ($line =~ $regex) { | |
| 16 | push @{$violated{$desc}||=[]}, $.; | |
| 17 | } | |
| 18 | } | |
| 19 | } | |
| 20 | ||
| 21 | if (%violated) { | |
| 22 | fail("$filename contains boilerplate text"); | |
| 23 | diag "$_ appears on lines @{$violated{$_}}" for keys %violated; | |
| 24 | } else { | |
| 25 | pass("$filename contains no boilerplate text"); | |
| 26 | } | |
| 27 | } | |
| 28 | ||
| 29 | sub module_boilerplate_ok { | |
| 30 | my ($module) = @_; | |
| 31 | not_in_file_ok($module => | |
| 32 | 'the great new $MODULENAME' => qr/ - The great new /, | |
| 33 | 'boilerplate description' => qr/Quick summary of what the module/, | |
| 34 | 'stub function definition' => qr/function[12]/, | |
| 35 | ); | |
| 36 | } | |
| 37 | ||
| 38 | TODO: { | |
| 39 | local $TODO = "Need to replace the boilerplate text"; | |
| 40 | ||
| 41 | not_in_file_ok(README => | |
| 42 | "The README is used..." => qr/The README is used/, | |
| 43 | "'version information here'" => qr/to provide version information/, | |
| 44 | ); | |
| 45 | ||
| 46 | not_in_file_ok(Changes => | |
| 47 | "placeholder date/time" => qr(Date/time) | |
| 48 | ); | |
| 49 | ||
| 50 | module_boilerplate_ok('lib/AnyEvent/I3.pm'); | |
| 51 | ||
| 52 | ||
| 53 | } | |
| 54 |
| 0 | #!perl -T | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | use Test::More; | |
| 5 | ||
| 6 | unless ( $ENV{RELEASE_TESTING} ) { | |
| 7 | plan( skip_all => "Author tests not required for installation" ); | |
| 8 | } | |
| 9 | ||
| 10 | eval "use Test::CheckManifest 0.9"; | |
| 11 | plan skip_all => "Test::CheckManifest 0.9 required" if $@; | |
| 12 | ok_manifest(); |
| 0 | use strict; | |
| 1 | use warnings; | |
| 2 | use Test::More; | |
| 3 | ||
| 4 | # Ensure a recent version of Test::Pod::Coverage | |
| 5 | my $min_tpc = 1.08; | |
| 6 | eval "use Test::Pod::Coverage $min_tpc"; | |
| 7 | plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" | |
| 8 | if $@; | |
| 9 | ||
| 10 | # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, | |
| 11 | # but older versions don't recognize some common documentation styles | |
| 12 | my $min_pc = 0.18; | |
| 13 | eval "use Pod::Coverage $min_pc"; | |
| 14 | plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" | |
| 15 | if $@; | |
| 16 | ||
| 17 | all_pod_coverage_ok(); |
| 0 | #!perl -T | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | use Test::More; | |
| 5 | ||
| 6 | # Ensure a recent version of Test::Pod | |
| 7 | my $min_tp = 1.22; | |
| 8 | eval "use Test::Pod $min_tp"; | |
| 9 | plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; | |
| 10 | ||
| 11 | all_pod_files_ok(); |
| 0 | Revision history for AnyEvent-I3 | |
| 1 | ||
| 2 | 0.17 2017-04-09 | |
| 3 | ||
| 4 | * support the shutdown event | |
| 5 | * use lib '.' for Perl 5.25.11+ | |
| 6 | ||
| 7 | 0.16 2014-10-03 | |
| 8 | ||
| 9 | * support the barconfig_update and binding event | |
| 10 | ||
| 11 | 0.15 2013-02-18 | |
| 12 | ||
| 13 | * support the window event | |
| 14 | ||
| 15 | 0.14 2012-09-22 | |
| 16 | ||
| 17 | * support the mode event | |
| 18 | ||
| 19 | 0.13 2012-08-05 | |
| 20 | ||
| 21 | * support the GET_VERSION request with a fall-back to i3 --version | |
| 22 | ||
| 23 | 0.12 2012-07-11 | |
| 24 | ||
| 25 | * taint mode fix: remove relative directories from $ENV{PATH} | |
| 26 | ||
| 27 | 0.11 2012-07-10 | |
| 28 | ||
| 29 | * taint mode fix for FreeBSD | |
| 30 | ||
| 31 | 0.10 2012-07-09 | |
| 32 | ||
| 33 | * Use i3 --get-socketpath by default for determining the socket path | |
| 34 | * Bugfix: Also delete callbacks which are triggered due to an error | |
| 35 | ||
| 36 | 0.09 2011-10-12 | |
| 37 | ||
| 38 | * Implement GET_BAR_CONFIG request | |
| 39 | ||
| 40 | 0.08 2011-09-26 | |
| 41 | ||
| 42 | * Implement GET_MARKS request | |
| 43 | * The synopsis mentioned ->workspaces, but it’s ->get_workspaces | |
| 44 | ||
| 45 | 0.07 2010-11-21 | |
| 46 | ||
| 47 | * Implement GET_TREE request | |
| 48 | ||
| 49 | 0.06 2010-06-16 | |
| 50 | ||
| 51 | * Add check to Makefile to abort in a Windows environment (neither i3 nor | |
| 52 | unix sockets available) | |
| 53 | ||
| 54 | 0.05 2010-06-09 | |
| 55 | ||
| 56 | * use getpwuid() to resolve ~ in socket paths instead of glob() | |
| 57 | ||
| 58 | 0.04 2010-03-27 | |
| 59 | ||
| 60 | * use new default ipc-socket path, glob() path, bump version | |
| 61 | ||
| 62 | 0.03 2010-03-26 | |
| 63 | ||
| 64 | * fix MANIFEST | |
| 65 | ||
| 66 | 0.02 2010-03-23 | |
| 67 | ||
| 68 | * first upload to CPAN |
| 0 | Changes | |
| 1 | inc/Module/Install.pm | |
| 2 | inc/Module/Install/Base.pm | |
| 3 | inc/Module/Install/Can.pm | |
| 4 | inc/Module/Install/Fetch.pm | |
| 5 | inc/Module/Install/Makefile.pm | |
| 6 | inc/Module/Install/Metadata.pm | |
| 7 | inc/Module/Install/Win32.pm | |
| 8 | inc/Module/Install/WriteAll.pm | |
| 9 | lib/AnyEvent/I3.pm | |
| 10 | Makefile.PL | |
| 11 | MANIFEST | |
| 12 | MANIFEST.SKIP | |
| 13 | META.yml | |
| 14 | README | |
| 15 | t/00-load.t | |
| 16 | t/01-workspaces.t | |
| 17 | t/02-sugar.t | |
| 18 | t/boilerplate.t | |
| 19 | t/manifest.t | |
| 20 | t/pod-coverage.t | |
| 21 | t/pod.t |
| 0 | ^\.git/ | |
| 1 | \.bak$ | |
| 2 | blib/ | |
| 3 | ^Makefile$ | |
| 4 | ^Makefile.old$ | |
| 5 | Build | |
| 6 | Build.bat | |
| 7 | ^pm_to_blib | |
| 8 | \.tar\.gz$ | |
| 9 | ^pod2htm(.*).tmp$ | |
| 10 | ^AnyEvent-I3- |
| 0 | use lib '.'; | |
| 1 | use inc::Module::Install; | |
| 2 | ||
| 3 | name 'AnyEvent-I3'; | |
| 4 | all_from 'lib/AnyEvent/I3.pm'; | |
| 5 | author 'Michael Stapelberg'; | |
| 6 | ||
| 7 | requires 'AnyEvent'; | |
| 8 | requires 'AnyEvent::Handle'; | |
| 9 | requires 'AnyEvent::Socket'; | |
| 10 | requires 'JSON::XS'; | |
| 11 | ||
| 12 | if ($^O eq 'MSWin32') { | |
| 13 | die "AnyEvent::I3 cannot be used on win32 (unix sockets are missing)"; | |
| 14 | } | |
| 15 | ||
| 16 | WriteAll; |
| 0 | AnyEvent-I3 | |
| 1 | ||
| 2 | This module connects to the i3 window manager using the UNIX socket based | |
| 3 | IPC interface it provides (if enabled in the configuration file). You can | |
| 4 | then subscribe to events or send messages and receive their replies. | |
| 5 | ||
| 6 | INSTALLATION | |
| 7 | ||
| 8 | To install this module, run the following commands: | |
| 9 | ||
| 10 | perl Makefile.PL | |
| 11 | make | |
| 12 | make test | |
| 13 | make install | |
| 14 | ||
| 15 | SUPPORT AND DOCUMENTATION | |
| 16 | ||
| 17 | After installing, you can find documentation for this module with the | |
| 18 | perldoc command. | |
| 19 | ||
| 20 | perldoc AnyEvent::I3 | |
| 21 | ||
| 22 | You can also look for information at: | |
| 23 | ||
| 24 | RT, CPAN's request tracker | |
| 25 | http://rt.cpan.org/NoAuth/Bugs.html?Dist=AnyEvent-I3 | |
| 26 | ||
| 27 | The i3 window manager website | |
| 28 | http://i3.zekjur.net/ | |
| 29 | ||
| 30 | ||
| 31 | LICENSE AND COPYRIGHT | |
| 32 | ||
| 33 | Copyright (C) 2010 Michael Stapelberg | |
| 34 | ||
| 35 | This program is free software; you can redistribute it and/or modify it | |
| 36 | under the terms of either: the GNU General Public License as published | |
| 37 | by the Free Software Foundation; or the Artistic License. | |
| 38 | ||
| 39 | See http://dev.perl.org/licenses/ for more information. |
| 0 | package AnyEvent::I3; | |
| 1 | # vim:ts=4:sw=4:expandtab | |
| 2 | ||
| 3 | use strict; | |
| 4 | use warnings; | |
| 5 | use JSON::XS; | |
| 6 | use AnyEvent::Handle; | |
| 7 | use AnyEvent::Socket; | |
| 8 | use AnyEvent; | |
| 9 | use Encode; | |
| 10 | use Scalar::Util qw(tainted); | |
| 11 | ||
| 12 | =head1 NAME | |
| 13 | ||
| 14 | AnyEvent::I3 - communicate with the i3 window manager | |
| 15 | ||
| 16 | =cut | |
| 17 | ||
| 18 | our $VERSION = '0.17'; | |
| 19 | ||
| 20 | =head1 VERSION | |
| 21 | ||
| 22 | Version 0.17 | |
| 23 | ||
| 24 | =head1 SYNOPSIS | |
| 25 | ||
| 26 | This module connects to the i3 window manager using the UNIX socket based | |
| 27 | IPC interface it provides (if enabled in the configuration file). You can | |
| 28 | then subscribe to events or send messages and receive their replies. | |
| 29 | ||
| 30 | use AnyEvent::I3 qw(:all); | |
| 31 | ||
| 32 | my $i3 = i3(); | |
| 33 | ||
| 34 | $i3->connect->recv or die "Error connecting"; | |
| 35 | say "Connected to i3"; | |
| 36 | ||
| 37 | my $workspaces = $i3->message(TYPE_GET_WORKSPACES)->recv; | |
| 38 | say "Currently, you use " . @{$workspaces} . " workspaces"; | |
| 39 | ||
| 40 | ...or, using the sugar methods: | |
| 41 | ||
| 42 | use AnyEvent::I3; | |
| 43 | ||
| 44 | my $workspaces = i3->get_workspaces->recv; | |
| 45 | say "Currently, you use " . @{$workspaces} . " workspaces"; | |
| 46 | ||
| 47 | A somewhat more involved example which dumps the i3 layout tree whenever there | |
| 48 | is a workspace event: | |
| 49 | ||
| 50 | use Data::Dumper; | |
| 51 | use AnyEvent; | |
| 52 | use AnyEvent::I3; | |
| 53 | ||
| 54 | my $i3 = i3(); | |
| 55 | ||
| 56 | $i3->connect->recv or die "Error connecting to i3"; | |
| 57 | ||
| 58 | $i3->subscribe({ | |
| 59 | workspace => sub { | |
| 60 | $i3->get_tree->cb(sub { | |
| 61 | my ($tree) = @_; | |
| 62 | say "tree: " . Dumper($tree); | |
| 63 | }); | |
| 64 | } | |
| 65 | })->recv->{success} or die "Error subscribing to events"; | |
| 66 | ||
| 67 | AE::cv->recv | |
| 68 | ||
| 69 | =head1 EXPORT | |
| 70 | ||
| 71 | =head2 $i3 = i3([ $path ]); | |
| 72 | ||
| 73 | Creates a new C<AnyEvent::I3> object and returns it. | |
| 74 | ||
| 75 | C<path> is an optional path of the UNIX socket to connect to. It is strongly | |
| 76 | advised to NOT specify this unless you're absolutely sure you need it. | |
| 77 | C<AnyEvent::I3> will automatically figure it out by querying the running i3 | |
| 78 | instance on the current DISPLAY which is almost always what you want. | |
| 79 | ||
| 80 | =head1 SUBROUTINES/METHODS | |
| 81 | ||
| 82 | =cut | |
| 83 | ||
| 84 | use Exporter qw(import); | |
| 85 | use base 'Exporter'; | |
| 86 | ||
| 87 | our @EXPORT = qw(i3); | |
| 88 | ||
| 89 | use constant TYPE_COMMAND => 0; | |
| 90 | use constant TYPE_GET_WORKSPACES => 1; | |
| 91 | use constant TYPE_SUBSCRIBE => 2; | |
| 92 | use constant TYPE_GET_OUTPUTS => 3; | |
| 93 | use constant TYPE_GET_TREE => 4; | |
| 94 | use constant TYPE_GET_MARKS => 5; | |
| 95 | use constant TYPE_GET_BAR_CONFIG => 6; | |
| 96 | use constant TYPE_GET_VERSION => 7; | |
| 97 | ||
| 98 | our %EXPORT_TAGS = ( 'all' => [ | |
| 99 | qw(i3 TYPE_COMMAND TYPE_GET_WORKSPACES TYPE_SUBSCRIBE TYPE_GET_OUTPUTS | |
| 100 | TYPE_GET_TREE TYPE_GET_MARKS TYPE_GET_BAR_CONFIG TYPE_GET_VERSION) | |
| 101 | ] ); | |
| 102 | ||
| 103 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } ); | |
| 104 | ||
| 105 | my $magic = "i3-ipc"; | |
| 106 | ||
| 107 | # TODO: auto-generate this from the header file? (i3/ipc.h) | |
| 108 | my $event_mask = (1 << 31); | |
| 109 | my %events = ( | |
| 110 | workspace => ($event_mask | 0), | |
| 111 | output => ($event_mask | 1), | |
| 112 | mode => ($event_mask | 2), | |
| 113 | window => ($event_mask | 3), | |
| 114 | barconfig_update => ($event_mask | 4), | |
| 115 | binding => ($event_mask | 5), | |
| 116 | shutdown => ($event_mask | 6), | |
| 117 | _error => 0xFFFFFFFF, | |
| 118 | ); | |
| 119 | ||
| 120 | sub i3 { | |
| 121 | AnyEvent::I3->new(@_) | |
| 122 | } | |
| 123 | ||
| 124 | # Calls i3, even when running in taint mode. | |
| 125 | sub _call_i3 { | |
| 126 | my ($args) = @_; | |
| 127 | ||
| 128 | my $path_tainted = tainted($ENV{PATH}); | |
| 129 | # This effectively circumvents taint mode checking for $ENV{PATH}. We | |
| 130 | # do this because users might specify PATH explicitly to call i3 in a | |
| 131 | # custom location (think ~/.bin/). | |
| 132 | (local $ENV{PATH}) = ($ENV{PATH} =~ /(.*)/); | |
| 133 | ||
| 134 | # In taint mode, we also need to remove all relative directories from | |
| 135 | # PATH (like . or ../bin). We only do this in taint mode and warn the | |
| 136 | # user, since this might break a real-world use case for some people. | |
| 137 | if ($path_tainted) { | |
| 138 | my @dirs = split /:/, $ENV{PATH}; | |
| 139 | my @filtered = grep !/^\./, @dirs; | |
| 140 | if (scalar @dirs != scalar @filtered) { | |
| 141 | $ENV{PATH} = join ':', @filtered; | |
| 142 | warn qq|Removed relative directories from PATH because you | . | |
| 143 | qq|are running Perl with taint mode enabled. Remove -T | . | |
| 144 | qq|to be able to use relative directories in PATH. | . | |
| 145 | qq|New PATH is "$ENV{PATH}"|; | |
| 146 | } | |
| 147 | } | |
| 148 | # Otherwise the qx() operator wont work: | |
| 149 | delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; | |
| 150 | chomp(my $result = qx(i3 $args)); | |
| 151 | # Circumventing taint mode again: the socket can be anywhere on the | |
| 152 | # system and that’s okay. | |
| 153 | if ($result =~ /^([^\0]+)$/) { | |
| 154 | return $1; | |
| 155 | } | |
| 156 | ||
| 157 | warn "Calling i3 $args failed. Is DISPLAY set and is i3 in your PATH?"; | |
| 158 | return undef; | |
| 159 | } | |
| 160 | ||
| 161 | =head2 $i3 = AnyEvent::I3->new([ $path ]) | |
| 162 | ||
| 163 | Creates a new C<AnyEvent::I3> object and returns it. | |
| 164 | ||
| 165 | C<path> is an optional path of the UNIX socket to connect to. It is strongly | |
| 166 | advised to NOT specify this unless you're absolutely sure you need it. | |
| 167 | C<AnyEvent::I3> will automatically figure it out by querying the running i3 | |
| 168 | instance on the current DISPLAY which is almost always what you want. | |
| 169 | ||
| 170 | =cut | |
| 171 | sub new { | |
| 172 | my ($class, $path) = @_; | |
| 173 | ||
| 174 | $path = _call_i3('--get-socketpath') unless $path; | |
| 175 | ||
| 176 | # This is the old default path (v3.*). This fallback line can be removed in | |
| 177 | # a year from now. -- Michael, 2012-07-09 | |
| 178 | $path ||= '~/.i3/ipc.sock'; | |
| 179 | ||
| 180 | # Check if we need to resolve ~ | |
| 181 | if ($path =~ /~/) { | |
| 182 | # We use getpwuid() instead of $ENV{HOME} because the latter is tainted | |
| 183 | # and thus produces warnings when running tests with perl -T | |
| 184 | my $home = (getpwuid($<))[7]; | |
| 185 | die "Could not get home directory" unless $home and -d $home; | |
| 186 | $path =~ s/~/$home/g; | |
| 187 | } | |
| 188 | ||
| 189 | bless { path => $path } => $class; | |
| 190 | } | |
| 191 | ||
| 192 | =head2 $i3->connect | |
| 193 | ||
| 194 | Establishes the connection to i3. Returns an C<AnyEvent::CondVar> which will | |
| 195 | be triggered with a boolean (true if the connection was established) as soon as | |
| 196 | the connection has been established. | |
| 197 | ||
| 198 | if ($i3->connect->recv) { | |
| 199 | say "Connected to i3"; | |
| 200 | } | |
| 201 | ||
| 202 | =cut | |
| 203 | sub connect { | |
| 204 | my ($self) = @_; | |
| 205 | my $cv = AnyEvent->condvar; | |
| 206 | ||
| 207 | tcp_connect "unix/", $self->{path}, sub { | |
| 208 | my ($fh) = @_; | |
| 209 | ||
| 210 | return $cv->send(0) unless $fh; | |
| 211 | ||
| 212 | $self->{ipchdl} = AnyEvent::Handle->new( | |
| 213 | fh => $fh, | |
| 214 | on_read => sub { my ($hdl) = @_; $self->_data_available($hdl) }, | |
| 215 | on_error => sub { | |
| 216 | my ($hdl, $fatal, $msg) = @_; | |
| 217 | delete $self->{ipchdl}; | |
| 218 | $hdl->destroy; | |
| 219 | ||
| 220 | my $cb = $self->{callbacks}; | |
| 221 | ||
| 222 | # Trigger all one-time callbacks with undef | |
| 223 | for my $type (keys %{$cb}) { | |
| 224 | next if ($type & $event_mask) == $event_mask; | |
| 225 | $cb->{$type}->(); | |
| 226 | delete $cb->{$type}; | |
| 227 | } | |
| 228 | ||
| 229 | # Trigger _error callback, if set | |
| 230 | my $type = $events{_error}; | |
| 231 | return unless defined($cb->{$type}); | |
| 232 | $cb->{$type}->($msg); | |
| 233 | } | |
| 234 | ); | |
| 235 | ||
| 236 | $cv->send(1) | |
| 237 | }; | |
| 238 | ||
| 239 | $cv | |
| 240 | } | |
| 241 | ||
| 242 | sub _data_available { | |
| 243 | my ($self, $hdl) = @_; | |
| 244 | ||
| 245 | $hdl->unshift_read( | |
| 246 | chunk => length($magic) + 4 + 4, | |
| 247 | sub { | |
| 248 | my $header = $_[1]; | |
| 249 | # Unpack message length and read the payload | |
| 250 | my ($len, $type) = unpack("LL", substr($header, length($magic))); | |
| 251 | $hdl->unshift_read( | |
| 252 | chunk => $len, | |
| 253 | sub { $self->_handle_i3_message($type, $_[1]) } | |
| 254 | ); | |
| 255 | } | |
| 256 | ); | |
| 257 | } | |
| 258 | ||
| 259 | sub _handle_i3_message { | |
| 260 | my ($self, $type, $payload) = @_; | |
| 261 | ||
| 262 | return unless defined($self->{callbacks}->{$type}); | |
| 263 | ||
| 264 | my $cb = $self->{callbacks}->{$type}; | |
| 265 | $cb->(decode_json $payload); | |
| 266 | ||
| 267 | return if ($type & $event_mask) == $event_mask; | |
| 268 | ||
| 269 | # If this was a one-time callback, we delete it | |
| 270 | # (when connection is lost, all one-time callbacks get triggered) | |
| 271 | delete $self->{callbacks}->{$type}; | |
| 272 | } | |
| 273 | ||
| 274 | =head2 $i3->subscribe(\%callbacks) | |
| 275 | ||
| 276 | Subscribes to the given event types. This function awaits a hashref with the | |
| 277 | key being the name of the event and the value being a callback. | |
| 278 | ||
| 279 | my %callbacks = ( | |
| 280 | workspace => sub { say "Workspaces changed" } | |
| 281 | ); | |
| 282 | ||
| 283 | if ($i3->subscribe(\%callbacks)->recv->{success}) { | |
| 284 | say "Successfully subscribed"; | |
| 285 | } | |
| 286 | ||
| 287 | The special callback with name C<_error> is called when the connection to i3 | |
| 288 | is killed (because of a crash, exit or restart of i3 most likely). You can | |
| 289 | use it to print an appropriate message and exit cleanly or to try to reconnect. | |
| 290 | ||
| 291 | my %callbacks = ( | |
| 292 | _error => sub { | |
| 293 | my ($msg) = @_; | |
| 294 | say "I am sorry. I am so sorry: $msg"; | |
| 295 | exit 1; | |
| 296 | } | |
| 297 | ); | |
| 298 | ||
| 299 | $i3->subscribe(\%callbacks)->recv; | |
| 300 | ||
| 301 | =cut | |
| 302 | sub subscribe { | |
| 303 | my ($self, $callbacks) = @_; | |
| 304 | ||
| 305 | # Register callbacks for each message type | |
| 306 | for my $key (keys %{$callbacks}) { | |
| 307 | my $type = $events{$key}; | |
| 308 | $self->{callbacks}->{$type} = $callbacks->{$key}; | |
| 309 | } | |
| 310 | ||
| 311 | $self->message(TYPE_SUBSCRIBE, [ keys %{$callbacks} ]) | |
| 312 | } | |
| 313 | ||
| 314 | =head2 $i3->message($type, $content) | |
| 315 | ||
| 316 | Sends a message of the specified C<type> to i3, possibly containing the data | |
| 317 | structure C<content> (or C<content>, encoded as utf8, if C<content> is a | |
| 318 | scalar), if specified. | |
| 319 | ||
| 320 | my $reply = $i3->message(TYPE_COMMAND, "reload")->recv; | |
| 321 | if ($reply->{success}) { | |
| 322 | say "Configuration successfully reloaded"; | |
| 323 | } | |
| 324 | ||
| 325 | =cut | |
| 326 | sub message { | |
| 327 | my ($self, $type, $content) = @_; | |
| 328 | ||
| 329 | die "No message type specified" unless defined($type); | |
| 330 | ||
| 331 | die "No connection to i3" unless defined($self->{ipchdl}); | |
| 332 | ||
| 333 | my $payload = ""; | |
| 334 | if ($content) { | |
| 335 | if (not ref($content)) { | |
| 336 | # Convert from Perl’s internal encoding to UTF8 octets | |
| 337 | $payload = encode_utf8($content); | |
| 338 | } else { | |
| 339 | $payload = encode_json $content; | |
| 340 | } | |
| 341 | } | |
| 342 | my $message = $magic . pack("LL", length($payload), $type) . $payload; | |
| 343 | $self->{ipchdl}->push_write($message); | |
| 344 | ||
| 345 | my $cv = AnyEvent->condvar; | |
| 346 | ||
| 347 | # We don’t preserve the old callback as it makes no sense to | |
| 348 | # have a callback on message reply types (only on events) | |
| 349 | $self->{callbacks}->{$type} = | |
| 350 | sub { | |
| 351 | my ($reply) = @_; | |
| 352 | $cv->send($reply); | |
| 353 | undef $self->{callbacks}->{$type}; | |
| 354 | }; | |
| 355 | ||
| 356 | $cv | |
| 357 | } | |
| 358 | ||
| 359 | =head1 SUGAR METHODS | |
| 360 | ||
| 361 | These methods intend to make your scripts as beautiful as possible. All of | |
| 362 | them automatically establish a connection to i3 blockingly (if it does not | |
| 363 | already exist). | |
| 364 | ||
| 365 | =cut | |
| 366 | ||
| 367 | sub _ensure_connection { | |
| 368 | my ($self) = @_; | |
| 369 | ||
| 370 | return if defined($self->{ipchdl}); | |
| 371 | ||
| 372 | $self->connect->recv or die "Unable to connect to i3 (socket path " . $self->{path} . ")"; | |
| 373 | } | |
| 374 | ||
| 375 | =head2 get_workspaces | |
| 376 | ||
| 377 | Gets the current workspaces from i3. | |
| 378 | ||
| 379 | my $ws = i3->get_workspaces->recv; | |
| 380 | say Dumper($ws); | |
| 381 | ||
| 382 | =cut | |
| 383 | sub get_workspaces { | |
| 384 | my ($self) = @_; | |
| 385 | ||
| 386 | $self->_ensure_connection; | |
| 387 | ||
| 388 | $self->message(TYPE_GET_WORKSPACES) | |
| 389 | } | |
| 390 | ||
| 391 | =head2 get_outputs | |
| 392 | ||
| 393 | Gets the current outputs from i3. | |
| 394 | ||
| 395 | my $outs = i3->get_outputs->recv; | |
| 396 | say Dumper($outs); | |
| 397 | ||
| 398 | =cut | |
| 399 | sub get_outputs { | |
| 400 | my ($self) = @_; | |
| 401 | ||
| 402 | $self->_ensure_connection; | |
| 403 | ||
| 404 | $self->message(TYPE_GET_OUTPUTS) | |
| 405 | } | |
| 406 | ||
| 407 | =head2 get_tree | |
| 408 | ||
| 409 | Gets the layout tree from i3 (>= v4.0). | |
| 410 | ||
| 411 | my $tree = i3->get_tree->recv; | |
| 412 | say Dumper($tree); | |
| 413 | ||
| 414 | =cut | |
| 415 | sub get_tree { | |
| 416 | my ($self) = @_; | |
| 417 | ||
| 418 | $self->_ensure_connection; | |
| 419 | ||
| 420 | $self->message(TYPE_GET_TREE) | |
| 421 | } | |
| 422 | ||
| 423 | =head2 get_marks | |
| 424 | ||
| 425 | Gets all the window identifier marks from i3 (>= v4.1). | |
| 426 | ||
| 427 | my $marks = i3->get_marks->recv; | |
| 428 | say Dumper($marks); | |
| 429 | ||
| 430 | =cut | |
| 431 | sub get_marks { | |
| 432 | my ($self) = @_; | |
| 433 | ||
| 434 | $self->_ensure_connection; | |
| 435 | ||
| 436 | $self->message(TYPE_GET_MARKS) | |
| 437 | } | |
| 438 | ||
| 439 | =head2 get_bar_config | |
| 440 | ||
| 441 | Gets the bar configuration for the specific bar id from i3 (>= v4.1). | |
| 442 | ||
| 443 | my $config = i3->get_bar_config($id)->recv; | |
| 444 | say Dumper($config); | |
| 445 | ||
| 446 | =cut | |
| 447 | sub get_bar_config { | |
| 448 | my ($self, $id) = @_; | |
| 449 | ||
| 450 | $self->_ensure_connection; | |
| 451 | ||
| 452 | $self->message(TYPE_GET_BAR_CONFIG, $id) | |
| 453 | } | |
| 454 | ||
| 455 | =head2 get_version | |
| 456 | ||
| 457 | Gets the i3 version via IPC, with a fall-back that parses the output of i3 | |
| 458 | --version (for i3 < v4.3). | |
| 459 | ||
| 460 | my $version = i3->get_version()->recv; | |
| 461 | say "major: " . $version->{major} . ", minor = " . $version->{minor}; | |
| 462 | ||
| 463 | =cut | |
| 464 | sub get_version { | |
| 465 | my ($self) = @_; | |
| 466 | ||
| 467 | $self->_ensure_connection; | |
| 468 | ||
| 469 | my $cv = AnyEvent->condvar; | |
| 470 | ||
| 471 | my $version_cv = $self->message(TYPE_GET_VERSION); | |
| 472 | my $timeout; | |
| 473 | $timeout = AnyEvent->timer( | |
| 474 | after => 1, | |
| 475 | cb => sub { | |
| 476 | warn "Falling back to i3 --version since the running i3 doesn’t support GET_VERSION yet."; | |
| 477 | my $version = _call_i3('--version'); | |
| 478 | $version =~ s/^i3 version //; | |
| 479 | my $patch = 0; | |
| 480 | my ($major, $minor) = ($version =~ /^([0-9]+)\.([0-9]+)/); | |
| 481 | if ($version =~ /^[0-9]+\.[0-9]+\.([0-9]+)/) { | |
| 482 | $patch = $1; | |
| 483 | } | |
| 484 | # Strip everything from the © sign on. | |
| 485 | $version =~ s/ ©.*$//g; | |
| 486 | $cv->send({ | |
| 487 | major => int($major), | |
| 488 | minor => int($minor), | |
| 489 | patch => int($patch), | |
| 490 | human_readable => $version, | |
| 491 | }); | |
| 492 | undef $timeout; | |
| 493 | }, | |
| 494 | ); | |
| 495 | $version_cv->cb(sub { | |
| 496 | undef $timeout; | |
| 497 | $cv->send($version_cv->recv); | |
| 498 | }); | |
| 499 | ||
| 500 | return $cv; | |
| 501 | } | |
| 502 | ||
| 503 | =head2 command($content) | |
| 504 | ||
| 505 | Makes i3 execute the given command | |
| 506 | ||
| 507 | my $reply = i3->command("reload")->recv; | |
| 508 | die "command failed" unless $reply->{success}; | |
| 509 | ||
| 510 | =cut | |
| 511 | sub command { | |
| 512 | my ($self, $content) = @_; | |
| 513 | ||
| 514 | $self->_ensure_connection; | |
| 515 | ||
| 516 | $self->message(TYPE_COMMAND, $content) | |
| 517 | } | |
| 518 | ||
| 519 | =head1 AUTHOR | |
| 520 | ||
| 521 | Michael Stapelberg, C<< <michael at i3wm.org> >> | |
| 522 | ||
| 523 | =head1 BUGS | |
| 524 | ||
| 525 | Please report any bugs or feature requests to C<bug-anyevent-i3 at | |
| 526 | rt.cpan.org>, or through the web interface at | |
| 527 | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AnyEvent-I3>. I will be | |
| 528 | notified, and then you'll automatically be notified of progress on your bug as | |
| 529 | I make changes. | |
| 530 | ||
| 531 | =head1 SUPPORT | |
| 532 | ||
| 533 | You can find documentation for this module with the perldoc command. | |
| 534 | ||
| 535 | perldoc AnyEvent::I3 | |
| 536 | ||
| 537 | You can also look for information at: | |
| 538 | ||
| 539 | =over 2 | |
| 540 | ||
| 541 | =item * RT: CPAN's request tracker | |
| 542 | ||
| 543 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=AnyEvent-I3> | |
| 544 | ||
| 545 | =item * The i3 window manager website | |
| 546 | ||
| 547 | L<http://i3wm.org> | |
| 548 | ||
| 549 | =back | |
| 550 | ||
| 551 | ||
| 552 | =head1 ACKNOWLEDGEMENTS | |
| 553 | ||
| 554 | ||
| 555 | =head1 LICENSE AND COPYRIGHT | |
| 556 | ||
| 557 | Copyright 2010-2012 Michael Stapelberg. | |
| 558 | ||
| 559 | This program is free software; you can redistribute it and/or modify it | |
| 560 | under the terms of either: the GNU General Public License as published | |
| 561 | by the Free Software Foundation; or the Artistic License. | |
| 562 | ||
| 563 | See http://dev.perl.org/licenses/ for more information. | |
| 564 | ||
| 565 | ||
| 566 | =cut | |
| 567 | ||
| 568 | 1; # End of AnyEvent::I3 |
| 0 | #!perl -T | |
| 1 | ||
| 2 | use Test::More tests => 1; | |
| 3 | ||
| 4 | BEGIN { | |
| 5 | use_ok( 'AnyEvent::I3' ) || print "Bail out! | |
| 6 | "; | |
| 7 | } | |
| 8 | ||
| 9 | diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" ); |
| 0 | #!perl -T | |
| 1 | # vim:ts=4:sw=4:expandtab | |
| 2 | ||
| 3 | use Test::More tests => 3; | |
| 4 | use AnyEvent::I3; | |
| 5 | use AnyEvent; | |
| 6 | ||
| 7 | my $i3 = i3(); | |
| 8 | my $cv = AnyEvent->condvar; | |
| 9 | ||
| 10 | # Try to connect to i3 | |
| 11 | $i3->connect->cb(sub { my ($v) = @_; $cv->send($v->recv) }); | |
| 12 | ||
| 13 | # But cancel if we are not connected after 0.5 seconds | |
| 14 | my $t = AnyEvent->timer(after => 0.5, cb => sub { $cv->send(0) }); | |
| 15 | my $connected = $cv->recv; | |
| 16 | ||
| 17 | SKIP: { | |
| 18 | skip 'No connection to i3', 3 unless $connected; | |
| 19 | ||
| 20 | my $workspaces = $i3->message(1)->recv; | |
| 21 | isa_ok($workspaces, 'ARRAY'); | |
| 22 | ||
| 23 | ok(@{$workspaces} > 0, 'More than zero workspaces found'); | |
| 24 | ||
| 25 | ok(defined(@{$workspaces}[0]->{num}), 'JSON deserialized'); | |
| 26 | } | |
| 27 | ||
| 28 | diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" ); |
| 0 | #!perl -T | |
| 1 | # vim:ts=4:sw=4:expandtab | |
| 2 | ||
| 3 | use Test::More tests => 3; | |
| 4 | use AnyEvent::I3; | |
| 5 | use AnyEvent; | |
| 6 | ||
| 7 | my $i3 = i3(); | |
| 8 | my $cv = AnyEvent->condvar; | |
| 9 | ||
| 10 | # Try to connect to i3 | |
| 11 | $i3->connect->cb(sub { my ($v) = @_; $cv->send($v->recv) }); | |
| 12 | ||
| 13 | # But cancel if we are not connected after 0.5 seconds | |
| 14 | my $t = AnyEvent->timer(after => 0.5, cb => sub { $cv->send(0) }); | |
| 15 | my $connected = $cv->recv; | |
| 16 | ||
| 17 | SKIP: { | |
| 18 | skip 'No connection to i3', 3 unless $connected; | |
| 19 | ||
| 20 | my $workspaces = i3->get_workspaces->recv; | |
| 21 | isa_ok($workspaces, 'ARRAY'); | |
| 22 | ||
| 23 | ok(@{$workspaces} > 0, 'More than zero workspaces found'); | |
| 24 | ||
| 25 | ok(defined(@{$workspaces}[0]->{num}), 'JSON deserialized'); | |
| 26 | } | |
| 27 | ||
| 28 | diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" ); |
| 0 | #!perl -T | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | use Test::More tests => 3; | |
| 5 | ||
| 6 | sub not_in_file_ok { | |
| 7 | my ($filename, %regex) = @_; | |
| 8 | open( my $fh, '<', $filename ) | |
| 9 | or die "couldn't open $filename for reading: $!"; | |
| 10 | ||
| 11 | my %violated; | |
| 12 | ||
| 13 | while (my $line = <$fh>) { | |
| 14 | while (my ($desc, $regex) = each %regex) { | |
| 15 | if ($line =~ $regex) { | |
| 16 | push @{$violated{$desc}||=[]}, $.; | |
| 17 | } | |
| 18 | } | |
| 19 | } | |
| 20 | ||
| 21 | if (%violated) { | |
| 22 | fail("$filename contains boilerplate text"); | |
| 23 | diag "$_ appears on lines @{$violated{$_}}" for keys %violated; | |
| 24 | } else { | |
| 25 | pass("$filename contains no boilerplate text"); | |
| 26 | } | |
| 27 | } | |
| 28 | ||
| 29 | sub module_boilerplate_ok { | |
| 30 | my ($module) = @_; | |
| 31 | not_in_file_ok($module => | |
| 32 | 'the great new $MODULENAME' => qr/ - The great new /, | |
| 33 | 'boilerplate description' => qr/Quick summary of what the module/, | |
| 34 | 'stub function definition' => qr/function[12]/, | |
| 35 | ); | |
| 36 | } | |
| 37 | ||
| 38 | TODO: { | |
| 39 | local $TODO = "Need to replace the boilerplate text"; | |
| 40 | ||
| 41 | not_in_file_ok(README => | |
| 42 | "The README is used..." => qr/The README is used/, | |
| 43 | "'version information here'" => qr/to provide version information/, | |
| 44 | ); | |
| 45 | ||
| 46 | not_in_file_ok(Changes => | |
| 47 | "placeholder date/time" => qr(Date/time) | |
| 48 | ); | |
| 49 | ||
| 50 | module_boilerplate_ok('lib/AnyEvent/I3.pm'); | |
| 51 | ||
| 52 | ||
| 53 | } | |
| 54 |
| 0 | #!perl -T | |
| 1 | ||
| 2 | use strict; | |
| 3 | use warnings; | |
| 4 | use Test::More; | |
| 5 | ||
| 6 | unless ( $ENV{RELEASE_TESTING} ) { | |
| 7 | plan( skip_all => "Author tests not required for installation" ); | |
| 8 | } | |
| 9 | ||
| 10 | eval "use Test::CheckManifest 0.9"; | |
| 11 | plan skip_all => "Test::CheckManifest 0.9 required" if $@; | |
| 12 | ok_manifest(); |
| 0 | use strict; | |
| 1 | use warnings; | |
| 2 | use Test::More; | |
| 3 | ||
| 4 | # Ensure a recent version of Test::Pod::Coverage | |
| 5 | my $min_tpc = 1.08; | |
| 6 | eval "use Test::Pod::Coverage $min_tpc"; | |
| 7 | plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" | |
| 8 | if $@; | |
| 9 | ||
| 10 | # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, | |
| 11 | # but older versions don't recognize some common documentation styles | |
| 12 | my $min_pc = 0.18; | |
| 13 | eval "use Pod::Coverage $min_pc"; | |
| 14 | plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" | |
| 15 | if $@; | |
| 16 | ||
| 17 | all_pod_coverage_ok(); |