Merge pull request #2860 from stapelberg/anyevent-i3
Merge the AnyEvent-I3 repository into i3/AnyEvent-I3
This commit is contained in:
commit
af24f07020
|
@ -0,0 +1,69 @@
|
||||||
|
Revision history for AnyEvent-I3
|
||||||
|
|
||||||
|
0.17 2017-04-09
|
||||||
|
|
||||||
|
* support the shutdown event
|
||||||
|
* use lib '.' for Perl 5.25.11+
|
||||||
|
|
||||||
|
0.16 2014-10-03
|
||||||
|
|
||||||
|
* support the barconfig_update and binding event
|
||||||
|
|
||||||
|
0.15 2013-02-18
|
||||||
|
|
||||||
|
* support the window event
|
||||||
|
|
||||||
|
0.14 2012-09-22
|
||||||
|
|
||||||
|
* support the mode event
|
||||||
|
|
||||||
|
0.13 2012-08-05
|
||||||
|
|
||||||
|
* support the GET_VERSION request with a fall-back to i3 --version
|
||||||
|
|
||||||
|
0.12 2012-07-11
|
||||||
|
|
||||||
|
* taint mode fix: remove relative directories from $ENV{PATH}
|
||||||
|
|
||||||
|
0.11 2012-07-10
|
||||||
|
|
||||||
|
* taint mode fix for FreeBSD
|
||||||
|
|
||||||
|
0.10 2012-07-09
|
||||||
|
|
||||||
|
* Use i3 --get-socketpath by default for determining the socket path
|
||||||
|
* Bugfix: Also delete callbacks which are triggered due to an error
|
||||||
|
|
||||||
|
0.09 2011-10-12
|
||||||
|
|
||||||
|
* Implement GET_BAR_CONFIG request
|
||||||
|
|
||||||
|
0.08 2011-09-26
|
||||||
|
|
||||||
|
* Implement GET_MARKS request
|
||||||
|
* The synopsis mentioned ->workspaces, but it’s ->get_workspaces
|
||||||
|
|
||||||
|
0.07 2010-11-21
|
||||||
|
|
||||||
|
* Implement GET_TREE request
|
||||||
|
|
||||||
|
0.06 2010-06-16
|
||||||
|
|
||||||
|
* Add check to Makefile to abort in a Windows environment (neither i3 nor
|
||||||
|
unix sockets available)
|
||||||
|
|
||||||
|
0.05 2010-06-09
|
||||||
|
|
||||||
|
* use getpwuid() to resolve ~ in socket paths instead of glob()
|
||||||
|
|
||||||
|
0.04 2010-03-27
|
||||||
|
|
||||||
|
* use new default ipc-socket path, glob() path, bump version
|
||||||
|
|
||||||
|
0.03 2010-03-26
|
||||||
|
|
||||||
|
* fix MANIFEST
|
||||||
|
|
||||||
|
0.02 2010-03-23
|
||||||
|
|
||||||
|
* first upload to CPAN
|
|
@ -0,0 +1,22 @@
|
||||||
|
Changes
|
||||||
|
inc/Module/Install.pm
|
||||||
|
inc/Module/Install/Base.pm
|
||||||
|
inc/Module/Install/Can.pm
|
||||||
|
inc/Module/Install/Fetch.pm
|
||||||
|
inc/Module/Install/Makefile.pm
|
||||||
|
inc/Module/Install/Metadata.pm
|
||||||
|
inc/Module/Install/Win32.pm
|
||||||
|
inc/Module/Install/WriteAll.pm
|
||||||
|
lib/AnyEvent/I3.pm
|
||||||
|
Makefile.PL
|
||||||
|
MANIFEST
|
||||||
|
MANIFEST.SKIP
|
||||||
|
META.yml
|
||||||
|
README
|
||||||
|
t/00-load.t
|
||||||
|
t/01-workspaces.t
|
||||||
|
t/02-sugar.t
|
||||||
|
t/boilerplate.t
|
||||||
|
t/manifest.t
|
||||||
|
t/pod-coverage.t
|
||||||
|
t/pod.t
|
|
@ -0,0 +1,11 @@
|
||||||
|
^\.git/
|
||||||
|
\.bak$
|
||||||
|
blib/
|
||||||
|
^Makefile$
|
||||||
|
^Makefile.old$
|
||||||
|
Build
|
||||||
|
Build.bat
|
||||||
|
^pm_to_blib
|
||||||
|
\.tar\.gz$
|
||||||
|
^pod2htm(.*).tmp$
|
||||||
|
^AnyEvent-I3-
|
|
@ -0,0 +1,17 @@
|
||||||
|
use lib '.';
|
||||||
|
use inc::Module::Install;
|
||||||
|
|
||||||
|
name 'AnyEvent-I3';
|
||||||
|
all_from 'lib/AnyEvent/I3.pm';
|
||||||
|
author 'Michael Stapelberg';
|
||||||
|
|
||||||
|
requires 'AnyEvent';
|
||||||
|
requires 'AnyEvent::Handle';
|
||||||
|
requires 'AnyEvent::Socket';
|
||||||
|
requires 'JSON::XS';
|
||||||
|
|
||||||
|
if ($^O eq 'MSWin32') {
|
||||||
|
die "AnyEvent::I3 cannot be used on win32 (unix sockets are missing)";
|
||||||
|
}
|
||||||
|
|
||||||
|
WriteAll;
|
|
@ -0,0 +1,40 @@
|
||||||
|
AnyEvent-I3
|
||||||
|
|
||||||
|
This module connects to the i3 window manager using the UNIX socket based
|
||||||
|
IPC interface it provides (if enabled in the configuration file). You can
|
||||||
|
then subscribe to events or send messages and receive their replies.
|
||||||
|
|
||||||
|
INSTALLATION
|
||||||
|
|
||||||
|
To install this module, run the following commands:
|
||||||
|
|
||||||
|
perl Makefile.PL
|
||||||
|
make
|
||||||
|
make test
|
||||||
|
make install
|
||||||
|
|
||||||
|
SUPPORT AND DOCUMENTATION
|
||||||
|
|
||||||
|
After installing, you can find documentation for this module with the
|
||||||
|
perldoc command.
|
||||||
|
|
||||||
|
perldoc AnyEvent::I3
|
||||||
|
|
||||||
|
You can also look for information at:
|
||||||
|
|
||||||
|
RT, CPAN's request tracker
|
||||||
|
http://rt.cpan.org/NoAuth/Bugs.html?Dist=AnyEvent-I3
|
||||||
|
|
||||||
|
The i3 window manager website
|
||||||
|
http://i3.zekjur.net/
|
||||||
|
|
||||||
|
|
||||||
|
LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
Copyright (C) 2010 Michael Stapelberg
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or modify it
|
||||||
|
under the terms of either: the GNU General Public License as published
|
||||||
|
by the Free Software Foundation; or the Artistic License.
|
||||||
|
|
||||||
|
See http://dev.perl.org/licenses/ for more information.
|
|
@ -0,0 +1,569 @@
|
||||||
|
package AnyEvent::I3;
|
||||||
|
# vim:ts=4:sw=4:expandtab
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use JSON::XS;
|
||||||
|
use AnyEvent::Handle;
|
||||||
|
use AnyEvent::Socket;
|
||||||
|
use AnyEvent;
|
||||||
|
use Encode;
|
||||||
|
use Scalar::Util qw(tainted);
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
AnyEvent::I3 - communicate with the i3 window manager
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
our $VERSION = '0.17';
|
||||||
|
|
||||||
|
=head1 VERSION
|
||||||
|
|
||||||
|
Version 0.17
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
This module connects to the i3 window manager using the UNIX socket based
|
||||||
|
IPC interface it provides (if enabled in the configuration file). You can
|
||||||
|
then subscribe to events or send messages and receive their replies.
|
||||||
|
|
||||||
|
use AnyEvent::I3 qw(:all);
|
||||||
|
|
||||||
|
my $i3 = i3();
|
||||||
|
|
||||||
|
$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";
|
||||||
|
|
||||||
|
A somewhat more involved example which dumps the i3 layout tree whenever there
|
||||||
|
is a workspace event:
|
||||||
|
|
||||||
|
use Data::Dumper;
|
||||||
|
use AnyEvent;
|
||||||
|
use AnyEvent::I3;
|
||||||
|
|
||||||
|
my $i3 = i3();
|
||||||
|
|
||||||
|
$i3->connect->recv or die "Error connecting to i3";
|
||||||
|
|
||||||
|
$i3->subscribe({
|
||||||
|
workspace => sub {
|
||||||
|
$i3->get_tree->cb(sub {
|
||||||
|
my ($tree) = @_;
|
||||||
|
say "tree: " . Dumper($tree);
|
||||||
|
});
|
||||||
|
}
|
||||||
|
})->recv->{success} or die "Error subscribing to events";
|
||||||
|
|
||||||
|
AE::cv->recv
|
||||||
|
|
||||||
|
=head1 EXPORT
|
||||||
|
|
||||||
|
=head2 $i3 = i3([ $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.
|
||||||
|
|
||||||
|
=head1 SUBROUTINES/METHODS
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
use Exporter qw(import);
|
||||||
|
use base 'Exporter';
|
||||||
|
|
||||||
|
our @EXPORT = qw(i3);
|
||||||
|
|
||||||
|
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;
|
||||||
|
use constant TYPE_GET_BAR_CONFIG => 6;
|
||||||
|
use constant TYPE_GET_VERSION => 7;
|
||||||
|
|
||||||
|
our %EXPORT_TAGS = ( 'all' => [
|
||||||
|
qw(i3 TYPE_COMMAND TYPE_GET_WORKSPACES TYPE_SUBSCRIBE TYPE_GET_OUTPUTS
|
||||||
|
TYPE_GET_TREE TYPE_GET_MARKS TYPE_GET_BAR_CONFIG TYPE_GET_VERSION)
|
||||||
|
] );
|
||||||
|
|
||||||
|
our @EXPORT_OK = ( @{ $EXPORT_TAGS{all} } );
|
||||||
|
|
||||||
|
my $magic = "i3-ipc";
|
||||||
|
|
||||||
|
# TODO: auto-generate this from the header file? (i3/ipc.h)
|
||||||
|
my $event_mask = (1 << 31);
|
||||||
|
my %events = (
|
||||||
|
workspace => ($event_mask | 0),
|
||||||
|
output => ($event_mask | 1),
|
||||||
|
mode => ($event_mask | 2),
|
||||||
|
window => ($event_mask | 3),
|
||||||
|
barconfig_update => ($event_mask | 4),
|
||||||
|
binding => ($event_mask | 5),
|
||||||
|
shutdown => ($event_mask | 6),
|
||||||
|
_error => 0xFFFFFFFF,
|
||||||
|
);
|
||||||
|
|
||||||
|
sub i3 {
|
||||||
|
AnyEvent::I3->new(@_)
|
||||||
|
}
|
||||||
|
|
||||||
|
# Calls i3, even when running in taint mode.
|
||||||
|
sub _call_i3 {
|
||||||
|
my ($args) = @_;
|
||||||
|
|
||||||
|
my $path_tainted = tainted($ENV{PATH});
|
||||||
|
# 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];
|
||||||
|
die "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}) {
|
||||||
|
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_COMMAND, "reload")->recv;
|
||||||
|
if ($reply->{success}) {
|
||||||
|
say "Configuration successfully reloaded";
|
||||||
|
}
|
||||||
|
|
||||||
|
=cut
|
||||||
|
sub message {
|
||||||
|
my ($self, $type, $content) = @_;
|
||||||
|
|
||||||
|
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)) {
|
||||||
|
# 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 die "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);
|
||||||
|
|
||||||
|
=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 get_bar_config
|
||||||
|
|
||||||
|
Gets the bar configuration for the specific bar id from i3 (>= v4.1).
|
||||||
|
|
||||||
|
my $config = i3->get_bar_config($id)->recv;
|
||||||
|
say Dumper($config);
|
||||||
|
|
||||||
|
=cut
|
||||||
|
sub get_bar_config {
|
||||||
|
my ($self, $id) = @_;
|
||||||
|
|
||||||
|
$self->_ensure_connection;
|
||||||
|
|
||||||
|
$self->message(TYPE_GET_BAR_CONFIG, $id)
|
||||||
|
}
|
||||||
|
|
||||||
|
=head2 get_version
|
||||||
|
|
||||||
|
Gets the i3 version via IPC, with a fall-back that parses the output of i3
|
||||||
|
--version (for i3 < v4.3).
|
||||||
|
|
||||||
|
my $version = i3->get_version()->recv;
|
||||||
|
say "major: " . $version->{major} . ", minor = " . $version->{minor};
|
||||||
|
|
||||||
|
=cut
|
||||||
|
sub get_version {
|
||||||
|
my ($self) = @_;
|
||||||
|
|
||||||
|
$self->_ensure_connection;
|
||||||
|
|
||||||
|
my $cv = AnyEvent->condvar;
|
||||||
|
|
||||||
|
my $version_cv = $self->message(TYPE_GET_VERSION);
|
||||||
|
my $timeout;
|
||||||
|
$timeout = AnyEvent->timer(
|
||||||
|
after => 1,
|
||||||
|
cb => sub {
|
||||||
|
warn "Falling back to i3 --version since the running i3 doesn’t support GET_VERSION yet.";
|
||||||
|
my $version = _call_i3('--version');
|
||||||
|
$version =~ s/^i3 version //;
|
||||||
|
my $patch = 0;
|
||||||
|
my ($major, $minor) = ($version =~ /^([0-9]+)\.([0-9]+)/);
|
||||||
|
if ($version =~ /^[0-9]+\.[0-9]+\.([0-9]+)/) {
|
||||||
|
$patch = $1;
|
||||||
|
}
|
||||||
|
# Strip everything from the © sign on.
|
||||||
|
$version =~ s/ ©.*$//g;
|
||||||
|
$cv->send({
|
||||||
|
major => int($major),
|
||||||
|
minor => int($minor),
|
||||||
|
patch => int($patch),
|
||||||
|
human_readable => $version,
|
||||||
|
});
|
||||||
|
undef $timeout;
|
||||||
|
},
|
||||||
|
);
|
||||||
|
$version_cv->cb(sub {
|
||||||
|
undef $timeout;
|
||||||
|
$cv->send($version_cv->recv);
|
||||||
|
});
|
||||||
|
|
||||||
|
return $cv;
|
||||||
|
}
|
||||||
|
|
||||||
|
=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 i3wm.org> >>
|
||||||
|
|
||||||
|
=head1 BUGS
|
||||||
|
|
||||||
|
Please report any bugs or feature requests to C<bug-anyevent-i3 at
|
||||||
|
rt.cpan.org>, or through the web interface at
|
||||||
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=AnyEvent-I3>. I will be
|
||||||
|
notified, and then you'll automatically be notified of progress on your bug as
|
||||||
|
I make changes.
|
||||||
|
|
||||||
|
=head1 SUPPORT
|
||||||
|
|
||||||
|
You can find documentation for this module with the perldoc command.
|
||||||
|
|
||||||
|
perldoc AnyEvent::I3
|
||||||
|
|
||||||
|
You can also look for information at:
|
||||||
|
|
||||||
|
=over 2
|
||||||
|
|
||||||
|
=item * RT: CPAN's request tracker
|
||||||
|
|
||||||
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=AnyEvent-I3>
|
||||||
|
|
||||||
|
=item * The i3 window manager website
|
||||||
|
|
||||||
|
L<http://i3wm.org>
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
|
||||||
|
=head1 ACKNOWLEDGEMENTS
|
||||||
|
|
||||||
|
|
||||||
|
=head1 LICENSE AND COPYRIGHT
|
||||||
|
|
||||||
|
Copyright 2010-2012 Michael Stapelberg.
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or modify it
|
||||||
|
under the terms of either: the GNU General Public License as published
|
||||||
|
by the Free Software Foundation; or the Artistic License.
|
||||||
|
|
||||||
|
See http://dev.perl.org/licenses/ for more information.
|
||||||
|
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
1; # End of AnyEvent::I3
|
|
@ -0,0 +1,10 @@
|
||||||
|
#!perl -T
|
||||||
|
|
||||||
|
use Test::More tests => 1;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
use_ok( 'AnyEvent::I3' ) || print "Bail out!
|
||||||
|
";
|
||||||
|
}
|
||||||
|
|
||||||
|
diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" );
|
|
@ -0,0 +1,29 @@
|
||||||
|
#!perl -T
|
||||||
|
# vim:ts=4:sw=4:expandtab
|
||||||
|
|
||||||
|
use Test::More tests => 3;
|
||||||
|
use AnyEvent::I3;
|
||||||
|
use AnyEvent;
|
||||||
|
|
||||||
|
my $i3 = i3();
|
||||||
|
my $cv = AnyEvent->condvar;
|
||||||
|
|
||||||
|
# Try to connect to i3
|
||||||
|
$i3->connect->cb(sub { my ($v) = @_; $cv->send($v->recv) });
|
||||||
|
|
||||||
|
# But cancel if we are not connected after 0.5 seconds
|
||||||
|
my $t = AnyEvent->timer(after => 0.5, cb => sub { $cv->send(0) });
|
||||||
|
my $connected = $cv->recv;
|
||||||
|
|
||||||
|
SKIP: {
|
||||||
|
skip 'No connection to i3', 3 unless $connected;
|
||||||
|
|
||||||
|
my $workspaces = $i3->message(1)->recv;
|
||||||
|
isa_ok($workspaces, 'ARRAY');
|
||||||
|
|
||||||
|
ok(@{$workspaces} > 0, 'More than zero workspaces found');
|
||||||
|
|
||||||
|
ok(defined(@{$workspaces}[0]->{num}), 'JSON deserialized');
|
||||||
|
}
|
||||||
|
|
||||||
|
diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" );
|
|
@ -0,0 +1,29 @@
|
||||||
|
#!perl -T
|
||||||
|
# vim:ts=4:sw=4:expandtab
|
||||||
|
|
||||||
|
use Test::More tests => 3;
|
||||||
|
use AnyEvent::I3;
|
||||||
|
use AnyEvent;
|
||||||
|
|
||||||
|
my $i3 = i3();
|
||||||
|
my $cv = AnyEvent->condvar;
|
||||||
|
|
||||||
|
# Try to connect to i3
|
||||||
|
$i3->connect->cb(sub { my ($v) = @_; $cv->send($v->recv) });
|
||||||
|
|
||||||
|
# But cancel if we are not connected after 0.5 seconds
|
||||||
|
my $t = AnyEvent->timer(after => 0.5, cb => sub { $cv->send(0) });
|
||||||
|
my $connected = $cv->recv;
|
||||||
|
|
||||||
|
SKIP: {
|
||||||
|
skip 'No connection to i3', 3 unless $connected;
|
||||||
|
|
||||||
|
my $workspaces = i3->get_workspaces->recv;
|
||||||
|
isa_ok($workspaces, 'ARRAY');
|
||||||
|
|
||||||
|
ok(@{$workspaces} > 0, 'More than zero workspaces found');
|
||||||
|
|
||||||
|
ok(defined(@{$workspaces}[0]->{num}), 'JSON deserialized');
|
||||||
|
}
|
||||||
|
|
||||||
|
diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" );
|
|
@ -0,0 +1,55 @@
|
||||||
|
#!perl -T
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Test::More tests => 3;
|
||||||
|
|
||||||
|
sub not_in_file_ok {
|
||||||
|
my ($filename, %regex) = @_;
|
||||||
|
open( my $fh, '<', $filename )
|
||||||
|
or die "couldn't open $filename for reading: $!";
|
||||||
|
|
||||||
|
my %violated;
|
||||||
|
|
||||||
|
while (my $line = <$fh>) {
|
||||||
|
while (my ($desc, $regex) = each %regex) {
|
||||||
|
if ($line =~ $regex) {
|
||||||
|
push @{$violated{$desc}||=[]}, $.;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (%violated) {
|
||||||
|
fail("$filename contains boilerplate text");
|
||||||
|
diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
|
||||||
|
} else {
|
||||||
|
pass("$filename contains no boilerplate text");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub module_boilerplate_ok {
|
||||||
|
my ($module) = @_;
|
||||||
|
not_in_file_ok($module =>
|
||||||
|
'the great new $MODULENAME' => qr/ - The great new /,
|
||||||
|
'boilerplate description' => qr/Quick summary of what the module/,
|
||||||
|
'stub function definition' => qr/function[12]/,
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
TODO: {
|
||||||
|
local $TODO = "Need to replace the boilerplate text";
|
||||||
|
|
||||||
|
not_in_file_ok(README =>
|
||||||
|
"The README is used..." => qr/The README is used/,
|
||||||
|
"'version information here'" => qr/to provide version information/,
|
||||||
|
);
|
||||||
|
|
||||||
|
not_in_file_ok(Changes =>
|
||||||
|
"placeholder date/time" => qr(Date/time)
|
||||||
|
);
|
||||||
|
|
||||||
|
module_boilerplate_ok('lib/AnyEvent/I3.pm');
|
||||||
|
|
||||||
|
|
||||||
|
}
|
||||||
|
|
|
@ -0,0 +1,13 @@
|
||||||
|
#!perl -T
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Test::More;
|
||||||
|
|
||||||
|
unless ( $ENV{RELEASE_TESTING} ) {
|
||||||
|
plan( skip_all => "Author tests not required for installation" );
|
||||||
|
}
|
||||||
|
|
||||||
|
eval "use Test::CheckManifest 0.9";
|
||||||
|
plan skip_all => "Test::CheckManifest 0.9 required" if $@;
|
||||||
|
ok_manifest();
|
|
@ -0,0 +1,18 @@
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Test::More;
|
||||||
|
|
||||||
|
# Ensure a recent version of Test::Pod::Coverage
|
||||||
|
my $min_tpc = 1.08;
|
||||||
|
eval "use Test::Pod::Coverage $min_tpc";
|
||||||
|
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
|
||||||
|
if $@;
|
||||||
|
|
||||||
|
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
|
||||||
|
# but older versions don't recognize some common documentation styles
|
||||||
|
my $min_pc = 0.18;
|
||||||
|
eval "use Pod::Coverage $min_pc";
|
||||||
|
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
|
||||||
|
if $@;
|
||||||
|
|
||||||
|
all_pod_coverage_ok();
|
|
@ -0,0 +1,12 @@
|
||||||
|
#!perl -T
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
use Test::More;
|
||||||
|
|
||||||
|
# Ensure a recent version of Test::Pod
|
||||||
|
my $min_tp = 1.22;
|
||||||
|
eval "use Test::Pod $min_tp";
|
||||||
|
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
|
||||||
|
|
||||||
|
all_pod_files_ok();
|
14
Makefile.am
14
Makefile.am
|
@ -53,6 +53,9 @@ check_PROGRAMS = \
|
||||||
check_SCRIPTS = \
|
check_SCRIPTS = \
|
||||||
testcases/complete-run.pl
|
testcases/complete-run.pl
|
||||||
|
|
||||||
|
check_DATA = \
|
||||||
|
anyevent-i3.stamp
|
||||||
|
|
||||||
clean-check:
|
clean-check:
|
||||||
rm -rf testsuite-* latest i3-cfg-for-* _Inline
|
rm -rf testsuite-* latest i3-cfg-for-* _Inline
|
||||||
clean-local: clean-check
|
clean-local: clean-check
|
||||||
|
@ -573,6 +576,15 @@ i3-config-parser.stamp: parser/$(dirstamp) generate-command-parser.pl parser-spe
|
||||||
$(AM_V_at) mv GENERATED_config_* $(top_builddir)/parser
|
$(AM_V_at) mv GENERATED_config_* $(top_builddir)/parser
|
||||||
$(AM_V_at) touch $@
|
$(AM_V_at) touch $@
|
||||||
|
|
||||||
|
################################################################################
|
||||||
|
# AnyEvent-I3 build process
|
||||||
|
################################################################################
|
||||||
|
|
||||||
|
anyevent-i3.stamp: generate-command-parser.pl parser-specs/config.spec
|
||||||
|
$(AM_V_BUILD) (cd $(top_srcdir)/AnyEvent-I3 && perl Makefile.PL && make)
|
||||||
|
$(AM_V_at) touch $@
|
||||||
|
|
||||||
CLEANFILES = \
|
CLEANFILES = \
|
||||||
i3-command-parser.stamp \
|
i3-command-parser.stamp \
|
||||||
i3-config-parser.stamp
|
i3-config-parser.stamp \
|
||||||
|
anyevent-i3.stamp
|
||||||
|
|
|
@ -8,7 +8,6 @@ WriteMakefile(
|
||||||
MIN_PERL_VERSION => '5.010000', # 5.10.0
|
MIN_PERL_VERSION => '5.010000', # 5.10.0
|
||||||
PREREQ_PM => {
|
PREREQ_PM => {
|
||||||
'AnyEvent' => 0,
|
'AnyEvent' => 0,
|
||||||
'AnyEvent::I3' => '0.16',
|
|
||||||
'X11::XCB' => '0.12',
|
'X11::XCB' => '0.12',
|
||||||
'Inline' => 0,
|
'Inline' => 0,
|
||||||
'Inline::C' => 0,
|
'Inline::C' => 0,
|
||||||
|
|
|
@ -18,7 +18,7 @@ use Time::HiRes qw(time);
|
||||||
use IO::Handle;
|
use IO::Handle;
|
||||||
|
|
||||||
# these are shipped with the testsuite
|
# these are shipped with the testsuite
|
||||||
use lib qw(@abs_top_builddir@/testcases/lib @abs_top_srcdir@/testcases/lib);
|
use lib qw(@abs_top_builddir@/testcases/lib @abs_top_srcdir@/testcases/lib @abs_top_srcdir@/AnyEvent-I3/blib/lib);
|
||||||
use i3test::Util qw(slurp);
|
use i3test::Util qw(slurp);
|
||||||
use StartXServer;
|
use StartXServer;
|
||||||
use StatusLine;
|
use StatusLine;
|
||||||
|
|
|
@ -7,6 +7,7 @@ use Test::Builder;
|
||||||
use X11::XCB::Rect;
|
use X11::XCB::Rect;
|
||||||
use X11::XCB::Window;
|
use X11::XCB::Window;
|
||||||
use X11::XCB qw(:all);
|
use X11::XCB qw(:all);
|
||||||
|
use lib qw(@abs_top_srcdir@/AnyEvent-I3/blib/lib);
|
||||||
use AnyEvent::I3;
|
use AnyEvent::I3;
|
||||||
use List::Util qw(first);
|
use List::Util qw(first);
|
||||||
use Time::HiRes qw(sleep);
|
use Time::HiRes qw(sleep);
|
||||||
|
|
|
@ -6,6 +6,7 @@ use warnings;
|
||||||
use v5.10;
|
use v5.10;
|
||||||
|
|
||||||
use i3test i3_autostart => 0;
|
use i3test i3_autostart => 0;
|
||||||
|
use lib qw(@abs_top_srcdir@/AnyEvent-I3/blib/lib);
|
||||||
use AnyEvent::I3;
|
use AnyEvent::I3;
|
||||||
use ExtUtils::PkgConfig;
|
use ExtUtils::PkgConfig;
|
||||||
|
|
||||||
|
|
|
@ -8,7 +8,6 @@ BEGIN {
|
||||||
X11::XCB::Connection
|
X11::XCB::Connection
|
||||||
X11::XCB::Window
|
X11::XCB::Window
|
||||||
AnyEvent
|
AnyEvent
|
||||||
AnyEvent::I3
|
|
||||||
IPC::Run
|
IPC::Run
|
||||||
ExtUtils::PkgConfig
|
ExtUtils::PkgConfig
|
||||||
Inline
|
Inline
|
||||||
|
|
|
@ -19,7 +19,7 @@ RUN apt-get update && \
|
||||||
dpkg-dev devscripts git equivs \
|
dpkg-dev devscripts git equivs \
|
||||||
clang clang-format-3.8 \
|
clang clang-format-3.8 \
|
||||||
lintian \
|
lintian \
|
||||||
libanyevent-perl libanyevent-i3-perl libextutils-pkgconfig-perl xcb-proto cpanminus xvfb xserver-xephyr xauth libinline-perl libinline-c-perl libxml-simple-perl libmouse-perl libmousex-nativetraits-perl libextutils-depends-perl perl libtest-deep-perl libtest-exception-perl libxml-parser-perl libtest-simple-perl libtest-fatal-perl libdata-dump-perl libtest-differences-perl libxml-tokeparser-perl libipc-run-perl libxcb-xtest0-dev libx11-xcb-perl libanyevent-i3-perl && \
|
libmodule-install-perl libanyevent-perl libextutils-pkgconfig-perl xcb-proto cpanminus xvfb xserver-xephyr xauth libinline-perl libinline-c-perl libxml-simple-perl libmouse-perl libmousex-nativetraits-perl libextutils-depends-perl perl libtest-deep-perl libtest-exception-perl libxml-parser-perl libtest-simple-perl libtest-fatal-perl libdata-dump-perl libtest-differences-perl libxml-tokeparser-perl libipc-run-perl libxcb-xtest0-dev libx11-xcb-perl libjson-xs-perl && \
|
||||||
rm -rf /var/lib/apt/lists/*
|
rm -rf /var/lib/apt/lists/*
|
||||||
|
|
||||||
# Install i3 build dependencies.
|
# Install i3 build dependencies.
|
||||||
|
|
Loading…
Reference in New Issue