File Coverage

blib/lib/X11/WM/Sawfish/UNIX.pm

Criterion	Covered	Total	%
statement	24	57	42.1
branch	0	8	0.0
condition	0	3	0.0
subroutine	8	12	66.6
pod	4	4	100.0
total	36	84	42.8

package X11::WM::Sawfish::UNIX;

# Copyright (C) 2003 Craig B. Agricola.  All rights reserved.  This library is
# free software; you can redistribute it and/or modify it under the same terms
# as Perl itself.

use 5.005;
use strict;
use warnings;

require Exporter;

use X11::WM::Sawfish;
our @ISA = qw(X11::WM::Sawfish);
our @EXPORT_OK = qw();
our @EXPORT = qw();
our $VERSION = '0.02';

use IO qw(Socket);

use constant req_eval           =>   0;
use constant req_eval_async     =>   1;
use constant req_end_of_session => 255;

sub new {
  my ($package, $display) = @_;
  $package = ref($package) || $package;
  my ($self) = {};
  bless($self, $package);
  $self->{SocketPath} = X11::WM::Sawfish::sawfish_socket_name($display);
  $self->get_server_version();
  if (!defined($self->{Socket})) {
    $!=111; # Connection refused
    return(undef);
  }
  $self->close_socket();
  return($self);
}

sub open_socket {
  my ($self) = @_;
  if (!defined($self->{Socket})) {
    $self->{Socket} = new IO::Socket::UNIX(Peer => $self->{SocketPath});
  }
  return($self->{Socket});
}

sub close_socket {
  my ($self) = @_;
  syswrite($self->{Socket}, pack("C", req_end_of_session));
  close($self->{Socket});
  undef($self->{Socket});
}

sub eval_form {
  my ($self, $form) = @_;
  my ($resp_len, $resp, $state);
  my $s = $self->open_socket();
  $resp = undef;
  if (defined($s)) {
    my $data = pack("CIa*", req_eval, length($form), $form);
    syswrite($s, $data);
    sysread($s, $data, 4);
    $resp_len = unpack("I", $data);
    sysread($s, $resp, $resp_len);
    ($state, $resp) = unpack("Ca*", $resp);
    if ($state != 1) { $resp = undef; }
  }
  return($resp);
}

1;
__END__