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