File Coverage

lib/Clipboard.pm
Criterion Covered Total %
statement 30 45 66.6
branch 7 22 31.8
condition 1 3 33.3
subroutine 7 10 70.0
pod 0 6 0.0
total 45 86 52.3


line stmt bran cond sub pod time code
1             package Clipboard;
2             $Clipboard::VERSION = '0.32';
3 2     2   275978 use strict;
  2         4  
  2         76  
4 2     2   12 use warnings;
  2         4  
  2         1937  
5              
6             our $driver;
7              
8 1     1 0 420209 sub copy { my $self = shift; return $driver->copy(@_); }
  1         9  
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 &copy }
16 1     1 0 1360 sub paste { my $self = shift; return $driver->paste(@_); }
  1         28  
17              
18 39     39 0 41 sub bind_os { my $driver = shift; return map { $_ => $driver } @_; }
  39         45  
  559         822  
19             sub find_driver {
20 13     13 0 5570 my $self = shift;
21 13         22 my $os = shift;
22 13         27 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(Xsel => 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(Xclip => qw(linux bsd$ aix bsdos dec_osf dgux
30             dynixptx gnu hpux irix dragonfly machten next os2 sco_sv solaris
31             sunos svr4 svr5 unicos unicosmk)),
32             #bind_os(WaylandClipboard => qw(linux)), # Do not uncomment this line...
33             bind_os(MacPasteboard => qw(darwin)),
34             );
35              
36 13 100       91 if ($os =~ /^(?:mswin|win|cygwin)/i) {
37             # If we are connected to windows through ssh, and xclip is
38             # available, use it.
39 2 50       5 if (exists $ENV{SSH_CONNECTION}) {
40 0     0   0 local $SIG{__WARN__} = sub {};
41 0         0 require Clipboard::Xsel;
42 0 0       0 return 'Xsel' if Clipboard::Xsel::xsel_available();
43 0         0 require Clipboard::Xclip;
44 0 0       0 return 'Xclip' if Clipboard::Xclip::xclip_available();
45             }
46              
47 2         13 return 'Win32';
48             }
49             # Preferentially use Clipboard::WaylandClipboard if we see WAYLAND_DISPLAY
50 11 50 33     29 if (exists($ENV{WAYLAND_DISPLAY}) && length($ENV{WAYLAND_DISPLAY}))
51             {
52 0         0 require Clipboard::WaylandClipboard;
53 0 0       0 return 'WaylandClipboard' if Clipboard::WaylandClipboard::available();
54             }
55 11         102 foreach my $d (sort keys %drivers)
56             {
57 99 100       642 if ($os =~ /$d/i)
58             {
59 10         59 return $drivers{$d};
60             }
61             }
62             # use xsel/xclip on unknown OSes that seem to have a DISPLAY
63 1 50       6 if (exists($ENV{DISPLAY}))
64             {
65 0         0 require Clipboard::Xsel;
66 0 0       0 return 'Xsel' if Clipboard::Xsel::xsel_available();
67 0         0 require Clipboard::Xclip;
68 0 0       0 return 'Xclip' if Clipboard::Xclip::xclip_available();
69             }
70              
71 1         41 die "The $os system is not yet supported by Clipboard.pm. Please email rking\@panoptic.com and tell him about this.\n";
72             }
73              
74             sub import {
75 3     3   359000 my $self = shift;
76 3         13 my $drv = Clipboard->find_driver($^O);
77 3         1132 require "Clipboard/$drv.pm";
78 3         57 $driver = "Clipboard::$drv";
79 3         224 return;
80             }
81              
82             1;
83             # vi:tw=72
84              
85             __END__
86              
87             =pod
88              
89             =encoding UTF-8
90              
91             =head1 NAME
92              
93             Clipboard - Copy and paste with any OS
94              
95             =head1 VERSION
96              
97             version 0.32
98              
99             =head1 SYNOPSIS
100              
101             use Clipboard;
102             print Clipboard->paste;
103             Clipboard->copy('foo');
104             # Same as copy on non-X / non-Xclip systems
105             Clipboard->copy_to_all_selections('text_to_copy');
106              
107             Clipboard->cut() is an alias for copy(). copy() is the preferred
108             method, because we're not really "cutting" anything.
109              
110             =head1 DESCRIPTION
111              
112             Who doesn't remember the first time they learned to copy and paste, and
113             generated an exponentially growing text document? Yes, that's right,
114             clipboards are magical.
115              
116             With Clipboard.pm, this magic is now trivial to access,
117             in a cross-platform-consistent API, from your Perl code.
118              
119             =head1 STATUS
120              
121             Seems to be working well for Linux, OSX, *BSD, and Windows. I use it
122             every day on Linux, so I think I've got most of the details hammered out
123             (X selections are kind of weird). Please let me know if you encounter
124             any problems in your setup.
125              
126             =head1 AUTHOR
127              
128             Ryan King <rking@panoptic.com>
129              
130             =head1 COPYRIGHT
131              
132             Copyright (c) 2010. Ryan King. All rights reserved.
133              
134             This program is free software; you can redistribute it and/or modify it
135             under the same terms as Perl itself.
136              
137             See http://www.perl.com/perl/misc/Artistic.html
138              
139             =head1 SEE ALSO
140              
141             L<clipaccumulate(1)>, L<clipbrowse(1)>, L<clipedit(1)>,
142             L<clipfilter(1)>, L<clipjoin(1)>
143              
144             =for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
145              
146             =head1 SUPPORT
147              
148             =head2 Websites
149              
150             The following websites have more information about this module, and may be of help to you. As always,
151             in addition to those websites please use your favorite search engine to discover more resources.
152              
153             =over 4
154              
155             =item *
156              
157             MetaCPAN
158              
159             A modern, open-source CPAN search engine, useful to view POD in HTML format.
160              
161             L<https://metacpan.org/release/Clipboard>
162              
163             =item *
164              
165             RT: CPAN's Bug Tracker
166              
167             The RT ( Request Tracker ) website is the default bug/issue tracking system for CPAN.
168              
169             L<https://rt.cpan.org/Public/Dist/Display.html?Name=Clipboard>
170              
171             =item *
172              
173             CPANTS
174              
175             The CPANTS is a website that analyzes the Kwalitee ( code metrics ) of a distribution.
176              
177             L<http://cpants.cpanauthors.org/dist/Clipboard>
178              
179             =item *
180              
181             CPAN Testers
182              
183             The CPAN Testers is a network of smoke testers who run automated tests on uploaded CPAN distributions.
184              
185             L<http://www.cpantesters.org/distro/C/Clipboard>
186              
187             =item *
188              
189             CPAN Testers Matrix
190              
191             The CPAN Testers Matrix is a website that provides a visual overview of the test results for a distribution on various Perls/platforms.
192              
193             L<http://matrix.cpantesters.org/?dist=Clipboard>
194              
195             =item *
196              
197             CPAN Testers Dependencies
198              
199             The CPAN Testers Dependencies is a website that shows a chart of the test results of all dependencies for a distribution.
200              
201             L<http://deps.cpantesters.org/?module=Clipboard>
202              
203             =back
204              
205             =head2 Bugs / Feature Requests
206              
207             Please report any bugs or feature requests by email to C<bug-clipboard at rt.cpan.org>, or through
208             the web interface at L<https://rt.cpan.org/Public/Bug/Report.html?Queue=Clipboard>. You will be automatically notified of any
209             progress on the request by the system.
210              
211             =head2 Source Code
212              
213             The code is open to the world, and available for you to hack on. Please feel free to browse it and play
214             with it, or whatever. If you want to contribute patches, please send me a diff or prod me to pull
215             from your repository :)
216              
217             L<https://github.com/shlomif/Clipboard>
218              
219             git clone git://github.com/shlomif/Clipboard.git
220              
221             =head1 AUTHOR
222              
223             Shlomi Fish <shlomif@cpan.org>
224              
225             =head1 BUGS
226              
227             Please report any bugs or feature requests on the bugtracker website
228             L<https://github.com/shlomif/Clipboard/issues>
229              
230             When submitting a bug or request, please include a test-file or a
231             patch to an existing test-file that illustrates the bug or desired
232             feature.
233              
234             =head1 COPYRIGHT AND LICENSE
235              
236             This software is copyright (c) 2025 by Ryan King <rking@panoptic.com>.
237              
238             This is free software; you can redistribute it and/or modify it under
239             the same terms as the Perl 5 programming language system itself.
240              
241             =cut