perl-App-cpanminus/fatunpack

#!/usr/bin/perl
use strict;
use warnings;
use File::Path;
use File::Spec;
use Getopt::Long;

my $libdir = 'lib';
my $filter = '';

GetOptions('libdir=s' => \$libdir, 'filter=s' => \$filter) or
    die "Could not parse arguments\n";
if ($filter eq '') {
    # Empty pattern passes previous result by definition. Do not use it.
    # Interpolared compilation is fixed in perl 5.18.0. RT#119095.
    $filter = qr/(?:)/;
}
eval { $filter = qr{$filter}; 1} or
    die "Could not compile filter as a regular expression: $@\n";

my ($file, $filename, $delimiter);
while (<>) {
    if (/^\$fatpacked\{\s*"([^"]*)"\s*\}\s*=.*<<\s*'([^']*)'\s*;/) {
        # Packed module beginning found
        $filename = $1;
        $delimiter = $2;
        if ($filename =~ $filter) {
            print STDERR "Extracting `$filename'\n";
            my $directory = (File::Spec->splitpath($filename))[1];
            File::Path::make_path(File::Spec->catfile($libdir, $directory));
            if ($file) {
                die "Unballanced fat-packed module at line $.\n";
            }
            open($file, '>', File::Spec->catfile($libdir, $filename)) or
                die "Could not create `",
                    File::Spec->catfile($libdir, $filename), "': $!\n";
        } else {
            print STDERR "Removing `$filename'\n";
        }
    } elsif (defined $delimiter and /^\Q$delimiter\E$/) {
        # Packed module end found
        if (defined $file) {
            close($file) or
                die "Could not close `",
                    File::Spec->catfile($libdir, $filename), "': $!\n";
            $file = undef;
        }
        $filename = undef;
        $delimiter = undef;
    } elsif (defined $file) {
        # Packed module to extract
        s/^  //;    # de-escape recursive here-documents
        print $file $_;
    } elsif (! defined $delimiter) {
        # Rest of code to output
        print STDOUT $_;
    }
}

__END__

=encoding utf8

=head1 NAME

fatunpack - Unpacker for App::FatPacker packets

=head1 SYNOPSYS

fatunpack [OPTION…] [PACKED_SCRIPT…]

=head1 DESCRIPTION

This tool unpacks scripts packed with App::FatPacker.

Packed script's file names are specified as positional arguments. If no
argument is given, a script from standard intput will be processed.

The content of packed script stripped of all bundled modules is written to
standard output.

=head1 OPTIONS

=over 8

=item B<--libdir DIRECTORY>

Directory to output unpacked modules to that where bundled into the input
script. Default value is C<lib>.

=item B<--filter REGULAR_EXPRESSION>

Save only modules whose file name matches the B<REGULAR_EXPRESSION>. The file
names are compared without B<--libdir> prefix. The expession is not anchored
by default. Empty expression matches any file name. Default value is empty
regular expression, i.e. to save all modules.

=back

=head1 VERSION

This is version 2.

=head1 COPYRIGHT

Copyright © 2013, 2014  Petr Písař <ppisar@redhat.com>.

=head1 LICENSE

This is free software.  You may redistribute copies of it under the terms of
the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
There is NO WARRANTY, to the extent permitted by law.

=cut