]> git.sur5r.net Git - i3/i3/blobdiff - lib/AnyEvent/I3.pm
Fix documentation for get_marks (s/tree/marks)
[i3/i3] / lib / AnyEvent / I3.pm
index d763357cf412d46bbad12c3fc5db1f5ad77e8139..3977e652adfae74ebb7f203ab7fcb99b07371d71 100644 (file)
@@ -15,11 +15,11 @@ AnyEvent::I3 - communicate with the i3 window manager
 
 =cut
 
-our $VERSION = '0.01';
+our $VERSION = '0.08';
 
 =head1 VERSION
 
-Version 0.01
+Version 0.08
 
 =head1 SYNOPSIS
 
@@ -29,14 +29,21 @@ then subscribe to events or send messages and receive their replies.
 
     use AnyEvent::I3 qw(:all);
 
-    my $i3 = i3("/tmp/i3-ipc.sock");
+    my $i3 = i3("~/.i3/ipc.sock");
 
-    $i3->connect->recv;
+    $i3->connect->recv or die "Error connecting";
     say "Connected to i3";
 
     my $workspaces = $i3->message(TYPE_GET_WORKSPACES)->recv;
     say "Currently, you use " . @{$workspaces} . " workspaces";
 
+...or, using the sugar methods:
+
+    use AnyEvent::I3;
+
+    my $workspaces = i3->get_workspaces->recv;
+    say "Currently, you use " . @{$workspaces} . " workspaces";
+
 =head1 EXPORT
 
 =head2 $i3 = i3([ $path ]);
@@ -57,9 +64,11 @@ use constant TYPE_COMMAND => 0;
 use constant TYPE_GET_WORKSPACES => 1;
 use constant TYPE_SUBSCRIBE => 2;
 use constant TYPE_GET_OUTPUTS => 3;
+use constant TYPE_GET_TREE => 4;
+use constant TYPE_GET_MARKS => 5;
 
 our %EXPORT_TAGS = ( 'all' => [
-    qw(i3 TYPE_COMMAND TYPE_GET_WORKSPACES TYPE_SUBSCRIBE TYPE_GET_OUTPUTS)
+    qw(i3 TYPE_COMMAND TYPE_GET_WORKSPACES TYPE_SUBSCRIBE TYPE_GET_OUTPUTS TYPE_GET_TREE TYPE_GET_MARKS)
 ] );
 
 our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } );
@@ -71,6 +80,7 @@ my $event_mask = (1 << 31);
 my %events = (
     workspace => ($event_mask | 0),
     output => ($event_mask | 1),
+    _error => 0xFFFFFFFF,
 );
 
 sub i3 {
@@ -86,7 +96,16 @@ the UNIX socket to connect to.
 sub new {
     my ($class, $path) = @_;
 
-    $path ||= '/tmp/i3-ipc.sock';
+    $path ||= '~/.i3/ipc.sock';
+
+    # Check if we need to resolve ~
+    if ($path =~ /~/) {
+        # We use getpwuid() instead of $ENV{HOME} because the latter is tainted
+        # and thus produces warnings when running tests with perl -T
+        my $home = (getpwuid($<))[7];
+        die "Could not get home directory" unless $home and -d $home;
+        $path =~ s/~/$home/g;
+    }
 
     bless { path => $path } => $class;
 }
@@ -113,7 +132,25 @@ sub connect {
 
         $self->{ipchdl} = AnyEvent::Handle->new(
             fh => $fh,
-            on_read => sub { my ($hdl) = @_; $self->_data_available($hdl) }
+            on_read => sub { my ($hdl) = @_; $self->_data_available($hdl) },
+            on_error => sub {
+                my ($hdl, $fatal, $msg) = @_;
+                delete $self->{ipchdl};
+                $hdl->destroy;
+
+                my $cb = $self->{callbacks};
+
+                # Trigger all one-time callbacks with undef
+                for my $type (keys %{$cb}) {
+                    next if ($type & $event_mask) == $event_mask;
+                    $cb->{$type}->();
+                }
+
+                # Trigger _error callback, if set
+                my $type = $events{_error};
+                return unless defined($cb->{$type});
+                $cb->{$type}->($msg);
+            }
         );
 
         $cv->send(1)
@@ -146,6 +183,12 @@ sub _handle_i3_message {
 
     my $cb = $self->{callbacks}->{$type};
     $cb->(decode_json $payload);
+
+    return if ($type & $event_mask) == $event_mask;
+
+    # If this was a one-time callback, we delete it
+    # (when connection is lost, all one-time callbacks get triggered)
+    delete $self->{callbacks}->{$type};
 }
 
 =head2 $i3->subscribe(\%callbacks)
@@ -161,6 +204,20 @@ key being the name of the event and the value being a callback.
         say "Successfully subscribed";
     }
 
+The special callback with name C<_error> is called when the connection to i3
+is killed (because of a crash, exit or restart of i3 most likely). You can
+use it to print an appropriate message and exit cleanly or to try to reconnect.
+
+    my %callbacks = (
+        _error => sub {
+            my ($msg) = @_;
+            say "I am sorry. I am so sorry: $msg";
+            exit 1;
+        }
+    );
+
+    $i3->subscribe(\%callbacks)->recv;
+
 =cut
 sub subscribe {
     my ($self, $callbacks) = @_;
@@ -191,6 +248,8 @@ sub message {
 
     die "No message type specified" unless defined($type);
 
+    die "No connection to i3" unless defined($self->{ipchdl});
+
     my $payload = "";
     if ($content) {
         if (not ref($content)) {
@@ -217,6 +276,102 @@ sub message {
     $cv
 }
 
+=head1 SUGAR METHODS
+
+These methods intend to make your scripts as beautiful as possible. All of
+them automatically establish a connection to i3 blockingly (if it does not
+already exist).
+
+=cut
+
+sub _ensure_connection {
+    my ($self) = @_;
+
+    return if defined($self->{ipchdl});
+
+    $self->connect->recv or die "Unable to connect to i3"
+}
+
+=head2 get_workspaces
+
+Gets the current workspaces from i3.
+
+    my $ws = i3->get_workspaces->recv;
+    say Dumper($ws);
+
+=cut
+sub get_workspaces {
+    my ($self) = @_;
+
+    $self->_ensure_connection;
+
+    $self->message(TYPE_GET_WORKSPACES)
+}
+
+=head2 get_outputs
+
+Gets the current outputs from i3.
+
+    my $outs = i3->get_outputs->recv;
+    say Dumper($outs);
+
+=cut
+sub get_outputs {
+    my ($self) = @_;
+
+    $self->_ensure_connection;
+
+    $self->message(TYPE_GET_OUTPUTS)
+}
+
+=head2 get_tree
+
+Gets the layout tree from i3 (>= v4.0).
+
+    my $tree = i3->get_tree->recv;
+    say Dumper($tree);
+
+=cut
+sub get_tree {
+    my ($self) = @_;
+
+    $self->_ensure_connection;
+
+    $self->message(TYPE_GET_TREE)
+}
+
+=head2 get_marks
+
+Gets all the window identifier marks from i3 (>= v4.1).
+
+    my $marks = i3->get_marks->recv;
+    say Dumper($marks);
+
+=cut
+sub get_marks {
+    my ($self) = @_;
+
+    $self->_ensure_connection;
+
+    $self->message(TYPE_GET_MARKS)
+}
+
+=head2 command($content)
+
+Makes i3 execute the given command
+
+    my $reply = i3->command("reload")->recv;
+    die "command failed" unless $reply->{success};
+
+=cut
+sub command {
+    my ($self, $content) = @_;
+
+    $self->_ensure_connection;
+
+    $self->message(TYPE_COMMAND, $content)
+}
+
 =head1 AUTHOR
 
 Michael Stapelberg, C<< <michael at stapelberg.de> >>