File Coverage

lib/Clipboard/Xclip.pm
Criterion Covered Total %
statement 17 51 33.3
branch 0 10 0.0
condition n/a
subroutine 4 11 36.3
pod 0 8 0.0
total 21 80 26.2


line stmt bran cond sub pod time code
1             package Clipboard::Xclip;
2             $Clipboard::Xclip::VERSION = '0.32';
3 2     2   18 use strict;
  2         3  
  2         79  
4 2     2   11 use warnings;
  2         4  
  2         99  
5              
6 2     2   12 use File::Spec ();
  2         3  
  2         1642  
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 = do { local $/; <$exe> };
  0         0  
  0         0  
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 71 open my $olderr, '>&', \*STDERR;
58 2         12 close STDERR;
59 2         136 open STDERR, '>', File::Spec->devnull;
60              
61 2         7843 my $open_retval = open my $just_checking, 'xclip -o|';
62              
63             # restore STDERR
64 2         81 close STDERR;
65 2         44 open STDERR, '>&', $olderr;
66 2         20 close $olderr;
67              
68 2         186 return $open_retval;
69             }
70              
71             {
72             xclip_available() or warn <<'EPIGRAPH';
73              
74             Can't find the 'xclip' program. 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__
84              
85             =pod
86              
87             =encoding UTF-8
88              
89             =head1 VERSION
90              
91             version 0.32
92              
93             =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
94              
95             =head1 SUPPORT
96              
97             =head2 Websites
98              
99             The following websites have more information about this module, and may be of help to you. As always,
100             in addition to those websites please use your favorite search engine to discover more resources.
101              
102             =over 4
103              
104             =item *
105              
106             MetaCPAN
107              
108             A modern, open-source CPAN search engine, useful to view POD in HTML format.
109              
110             L<https://metacpan.org/release/Clipboard>
111              
112             =item *
113              
114             RT: CPAN's Bug Tracker
115              
116             The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN.
117              
118             L<https://rt.cpan.org/Public/Dist/Display.html?Name=Clipboard>
119              
120             =item *
121              
122             CPANTS
123              
124             The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.
125              
126             L<http://cpants.cpanauthors.org/dist/Clipboard>
127              
128             =item *
129              
130             CPAN Testers
131              
132             The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions.
133              
134             L<http://www.cpantesters.org/distro/C/Clipboard>
135              
136             =item *
137              
138             CPAN Testers Matrix
139              
140             The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.
141              
142             L<http://matrix.cpantesters.org/?dist=Clipboard>
143              
144             =item *
145              
146             CPAN Testers Dependencies
147              
148             The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.
149              
150             L<http://deps.cpantesters.org/?module=Clipboard>
151              
152             =back
153              
154             =head2 Bugs / Feature Requests
155              
156             Please report any bugs or feature requests by email to C<bug-clipboard at rt.cpan.org>, or through
157             the web interface at L<https://rt.cpan.org/Public/Bug/Report.html?Queue=Clipboard>. You will be automatically notified of any
158             progress on the request by the system.
159              
160             =head2 Source Code
161              
162             The code is open to the world, and available for you to hack on. Please feel free to browse it and play
163             with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
164             from your repository :)
165              
166             L<https://github.com/shlomif/Clipboard>
167              
168             git clone git://github.com/shlomif/Clipboard.git
169              
170             =head1 AUTHOR
171              
172             Shlomi Fish <shlomif@cpan.org>
173              
174             =head1 BUGS
175              
176             Please report any bugs or feature requests on the bugtracker website
177             L<https://github.com/shlomif/Clipboard/issues>
178              
179             When submitting a bug or request, please include a test-file or a
180             patch to an existing test-file that illustrates the bug or desired
181             feature.
182              
183             =head1 COPYRIGHT AND LICENSE
184              
185             This software is copyright (c) 2025 by Ryan King <rking@panoptic.com>.
186              
187             This is free software; you can redistribute it and/or modify it under
188             the same terms as the Perl 5 programming language system itself.
189              
190             =cut