/usr/bin/ptar is in perl 5.22.1-9.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | #!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
#!/usr/bin/perl
use strict;
use File::Find;
use Getopt::Std;
use Archive::Tar;
use Data::Dumper;
# Allow historic support for dashless bundled options
# tar cvf file.tar
# is valid (GNU) tar style
@ARGV && $ARGV[0] =~ m/^[DdcvzthxIC]+[fT]?$/ and
unshift @ARGV, map { "-$_" } split m// => shift @ARGV;
my $opts = {};
getopts('Ddcvzthxf:ICT:', $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;
my @src = @ARGV;
if( $opts->{T} ) {
if( $opts->{T} eq "-" ) {
chomp( @src = <STDIN> );
} elsif( open my $fh, "<", $opts->{T} ) {
chomp( @src = <$fh> );
} else {
die "$0: $opts->{T}: $!\n";
}
}
find( sub { push @files, $File::Find::name;
print $File::Find::name.$/ if $verbose }, @src );
if ($file eq '-') {
use IO::Handle;
$file = IO::Handle->new();
$file->fdopen(fileno(STDOUT),"w");
}
my $tar = Archive::Tar->new;
$tar->add_files(@files);
if( $opts->{C} ) {
for my $f ($tar->get_files) {
$f->mode($f->mode & ~022); # chmod go-w
}
}
$tar->write($file, $compress);
} 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] [-C] [-f ARCHIVE_FILE | -] FILE FILE ...
ptar -c [-v] [-z] [-C] [-T index | -] [-f ARCHIVE_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 extracted from ARCHIVE_FILE
h Prints this help message
C CPAN mode - drop 022 from permissions
T get names to create from file
=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;
}
|