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
  12 =head1 NAME
  13
  14 AnyEvent::I3 - communicate with the i3 window manager
  15
  16 =cut
  17
  18 our $VERSION = '0.07';
  19
  20 =head1 VERSION
  21
  22 Version 0.07
  23
  24 =head1 SYNOPSIS
  25
  26 This module connects to the i3 window manager using the UNIX socket based
  27 IPC interface it provides (if enabled in the configuration file). You can
  28 then subscribe to events or send messages and receive their replies.
  29
  30     use AnyEvent::I3 qw(:all);
  31
  32     my $i3 = i3("~/.i3/ipc.sock");
  33
  34     $i3->connect->recv or die "Error connecting";
  35     say "Connected to i3";
  36
  37     my $workspaces = $i3->message(TYPE_GET_WORKSPACES)->recv;
  38     say "Currently, you use " . @{$workspaces} . " workspaces";
  39
  40 ...or, using the sugar methods:
  41
  42     use AnyEvent::I3;
  43
  44     my $workspaces = i3->get_workspaces->recv;
  45     say "Currently, you use " . @{$workspaces} . " workspaces";
  46
  47 =head1 EXPORT
  48
  49 =head2 $i3 = i3([ $path ]);
  50
  51 Creates a new C<AnyEvent::I3> object and returns it. C<path> is the path of
  52 the UNIX socket to connect to.
  53
  54 =head1 SUBROUTINES/METHODS
  55
  56 =cut
  57
  58 use Exporter qw(import);
  59 use base 'Exporter';
  60
  61 our @EXPORT = qw(i3);
  62
  63 use constant TYPE_COMMAND => 0;
  64 use constant TYPE_GET_WORKSPACES => 1;
  65 use constant TYPE_SUBSCRIBE => 2;
  66 use constant TYPE_GET_OUTPUTS => 3;
  67 use constant TYPE_GET_TREE => 4;
  68
  69 our %EXPORT_TAGS = ( 'all' => [
  70     qw(i3 TYPE_COMMAND TYPE_GET_WORKSPACES TYPE_SUBSCRIBE TYPE_GET_OUTPUTS TYPE_GET_TREE)
  71 ] );
  72
  73 our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } );
  74
  75 my $magic = "i3-ipc";
  76
  77 # TODO: auto-generate this from the header file? (i3/ipc.h)
  78 my $event_mask = (1 << 31);
  79 my %events = (
  80     workspace => ($event_mask | 0),
  81     output => ($event_mask | 1),
  82     _error => 0xFFFFFFFF,
  83 );
  84
  85 sub i3 {
  86     AnyEvent::I3->new(@_)
  87 }
  88
  89 =head2 $i3 = AnyEvent::I3->new([ $path ])
  90
  91 Creates a new C<AnyEvent::I3> object and returns it. C<path> is the path of
  92 the UNIX socket to connect to.
  93
  94 =cut
  95 sub new {
  96     my ($class, $path) = @_;
  97
  98     $path ||= '~/.i3/ipc.sock';
  99
 100     # Check if we need to resolve ~
 101     if ($path =~ /~/) {
 102         # We use getpwuid() instead of $ENV{HOME} because the latter is tainted
 103         # and thus produces warnings when running tests with perl -T
 104         my $home = (getpwuid($<))[7];
 105         die "Could not get home directory" unless $home and -d $home;
 106         $path =~ s/~/$home/g;
 107     }
 108
 109     bless { path => $path } => $class;
 110 }
 111
 112 =head2 $i3->connect
 113
 114 Establishes the connection to i3. Returns an C<AnyEvent::CondVar> which will
 115 be triggered with a boolean (true if the connection was established) as soon as
 116 the connection has been established.
 117
 118     if ($i3->connect->recv) {
 119         say "Connected to i3";
 120     }
 121
 122 =cut
 123 sub connect {
 124     my ($self) = @_;
 125     my $cv = AnyEvent->condvar;
 126
 127     tcp_connect "unix/", $self->{path}, sub {
 128         my ($fh) = @_;
 129
 130         return $cv->send(0) unless $fh;
 131
 132         $self->{ipchdl} = AnyEvent::Handle->new(
 133             fh => $fh,
 134             on_read => sub { my ($hdl) = @_; $self->_data_available($hdl) },
 135             on_error => sub {
 136                 my ($hdl, $fatal, $msg) = @_;
 137                 delete $self->{ipchdl};
 138                 $hdl->destroy;
 139
 140                 my $cb = $self->{callbacks};
 141
 142                 # Trigger all one-time callbacks with undef
 143                 for my $type (keys %{$cb}) {
 144                     next if ($type & $event_mask) == $event_mask;
 145                     $cb->{$type}->();
 146                 }
 147
 148                 # Trigger _error callback, if set
 149                 my $type = $events{_error};
 150                 return unless defined($cb->{$type});
 151                 $cb->{$type}->($msg);
 152             }
 153         );
 154
 155         $cv->send(1)
 156     };
 157
 158     $cv
 159 }
 160
 161 sub _data_available {
 162     my ($self, $hdl) = @_;
 163
 164     $hdl->unshift_read(
 165         chunk => length($magic) + 4 + 4,
 166         sub {
 167             my $header = $_[1];
 168             # Unpack message length and read the payload
 169             my ($len, $type) = unpack("LL", substr($header, length($magic)));
 170             $hdl->unshift_read(
 171                 chunk => $len,
 172                 sub { $self->_handle_i3_message($type, $_[1]) }
 173             );
 174         }
 175     );
 176 }
 177
 178 sub _handle_i3_message {
 179     my ($self, $type, $payload) = @_;
 180
 181     return unless defined($self->{callbacks}->{$type});
 182
 183     my $cb = $self->{callbacks}->{$type};
 184     $cb->(decode_json $payload);
 185
 186     return if ($type & $event_mask) == $event_mask;
 187
 188     # If this was a one-time callback, we delete it
 189     # (when connection is lost, all one-time callbacks get triggered)
 190     delete $self->{callbacks}->{$type};
 191 }
 192
 193 =head2 $i3->subscribe(\%callbacks)
 194
 195 Subscribes to the given event types. This function awaits a hashref with the
 196 key being the name of the event and the value being a callback.
 197
 198     my %callbacks = (
 199         workspace => sub { say "Workspaces changed" }
 200     );
 201
 202     if ($i3->subscribe(\%callbacks)->recv->{success})
 203         say "Successfully subscribed";
 204     }
 205
 206 The special callback with name C<_error> is called when the connection to i3
 207 is killed (because of a crash, exit or restart of i3 most likely). You can
 208 use it to print an appropriate message and exit cleanly or to try to reconnect.
 209
 210     my %callbacks = (
 211         _error => sub {
 212             my ($msg) = @_;
 213             say "I am sorry. I am so sorry: $msg";
 214             exit 1;
 215         }
 216     );
 217
 218     $i3->subscribe(\%callbacks)->recv;
 219
 220 =cut
 221 sub subscribe {
 222     my ($self, $callbacks) = @_;
 223
 224     # Register callbacks for each message type
 225     for my $key (keys %{$callbacks}) {
 226         my $type = $events{$key};
 227         $self->{callbacks}->{$type} = $callbacks->{$key};
 228     }
 229
 230     $self->message(TYPE_SUBSCRIBE, [ keys %{$callbacks} ])
 231 }
 232
 233 =head2 $i3->message($type, $content)
 234
 235 Sends a message of the specified C<type> to i3, possibly containing the data
 236 structure C<content> (or C<content>, encoded as utf8, if C<content> is a
 237 scalar), if specified.
 238
 239     my $reply = $i3->message(TYPE_COMMAND, "reload")->recv;
 240     if ($reply->{success}) {
 241         say "Configuration successfully reloaded";
 242     }
 243
 244 =cut
 245 sub message {
 246     my ($self, $type, $content) = @_;
 247
 248     die "No message type specified" unless defined($type);
 249
 250     die "No connection to i3" unless defined($self->{ipchdl});
 251
 252     my $payload = "";
 253     if ($content) {
 254         if (not ref($content)) {
 255             # Convert from Perl’s internal encoding to UTF8 octets
 256             $payload = encode_utf8($content);
 257         } else {
 258             $payload = encode_json $content;
 259         }
 260     }
 261     my $message = $magic . pack("LL", length($payload), $type) . $payload;
 262     $self->{ipchdl}->push_write($message);
 263
 264     my $cv = AnyEvent->condvar;
 265
 266     # We don’t preserve the old callback as it makes no sense to
 267     # have a callback on message reply types (only on events)
 268     $self->{callbacks}->{$type} =
 269         sub {
 270             my ($reply) = @_;
 271             $cv->send($reply);
 272             undef $self->{callbacks}->{$type};
 273         };
 274
 275     $cv
 276 }
 277
 278 =head1 SUGAR METHODS
 279
 280 These methods intend to make your scripts as beautiful as possible. All of
 281 them automatically establish a connection to i3 blockingly (if it does not
 282 already exist).
 283
 284 =cut
 285
 286 sub _ensure_connection {
 287     my ($self) = @_;
 288
 289     return if defined($self->{ipchdl});
 290
 291     $self->connect->recv or die "Unable to connect to i3"
 292 }
 293
 294 =head2 get_workspaces
 295
 296 Gets the current workspaces from i3.
 297
 298     my $ws = i3->get_workspaces->recv;
 299     say Dumper($ws);
 300
 301 =cut
 302 sub get_workspaces {
 303     my ($self) = @_;
 304
 305     $self->_ensure_connection;
 306
 307     $self->message(TYPE_GET_WORKSPACES)
 308 }
 309
 310 =head2 get_outputs
 311
 312 Gets the current outputs from i3.
 313
 314     my $outs = i3->get_outputs->recv;
 315     say Dumper($outs);
 316
 317 =cut
 318 sub get_outputs {
 319     my ($self) = @_;
 320
 321     $self->_ensure_connection;
 322
 323     $self->message(TYPE_GET_OUTPUTS)
 324 }
 325
 326 =head2 get_tree
 327
 328 Gets the layout tree from i3 (tree branch only).
 329
 330     my $tree = i3->get_tree->recv;
 331     say Dumper($tree);
 332
 333 =cut
 334 sub get_tree {
 335     my ($self) = @_;
 336
 337     $self->_ensure_connection;
 338
 339     $self->message(TYPE_GET_TREE)
 340 }
 341
 342
 343 =head2 command($content)
 344
 345 Makes i3 execute the given command
 346
 347     my $reply = i3->command("reload")->recv;
 348     die "command failed" unless $reply->{success};
 349
 350 =cut
 351 sub command {
 352     my ($self, $content) = @_;
 353
 354     $self->_ensure_connection;
 355
 356     $self->message(TYPE_COMMAND, $content)
 357 }
 358
 359 =head1 AUTHOR
 360
 361 Michael Stapelberg, C<< <michael at stapelberg.de> >>
 362
 363 =head1 BUGS
 364
 365 Please report any bugs or feature requests to C<bug-anyevent-i3 at
 366 rt.cpan.org>, or through the web interface at
 367 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AnyEvent-I3>.  I will be
 368 notified, and then you'll automatically be notified of progress on your bug as
 369 I make changes.
 370
 371 =head1 SUPPORT
 372
 373 You can find documentation for this module with the perldoc command.
 374
 375     perldoc AnyEvent::I3
 376
 377 You can also look for information at:
 378
 379 =over 2
 380
 381 =item * RT: CPAN's request tracker
 382
 383 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=AnyEvent-I3>
 384
 385 =item * The i3 window manager website
 386
 387 L<http://i3.zekjur.net/>
 388
 389 =back
 390
 391
 392 =head1 ACKNOWLEDGEMENTS
 393
 394
 395 =head1 LICENSE AND COPYRIGHT
 396
 397 Copyright 2010 Michael Stapelberg.
 398
 399 This program is free software; you can redistribute it and/or modify it
 400 under the terms of either: the GNU General Public License as published
 401 by the Free Software Foundation; or the Artistic License.
 402
 403 See http://dev.perl.org/licenses/ for more information.
 404
 405
 406 =cut
 407
 408 1; # End of AnyEvent::I3