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