From: Michael Stapelberg Date: Sat, 13 Mar 2010 16:11:09 +0000 (+0100) Subject: Initial commit X-Git-Tag: AnyEvent-0.02~20 X-Git-Url: https://git.sur5r.net/?a=commitdiff_plain;h=3c448c470758e6fefa2b3cbaff4983d62d794f40;p=i3%2Fi3 Initial commit --- 3c448c470758e6fefa2b3cbaff4983d62d794f40 diff --git a/Changes b/Changes new file mode 100644 index 00000000..7071c737 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for AnyEvent-I3 + +0.01 Date/time + First version, released on an unsuspecting world. + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 00000000..7087a287 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,9 @@ +Changes +MANIFEST +Makefile.PL +README +lib/AnyEvent/I3.pm +t/00-load.t +t/manifest.t +t/pod-coverage.t +t/pod.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 00000000..2082ce24 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,12 @@ +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'; + +WriteAll; diff --git a/README b/README new file mode 100644 index 00000000..3aff4b15 --- /dev/null +++ b/README @@ -0,0 +1,55 @@ +AnyEvent-I3 + +The README is used to introduce the module and provide instructions on +how to install the module, any machine dependencies it may have (for +example C compilers and installed libraries) and any other information +that should be provided before the module is installed. + +A README file is required for CPAN modules since CPAN extracts the README +file from a module distribution so that people browsing the archive +can use it to get an idea of the module's uses. It is usually a good idea +to provide version information here so that people can decide whether +fixes for the module are worth downloading. + + +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 + + AnnoCPAN, Annotated CPAN documentation + http://annocpan.org/dist/AnyEvent-I3 + + CPAN Ratings + http://cpanratings.perl.org/d/AnyEvent-I3 + + Search CPAN + http://search.cpan.org/dist/AnyEvent-I3/ + + +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. + diff --git a/ignore.txt b/ignore.txt new file mode 100644 index 00000000..01d97f8a --- /dev/null +++ b/ignore.txt @@ -0,0 +1,12 @@ +blib* +Makefile +Makefile.old +Build +Build.bat +_build* +pm_to_blib* +*.tar.gz +.lwpcookies +cover_db +pod2htm*.tmp +AnyEvent-I3-* diff --git a/lib/AnyEvent/I3.pm b/lib/AnyEvent/I3.pm new file mode 100644 index 00000000..f365d394 --- /dev/null +++ b/lib/AnyEvent/I3.pm @@ -0,0 +1,257 @@ +package AnyEvent::I3; +# vim:ts=4:sw=4:expandtab + +use strict; +use warnings; +use JSON::XS; +use AnyEvent::Handle; +use AnyEvent::Socket; +use AnyEvent; + +=head1 NAME + +AnyEvent::I3 - communicate with the i3 window manager + +=cut + +our $VERSION = '0.01'; + +=head1 VERSION + +Version 0.01 + +=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. + +Note that as soon as you subscribe to some kind of event, you should B +send any more messages as race conditions might occur. Instead, open another +connection for that. + + use AnyEvent::I3; + + my $i3 = i3("/tmp/i3-ipc.sock"); + + $i3->connect->recv; + say "Connected to i3"; + + my $workspaces = $i3->message(1)->recv; + say "Currently, you use " . @{$workspaces} . " workspaces"; + +=head1 EXPORT + +=head2 $i3 = i3([ $path ]); + +Creates a new C object and returns it. C is the path of +the UNIX socket to connect to. + +=head1 SUBROUTINES/METHODS + +=cut + + +use Exporter; +use base 'Exporter'; + +our @EXPORT = qw(i3); + + +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), +); + +sub bytelength { + my ($scalar) = @_; + use bytes; + length($scalar) +} + +sub i3 { + AnyEvent::I3->new(@_) +} + +=head2 $i3 = AnyEvent::I3->new([ $path ]) + +Creates a new C object and returns it. C is the path of +the UNIX socket to connect to. + +=cut +sub new { + my ($class, $path) = @_; + + $path ||= '/tmp/i3-ipc.sock'; + + bless { path => $path } => $class; +} + +=head2 $i3->connect + +Establishes the connection to i3. Returns an C which will +be triggered as soon as the connection has been established. + +=cut +sub connect { + my ($self) = @_; + my $hdl; + my $cv = AnyEvent->condvar; + + tcp_connect "unix/", $self->{path}, sub { + my ($fh) = @_; + + $self->{ipchdl} = AnyEvent::Handle->new( + fh => $fh, + on_read => sub { my ($hdl) = @_; $self->data_available($hdl) } + ); + + $cv->send + }; + + $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); +} + +=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. + + $i3->subscribe({ + workspace => sub { say "Workspaces changed" } + }); + +=cut +sub subscribe { + my ($self, $callbacks) = @_; + + my $payload = encode_json [ keys %{$callbacks} ]; + my $message = $magic . pack("LL", bytelength($payload), 2) . $payload; + $self->{ipchdl}->push_write($message); + + # Register callbacks for each message type + for my $key (keys %{$callbacks}) { + my $type = $events{$key}; + $self->{callbacks}->{$type} = $callbacks->{$key}; + } +} + +=head2 $i3->message($type, $content) + +Sends a message of the specified C to i3, possibly containing the data +structure C, if specified. + + my $cv = $i3->message(0, "reload"); + my $reply = $cv->recv; + if ($reply->{success}) { + say "Configuration successfully reloaded"; + } + +=cut +sub message { + my ($self, $type, $content) = @_; + + die "No message type specified" unless $type; + + my $payload = ""; + if ($content) { + if (ref($content) eq "SCALAR") { + $payload = $content; + } else { + $payload = encode_json $content; + } + } + my $message = $magic . pack("LL", bytelength($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 AUTHOR + +Michael Stapelberg, C<< >> + +=head1 BUGS + +Please report any bugs or feature requests to C, or through +the web interface at L. 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 + +=item * The i3 window manager website + +L + +=back + + +=head1 ACKNOWLEDGEMENTS + + +=head1 LICENSE AND COPYRIGHT + +Copyright 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. + + +=cut + +1; # End of AnyEvent::I3 diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 00000000..4bf6151e --- /dev/null +++ b/t/00-load.t @@ -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" ); diff --git a/t/01-workspaces.t b/t/01-workspaces.t new file mode 100644 index 00000000..5e708d13 --- /dev/null +++ b/t/01-workspaces.t @@ -0,0 +1,12 @@ +#!perl -T + +use Test::More tests => 1; +use AnyEvent::I3; + +my $i3 = i3(); +my $cv = $i3->connect; +$cv->recv; + +ok(1, "connected"); + +diag( "Testing AnyEvent::I3 $AnyEvent::I3::VERSION, Perl $], $^X" ); diff --git a/t/boilerplate.t b/t/boilerplate.t new file mode 100644 index 00000000..effb65b6 --- /dev/null +++ b/t/boilerplate.t @@ -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'); + + +} + diff --git a/t/manifest.t b/t/manifest.t new file mode 100644 index 00000000..45eb83fd --- /dev/null +++ b/t/manifest.t @@ -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(); diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 00000000..fc40a57c --- /dev/null +++ b/t/pod-coverage.t @@ -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(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 00000000..ee8b18ad --- /dev/null +++ b/t/pod.t @@ -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();