Add the ptar(1) utility from Archive::Tar

p4raw-id: //depot/perl@24926

8 files changed, 141 insertions, 6 deletions

diff --git a/MANIFEST b/MANIFEST
index 692f6f7226..6cc9a0fe7d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1183,6 +1183,7 @@ lib/assertions.pm		module support for -A flag
 lib/assert.pl			assertion and panic with stack trace
 lib/Archive/Tar/Constant.pm	Archive::Tar
 lib/Archive/Tar/File.pm		Archive::Tar
+lib/Archive/Tar/bin/ptar	the ptar utility
 lib/Archive/Tar/t/01_use.t	Archive::Tar tests
 lib/Archive/Tar/t/02_methods.t	Archive::Tar tests
 lib/Archive/Tar/t/03_file.t	Archive::Tar tests
@@ -3050,6 +3051,7 @@ utils/perlivp.PL		installation verification procedure
 utils/piconv.PL			iconv(1), reinvented in perl
 utils/pl2pm.PL			A pl to pm translator
 utils/prove.PL			The prove harness utility
+utils/ptar.PL			The ptar utility
 utils/splain.PL			Stand-alone version of diagnostics.pm
 utils/xsubpp.PL			External subroutine preprocessor
 uts/sprintf_wrap.c		sprintf wrapper for UTS
diff --git a/lib/Archive/Tar/bin/ptar b/lib/Archive/Tar/bin/ptar
new file mode 100644
index 0000000000..014d2f7f42
--- /dev/null
+++ b/lib/Archive/Tar/bin/ptar
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+use strict;
+
+use Getopt::Std;
+use Archive::Tar;
+use File::Find;
+
+my $opts = {};
+getopts('dcvzthxf:', $opts) or die usage();
+
+### show the help message ###
+die usage() if $opts->{h};
+
+### enable debugging (undocumented feature)
+local $Archive::Tar::DEBUG = 1 if $opts->{d};
+
+### sanity checks ###
+unless ( 1 == grep { defined $opts->{$_} } qw[x t c] ) {
+    die "You need exactly one of 'x', 't' or 'c' options: " . usage();
+}
+
+my $compress    = $opts->{z} ? 1 : 0;
+my $verbose     = $opts->{v} ? 1 : 0;
+my $file        = $opts->{f} ? $opts->{f} : 'default.tar';
+my $tar         = Archive::Tar->new();
+
+if( $opts->{c} ) {
+    my @files;
+    find( sub { push @files, $File::Find::name;
+                print $File::Find::name.$/ if $verbose }, @ARGV );
+                
+    Archive::Tar->create_archive( $file, $compress, @files );              
+    exit;
+} 
+
+my $tar = Archive::Tar->new($file, $compress);
+
+if( $opts->{t} ) {
+    print map { $_->full_path . $/ } $tar->get_files; 
+
+} elsif( $opts->{x} ) {    
+    print map { $_->full_path . $/ } $tar->get_files
+        if $verbose;
+    Archive::Tar->extract_archive($file, $compress);
+}    
+
+
+
+sub usage {
+    qq[
+Usage:  ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...      
+        ptar -x [-v] [-z] [-f ARCHIVE_FILE] 
+        ptar -t [-z] [-f ARCHIVE_FILE] 
+        ptar -h
+    
+    ptar is a small, tar look-alike program that uses the perl module
+    Archive::Tar to extract, create and list tar archives.    
+    
+Options:
+    x   Extract from ARCHIVE_FILE
+    c   Create ARCHIVE_FILE from FILE
+    t   List the contents of ARCHIVE_FILE
+    f   Name of the ARCHIVE_FILE to use. Default is './default.tar'
+    z   Read/Write zlib compressed ARCHIVE_FILE (not always available)
+    v   Print filenames as they are added or extraced from ARCHIVE_FILE
+    h   Prints this help message
+
+See Also:
+    tar(1)
+    Archive::Tar
+
+    \n]
+}
+
diff --git a/utils.lst b/utils.lst
index cbb84569a1..cad0a3cc5b 100644
--- a/utils.lst
+++ b/utils.lst
@@ -21,6 +21,7 @@ utils/perlivp
 utils/piconv
 utils/pl2pm
 utils/prove
+utils/ptar
 utils/splain
 utils/xsubpp
 x2p/a2p         # pod = x2p/a2p.pod
diff --git a/utils/Makefile b/utils/Makefile
index 7b2fdd7c6e..5b21d0afb6 100644
--- a/utils/Makefile
+++ b/utils/Makefile
@@ -5,9 +5,9 @@ REALPERL = ../perl
 # Files to be built with variable substitution after miniperl is
 # available.  Dependencies handled manually below (for now).
 
-pl = c2ph.PL cpan.PL corelist.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL
-plextract = c2ph cpan corelist h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove splain perlcc dprofpp libnetcfg piconv enc2xs xsubpp
-plextractexe = ./c2ph ./cpan ./corelist ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./splain ./perlcc ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp
+pl = c2ph.PL cpan.PL corelist.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL splain.PL perlcc.PL dprofpp.PL libnetcfg.PL piconv.PL enc2xs.PL xsubpp.PL
+plextract = c2ph cpan corelist h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove ptar splain perlcc dprofpp libnetcfg piconv enc2xs xsubpp
+plextractexe = ./c2ph ./cpan ./corelist ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./splain ./perlcc ./dprofpp ./libnetcfg ./piconv ./enc2xs ./xsubpp
 
 all: $(plextract) 
 
@@ -47,6 +47,8 @@ perlivp:	perlivp.PL ../config.sh
 
 prove:		prove.PL ../config.sh
 
+ptar:		ptar.PL ../config.sh
+
 pl2pm:		pl2pm.PL ../config.sh
 
 splain:		splain.PL ../config.sh ../lib/diagnostics.pm
diff --git a/utils/ptar.PL b/utils/ptar.PL
new file mode 100644
index 0000000000..b933659a4c
--- /dev/null
+++ b/utils/ptar.PL
@@ -0,0 +1,51 @@
+#!/usr/local/bin/perl
+
+use Config;
+use File::Basename qw(&basename &dirname);
+use Cwd;
+
+# List explicitly here the variables you want Configure to
+# generate.  Metaconfig only looks for shell variables, so you
+# have to mention them as if they were shell variables, not
+# %Config entries.  Thus you write
+#  $startperl
+# to ensure Configure will look for $Config{startperl}.
+
+# This forces PL files to create target in same directory as PL file.
+# This is so that make depend always knows where to find PL derivatives.
+my $origdir = cwd;
+chdir dirname($0);
+my $file = basename($0, '.PL');
+$file .= '.com' if $^O eq 'VMS';
+
+open OUT,">$file" or die "Can't create $file: $!";
+
+print "Extracting $file (with variable substitutions)\n";
+
+# In this section, perl variables will be expanded during extraction.
+# You can use $Config{...} to use Configure variables.
+
+print OUT <<"!GROK!THIS!";
+$Config{startperl}
+    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
+	if \$running_under_some_shell;
+!GROK!THIS!
+
+use File::Spec;
+
+my $script = File::Spec->catfile(
+            File::Spec->catdir(
+                File::Spec->updir, qw[lib Archive Tar bin]
+            ), "ptar");
+
+if (open(IN, $script)) {
+    print OUT <IN>;
+    close IN;
+} else {
+    die "$0: cannot find '$script'\n";
+}
+
+close OUT or die "Can't close $file: $!";
+chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
+exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
+chdir $origdir;
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index 3c9c0d925a..8c16da9ecf 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -344,7 +344,7 @@ LIBPREREQ = $(ARCHDIR)Config.pm $(ARCHDIR)Config_heavy.pl [.lib.VMS]Filespec.pm
 utils1 = [.lib.pod]perldoc.com [.lib.ExtUtils]Miniperl.pm [.utils]c2ph.com [.utils]h2ph.com 
 utils2 = [.utils]h2xs.com [.utils]libnetcfg.com [.lib]perlbug.com [.lib]perlcc.com [.utils]dprofpp.com 
 utils3 = [.utils]perlivp.com [.lib]splain.com [.utils]pl2pm.com [.utils]xsubpp.com [.utils]instmodsh.com
-utils4 = [.utils]enc2xs.com [.utils]piconv.com [.utils]cpan.com [.utils]prove.com [.utils]corelist.com
+utils4 = [.utils]enc2xs.com [.utils]piconv.com [.utils]cpan.com [.utils]prove.com [.utils]ptar.com [.utils]corelist.com
 
 .ifdef NOX2P
 all : base extras archcorefiles preplibrary perlpods
@@ -552,6 +552,9 @@ dynext : $(LIBPREREQ) $(DBG)perlshr$(E) preplibrary
 [.utils]prove.com : [.utils]prove.PL $(ARCHDIR)Config.pm
 	$(MINIPERL) -"I[-.lib]" $(MMS$SOURCE)
 
+[.utils]ptar.com : [.utils]ptar.PL $(ARCHDIR)Config.pm
+	$(MINIPERL) -"I[-.lib]" $(MMS$SOURCE)
+
 [.utils]corelist.com : [.utils]corelist.PL $(ARCHDIR)Config.pm
 	$(MINIPERL) -"I[-.lib]" $(MMS$SOURCE)
 
diff --git a/win32/Makefile b/win32/Makefile
index 67fd3081b9..22f2f447bf 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -522,6 +522,7 @@ UTILS		=			\
 		..\utils\cpan		\
 		..\utils\xsubpp		\
 		..\utils\prove		\
+		..\utils\ptar		\
 		..\utils\instmodsh	\
 		..\pod\checkpods	\
 		..\pod\pod2html		\
@@ -1178,7 +1179,7 @@ distclean: realclean
 	    podchecker podselect
 	-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
 	    perldoc perlivp dprofpp perlcc libnetcfg enc2xs piconv cpan *.bat \
-	    xsubpp instmodsh prove corelist
+	    xsubpp instmodsh prove ptar corelist
 	-cd ..\x2p && del /f find2perl s2p psed *.bat
 	-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
 	-del /f $(CONFIGPM)
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 0f35355727..e5310ff30f 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -678,6 +678,7 @@ UTILS		=			\
 		..\utils\cpan		\
 		..\utils\xsubpp		\
 		..\utils\prove		\
+		..\utils\ptar		\
 		..\utils\instmodsh	\
 		..\pod\checkpods	\
 		..\pod\pod2html		\
@@ -1335,7 +1336,7 @@ distclean: realclean
 	    podchecker podselect
 	-cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \
 	    perldoc perlivp dprofpp perlcc libnetcfg enc2xs piconv cpan *.bat \
-	    xsubpp instmodsh prove corelist
+	    xsubpp instmodsh prove ptar corelist
 	-cd ..\x2p && del /f find2perl s2p psed *.bat
 	-del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new
 	-del /f $(CONFIGPM)