10 getopts
('Ddcvzthxf:IC', $opts) or die usage
();
12 ### show the help message ###
13 die usage
() if $opts->{h
};
15 ### enable debugging (undocumented feature)
16 local $Archive::Tar
::DEBUG
= 1 if $opts->{d
};
18 ### enable insecure extracting.
19 local $Archive::Tar
::INSECURE_EXTRACT_MODE
= 1 if $opts->{I
};
22 unless ( 1 == grep { defined $opts->{$_} } qw
[x t c
] ) {
23 die "You need exactly one of 'x', 't' or 'c' options: " . usage
();
26 my $compress = $opts->{z
} ?
1 : 0;
27 my $verbose = $opts->{v
} ?
1 : 0;
28 my $file = $opts->{f
} ?
$opts->{f
} : 'default.tar';
29 my $tar = Archive
::Tar
->new();
34 find
( sub { push @files, $File::Find
::name
;
35 print $File::Find
::name
.$/ if $verbose }, @ARGV );
39 $file = IO
::Handle
->new();
40 $file->fdopen(fileno(STDOUT
),"w");
43 my $tar = Archive
::Tar
->new;
44 $tar->add_files(@files);
46 for my $f ($tar->get_files) {
47 $f->mode($f->mode & ~022); # chmod go-w
50 $tar->write($file, $compress);
54 $file = IO
::Handle
->new();
55 $file->fdopen(fileno(STDIN
),"r");
58 ### print the files we're finding?
59 my $print = $verbose || $opts->{'t'} || 0;
61 my $iter = Archive
::Tar
->iter( $file );
63 while( my $f = $iter->() ) {
64 print $f->full_path . $/ if $print;
66 ### data dumper output
67 print Dumper
( $f ) if $opts->{'D'};
70 $f->extract if $opts->{'x'};
74 ### pod & usage in one
76 my $usage .= << '=cut';
81 ptar - a tar-like program written in perl
85 ptar is a small, tar look-alike program that uses the perl module
86 Archive::Tar to extract, create and list tar archives.
90 ptar -c [-v] [-z] [-C] [-f ARCHIVE_FILE | -] FILE FILE ...
91 ptar -x [-v] [-z] [-f ARCHIVE_FILE | -]
92 ptar -t [-z] [-f ARCHIVE_FILE | -]
97 c Create ARCHIVE_FILE or STDOUT (-) from FILE
98 x Extract from ARCHIVE_FILE or STDIN (-)
99 t List the contents of ARCHIVE_FILE or STDIN (-)
100 f Name of the ARCHIVE_FILE to use. Default is './default.tar'
101 z Read/Write zlib compressed ARCHIVE_FILE (not always available)
102 v Print filenames as they are added or extraced from ARCHIVE_FILE
103 h Prints this help message
104 C CPAN mode - drop 022 from permissions
108 tar(1), L<Archive::Tar>.
112 ### strip the pod directives
113 $usage =~ s/=pod\n//g;
114 $usage =~ s/=head1 //g;
116 ### add some newlines