view release on metacpan or  search on metacpan

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

    # This effectively circumvents taint mode checking for $ENV{PATH}. We
    # do this because users might specify PATH explicitly to call i3 in a
    # custom location (think ~/.bin/).
    (local $ENV{PATH}) = ($ENV{PATH} =~ /(.*)/);

    # In taint mode, we also need to remove all relative directories from
    # PATH (like . or ../bin). We only do this in taint mode and warn the
    # user, since this might break a real-world use case for some people.
    if ($path_tainted) {
        my @dirs = split /:/, $ENV{PATH};
        my @filtered = grep !/^\./, @dirs;
        if (scalar @dirs != scalar @filtered) {
            $ENV{PATH} = join ':', @filtered;
            warn qq|Removed relative directories from PATH because you | .
                 qq|are running Perl with taint mode enabled. Remove -T | .
                 qq|to be able to use relative directories in PATH. | .
                 qq|New PATH is "$ENV{PATH}"|;
        }
    }
    # Otherwise the qx() operator wont work:
    delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
    chomp(my $result = qx(i3 $args));
    # Circumventing taint mode again: the socket can be anywhere on the
    # system and that’s okay.
    if ($result =~ /^([^\0]+)$/) {
        return $1;
    }

    warn "Calling i3 $args failed. Is DISPLAY set and is i3 in your PATH?";
    return undef;
}

=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