diff options
author | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-17 12:20:49 +0000 |
---|---|---|
committer | Siep Kroonenberg <siepo@cybercomm.nl> | 2011-02-17 12:20:49 +0000 |
commit | 316ee97c621496b0fe3267f57cce81bee44ca1e6 (patch) | |
tree | cb2cab1192b4f58a7971af19b213e980bceda4b4 /Master/tlpkg/tlperl0/bin/ptar | |
parent | cd0f87b5d39480d85ad9bd4ee37f520f75bed560 (diff) |
Moving old tlperl prior to committing new one
git-svn-id: svn://tug.org/texlive/trunk@21422 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl0/bin/ptar')
-rwxr-xr-x | Master/tlpkg/tlperl0/bin/ptar | 114 |
1 files changed, 114 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl0/bin/ptar b/Master/tlpkg/tlperl0/bin/ptar new file mode 100755 index 00000000000..6a3c1bcd2ec --- /dev/null +++ b/Master/tlpkg/tlperl0/bin/ptar @@ -0,0 +1,114 @@ +#!/usr/bin/perl +use strict; + +use File::Find; +use Getopt::Std; +use Archive::Tar; +use Data::Dumper; + +my $opts = {}; +getopts('Ddcvzthxf:I', $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}; + +### enable insecure extracting. +local $Archive::Tar::INSECURE_EXTRACT_MODE = 1 if $opts->{I}; + +### 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 ); + + if ($file eq '-') { + use IO::Handle; + $file = IO::Handle->new(); + $file->fdopen(fileno(STDOUT),"w"); + } + + Archive::Tar->create_archive( $file, $compress, @files ); + +} else { + if ($file eq '-') { + use IO::Handle; + $file = IO::Handle->new(); + $file->fdopen(fileno(STDIN),"r"); + } + + ### print the files we're finding? + my $print = $verbose || $opts->{'t'} || 0; + + my $iter = Archive::Tar->iter( $file ); + + while( my $f = $iter->() ) { + print $f->full_path . $/ if $print; + + ### data dumper output + print Dumper( $f ) if $opts->{'D'}; + + ### extract it + $f->extract if $opts->{'x'}; + } +} + +### pod & usage in one +sub usage { + my $usage .= << '=cut'; +=pod + +=head1 NAME + + ptar - a tar-like program written in perl + +=head1 DESCRIPTION + + ptar is a small, tar look-alike program that uses the perl module + Archive::Tar to extract, create and list tar archives. + +=head1 SYNOPSIS + + ptar -c [-v] [-z] [-f ARCHIVE_FILE | -] FILE FILE ... + ptar -x [-v] [-z] [-f ARCHIVE_FILE | -] + ptar -t [-z] [-f ARCHIVE_FILE | -] + ptar -h + +=head1 OPTIONS + + c Create ARCHIVE_FILE or STDOUT (-) from FILE + x Extract from ARCHIVE_FILE or STDIN (-) + t List the contents of ARCHIVE_FILE or STDIN (-) + 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 + +=head1 SEE ALSO + + tar(1), L<Archive::Tar>. + +=cut + + ### strip the pod directives + $usage =~ s/=pod\n//g; + $usage =~ s/=head1 //g; + + ### add some newlines + $usage .= $/.$/; + + return $usage; +} + |