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.16';
  20
  21 =head1 VERSION
  22
  23 Version 0.16
  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     mode => ($event_mask | 2),
 114     window => ($event_mask | 3),
 115     barconfig_update => ($event_mask | 4),
 116     binding => ($event_mask | 5),
 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