From 291d3373af7c9af2d76b20ef0c41053f58581942 Mon Sep 17 00:00:00 2001
From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Tue, 21 Jun 2005 15:04:10 +0000
Subject: Add the ptar(1) utility from Archive::Tar

p4raw-id: //depot/perl@24926
---
 lib/Archive/Tar/bin/ptar | 74 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 74 insertions(+)
 create mode 100644 lib/Archive/Tar/bin/ptar

(limited to 'lib/Archive')

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]
+}
+
-- 
cgit v1.2.1