view release on metacpan or  search on metacpan

lib/AnyEvent/I3.pm  view on Meta::CPAN

=head2 $i3 = AnyEvent::I3->new([ $path ])

Creates a new C<AnyEvent::I3> object and returns it.

C<path> is an optional path of the UNIX socket to connect to. It is strongly
advised to NOT specify this unless you're absolutely sure you need it.
C<AnyEvent::I3> will automatically figure it out by querying the running i3
instance on the current DISPLAY which is almost always what you want.

=cut
sub new {
    my ($class, $path) = @_;

    $path = _call_i3('--get-socketpath') unless $path;

    # This is the old default path (v3.*). This fallback line can be removed in
    # a year from now. -- Michael, 2012-07-09
    $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];
        confess "Could not get home directory" unless $home and -d $home;
        $path =~ s/~/$home/g;
    }

    bless { path => $path } => $class;
}

=head2 $i3->connect

Establishes the connection to i3. Returns an C<AnyEvent::CondVar> which will
be triggered with a boolean (true if the connection was established) as soon as
the connection has been established.

    if ($i3->connect->recv) {
        say "Connected to i3";
    }

=cut
sub connect {
    my ($self) = @_;
    my $cv = AnyEvent->condvar;

    tcp_connect "unix/", $self->{path}, sub {
        my ($fh) = @_;

        return $cv->send(0) unless $fh;

        $self->{ipchdl} = AnyEvent::Handle->new(
            fh => $fh,
            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}->();
                    delete $cb->{$type};
                }

                # Trigger _error callback, if set
                my $type = $events{_error};
                return unless defined($cb->{$type});
                $cb->{$type}->($msg);
            }
        );

        $cv->send(1)
    };

    $cv
}

sub _data_available {
    my ($self, $hdl) = @_;

    $hdl->unshift_read(
        chunk => length($magic) + 4 + 4,
        sub {
            my $header = $_[1];
            # Unpack message length and read the payload
            my ($len, $type) = unpack("LL", substr($header, length($magic)));
            $hdl->unshift_read(
                chunk => $len,
                sub { $self->_handle_i3_message($type, $_[1]) }
            );
        }
    );
}

sub _handle_i3_message {
    my ($self, $type, $payload) = @_;

    return unless defined($self->{callbacks}->{$type});

    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)

Subscribes to the given event types. This function awaits a hashref with the
key being the name of the event and the value being a callback.

    my %callbacks = (
        workspace => sub { say "Workspaces changed" }
    );

    if ($i3->subscribe(\%callbacks)->recv->{success}) {
        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) = @_;

    # Register callbacks for each message type
    for my $key (keys %{$callbacks}) {
        if (!exists $events{$key}) {
            warn "Could not subscribe to event type '$key'." .
            " Supported events are " . join(" ", sort keys %events), $/;
            next;
        }
        my $type = $events{$key};
        $self->{callbacks}->{$type} = $callbacks->{$key};
    }

    $self->message(TYPE_SUBSCRIBE, [ keys %{$callbacks} ])
}

=head2 $i3->message($type, $content)

Sends a message of the specified C<type> to i3, possibly containing the data
structure C<content> (or C<content>, encoded as utf8, if C<content> is a
scalar), if specified.

    my $reply = $i3->message(TYPE_RUN_COMMAND, "reload")->recv;
    if ($reply->{success}) {
        say "Configuration successfully reloaded";
    }

=cut
sub message {
    my ($self, $type, $content) = @_;

    confess "No message type specified" unless defined($type);

    confess "No connection to i3" unless defined($self->{ipchdl});

    my $payload = "";
    if ($content) {
        if (not ref($content)) {
            # Convert from Perl’s internal encoding to UTF8 octets
            $payload = encode_utf8($content);
        } else {
            $payload = encode_json $content;
        }
    }
    my $message = $magic . pack("LL", length($payload), $type) . $payload;
    $self->{ipchdl}->push_write($message);

    my $cv = AnyEvent->condvar;

    # We don’t preserve the old callback as it makes no sense to
    # have a callback on message reply types (only on events)
    $self->{callbacks}->{$type} =
        sub {
            my ($reply) = @_;
            $cv->send($reply);
            undef $self->{callbacks}->{$type};
        };

    $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 confess "Unable to connect to i3 (socket path " . $self->{path} . ")";
}

=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);