| Subject: | [PATCH] support xclip over ssh on Win32/cygwin |
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