Re: Building 25309 on VAX (OpenVMS 7.2) not ok
[p5sagit/p5-mst-13.2.git] / lib / Archive / Tar / bin / ptar
CommitLineData
291d3373 1#!/usr/bin/perl
2use strict;
3
4use Getopt::Std;
5use Archive::Tar;
6use File::Find;
7
8my $opts = {};
9getopts('dcvzthxf:', $opts) or die usage();
10
11### show the help message ###
12die usage() if $opts->{h};
13
14### enable debugging (undocumented feature)
15local $Archive::Tar::DEBUG = 1 if $opts->{d};
16
17### sanity checks ###
18unless ( 1 == grep { defined $opts->{$_} } qw[x t c] ) {
19 die "You need exactly one of 'x', 't' or 'c' options: " . usage();
20}
21
22my $compress = $opts->{z} ? 1 : 0;
23my $verbose = $opts->{v} ? 1 : 0;
24my $file = $opts->{f} ? $opts->{f} : 'default.tar';
25my $tar = Archive::Tar->new();
26
27if( $opts->{c} ) {
28 my @files;
29 find( sub { push @files, $File::Find::name;
30 print $File::Find::name.$/ if $verbose }, @ARGV );
81a5970e 31
32 Archive::Tar->create_archive( $file, $compress, @files );
291d3373 33 exit;
81a5970e 34}
291d3373 35
36my $tar = Archive::Tar->new($file, $compress);
37
38if( $opts->{t} ) {
81a5970e 39 print map { $_->full_path . $/ } $tar->get_files;
291d3373 40
81a5970e 41} elsif( $opts->{x} ) {
291d3373 42 print map { $_->full_path . $/ } $tar->get_files
43 if $verbose;
44 Archive::Tar->extract_archive($file, $compress);
81a5970e 45}
291d3373 46
47
48
49sub usage {
50 qq[
81a5970e 51Usage: ptar -c [-v] [-z] [-f ARCHIVE_FILE] FILE FILE ...
52 ptar -x [-v] [-z] [-f ARCHIVE_FILE]
53 ptar -t [-z] [-f ARCHIVE_FILE]
291d3373 54 ptar -h
81a5970e 55
291d3373 56 ptar is a small, tar look-alike program that uses the perl module
81a5970e 57 Archive::Tar to extract, create and list tar archives.
58
291d3373 59Options:
60 x Extract from ARCHIVE_FILE
61 c Create ARCHIVE_FILE from FILE
62 t List the contents of ARCHIVE_FILE
63 f Name of the ARCHIVE_FILE to use. Default is './default.tar'
64 z Read/Write zlib compressed ARCHIVE_FILE (not always available)
65 v Print filenames as they are added or extraced from ARCHIVE_FILE
66 h Prints this help message
67
68See Also:
69 tar(1)
70 Archive::Tar
71
72 \n]
73}
74