r57840 - in /branches/upstream/libshell-perl: ./ current/ current/Changes current/MANIFEST current/META.yml current/Makefile.PL current/README current/Shell.pm current/t/ current/t/01_use.t current/t/99_pod.t current/t/Shell.t

dom at users.alioth.debian.org dom at users.alioth.debian.org
Wed May 12 20:01:06 UTC 2010


Author: dom
Date: Wed May 12 20:00:48 2010
New Revision: 57840

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=57840
Log:
[svn-inject] Installing original source of libshell-perl

Added:
    branches/upstream/libshell-perl/
    branches/upstream/libshell-perl/current/
    branches/upstream/libshell-perl/current/Changes
    branches/upstream/libshell-perl/current/MANIFEST
    branches/upstream/libshell-perl/current/META.yml
    branches/upstream/libshell-perl/current/Makefile.PL
    branches/upstream/libshell-perl/current/README
    branches/upstream/libshell-perl/current/Shell.pm
    branches/upstream/libshell-perl/current/t/
    branches/upstream/libshell-perl/current/t/01_use.t
    branches/upstream/libshell-perl/current/t/99_pod.t
    branches/upstream/libshell-perl/current/t/Shell.t   (with props)

Added: branches/upstream/libshell-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libshell-perl/current/Changes?rev=57840&op=file
==============================================================================
--- branches/upstream/libshell-perl/current/Changes (added)
+++ branches/upstream/libshell-perl/current/Changes Wed May 12 20:00:48 2010
@@ -1,0 +1,22 @@
+
+Revision history for Shell.
+
+0.72    Fri Feb 2 2007
+        - no real change
+        - fixed test bug that produced false warning	
+
+0.71    Wed Jul 7 2006
+        - fixed POD: =begin private with no =end private
+        - new tests t/01_use.t and t/99_pod.t
+
+0.7     Wed Jul 6 2006 
+        - using closures rather than eval "string" (r466)
+        - tabs to spaces in sources (r468)
+        - (change #28502 to bleadperl)
+
+0.6     Wed Jul 5 2006
+        - initial CPAN release
+
+undef   Thu Sep 22 1994
+        - Larry Wall posts to perl5-porters at isu.edu about
+          "a new module [he] just wrote": Shell.pm

Added: branches/upstream/libshell-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libshell-perl/current/MANIFEST?rev=57840&op=file
==============================================================================
--- branches/upstream/libshell-perl/current/MANIFEST (added)
+++ branches/upstream/libshell-perl/current/MANIFEST Wed May 12 20:00:48 2010
@@ -1,0 +1,11 @@
+Changes
+README
+Makefile.PL
+MANIFEST			This list of files
+
+Shell.pm
+t/Shell.t
+t/01_use.t
+t/99_pod.t
+
+META.yml                                 Module meta-data (added by MakeMaker)

Added: branches/upstream/libshell-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libshell-perl/current/META.yml?rev=57840&op=file
==============================================================================
--- branches/upstream/libshell-perl/current/META.yml (added)
+++ branches/upstream/libshell-perl/current/META.yml Wed May 12 20:00:48 2010
@@ -1,0 +1,12 @@
+--- #YAML:1.0
+name:                Shell
+version:             0.72
+abstract:            run shell commands transparently within perl
+license:             perl
+generated_by:        ExtUtils::MakeMaker version 6.31
+distribution_type:   module
+requires:     
+    Test::More:                    0
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.2.html
+    version: 1.2

Added: branches/upstream/libshell-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libshell-perl/current/Makefile.PL?rev=57840&op=file
==============================================================================
--- branches/upstream/libshell-perl/current/Makefile.PL (added)
+++ branches/upstream/libshell-perl/current/Makefile.PL Wed May 12 20:00:48 2010
@@ -1,0 +1,20 @@
+
+use ExtUtils::MakeMaker;
+
+my $EUMM_VERSION = eval $ExtUtils::MakeMaker::VERSION;
+
+WriteMakefile(
+  NAME           => 'Shell',
+  VERSION_FROM   => 'Shell.pm',
+  INSTALLDIRS    => 'perl',
+  PREREQ_PM      => {
+    'Test::More' => 0,
+  },
+  ($] >= 5.005 ? (
+    ABSTRACT_FROM => 'Shell.pm',
+  ) : ()),
+  ($EUMM_VERSION >= 6.31 ? (
+    LICENSE => 'perl', 
+  ) :())
+
+);

Added: branches/upstream/libshell-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libshell-perl/current/README?rev=57840&op=file
==============================================================================
--- branches/upstream/libshell-perl/current/README (added)
+++ branches/upstream/libshell-perl/current/README Wed May 12 20:00:48 2010
@@ -1,0 +1,50 @@
+Shell version 0.72
+==================
+
+NAME
+
+    Shell - run shell commands transparently within perl
+
+SYNOPSIS
+
+       use Shell qw(cat ps cp);
+       $passwd = cat('</etc/passwd');
+       @pslines = ps('-ww'),
+       cp("/etc/passwd", "/tmp/passwd");
+
+       # object oriented 
+       my $sh = Shell->new;
+       print $sh->ls('-l');
+
+DESCRIPTION
+
+This package is a show case, illustrating how to provide a 
+simple interface for obtaining the standard output of
+arbitrary commands. It shouldn't be used for production programs. 
+
+This was originally written by Larry Wall back in 1994.
+Later contributions came from Jenda at Krynicky.cz, Dave Cottle,
+Casey West and Wolfgang Laun.
+
+Extracted from core distribution for publishing on the CPAN 
+by Adriano Ferreira <ferreira at cpan.org>.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+  Test::More
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2005 by Perl 5 Porters
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.

Added: branches/upstream/libshell-perl/current/Shell.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libshell-perl/current/Shell.pm?rev=57840&op=file
==============================================================================
--- branches/upstream/libshell-perl/current/Shell.pm (added)
+++ branches/upstream/libshell-perl/current/Shell.pm Wed May 12 20:00:48 2010
@@ -1,0 +1,265 @@
+package Shell;
+use 5.006_001;
+use strict;
+use warnings;
+use File::Spec::Functions;
+
+our($capture_stderr, $raw, $VERSION, $AUTOLOAD);
+
+$VERSION = '0.72';
+
+sub new { bless \my $foo, shift }
+sub DESTROY { }
+
+sub import {
+    my $self = shift;
+    my ($callpack, $callfile, $callline) = caller;
+    my @EXPORT;
+    if (@_) {
+        @EXPORT = @_;
+    } else {
+        @EXPORT = 'AUTOLOAD';
+    }
+    foreach my $sym (@EXPORT) {
+        no strict 'refs';
+        *{"${callpack}::$sym"} = \&{"Shell::$sym"};
+    }
+}
+
+# NOTE: this is used to enable constant folding in 
+# expressions like (OS eq 'MSWin32') and 
+# (OS eq 'os2') just like it happened in  0.6  version 
+# which used eval "string" to install subs on the fly.
+use constant OS => $^O;
+
+=begin private
+
+=item B<_make_cmd>
+
+  $sub = _make_cmd($cmd);
+  $sub = $shell->_make_cmd($cmd);
+
+Creates a closure which invokes the system command C<$cmd>.
+
+=end private
+
+=cut
+
+sub _make_cmd {
+    shift if ref $_[0] && $_[0]->isa( 'Shell' );
+    my $cmd = shift;
+    my $null = File::Spec::Functions::devnull();
+    $Shell::capture_stderr ||= 0;
+    # closing over $^O, $cmd, and $null
+    return sub {
+            shift if ref $_[0] && $_[0]->isa( 'Shell' );
+            if (@_ < 1) {
+                $Shell::capture_stderr ==  1 ? `$cmd 2>&1` : 
+                $Shell::capture_stderr == -1 ? `$cmd 2>$null` : 
+                `$cmd`;
+            } elsif (OS eq 'os2') {
+                local(*SAVEOUT, *READ, *WRITE);
+
+                open SAVEOUT, '>&STDOUT' or die;
+                pipe READ, WRITE or die;
+                open STDOUT, '>&WRITE' or die;
+                close WRITE;
+
+                my $pid = system(1, $cmd, @_);
+                die "Can't execute $cmd: $!\n" if $pid < 0;
+
+                open STDOUT, '>&SAVEOUT' or die;
+                close SAVEOUT;
+
+                if (wantarray) {
+                    my @ret = <READ>;
+                    close READ;
+                    waitpid $pid, 0;
+                    @ret;
+                } else {
+                    local($/) = undef;
+                    my $ret = <READ>;
+                    close READ;
+                    waitpid $pid, 0;
+                    $ret;
+                }
+            } else {
+                my $a;
+                my @arr = @_;
+                unless( $Shell::raw ){
+                  if (OS eq 'MSWin32') {
+                    # XXX this special-casing should not be needed
+                    # if we do quoting right on Windows. :-(
+                    #
+                    # First, escape all quotes.  Cover the case where we
+                    # want to pass along a quote preceded by a backslash
+                    # (i.e., C<"param \""" end">).
+                    # Ugly, yup?  You know, windoze.
+                    # Enclose in quotes only the parameters that need it:
+                    #   try this: c:> dir "/w"
+                    #   and this: c:> dir /w
+                    for (@arr) {
+                        s/"/\\"/g;
+                        s/\\\\"/\\\\"""/g;
+                        $_ = qq["$_"] if /\s/;
+                    }
+                  } else {
+                    for (@arr) {
+                        s/(['\\])/\\$1/g;
+                        $_ = $_;
+                     }
+                  }
+                }
+                push @arr, '2>&1'        if $Shell::capture_stderr ==  1;
+                push @arr, '2>$null' if $Shell::capture_stderr == -1;
+                open(SUBPROC, join(' ', $cmd, @arr, '|'))
+                    or die "Can't exec $cmd: $!\n";
+                if (wantarray) {
+                    my @ret = <SUBPROC>;
+                    close SUBPROC;        # XXX Oughta use a destructor.
+                    @ret;
+                } else {
+                    local($/) = undef;
+                    my $ret = <SUBPROC>;
+                    close SUBPROC;
+                    $ret;
+                }
+            }
+        };
+        }
+
+sub AUTOLOAD {
+    shift if ref $_[0] && $_[0]->isa( 'Shell' );
+    my $cmd = $AUTOLOAD;
+    $cmd =~ s/^.*:://;
+    no strict 'refs';
+    *$AUTOLOAD = _make_cmd($cmd);
+    goto &$AUTOLOAD;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Shell - run shell commands transparently within perl
+
+=head1 SYNOPSIS
+
+   use Shell qw(cat ps cp);
+   $passwd = cat('</etc/passwd');
+   @pslines = ps('-ww'),
+   cp("/etc/passwd", "/tmp/passwd");
+
+   # object oriented 
+   my $sh = Shell->new;
+   print $sh->ls('-l');
+
+=head1 DESCRIPTION
+
+=head2 Caveats
+
+This package is included as a show case, illustrating a few Perl features.
+It shouldn't be used for production programs. Although it does provide a 
+simple interface for obtaining the standard output of arbitrary commands,
+there may be better ways of achieving what you need.
+
+Running shell commands while obtaining standard output can be done with the
+C<qx/STRING/> operator, or by calling C<open> with a filename expression that
+ends with C<|>, giving you the option to process one line at a time.
+If you don't need to process standard output at all, you might use C<system>
+(in preference of doing a print with the collected standard output).
+
+Since Shell.pm and all of the aforementioned techniques use your system's
+shell to call some local command, none of them is portable across different 
+systems. Note, however, that there are several built in functions and 
+library packages providing portable implementations of functions operating
+on files, such as: C<glob>, C<link> and C<unlink>, C<mkdir> and C<rmdir>, 
+C<rename>, C<File::Compare>, C<File::Copy>, C<File::Find> etc.
+
+Using Shell.pm while importing C<foo> creates a subroutine C<foo> in the
+namespace of the importing package. Calling C<foo> with arguments C<arg1>,
+C<arg2>,... results in a shell command C<foo arg1 arg2...>, where the 
+function name and the arguments are joined with a blank. (See the subsection 
+on Escaping magic characters.) Since the result is essentially a command
+line to be passed to the shell, your notion of arguments to the Perl
+function is not necessarily identical to what the shell treats as a
+command line token, to be passed as an individual argument to the program.
+Furthermore, note that this implies that C<foo> is callable by file name
+only, which frequently depends on the setting of the program's environment.
+
+Creating a Shell object gives you the opportunity to call any command
+in the usual OO notation without requiring you to announce it in the
+C<use Shell> statement. Don't assume any additional semantics being
+associated with a Shell object: in no way is it similar to a shell
+process with its environment or current working directory or any
+other setting.
+
+=head2 Escaping Magic Characters
+
+It is, in general, impossible to take care of quoting the shell's
+magic characters. For some obscure reason, however, Shell.pm quotes
+apostrophes (C<'>) and backslashes (C<\>) on UNIX, and spaces and
+quotes (C<">) on Windows.
+
+=head2 Configuration
+
+If you set $Shell::capture_stderr to true, the module will attempt to
+capture the standard error output of the process as well. This is
+done by adding C<2E<gt>&1> to the command line, so don't try this on
+a system not supporting this redirection.
+
+If you set $Shell::raw to true no quoting whatsoever is done.
+
+=head1 BUGS
+
+Quoting should be off by default.
+
+It isn't possible to call shell built in commands, but it can be
+done by using a workaround, e.g. shell( '-c', 'set' ).
+
+Capturing standard error does not work on some systems (e.g. VMS).
+
+=head1 AUTHOR
+
+  Date: Thu, 22 Sep 94 16:18:16 -0700
+  Message-Id: <9409222318.AA17072 at scalpel.netlabs.com>
+  To: perl5-porters at isu.edu
+  From: Larry Wall <lwall at scalpel.netlabs.com>
+  Subject: a new module I just wrote
+
+Here's one that'll whack your mind a little out.
+
+    #!/usr/bin/perl
+
+    use Shell;
+
+    $foo = echo("howdy", "<funny>", "world");
+    print $foo;
+
+    $passwd = cat("</etc/passwd");
+    print $passwd;
+
+    sub ps;
+    print ps -ww;
+
+    cp("/etc/passwd", "/etc/passwd.orig");
+
+That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
+package (and uncovered a bug in Beta 3, by the way).  Maybe the usual
+usage should be
+
+    use Shell qw(echo cat ps cp);
+
+Larry Wall
+
+Changes by Jenda at Krynicky.cz and Dave Cottle <d.cottle at csc.canterbury.ac.nz>.
+
+Changes for OO syntax and bug fixes by Casey West <casey at geeknest.com>.
+
+C<$Shell::raw> and pod rewrite by Wolfgang Laun.
+
+Rewritten to use closures rather than C<eval "string"> by Adriano Ferreira.
+
+=cut

Added: branches/upstream/libshell-perl/current/t/01_use.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libshell-perl/current/t/01_use.t?rev=57840&op=file
==============================================================================
--- branches/upstream/libshell-perl/current/t/01_use.t (added)
+++ branches/upstream/libshell-perl/current/t/01_use.t Wed May 12 20:00:48 2010
@@ -1,0 +1,5 @@
+
+use Test::More tests => 1;
+BEGIN { use_ok('Shell') };
+
+diag( "Testing Shell $Shell::VERSION, Perl $], $^X" );

Added: branches/upstream/libshell-perl/current/t/99_pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libshell-perl/current/t/99_pod.t?rev=57840&op=file
==============================================================================
--- branches/upstream/libshell-perl/current/t/99_pod.t (added)
+++ branches/upstream/libshell-perl/current/t/99_pod.t Wed May 12 20:00:48 2010
@@ -1,0 +1,7 @@
+
+use strict;
+use Test::More;
+eval "use Test::Pod 1.18";
+plan skip_all => "Test::Pod 1.18 required for testing POD" if $@;
+
+all_pod_files_ok(all_pod_files("."));

Added: branches/upstream/libshell-perl/current/t/Shell.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libshell-perl/current/t/Shell.t?rev=57840&op=file
==============================================================================
--- branches/upstream/libshell-perl/current/t/Shell.t (added)
+++ branches/upstream/libshell-perl/current/t/Shell.t Wed May 12 20:00:48 2010
@@ -1,0 +1,72 @@
+#!./perl
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
+}
+
+use Test::More tests => 7;
+
+BEGIN { use_ok('Shell'); }
+
+my $so = Shell->new;
+ok($so, 'Shell->new');
+
+my $Is_VMS     = $^O eq 'VMS';
+my $Is_MSWin32 = $^O eq 'MSWin32';
+my $Is_NetWare = $^O eq 'NetWare';
+
+$Shell::capture_stderr = 1;
+
+# Now test that that works ..
+
+my $tmpfile = 'sht0001';
+while ( -f $tmpfile ) {
+    $tmpfile++;
+}
+END { -f $tmpfile && (open STDERR, '>&SAVERR' and unlink $tmpfile) }
+
+no warnings 'once'; 
+# no false warning about   Name "main::SAVERR" used only once: possible typo
+
+open(SAVERR, ">&STDERR");
+open(STDERR, ">$tmpfile");
+
+xXx_not_there();  # Ok someone could have a program called this :(
+
+# On os2 the warning is on by default...
+ok(($^O eq 'os2' xor !(-s $tmpfile)), '$Shell::capture_stderr');
+
+$Shell::capture_stderr = 0;
+
+# someone will have to fill in the blanks for other platforms
+
+if ($Is_VMS) {
+    ok(directory(), 'Execute command');
+    my @files = directory('*.*');
+    ok(@files, 'Quoted arguments');
+
+    ok(eq_array(\@files, [$so->directory('*.*')]), 'object method');
+    eval { $so->directory };
+    ok(!$@, '2 methods calls');
+} elsif ($Is_MSWin32) {
+    ok(dir(), 'Execute command');
+    my @files = dir('*.*');
+    ok(@files, 'Quoted arguments');
+
+    ok(eq_array(\@files, [$so->dir('*.*')]), 'object method');
+    eval { $so->dir };
+    ok(!$@, '2 methods calls');
+} else {
+    ok(ls(), 'Execute command');
+    my @files = ls('*');
+    ok(@files, 'Quoted arguments');
+
+    ok(eq_array(\@files, [$so->ls('*')]), 'object method');
+    eval { $so->ls };
+    ok(!$@, '2 methods calls');
+
+}
+open(STDERR, ">&SAVERR") ;

Propchange: branches/upstream/libshell-perl/current/t/Shell.t
------------------------------------------------------------------------------
    svn:executable = 




More information about the Pkg-perl-cvs-commits mailing list