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