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

package Clipboard;
$Clipboard::VERSION = '0.26';
use strict;
use warnings;

our $driver;

sub copy { my $self = shift; $driver->copy(@_); }
sub copy_to_all_selections {
    my $self = shift;
    my $meth = $driver->can('copy_to_all_selections');
    return $meth ? $meth->($driver, @_) : $driver->copy(@_);
}

sub cut { goto © }
sub paste { my $self = shift; $driver->paste(@_); }

sub bind_os { my $driver = shift; map { $_ => $driver } @_; }
sub find_driver {
    my $self = shift;
    my $os = shift;
    my %drivers = (
        # list stolen from Module::Build, with some modifications (for
        # example, cygwin doesn't count as Unix here, because it will
        # use the Win32 clipboard.)
        bind_os(Xclip => qw(linux bsd$ aix bsdos dec_osf dgux
            dynixptx gnu hpux irix dragonfly machten next os2 sco_sv solaris
            sunos svr4 svr5 unicos unicosmk)),
        bind_os(MacPasteboard => qw(darwin)),
    );

    if ($os =~ /^(?:mswin|win|cygwin)/i) {
        # If we are connected to windows through ssh, and xclip is
        # available, use it.
        if (exists $ENV{SSH_CONNECTION}) {
            local $SIG{__WARN__} = sub {};
            require Clipboard::Xclip;

            return 'Xclip' if Clipboard::Xclip::xclip_available();
        }

        return 'Win32';
    }

    $os =~ /$_/i && return $drivers{$_} for keys %drivers;

    # use xclip on unknown OSes that seem to have a DISPLAY
    return 'Xclip' if exists $ENV{DISPLAY};

    die "The $os system is not yet supported by Clipboard.pm.  Please email rking\@panoptic.com and tell him about this.\n";
}

sub import {
    my $self = shift;
    my $drv = Clipboard->find_driver($^O);
    require "Clipboard/$drv.pm";
    $driver = "Clipboard::$drv";
}

1;
# vi:tw=72

__END__