summaryrefslogtreecommitdiff
path: root/cpan/Archive-Tar
diff options
context:
space:
mode:
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>2010-11-15 23:50:40 +0000
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>2010-11-15 23:55:16 +0000
commitdeabda197e63bdf85e3277cea5e6a0782d7213c9 (patch)
tree6308b7b6659f65b7b7b314e98d584549d0faf462 /cpan/Archive-Tar
parent53226d62f432e693941b50e0f0c9c9ad3048d4e7 (diff)
downloadperl-deabda197e63bdf85e3277cea5e6a0782d7213c9.tar.gz
Update Archive-Tar to CPAN version 1.70
[DELTA] * important changes in version 1.70 15/11/2010 - Add ptargrep utility courtesy of Grant McLean ** I think I found everywhere that needed updating by grepping for 'ptardiff' and adding where needed. This stuff is definitively not intuitive.
Diffstat (limited to 'cpan/Archive-Tar')
-rw-r--r--cpan/Archive-Tar/bin/ptargrep188
-rw-r--r--cpan/Archive-Tar/lib/Archive/Tar.pm2
-rw-r--r--cpan/Archive-Tar/lib/Archive/Tar/Constant.pm2
-rw-r--r--cpan/Archive-Tar/lib/Archive/Tar/File.pm2
4 files changed, 191 insertions, 3 deletions
diff --git a/cpan/Archive-Tar/bin/ptargrep b/cpan/Archive-Tar/bin/ptargrep
new file mode 100644
index 0000000000..f01730c57f
--- /dev/null
+++ b/cpan/Archive-Tar/bin/ptargrep
@@ -0,0 +1,188 @@
+#!/usr/bin/perl
+##############################################################################
+# Tool for using regular expressions against the contents of files in a tar
+# archive. See 'targrep --help' for more documentation.
+#
+
+use strict;
+use warnings;
+
+use Pod::Usage qw(pod2usage);
+use Getopt::Long qw(GetOptions);
+use Archive::Tar qw();
+use File::Path qw(mkpath);
+
+my(%opt, $pattern);
+
+if(!GetOptions(\%opt,
+ 'basename|b',
+ 'ignore-case|i',
+ 'list-only|l',
+ 'verbose|v',
+ 'help|?',
+)) {
+ pod2usage(-exitval => 1, -verbose => 0);
+}
+
+
+pod2usage(-exitstatus => 0, -verbose => 2) if $opt{help};
+
+pod2usage(-exitval => 1, -verbose => 0,
+ -message => "No pattern specified",
+) unless @ARGV;
+make_pattern( shift(@ARGV) );
+
+pod2usage(-exitval => 1, -verbose => 0,
+ -message => "No tar files specified",
+) unless @ARGV;
+
+process_archive($_) foreach @ARGV;
+
+exit 0;
+
+
+sub make_pattern {
+ my($pat) = @_;
+
+ if($opt{'ignore-case'}) {
+ $pattern = qr{(?im)$pat};
+ }
+ else {
+ $pattern = qr{(?m)$pat};
+ }
+}
+
+
+sub process_archive {
+ my($filename) = @_;
+
+ _log("Processing archive: $filename");
+ my $next = Archive::Tar->iter($filename);
+ while( my $f = $next->() ) {
+ next unless $f->is_file;
+ match_file($f) if $f->size > 0;
+ }
+}
+
+
+sub match_file {
+ my($f) = @_;
+ my $path = $f->name;
+
+ _log("filename: %s (%d bytes)", $path, $f->size);
+
+ my $body = $f->get_content();
+ if($body !~ $pattern) {
+ _log(" no match");
+ return;
+ }
+
+ if($opt{'list-only'}) {
+ print $path, "\n";
+ return;
+ }
+
+ save_file($path, $body);
+}
+
+
+sub save_file {
+ my($path, $body) = @_;
+
+ _log(" found match - extracting");
+ my($fh);
+ my($dir, $file) = $path =~ m{\A(?:(.*)/)?([^/]+)\z};
+ if($dir and not $opt{basename}) {
+ _log(" writing to $dir/$file");
+ $dir =~ s{\A/}{./};
+ mkpath($dir) unless -d $dir;
+ open $fh, '>', "$dir/$file" or die "open($dir/$file): $!";
+ }
+ else {
+ _log(" writing to ./$file");
+ open $fh, '>', $file or die "open($file): $!";
+ }
+ print $fh $body;
+ close($fh);
+}
+
+
+sub _log {
+ return unless $opt{verbose};
+ my($format, @args) = @_;
+ warn sprintf($format, @args) . "\n";
+}
+
+
+__END__
+
+=head1 NAME
+
+targrep - Apply pattern matching to the contents of files in a tar archive
+
+=head1 SYNOPSIS
+
+ targrep [options] <pattern> <tar file> ...
+
+ Options:
+
+ --basename|-b ignore directory paths from archive
+ --ignore-case|-i do case-insensitive pattern matching
+ --list-only|-l list matching filenames rather than extracting matches
+ --verbose|-v write debugging message to STDERR
+ --help|-? detailed help message
+
+=head1 DESCRIPTION
+
+This utility allows you to apply pattern matching to B<the contents> of files
+contained in a tar archive. You might use this to identify all files in an
+archive which contain lines matching the specified pattern and either print out
+the pathnames or extract the files.
+
+The pattern will be used as a Perl regular expression (as opposed to a simple
+grep regex).
+
+Multiple tar archive filenames can be specified - they will each be processed
+in turn.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<--basename> (alias -b)
+
+When matching files are extracted, ignore the directory path from the archive
+and write to the current directory using the basename of the file from the
+archive. Beware: if two matching files in the archive have the same basename,
+the second file extracted will overwrite the first.
+
+=item B<--ignore-case> (alias -i)
+
+Make pattern matching case-insensitive.
+
+=item B<--list-only> (alias -l)
+
+Print the pathname of each matching file from the archive to STDOUT. Without
+this option, the default behaviour is to extract each matching file.
+
+=item B<--verbose> (alias -v)
+
+Log debugging info to STDERR.
+
+=item B<--help> (alias -?)
+
+Display this documentation.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 2010 Grant McLean E<lt>grantm@cpan.orgE<gt>
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+
+
diff --git a/cpan/Archive-Tar/lib/Archive/Tar.pm b/cpan/Archive-Tar/lib/Archive/Tar.pm
index 83834c4bb6..e6f3758ab2 100644
--- a/cpan/Archive-Tar/lib/Archive/Tar.pm
+++ b/cpan/Archive-Tar/lib/Archive/Tar.pm
@@ -31,7 +31,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
$DEBUG = 0;
$WARN = 1;
$FOLLOW_SYMLINK = 0;
-$VERSION = "1.68";
+$VERSION = "1.70";
$CHOWN = 1;
$CHMOD = 1;
$SAME_PERMISSIONS = $> == 0 ? 1 : 0;
diff --git a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm
index b688024c93..521ef5c043 100644
--- a/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm
+++ b/cpan/Archive-Tar/lib/Archive/Tar/Constant.pm
@@ -3,7 +3,7 @@ package Archive::Tar::Constant;
BEGIN {
require Exporter;
- $VERSION = '1.68';
+ $VERSION = '1.70';
@ISA = qw[Exporter];
require Time::Local if $^O eq "MacOS";
diff --git a/cpan/Archive-Tar/lib/Archive/Tar/File.pm b/cpan/Archive-Tar/lib/Archive/Tar/File.pm
index 6dce9b66c9..d48621c74c 100644
--- a/cpan/Archive-Tar/lib/Archive/Tar/File.pm
+++ b/cpan/Archive-Tar/lib/Archive/Tar/File.pm
@@ -13,7 +13,7 @@ use Archive::Tar::Constant;
use vars qw[@ISA $VERSION];
#@ISA = qw[Archive::Tar];
-$VERSION = '1.68';
+$VERSION = '1.70';
### set value to 1 to oct() it during the unpack ###
my $tmpl = [