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


line stmt bran cond sub pod time code
1             package X11::WM::Sawfish;
2              
3             # Copyright (C) 2003 Craig B. Agricola. All rights reserved. This library is
4             # free software; you can redistribute it and/or modify it under the same terms
5             # as Perl itself.
6              
7 1     1   6525 use 5.005;
  1         3  
  1         34  
8 1     1   4 use strict;
  1         2  
  1         32  
9 1     1   5 use warnings;
  1         6  
  1         106  
10              
11             require Exporter;
12              
13             our @ISA = qw(Exporter);
14             our @EXPORT_OK = qw();
15             our @EXPORT = qw();
16             our $VERSION = '0.03';
17              
18 1     1   741 use Sys::Hostname;
  1         1301  
  1         69  
19              
20 1     1   643 use X11::WM::Sawfish::UNIX;
  1         4  
  1         147  
21 1     1   6535 use X11::WM::Sawfish::XProp;
  0            
  0            
22              
23             sub new {
24             my $package = shift(@_);
25             $package = ref($package) || $package;
26             my ($self) = new X11::WM::Sawfish::UNIX(@_);
27             if (!defined($self)) {
28             $self = new X11::WM::Sawfish::XProp(@_);
29             }
30             return($self);
31             }
32              
33             sub canonical_display_name {
34             my ($display) = @_;
35             if (!defined($display)) { $display = $ENV{"DISPLAY"}; }
36             $display =~ s/^unix:/:/;
37             if (substr($display, 0, 1) eq ":") {
38             $display = hostname() . $display;
39             }
40             my $i = index($display, ":");
41             if (($i > -1) && (index($display, ".", $i) == -1))
42             {
43             $display .= ".0";
44             }
45             return($display);
46             }
47              
48             sub sawfish_socket_name {
49             my ($display) = @_;
50             my $socket = sprintf("/tmp/.sawfish-%s/%s",
51             (getpwuid($<))[0], canonical_display_name($display));
52             return($socket);
53             }
54              
55             sub get_server_version {
56             my ($self) = @_;
57             my ($response) = $self->eval_form("sawfish-version");
58             if (defined($response)) {
59             $response =~ s#^"##;
60             $response =~ s#"$##;
61             $self->{ServerVersion} = $response;
62             }
63             return($response);
64             }
65              
66             sub ServerVersion {
67             return($_[0]->{ServerVersion});
68             }
69              
70             1;
71             __END__