Clipboard-0.13/0000755000175000017500000000000011455234473012352 5ustar rkingrkingClipboard-0.13/scripts/0000755000175000017500000000000011455234473014041 5ustar rkingrkingClipboard-0.13/scripts/clipjoin0000755000175000017500000000373511453216156015602 0ustar rkingrking#!/usr/bin/perl use Clipboard; use strict; my $data = join '', Clipboard->paste; $data =~ s/\s+\|\s+//gm; $data =~ s/^\+//gm; $data =~ s/\n//gms; $data =~ s/\s{2,}/ /g; Clipboard->copy($data); print Clipboard->paste, "\n...is now in the Clipboard\n" unless $ARGV[0] eq '-q'; =head1 NAME clipjoin - Remove superfluous spaces from the clipboard. =head1 MOTIVATION Often you'll copy some stuff, like this: hey rking, you should use YBFOD: http://search.cpan | .org/~ingy/Acme-YBFOD-0.11/ Getting that URL to a browser is tedious. Another IRC example is longer quotes: Objective consideration of contemporary phenomena compels the conclusion that success or failure in competitive activities exhibits no tendency to be commensurate with enate capacity but that a considerable element of the unpredictable must invariably be taken into account. I returned, and saw under the sun, that the race is not to the swift, nor the battle to the strong, neither yet bread to the wise, nor yet riches to men of understanding, nor yet favour to men of skill, but time and chance happeneth to them all. If you wanted to quote that to someone, you'd have \n's and " "'s everywhere, unless you ran "clipjoin" first. An example from mutt: ,-------------------------------------------. | xterm (X) | +-------------------------------------------+ | http://www.thisisalink.com/that/wrapped/ar| |+ound/a/line/and/its/a/pain/without/the/joi| |+inclip/script | `-------------------------------------------' Becomes: http://www.thisisalink.com/that/wrapped/around/a/line/and/its/a/pain/without/the/clipjoin/script =head1 AUTHOR Ryan King =head1 COPYRIGHT Copyright (c) 2010. Ryan King. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L Clipboard-0.13/scripts/clipbrowse0000755000175000017500000000334011453225176016136 0ustar rkingrking#!/usr/bin/perl -w use strict; use Clipboard; my $browser = $ENV{BROWSER} || 'chromium-browser "%s"'; $browser .= ' %s' unless $browser =~ /%s/; my $query = Clipboard->paste; $query =~ s/['"]/\\$&/; system(sprintf $browser, $query); =head1 NAME clipbrowse - Load a URL from the clipboard into your browser. =head1 USAGE # ...copy something # (You might want to do a `clipjoin` if the URL text is messy) $ clipbrowse Remember that many browsers will usefully load things that don't look like URL's. For example Firefox does a Google "I'm feeling lucky" with non-URLs. This means you can have any text in your clipboard and `clipbrowse`. =head1 MOTIVATION It saves a couple of seconds every time you run it. Chrome and Firefox, for examples, automatically create a new tab and loads the page when you invoke it from the command line. Already we've saved a Ctrl+T and a Shift+Insert. When you consider the parallelizing (that your browser will be actively loading the page while you're Alt+Tabbing to it), you've squeaked out a little more. Maybe I'm just a freak, but I like shaving out wasted time like that. =head1 CONFIGURATION The environment variable C<$BROWSER> will override the default launching command. If you have a %s in the line, it will be replaced with the url. if not, the url will be appended at the end. The default is `chromium-browser "%s"` (Debian's Google Chrome) If you still use Firefox, consider: `firefox -remote "openURL(%s,new-tab)"'`. =head1 AUTHOR Ryan King =head1 COPYRIGHT Copyright (c) 2010. Ryan King. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L Clipboard-0.13/scripts/clipaccumulate0000755000175000017500000000346111453216156016762 0ustar rkingrking#!/usr/bin/perl use strict; use Clipboard; my $END_STRING = 'endEndENDenDend'; my $should_quit = 0; my $prev = Clipboard->paste; my $total = ''; warn "To exit, hit ^C, or copy this string into the clipboard: $END_STRING\n"; $SIG{INT} = sub { $should_quit = 1 }; while (1) { my $cur = Clipboard->paste; $should_quit = 1 if $cur eq $END_STRING; last if $should_quit; if ($prev ne $cur) { print $cur, ' '; $total .= $cur . ' '; } $prev = $cur; } END { Clipboard->copy($total); print "\nClipboard accumulated.\n"; } =head1 NAME clipaccumulate - Make a bunch of little clipboards into one big one. =head1 USAGE The first thing it says (which goes to STDERR, so you can redirect into a file if you want), is how to exit, which is by copying the magic "end" string into the clipboard. Crufty? Yep. You can still do Ctrl+C if you don't like this (or if the string scrolls off the top of the screen). The next thing it does is wait for the clipboard to change, at which point it will print out the new data and go back to waiting for the clipboard to change. Then you copy the exit string, and it will fill the clipboard with all the little pieces it saw along the way. (Right now, it just joins everything with spaces in between - is this bugging anyone?) =head1 MOTIVATION Hard to explain. I run into cases where I wanted to make a bunch of small notes that included all these different bits of info. Instead of jotting them down on a scrap of paper, I made this. Let me know how it can be made better. =head1 AUTHOR Ryan King =head1 COPYRIGHT Copyright (c) 2010. Ryan King. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L Clipboard-0.13/scripts/clipedit0000755000175000017500000000470111453234215015556 0ustar rkingrking#!/usr/bin/perl use strict; use Clipboard; my $orig = Clipboard->paste; my $tmpfilename = "/tmp/clipedit$$"; open my $tmpfile, ">$tmpfilename" or die "Failure to open $tmpfilename: $!"; print $tmpfile $orig; close $tmpfile; my $ed = $ENV{VISUAL} || $ENV{EDITOR} || 'vim'; system($ed, $tmpfilename); open $tmpfile, $tmpfilename or die "Failure to open $tmpfilename: $!"; my $edited = join '', <$tmpfile>; my $current = Clipboard->paste; if ($current ne $orig) { local $| = 1; boldprint("1) When you started, the Clipboard contained:\n"); print $orig; boldprint("\n2) ...but now the Clipboard contains:\n"); print $current; boldprint("\n3) and you edited to this:\n"); print $edited; boldprint("\nWhich would you like to use (1, 2, or the default, 3)? "); my %actions = ( 1 => $orig, 2 => $current, 3 => $edited, ); my $answer; while (1) { $answer = ; chomp $answer; $answer = 3 if $answer eq ''; last if exists $actions{$answer}; my @puzzles = qw(hrm what huh uhh who because sneevle); boldprint(ucfirst($puzzles[int rand $#puzzles]) . "? "); } $edited = $actions{$answer}; } Clipboard->copy($edited); print Clipboard->paste; boldprint("\n...is now in the Clipboard\n"); unlink($tmpfilename) or die "Couldn't remove $tmpfilename: $!"; sub boldprint { # If you are in a situation where this output is annoying, such as in a # DOS console without ANSI parsing, please send a patch. For now, I'll # just do the simplest thing and print it every time: printf "\e[033m%s\e[0m", shift; } =head1 NAME clipedit - Edit clipboard contents in one swoop. =head1 MOTIVATION Eliminating the "Open editor, edit stuff, copy back to the clipboard" shuffle. =head1 NOTE If for some reason the clipboard contents changes during the edit session, you will be prompted to choose between 1) the original Clipboard contents, 2) the new Clipboard contents, and 3) the result of your edits (which is the default if you just hit "Enter"). =head1 CONFIGURATION If you don't want the script to use C to edit, set either the environment variable C<$VISUAL> or C<$EDITOR>. =head1 AUTHOR Ryan King =head1 COPYRIGHT Copyright (c) 2010. Ryan King. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L Clipboard-0.13/scripts/clipfilter0000755000175000017500000000425711453252255016130 0ustar rkingrking#!/usr/bin/perl use strict; use Clipboard; my %methods = ( -html => sub { require CGI; CGI::escapeHTML($_[0]) }, -uri => sub { require URI::Escape; URI::Escape::uri_escape($_[0]) }, ); my $result = filter($ARGV[0], Clipboard->paste); Clipboard->copy($result); print $result, "\n... is now in the clipboard.\n"; sub filter { my ($method, $data) = @_; if (exists $methods{$method}) { return $methods{$method}->($data); } else { require IPC::Open2; my ($child_out, $child_in); my $cmd_text = join ' ', @ARGV; # just for error message output my $pid = IPC::Open2::open2($child_out, $child_in, @ARGV) or die "Couldn't open pipe to `$cmd_text`: $!"; print $child_in $data or die "Couldn't write to `$cmd_text`: $?"; close $child_in or die "Couldn't close 'in' for `$cmd_text`: $?"; my $ret = join '', <$child_out>; # Hrmm... error handling? close $child_out or die "Couldn't close 'out' for `$cmd_text`: $?"; waitpid($pid, 0); die "Child error for `$cmd_text`: $?" if $? >> 8; return $ret; } } =head1 NAME clipfilter - Run various conversions for your clipboard data. =head1 USAGE # (copy some stuff) $ clipfilter -html # (paste, with html entities substituted in) # or URI-escaping: $ clipfilter -uri # or pipe through an arbitrary program, like `tac`, the backwards cat: $ clipfilter tac # Note: currently, this just dumps everything to open2() and reads # everything back. It could possibly create a deadlock, but I haven't # found the case that causes this, yet. =head1 MOTIVATION A very frequent user pattern is to copy something, edit it in some rote way, and then paste it back. Writing your own filter scripts will make it even more useful. =head1 BUGS Current weirdness when piping this to some programs, like 'wc' and 'tail'. I will work on this. =head1 AUTHOR Ryan King =head1 COPYRIGHT Copyright (c) 2010. Ryan King. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L Clipboard-0.13/README0000644000175000017500000000223711453216156013232 0ustar rkingrkingSYNOPSIS use Clipboard; print Clipboard->paste; Clipboard->copy('foo'); Clipboard->cut() is an alias for copy(). copy() is the preferred method, because we're not really "cutting" anything. Also see the scripts: clipaccumulate clipbrowse clipedit clipfilter clipjoin DESCRIPTION Who doesn't remember the first time they learned to copy and paste, and generated an exponentially growing text document? Yes, that's right, clipboards are magical. With Clipboard.pm, this magic is now trivial to access, in a cross-platform-consistent API, from your Perl code. STATUS Seems to be working well for Linux, OSX, *BSD, and Windows. I use it every day on Linux, so I think I've got most of the details hammered out (X selections are kind of weird). Please let me know if you encounter any problems in your setup. AUTHOR Ryan King COPYRIGHT Copyright (c) 2010. Ryan King. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See http://www.perl.com/perl/misc/Artistic.html Clipboard-0.13/t/0000755000175000017500000000000011455234473012615 5ustar rkingrkingClipboard-0.13/t/mock.t0000644000175000017500000000041411422435322013720 0ustar rkingrkinguse Test::Clipboard; use Test::MockClipboard; use strict; # XXX make Test::Clipboard do this $Clipboard::driver = 'PhonyClipboard'; my $str = 'Semirobotic Invasion'; Clipboard->copy($str); is($PhonyClipboard::board, $str, 'copy'); is(Clipboard->paste, $str, 'paste'); Clipboard-0.13/t/drivers.t0000644000175000017500000000117611455234405014460 0ustar rkingrkinguse Test::Clipboard; use strict; # XXX make Test::Clipboard do this my %map = qw( linux Xclip freebsd Xclip netbsd Xclip openbsd Xclip dragonfly Xclip Win32 Win32 cygwin Win32 darwin MacPasteboard ); use_ok 'Clipboard'; 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'); is($Clipboard::driver, "Clipboard::$drv", "Actually loaded $drv"); my $silence_stupid_warning = $Clipboard::driver; Clipboard-0.13/META.yml0000644000175000017500000000064411455234456013630 0ustar rkingrking--- abstract: 'Cliboard - Copy and Paste with any OS' author: - 'Ryan King ' distribution_type: module generated_by: 'Module::Install version 0.77' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Clipboard no_index: directory: - inc - t requires: perl: 5.6.0 resources: license: http://dev.perl.org/licenses/ version: 0.13 Clipboard-0.13/inc/0000755000175000017500000000000011455234473013123 5ustar rkingrkingClipboard-0.13/inc/Module/0000755000175000017500000000000011455234473014350 5ustar rkingrkingClipboard-0.13/inc/Module/Install.pm0000644000175000017500000002116211453216156016312 0ustar rkingrking#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } BEGIN { require 5.004; } use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.77'; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" } Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); use Cwd (); use File::Find (); use File::Path (); use FindBin; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unless ( uc($1) eq $1 ) { unshift @_, ( $self, $1 ); goto &{$self->can('call')}; } }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; open FH, "< $_[0]" or die "open($_[0]): $!"; my $str = do { local $/; }; close FH or die "close($_[0]): $!"; return $str; } sub _write { local *FH; open FH, "> $_[0]" or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" } close FH or die "close($_[0]): $!"; } # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s ) ? $_[0] : undef; } 1; # Copyright 2008 Adam Kennedy. Clipboard-0.13/inc/Module/Install/0000755000175000017500000000000011455234473015756 5ustar rkingrkingClipboard-0.13/inc/Module/Install/Win32.pm0000644000175000017500000000340211453216156017211 0ustar rkingrking#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.77'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Clipboard-0.13/inc/Module/Install/Metadata.pm0000644000175000017500000002700211453216156020031 0ustar rkingrking#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}{resources} }; } return $self->{values}{resources}{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } sub requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{requires} }, [ $module, $version ]; } $self->{values}{requires}; } sub build_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{build_requires} }, [ $module, $version ]; } $self->{values}{build_requires}; } sub configure_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{configure_requires} }, [ $module, $version ]; } $self->{values}{configure_requires}; } sub recommends { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{recommends} }, [ $module, $version ]; } $self->{values}{recommends}; } sub bundles { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{bundles} }, [ $module, $version ]; } $self->{values}{bundles}; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}{resources} ||= []; push @{ $self->{values}{resources} }, [ $name, $value ]; } $self->{values}{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{values}{sign} if defined wantarray and ! @_; $self->{values}{sign} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; return $self->{values}{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). $version =~ s/^(\d+)\.(\d+)\.(\d+)$/sprintf("%d.%03d%03d",$1,$2,$3)/e; $version =~ s/_.+$//; $version = $version + 0; # Numify unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}{perl_version} = $version; return 1; } sub license { my $self = shift; return $self->{values}{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $self->{values}{license} = $license; # Automatically fill in license URLs if ( $license eq 'perl' ) { $self->resources( license => 'http://dev.perl.org/licenses/' ); } return 1; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless $self->author; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}{features} ? @{ $self->{values}{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub perl_version_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub license_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n"; } $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g; unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than on rt.cpan.org link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die("Cannot find script '$_'"); } } } 1; Clipboard-0.13/inc/Module/Install/WriteAll.pm0000644000175000017500000000132111453216156020030 0ustar rkingrking#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.77'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } } 1; Clipboard-0.13/inc/Module/Install/Can.pm0000644000175000017500000000342211453216156017012 0ustar rkingrking#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 158 Clipboard-0.13/inc/Module/Install/Makefile.pm0000644000175000017500000001454611453216156020037 0ustar rkingrking#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ( $self->{makemaker_args} ||= {} ); %$args = ( %$args, @_ ); return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Make sure we have a new enough require ExtUtils::MakeMaker; # MakeMaker can complain about module versions that include # an underscore, even though its own version may contain one! # Hence the funny regexp to get rid of it. See RT #35800 # for details. $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); # Generate the my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 379 Clipboard-0.13/inc/Module/Install/Fetch.pm0000644000175000017500000000463011453216156017344 0ustar rkingrking#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.77'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Clipboard-0.13/inc/Module/Install/Base.pm0000644000175000017500000000205011453216156017157 0ustar rkingrking#line 1 package Module::Install::Base; $VERSION = '0.77'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 101 sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 146 Clipboard-0.13/INSTALL0000644000175000017500000000045511422435322013375 0ustar rkingrkingperl Makefile.PL && make all test && sudo make install # or, if you aren't rootish: # perl Makefile.PL PREFIX=~/local && make all test install # If you're missing any dependencies, "perl Makefile.PL" will let you know # (hopefully). Just use "cpan" to install them, and you should be ready to # go. Clipboard-0.13/at/0000755000175000017500000000000011455234473012756 5ustar rkingrkingClipboard-0.13/at/clipbrowse-test0000755000175000017500000000071011453252255016024 0ustar rkingrking#!/bin/sh PATH=scripts:$PATH PCBe='perl -Ilib -MClipboard -e' CB='perl -Ilib scripts/clipbrowse' # BROWSER="firefox -remote \"openURL(%s,new-tab)\"" echo "# \$BROWSER == '$BROWSER'" echo "# Using $CB" $PCBe 'print qq[# and $INC{"Clipboard.pm"}\n]' check() { echo -n Checking "$1" $PCBe 'Clipboard->copy($ARGV[0])' "$1" || exit 1 $CB || exit 1 echo ' ok' } check 'http://cpan.org' check cpan check "'" check '"' check '()*&#(*&$;$$!!!#$@#' Clipboard-0.13/at/clipfilter-test0000755000175000017500000000043211453252255016011 0ustar rkingrking#!/bin/sh -x reset_data() { cat scripts/clip* | perl -Ilib -MClipboard -e 'Clipboard->copy(join "", <>)' } reset_data perl -Ilib scripts/clipfilter -html # TODO: | tail <--buggy reset_data perl -Ilib scripts/clipfilter -uri reset_data perl -Ilib scripts/clipfilter tac Clipboard-0.13/at/pxclip0000755000175000017500000000104011453234215014166 0ustar rkingrking#!/bin/sh # Useful for exploring the way X selections work. # For example, run watch -n1 pxclip in one xterm, then highlight something in # another. Now single-click in the xterm to remove the highlighting. Now # highlight something in Firefox. Now highlight something in the xterm again. # Now switch back to Firefox, and hit ^C. # Weird, huh? for n in primary secondary clipboard buffer; do echo == $n == xclip -o -selection $n echo done echo == Clipboard.pm default == perl -Ilib -MClipboard -e "print Clipboard->paste" echo Clipboard-0.13/at/clipjoin-test0000755000175000017500000000127111453252255015465 0ustar rkingrking#!/usr/bin/perl -w use strict; use lib 'lib'; use Clipboard; my $CJ = 'perl -Ilib scripts/clipjoin'; print "# Using $CJ and $INC{'Clipboard.pm'}\n"; my %tests = ( "http://as\ndf.com" => 'http://asdf.com', "http://as\n | df.com" => 'http://asdf.com', "http://as\n+df.com" => 'http://asdf.com', "A\n tall \nquote." => 'A tall quote.', # html-ish interpretation of space ); for my $input (keys %tests) { my $expected = $tests{$input}; Clipboard->copy($input); system("$CJ -q") == 0 or die "$CJ failed: $!"; my $actual = Clipboard->paste; if ($actual ne $expected) { print "[$actual] != [$expected]\n"; } else { print "$actual ok\n"; } } Clipboard-0.13/at/all-xclip-selections0000755000175000017500000000071411422435322016727 0ustar rkingrking#!/usr/bin/perl -w # prove that Clipboard::Xclip will dig around through the selections until it # finds something. use strict; use lib 'lib'; use Clipboard; use Test::More 'no_plan'; for (Clipboard::Xclip->all_selections) { my $str = "$_ paste worked\n\nwith double-newlines, even."; Clipboard::Xclip->copy_to_selection($_, $str); my $actual = Clipboard->paste; is $actual, $str, "$_ test"; Clipboard::Xclip->copy_to_selection($_, ''); } Clipboard-0.13/at/all0000755000175000017500000000031211453252255013444 0ustar rkingrking#!/bin/sh -v for n in \ at/run \ at/pxclip \ at/all-xclip-selections \ at/clipfilter-test \ at/clipjoin-test \ at/clipbrowse-test \ ; do echo -n "Run $n? "; read X; $n; done Clipboard-0.13/at/run0000755000175000017500000000073011422435322013476 0ustar rkingrking#!/usr/bin/perl -w # Basic acceptance test. I didn't want to put anything that messes with the # real clipboard into t/ in case it ends up inadvertently messing up someones # selection, somehow. use strict; use lib 'lib'; use Clipboard; my $save = Clipboard->paste; print "Original: ", Clipboard->paste, "\n"; Clipboard->copy('looks like Clipboard->copy works'); print " Now: ", Clipboard->paste, "\n"; Clipboard->copy($save); print "(Restored original clipboard)\n" Clipboard-0.13/lib/0000755000175000017500000000000011455234473013120 5ustar rkingrkingClipboard-0.13/lib/Clipboard/0000755000175000017500000000000011455234473015017 5ustar rkingrkingClipboard-0.13/lib/Clipboard/Win32.pm0000644000175000017500000000030311453234215016243 0ustar rkingrkingpackage Clipboard::Win32; use Win32::Clipboard; our $board = Win32::Clipboard(); sub copy { my $self = shift; $board->Set($_[0]); } sub paste { my $self = shift; $board->Get(); } Clipboard-0.13/lib/Clipboard/MacPasteboard.pm0000644000175000017500000000042411455232637020062 0ustar rkingrkingpackage Clipboard::MacPasteboard; use Mac::Pasteboard; our $board = Mac::Pasteboard->new(); $board->set( missing_ok => 1 ); sub copy { my $self = shift; $board->clear(); $board->copy($_[0]); } sub paste { my $self = shift; return scalar $board->paste(); } Clipboard-0.13/lib/Clipboard/Xclip.pm0000644000175000017500000000246211453243242016430 0ustar rkingrkingpackage Clipboard::Xclip; use Clipboard; sub copy { my $self = shift; my ($input) = @_; $self->copy_to_selection($self->favorite_selection, $input); } sub copy_to_selection { my $self = shift; my ($selection, $input) = @_; my $cmd = '|xclip -i -selection '. $selection; my $r = open my $exe, $cmd or die "Couldn't run `$cmd`: $!\n"; print $exe $input; close $exe or die "Error closing `$cmd`: $!"; } sub paste { my $self = shift; for ($self->all_selections) { my $data = $self->paste_from_selection($_); return $data if length $data; } undef } sub paste_from_selection { my $self = shift; my ($selection) = @_; my $cmd = "xclip -o -selection $selection|"; open my $exe, $cmd or die "Couldn't run `$cmd`: $!\n"; my $result = join '', <$exe>; close $exe or die "Error closing `$cmd`: $!"; return $result; } # 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] } { open my $just_checking, 'xclip -o|' or warn <<'EPIGRAPH'; Can't find the 'xclip' script. Clipboard.pm's X support depends on it. Here's the project homepage: http://sourceforge.net/projects/xclip/ EPIGRAPH } Clipboard-0.13/lib/Clipboard.pm0000644000175000017500000000442711455233566015366 0ustar rkingrkingpackage Clipboard; our $VERSION = '0.13'; our $driver; sub copy { my $self = shift; $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 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)), ); $os =~ /$_/i && return $drivers{$_} for keys %drivers; 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; =head1 NAME Clipboard - Copy and paste with any OS =head1 SYNOPSIS use Clipboard; print Clipboard->paste; Clipboard->copy('foo'); Clipboard->cut() is an alias for copy(). copy() is the preferred method, because we're not really "cutting" anything. Also see the scripts: clipaccumulate clipbrowse clipedit clipfilter clipjoin =head1 DESCRIPTION Who doesn't remember the first time they learned to copy and paste, and generated an exponentially growing text document? Yes, that's right, clipboards are magical. With Clipboard.pm, this magic is now trivial to access, in a cross-platform-consistent API, from your Perl code. =head1 STATUS Seems to be working well for Linux, OSX, *BSD, and Windows. I use it every day on Linux, so I think I've got most of the details hammered out (X selections are kind of weird). Please let me know if you encounter any problems in your setup. =head1 AUTHOR Ryan King =head1 COPYRIGHT Copyright (c) 2010. Ryan King. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See http://www.perl.com/perl/misc/Artistic.html =cut # vi:tw=72 Clipboard-0.13/Makefile.PL0000644000175000017500000000064511453234215014321 0ustar rkingrkinguse inc::Module::Install; name('Clipboard'); author('Ryan King '); abstract('Cliboard - Copy and Paste with any OS'); license('perl'); version_from 'lib/Clipboard.pm'; perl_version 5.006; requires 'Win32::Clipboard' if $^O =~ /mswin|cygwin/i; requires 'Mac::Pasteboard' if $^O =~ /macos|darwin/i; install_script("scripts/clip$_") for qw'join edit browse accumulate filter'; check_nmake(); WriteAll(); Clipboard-0.13/MANIFEST0000644000175000017500000000121311453252255013474 0ustar rkingrkingat/all at/all-xclip-selections at/clipbrowse-test at/clipfilter-test at/clipjoin-test at/pxclip at/run Changes inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm INSTALL lib/Clipboard.pm lib/Clipboard/MacPasteboard.pm lib/Clipboard/Win32.pm lib/Clipboard/Xclip.pm Makefile.PL MANIFEST This list of files META.yml README scripts/clipaccumulate scripts/clipbrowse scripts/clipedit scripts/clipfilter scripts/clipjoin t/drivers.t t/mock.t Test/Clipboard.pm Test/MockClipboard.pm Clipboard-0.13/Test/0000755000175000017500000000000011455234473013271 5ustar rkingrkingClipboard-0.13/Test/MockClipboard.pm0000644000175000017500000000025111453243242016326 0ustar rkingrkingpackage PhonyClipboard; our $board = ''; sub copy { my $self = shift; $board = $_[0]; } sub paste { my $self = shift; $board } $Clipboard::driver = 'PhonyClipboard'; 1; Clipboard-0.13/Test/Clipboard.pm0000644000175000017500000000012511453243242015514 0ustar rkingrkinguse Test::More 'no_plan'; use strict; use warnings; use lib 'lib'; use Clipboard; 1; Clipboard-0.13/Changes0000644000175000017500000000374511455234342013651 0ustar rkingrking--- version: 0.13 date: Wed Oct 13 00:42:03 EDT 2010 changes: - Tom Wyant's excellent Mac fixups --- version: 0.12 date: Mon Oct 11 02:11:44 EDT 2010 changes: - Just added 'dragonfly' OS to recognized list (as *nix type) --- version: 0.11 date: Thu Oct 7 00:20:45 EDT 2010 changes: - Removed dependency on IO::All, Spiffy and IO::Run (!) - Switched Mac from pbcopy shelling to Mac::Pasteboard (Tom Wyant) - Improved error handling of Xclip.pm - Added at/clipfilter-test --- version: 0.10 date: Wed Oct 6 21:16:25 EDT 2010 changes: - Correct recognition of Windows in Makefile.PL (Alexandr Ciornii) - Makefile.PL version update (Alexandr Ciornii) - clipjoin now escapes weechat-type mess, and also now has -q flag. - clipbrowse now defaults to chromium-browser. - added at/clipjoin-test and at/clipbrowse-test - Updating email address and copyright date. - Minor text updates here and there. --- version: 0.09 date: Thu Oct 20 09:30:45 CDT 2005 changes: - Included Anton Berezin's Clipboard::Xclip fix for data that includes \n\n - Added scripts/clipfilter (also with Anton's feedback) - Removed dependency on IO::All - Cheated to make CPAN tests pass (turned 'xclip' dependency into warning). The real fix here is probably to Inline::C it - the xclip source is not that hard to read and pare down to a minimal set. --- version: 0.08 date: Tue Jun 21 23:10:15 CDT 2005 changes: - Fixed the MSWin32 OS string. Oops - I thought it was winSomething - Added a few more OS strings - clipaccumulate, the most obscure script in the batch! --- version: 0.07 date: Thu Jun 2 00:10:26 PDT 2005 changes: - fixed stupid typo in clipedit. Not sure how I let this slip by me. =\ --- version: 0.06 date: Wed Jun 1 11:30:37 PDT 2005 changes: - `editclip`, sure to be a celebrated entry in the world of clipboard editing! - Renamed `joinclip` to `clipjoin`, and `browseclip` to `clipbrowse`. Sorry if you already are in the habit of typing the others (I still am). - `clipbrowse` now opens URLs into a new tab.