File Coverage

blib/lib/X11/WM/Sawfish.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package X11::WM::Sawfish;

# 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;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw();
our @EXPORT = qw();
our $VERSION = '0.03';

use Sys::Hostname;

use X11::WM::Sawfish::UNIX;
use X11::WM::Sawfish::XProp;

sub new {
  my $package = shift(@_);
  $package = ref($package) || $package;
  my ($self) = new X11::WM::Sawfish::UNIX(@_);
  if (!defined($self)) {
    $self = new X11::WM::Sawfish::XProp(@_);
  }
  return($self);
}

sub canonical_display_name {
  my ($display) = @_;
  if (!defined($display)) { $display = $ENV{"DISPLAY"}; }
  $display =~ s/^unix:/:/;
  if (substr($display, 0, 1) eq ":") {
    $display = hostname() . $display;
  }
  my $i = index($display, ":");
  if (($i > -1) && (index($display, ".", $i) == -1))
  {
    $display .= ".0";
  }
  return($display);
}

sub sawfish_socket_name {
  my ($display) = @_;
  my $socket = sprintf("/tmp/.sawfish-%s/%s",
                       (getpwuid($<))[0], canonical_display_name($display));
  return($socket);
}

sub get_server_version {
  my ($self) = @_;
  my ($response) = $self->eval_form("sawfish-version");
  if (defined($response)) {
    $response =~ s#^"##;
    $response =~ s#"$##;
    $self->{ServerVersion} = $response;
  }
  return($response);
}

sub ServerVersion {
  return($_[0]->{ServerVersion});
}

1;
__END__