|
 |
f3efe5 |
#!/usr/bin/perl
|
|
|
f3efe5 |
use strict;
|
|
|
f3efe5 |
use warnings;
|
|
|
f3efe5 |
use File::Path;
|
|
|
f3efe5 |
use File::Spec;
|
|
|
f3efe5 |
use Getopt::Long;
|
|
|
f3efe5 |
|
|
|
f3efe5 |
my $libdir = 'lib';
|
|
|
f3efe5 |
my $filter = '';
|
|
|
f3efe5 |
|
|
|
f3efe5 |
GetOptions('libdir=s' => \$libdir, 'filter=s' => \$filter) or
|
|
|
f3efe5 |
die "Could not parse arguments\n";
|
|
|
f3efe5 |
if ($filter eq '') {
|
|
|
f3efe5 |
# Empty pattern passes previous result by definition. Do not use it.
|
|
|
f3efe5 |
# Interpolared compilation is fixed in perl 5.18.0. RT#119095.
|
|
|
f3efe5 |
$filter = qr/(?:)/;
|
|
|
f3efe5 |
}
|
|
|
f3efe5 |
eval { $filter = qr{$filter}; 1} or
|
|
|
f3efe5 |
die "Could not compile filter as a regular expression: $@\n";
|
|
|
f3efe5 |
|
|
|
f3efe5 |
my ($file, $filename, $delimiter);
|
|
|
f3efe5 |
while (<>) {
|
|
|
f3efe5 |
if (/^\$fatpacked\{\s*"([^"]*)"\s*\}\s*=.*<<\s*'([^']*)'\s*;/) {
|
|
|
f3efe5 |
# Packed module beginning found
|
|
|
f3efe5 |
$filename = $1;
|
|
|
f3efe5 |
$delimiter = $2;
|
|
|
f3efe5 |
if ($filename =~ $filter) {
|
|
|
f3efe5 |
print STDERR "Extracting `$filename'\n";
|
|
|
f3efe5 |
my $directory = (File::Spec->splitpath($filename))[1];
|
|
|
f3efe5 |
File::Path::make_path(File::Spec->catfile($libdir, $directory));
|
|
|
f3efe5 |
if ($file) {
|
|
|
f3efe5 |
die "Unballanced fat-packed module at line $.\n";
|
|
|
f3efe5 |
}
|
|
|
f3efe5 |
open($file, '>', File::Spec->catfile($libdir, $filename)) or
|
|
|
f3efe5 |
die "Could not create `",
|
|
|
f3efe5 |
File::Spec->catfile($libdir, $filename), "': $!\n";
|
|
|
f3efe5 |
} else {
|
|
|
f3efe5 |
print STDERR "Removing `$filename'\n";
|
|
|
f3efe5 |
}
|
|
|
f3efe5 |
} elsif (defined $delimiter and /^\Q$delimiter\E$/) {
|
|
|
f3efe5 |
# Packed module end found
|
|
|
f3efe5 |
if (defined $file) {
|
|
|
f3efe5 |
close($file) or
|
|
|
f3efe5 |
die "Could not close `",
|
|
|
f3efe5 |
File::Spec->catfile($libdir, $filename), "': $!\n";
|
|
|
f3efe5 |
$file = undef;
|
|
|
f3efe5 |
}
|
|
|
f3efe5 |
$filename = undef;
|
|
|
f3efe5 |
$delimiter = undef;
|
|
|
f3efe5 |
} elsif (defined $file) {
|
|
|
f3efe5 |
# Packed module to extract
|
|
|
f3efe5 |
s/^ //; # de-escape recursive here-documents
|
|
|
f3efe5 |
print $file $_;
|
|
|
f3efe5 |
} elsif (! defined $delimiter) {
|
|
|
f3efe5 |
# Rest of code to output
|
|
|
f3efe5 |
print STDOUT $_;
|
|
|
f3efe5 |
}
|
|
|
f3efe5 |
}
|
|
|
f3efe5 |
|
|
|
f3efe5 |
__END__
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=encoding utf8
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=head1 NAME
|
|
|
f3efe5 |
|
|
|
f3efe5 |
fatunpack - Unpacker for App::FatPacker packets
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=head1 SYNOPSYS
|
|
|
f3efe5 |
|
|
|
f3efe5 |
fatunpack [OPTION…] [PACKED_SCRIPT…]
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=head1 DESCRIPTION
|
|
|
f3efe5 |
|
|
|
f3efe5 |
This tool unpacks scripts packed with App::FatPacker.
|
|
|
f3efe5 |
|
|
|
f3efe5 |
Packed script's file names are specified as positional arguments. If no
|
|
|
f3efe5 |
argument is given, a script from standard intput will be processed.
|
|
|
f3efe5 |
|
|
|
f3efe5 |
The content of packed script stripped of all bundled modules is written to
|
|
|
f3efe5 |
standard output.
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=head1 OPTIONS
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=over 8
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=item B<--libdir DIRECTORY>
|
|
|
f3efe5 |
|
|
|
f3efe5 |
Directory to output unpacked modules to that where bundled into the input
|
|
|
f3efe5 |
script. Default value is C<lib>.
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=item B<--filter REGULAR_EXPRESSION>
|
|
|
f3efe5 |
|
|
|
f3efe5 |
Save only modules whose file name matches the B<REGULAR_EXPRESSION>. The file
|
|
|
f3efe5 |
names are compared without B<--libdir> prefix. The expession is not anchored
|
|
|
f3efe5 |
by default. Empty expression matches any file name. Default value is empty
|
|
|
f3efe5 |
regular expression, i.e. to save all modules.
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=back
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=head1 VERSION
|
|
|
f3efe5 |
|
|
|
f3efe5 |
This is version 2.
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=head1 COPYRIGHT
|
|
|
f3efe5 |
|
|
|
f3efe5 |
Copyright © 2013, 2014 Petr Písař <ppisar@redhat.com>.
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=head1 LICENSE
|
|
|
f3efe5 |
|
|
|
f3efe5 |
This is free software. You may redistribute copies of it under the terms of
|
|
|
f3efe5 |
the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
|
|
|
f3efe5 |
There is NO WARRANTY, to the extent permitted by law.
|
|
|
f3efe5 |
|
|
|
f3efe5 |
=cut
|