require 5.006; use strict; use warnings; use IPC::Open3; our $VERSION = v0.0.1; our $DEBUG = 99; our $AUTOLOAD; our $SAWFISH_CLIENT = '/usr/bin/sawfish-client'; our @MODULE = qw/ maximize /; sub new { my $proto = shift; my $class = ref $proto || $proto; my $self = {}; bless( $self, $class ); $self->connect or die "failed connecting to sawfish-client '$SAWFISH_CLIENT'"; $self->getline; # toss out banner (ahh, the joys of programming by co-inky-dink...) return $self; } sub AUTOLOAD { my $self = shift; ref $self or return undef; dp( "Autoloaded $AUTOLOAD \@_=@_" ); my $lispfunc = $AUTOLOAD; $lispfunc =~ s/.*://; $lispfunc =~ s/_/-/g; if ( wantarray ) { return( $self->generic_window_command( $lispfunc, @_ ) ); } return scalar $self->generic_window_command( $lispfunc, @_ ); } sub generic_window_command { my $self = shift; my $command = shift; my $id = shift; $id = sprintf( "%#x", 0+$id) if defined $id; # convert to decorated hex my $lisp = "$command"; $lisp .= " (get-window-by-id $id)" if defined $id; $lisp .= " @_" if @_; my $res = $self->eval( "($lisp)" ); return undef if $res =~ /^\007\*{3}/; if ( wantarray ) { $res =~ s/^\((.*)\)$/$1/; my (@res) = split( ' . ', $res ); return @res; } return $res; } sub fullscreen { my $self = shift; my $win = shift; $self->make_window_ignored( $win ); $self->move_resize_window_to( $win, 0, 0, $self->screen_width, $self->screen_height ); } sub managed_windows { my $self = shift; my $raw = $self->eval( '(managed-windows)' ); my ( @windows ) = map { hex } ($raw =~ /\#/g); return @windows; } sub eval { my $self = shift; my @responses = (); foreach my $lisp ( @_ ) { dp( "sending '$lisp'" ); $self->send( $lisp ); my $res = $self->getline; push @responses, $res; dp( "got reply '$res'" ); } return @responses if wantarray; return pop(@responses); } sub send { my $self = shift; my $lisp = join( '', @_ ); $lisp =~ s/[\n\r]/ /g; my $fh = $self->{wfh}; print $fh $lisp,"\n"; } sub getline { my $self = shift; my $fh = $self->{rfh}; <$fh>; # toss echoed input (can this fail? what if input contains a newline? local $/ = "\nuser> "; # local $/ = "user> "; chomp( my $res = <$fh> ); $res =~ tr/\r//d; return $res; } sub connect { my $self = shift; my @args = ('-'); # meow foreach my $module ( @MODULE ) { unshift( @args, '-r', $module); } dp( "@args" ); $self->{pid} = open3( $self->{wfh}, $self->{rfh}, $self->{efh}, $SAWFISH_CLIENT, @args ); return $self->{pid}; } sub disconnect { my $self = shift; kill 9, $self->{pid}; waitpid( $self->{pid}, 0 ) if exists $self->{pid}; } sub reconnect { my $self = shift; $self->disconnect; $self->connect; } sub DESTROY { my $self = shift; $self->disconnect; } ### sub dp { return undef unless $DEBUG; my $mess = join( '', @_ ); #$mess =~ s/\n/\\n/g; $mess =~ s/\r/\\r/g; print "DEBUG: >>> $mess <<<\n"; } 1; __END__ =head1 NAME Sawfish - Perl interface to sawfish-client =head1 SYNOPSIS use Sawfish; my $sawfish = new Sawfish(); my $win = $sawfish->get_window_by_name( 'pine' ); die "can't find a window named 'pine'" unless defined $win and $win; $sawfish->x_raise_window( $win ); for (1..5) { $sawfish->make_window_ignored( $win ); sleep 1; $sawfish->make_window_not_ignored( $win ); sleep 1; } =head1 DESCRIPTION Stub documentation for Sawfish. Oops, did I really forget to do this?! =head2 EXPORT None. =head1 AUTHOR Paris Sinclair Epariss@efn.orgE =head1 SEE ALSO L. =cut