File Coverage

lib/Clipboard/Xclip.pm
Criterion Covered Total %
statement 17 49 34.6
branch 0 10 0.0
condition n/a
subroutine 4 11 36.3
pod 0 8 0.0
total 21 78 26.9


line stmt bran cond sub pod time code
1             package Clipboard::Xclip;
2             $Clipboard::Xclip::VERSION = '0.28';
3 2     2   14 use strict;
  2         3  
  2         60  
4 2     2   10 use warnings;
  2         2  
  2         64  
5              
6 2     2   10 use File::Spec ();
  2         8  
  2         1189  
7              
8             sub copy {
9 0     0 0 0 my $self = shift;
10 0         0 my ($input) = @_;
11 0         0 return $self->copy_to_selection($self->favorite_selection, $input);
12             }
13              
14             sub copy_to_all_selections {
15 0     0 0 0 my $self = shift;
16 0         0 my ($input) = @_;
17 0         0 foreach my $sel ($self->all_selections) {
18 0         0 $self->copy_to_selection($sel, $input);
19             }
20 0         0 return;
21             }
22              
23             sub copy_to_selection {
24 0     0 0 0 my $self = shift;
25 0         0 my ($selection, $input) = @_;
26 0         0 my $cmd = '|xclip -i -selection '. $selection;
27 0 0       0 my $r = open my $exe, $cmd or die "Couldn't run `$cmd`: $!\n";
28 0         0 binmode $exe, ':encoding(UTF-8)';
29 0         0 print {$exe} $input;
  0         0  
30 0 0       0 close $exe or die "Error closing `$cmd`: $!";
31              
32 0         0 return;
33             }
34             sub paste {
35 0     0 0 0 my $self = shift;
36 0         0 for ($self->all_selections) {
37 0         0 my $data = $self->paste_from_selection($_);
38 0 0       0 return $data if length $data;
39             }
40 0         0 return undef;
41             }
42             sub paste_from_selection {
43 0     0 0 0 my $self = shift;
44 0         0 my ($selection) = @_;
45 0         0 my $cmd = "xclip -o -selection $selection|";
46 0 0       0 open my $exe, $cmd or die "Couldn't run `$cmd`: $!\n";
47 0         0 my $result = join '', <$exe>;
48 0 0       0 close $exe or die "Error closing `$cmd`: $!";
49 0         0 return $result;
50             }
51             # This ordering isn't officially verified, but so far seems to work the best:
52 0     0 0 0 sub all_selections { qw(primary buffer clipboard secondary) }
53 0     0 0 0 sub favorite_selection { my $self = shift; ($self->all_selections)[0] }
  0         0  
54              
55             sub xclip_available {
56             # close STDERR
57 2     2 0 49 open my $olderr, '>&', \*STDERR;
58 2         17 close STDERR;
59 2         96 open STDERR, '>', File::Spec->devnull;
60              
61 2         4713 my $open_retval = open my $just_checking, 'xclip -o|';
62              
63             # restore STDERR
64 2         133 close STDERR;
65 2         73 open STDERR, '>&', $olderr;
66 2         31 close $olderr;
67              
68 2         261 return $open_retval;
69             }
70              
71             {
72             xclip_available() or warn <<'EPIGRAPH';
73              
74             Can't find the 'xclip' script. Clipboard.pm's X support depends on it.
75              
76             Here's the project homepage: http://sourceforge.net/projects/xclip/
77              
78             EPIGRAPH
79             }
80              
81             1;
82              
83             __END__