forked from pool/perl-App-cpanminus
115 lines
3.1 KiB
Plaintext
115 lines
3.1 KiB
Plaintext
|
#!/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
|