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