git.sur5r.net Git - i3/i3/blob - lib/AnyEvent/I3.pm

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