blob: 6c439e086dcd40816b78658fd9eb37351e1239d6 (
plain)
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
|
@rem = '--*-Perl-*--
@echo off
if "%OS%" == "Windows_NT" goto WinNT
perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
:WinNT
perl -x -S %0 %*
if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
if %errorlevel% == 9009 echo You do not have Perl in your PATH.
if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
goto endofperl
@rem ';
#!/usr/bin/perl
#line 15
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;
}
__END__
:endofperl
|
