line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Clipboard::Xclip; |
2
|
|
|
|
|
|
|
$Clipboard::Xclip::VERSION = '0.27'; |
3
|
2
|
|
|
2
|
|
13
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
65
|
|
4
|
2
|
|
|
2
|
|
10
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
51
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
10
|
use File::Spec (); |
|
2
|
|
|
|
|
19
|
|
|
2
|
|
|
|
|
1208
|
|
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
|
59
|
open my $olderr, '>&', \*STDERR; |
58
|
2
|
|
|
|
|
16
|
close STDERR; |
59
|
2
|
|
|
|
|
104
|
open STDERR, '>', File::Spec->devnull; |
60
|
|
|
|
|
|
|
|
61
|
2
|
|
|
|
|
4421
|
my $open_retval = open my $just_checking, 'xclip -o|'; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# restore STDERR |
64
|
2
|
|
|
|
|
139
|
close STDERR; |
65
|
2
|
|
|
|
|
106
|
open STDERR, '>&', $olderr; |
66
|
2
|
|
|
|
|
42
|
close $olderr; |
67
|
|
|
|
|
|
|
|
68
|
2
|
|
|
|
|
256
|
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__ |