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