Skip Menu |
 

This queue is for tickets about the Clipboard CPAN distribution.

Report information
The Basics
Id: 84917
Status: new
Priority: 0/
Queue: Clipboard

People
Owner: Nobody in particular
Requestors: rkitover [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 0.13
Fixed in: (no value)

Attachments
0001-use-xclip-on-Win32-cygwin-over-ssh.patch



Subject: [PATCH] support xclip over ssh on Win32/cygwin
Download (untitled) / with headers
text/plain 194b
Attached is the git format-patch patch (can be applied with git am.) If you are no longer maintaining this module, could you please give me comaint on pause? My CPAN ID is RKITOVER. Thank you!
Subject: 0001-use-xclip-on-Win32-cygwin-over-ssh.patch
From 0dce233a20280a374477838976af0eeaf95bb831 Mon Sep 17 00:00:00 2001 From: Rafael Kitover <rkitover@cpan.org> Date: Mon, 29 Apr 2013 11:46:35 -0400 Subject: [PATCH] use xclip on Win32/cygwin over ssh On Win32 or cygwin, if SSH_CONNECTION is set and xclip is available, use xclip instead of Win32::Clipboard. For unknown OSes, use xclip if DISPLAY is set. --- Changes | 2 ++ lib/Clipboard.pm | 19 ++++++++++++++++++- lib/Clipboard/Xclip.pm | 23 +++++++++++++++++++++-- t/drivers.t | 26 ++++++++++++++++++++++++-- 4 files changed, 65 insertions(+), 5 deletions(-) diff --git a/Changes b/Changes index 073f852..98e6df5 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +- use xclip on cygwin/win32 if SSH_CONNECTION is set (rkitover) +- use xclip if DISPLAY is set and OS is unknown (rkitover) --- version: 0.13 date: Wed Oct 13 00:42:03 EDT 2010 diff --git a/lib/Clipboard.pm b/lib/Clipboard.pm index 4fb4095..fdc2c39 100644 --- a/lib/Clipboard.pm +++ b/lib/Clipboard.pm @@ -18,9 +18,26 @@ sub find_driver { dynixptx hpux irix dragonfly machten next os2 sco_sv solaris sunos svr4 svr5 unicos unicosmk)), bind_os(MacPasteboard => qw(darwin)), - bind_os(Win32 => qw(mswin ^win cygwin)), ); + + 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"; } diff --git a/lib/Clipboard/Xclip.pm b/lib/Clipboard/Xclip.pm index 9da20cd..d5b686c 100644 --- a/lib/Clipboard/Xclip.pm +++ b/lib/Clipboard/Xclip.pm @@ -1,5 +1,7 @@ package Clipboard::Xclip; -use Clipboard; + +use File::Spec (); + sub copy { my $self = shift; my ($input) = @_; @@ -33,8 +35,25 @@ sub paste_from_selection { # This ordering isn't officially verified, but so far seems to work the best: sub all_selections { qw(primary buffer clipboard secondary) } sub favorite_selection { my $self = shift; ($self->all_selections)[0] } + +sub xclip_available { + # close STDERR + open my $olderr, '>&', \*STDERR; + close STDERR; + open STDERR, '>', File::Spec->devnull; + + my $open_retval = open my $just_checking, 'xclip -o|'; + + # restore STDERR + close STDERR; + open STDERR, '>&', $olderr; + close $olderr; + + return $open_retval; +} + { - open my $just_checking, 'xclip -o|' or warn <<'EPIGRAPH'; + xclip_available() or warn <<'EPIGRAPH'; Can't find the 'xclip' script. Clipboard.pm's X support depends on it. diff --git a/t/drivers.t b/t/drivers.t index 1ae7014..a64881e 100644 --- a/t/drivers.t +++ b/t/drivers.t @@ -1,5 +1,6 @@ use Test::Clipboard; use strict; # XXX make Test::Clipboard do this + my %map = qw( linux Xclip freebsd Xclip @@ -10,12 +11,33 @@ my %map = qw( cygwin Win32 darwin MacPasteboard ); + +use_ok 'Clipboard::Xclip'; use_ok 'Clipboard'; + +if (exists $ENV{SSH_CONNECTION} && Clipboard::Xclip::xclip_available()) { + $map{Win32} = 'Xclip'; + $map{cygwin} = 'Xclip'; +} + is(Clipboard->find_driver($_), $map{$_}, $_) for keys %map; + my $drv = Clipboard->find_driver($^O); ok(exists $INC{"Clipboard/$drv.pm"}, "Driver-check ($drv)"); -eval { Clipboard->find_driver('NonOS') }; -like($@, qr/is not yet supported/, 'find_driver correctly fails'); + +eval { + local %ENV = %ENV; + delete $ENV{DISPLAY}; + Clipboard->find_driver('NonOS') +}; +like($@, qr/is not yet supported/, 'find_driver correctly fails with no DISPLAY'); + +my $display_drv = do { + local %ENV = %ENV; + $ENV{DISPLAY} = ':0.0'; + Clipboard->find_driver('NonOS') +}; +is $display_drv, 'Xclip', 'driver is Xclip on unknown OS with DISPLAY set'; is($Clipboard::driver, "Clipboard::$drv", "Actually loaded $drv"); my $silence_stupid_warning = $Clipboard::driver; -- 1.7.9


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.