File Coverage

lib/Clipboard.pm
Criterion Covered Total %
statement 26 33 78.7
branch 5 10 50.0
condition 2 2 100.0
subroutine 7 10 70.0
pod 0 6 0.0
total 40 61 65.5


line stmt bran cond sub pod time code
1             package Clipboard;
2             $Clipboard::VERSION = '0.27';
3 2     2   157132 use strict;
  2         12  
  2         66  
4 2     2   11 use warnings;
  2         3  
  2         1135  
5              
6             our $driver;
7              
8 1     1 0 109 sub copy { my $self = shift; $driver->copy(@_); }
  1         8  
9             sub copy_to_all_selections {
10 0     0 0 0 my $self = shift;
11 0         0 my $meth = $driver->can('copy_to_all_selections');
12 0 0       0 return $meth ? $meth->($driver, @_) : $driver->copy(@_);
13             }
14              
15 0     0 0 0 sub cut { goto © }
16 1     1 0 1016 sub paste { my $self = shift; $driver->paste(@_); }
  1         6  
17              
18 28     28 0 31 sub bind_os { my $driver = shift; map { $_ => $driver } @_; }
  28         47  
  308         488  
19             sub find_driver {
20 14     14 0 5841 my $self = shift;
21 14         28 my $os = shift;
22 14         37 my %drivers = (
23             # list stolen from Module::Build, with some modifications (for
24             # example, cygwin doesn't count as Unix here, because it will
25             # use the Win32 clipboard.)
26             bind_os(Xclip => qw(linux bsd$ aix bsdos dec_osf dgux
27             dynixptx gnu hpux irix dragonfly machten next os2 sco_sv solaris
28             sunos svr4 svr5 unicos unicosmk)),
29             bind_os(MacPasteboard => qw(darwin)),
30             );
31              
32 14 100       93 if ($os =~ /^(?:mswin|win|cygwin)/i) {
33             # If we are connected to windows through ssh, and xclip is
34             # available, use it.
35 2 50       8 if (exists $ENV{SSH_CONNECTION}) {
36 0     0   0 local $SIG{__WARN__} = sub {};
37 0         0 require Clipboard::Xclip;
38              
39 0 0       0 return 'Xclip' if Clipboard::Xclip::xclip_available();
40             }
41              
42 2         14 return 'Win32';
43             }
44              
45 12   100     764 $os =~ /$_/i && return $drivers{$_} for keys %drivers;
46              
47             # use xclip on unknown OSes that seem to have a DISPLAY
48 2 100       32 return 'Xclip' if exists $ENV{DISPLAY};
49              
50 1         43 die "The $os system is not yet supported by Clipboard.pm. Please email rking\@panoptic.com and tell him about this.\n";
51             }
52              
53             sub import {
54 3     3   1318 my $self = shift;
55 3         18 my $drv = Clipboard->find_driver($^O);
56 3         818 require "Clipboard/$drv.pm";
57 3         243 $driver = "Clipboard::$drv";
58             }
59              
60             1;
61             # vi:tw=72
62              
63             __END__