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