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