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