FM / bin

/snap/gh/640/usr/bin

Name	Size	Mode	Actions
corelist	15375	0755	edit dl rm
cpan	8360	0755	edit dl rm
cpan5.38-x86_64-linux-gnu	8381	0755	edit dl rm
enc2xs	41947	0755	edit dl rm
encguess	3069	0755	edit dl rm
git	4066232	0755	edit dl rm
git-receive-pack	4066232	0755	edit dl rm
git-shell	639808	0755	edit dl rm
git-upload-archive	4066232	0755	edit dl rm
git-upload-pack	4066232	0755	edit dl rm
h2ph	29227	0755	edit dl rm
h2xs	60934	0755	edit dl rm
instmodsh	4373	0755	edit dl rm
json_pp	4992	0755	edit dl rm
libnetcfg	15778	0755	edit dl rm
nano	279040	0755	edit dl rm
perl	4019312	0755	edit dl rm
perl5.38-x86_64-linux-gnu	14648	0755	edit dl rm
perl5.38.2	4019312	0755	edit dl rm
perlbug	45593	0755	edit dl rm
perldoc	125	0755	edit dl rm
perlivp	10867	0755	edit dl rm
perlthanks	45593	0755	edit dl rm
piconv	8360	0755	edit dl rm
pl2pm	4536	0755	edit dl rm
pod2html	4041	0755	edit dl rm
pod2man	18898	0755	edit dl rm
pod2text	13112	0755	edit dl rm
pod2usage	4107	0755	edit dl rm
podchecker	3658	0755	edit dl rm
prove	13659	0755	edit dl rm
ptar	3566	0755	edit dl rm
ptardiff	2645	0755	edit dl rm
ptargrep	4395	0755	edit dl rm
rnano	279040	0755	edit dl rm
scalar	684992	0755	edit dl rm
shasum	9982	0755	edit dl rm
splain	19449	0755	edit dl rm
streamzip	8061	0755	edit dl rm
xsubpp	5167	0755	edit dl rm
zipdetails	70193	0755	edit dl rm

Edit: /snap/gh/640/usr/bin/ptargrep (4395B)

#!/usr/bin/perl
    eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
	if 0; # ^ Run only under a shell
#!/usr/bin/perl
##############################################################################
# Tool for using regular expressions against the contents of files in a tar
# archive.  See 'ptargrep --help' for more documentation.
#

BEGIN { pop @INC if $INC[-1] eq '.' }
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;
    my $prefix = $f->prefix;
    if (defined $prefix) {
        $path = File::Spec->catfile($prefix, $path);
    }

_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

ptargrep - Apply pattern matching to the contents of files in a tar archive

=head1 SYNOPSIS

ptargrep [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

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

cmd: