perl-App-cpanminus/fatunpack

115 lines
3.1 KiB
Perl

#!/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