view release on metacpan or  search on metacpan

lib/App/SlimPacker.pm  view on Meta::CPAN

package App::SlimPacker;
use strict;
use warnings;
use App::SlimPacker::Minify qw(
    process process_deps minify_file name_gen needs_space
    module_deps collect_bundle_globals
    rename_module_name rename_module_path
);
use Exporter 'import';
our $VERSION = '0.08';
our @EXPORT_OK = qw(
    process process_deps minify_file name_gen needs_space
    pack_string perl_switches plugin_search_paths inline_plugins
    module_deps collect_bundle_globals
    rename_module_name rename_module_path
);

# Build a perl program from -m/-M/-e/-E switch arguments, perl-binary style.
#   perl_switches(\@m, \@M, \@e, \@E) -> program text
#   -m Foo          -> use Foo ();
#   -M Foo          -> use Foo;
#   -M Foo=bar,baz  -> use Foo qw(bar baz);
#   -M Foo=5.010    -> use Foo 5.010;
#   -M 5.010        -> use 5.010;
#   -E CODE         -> use feature qw(:all); CODE
sub perl_switches {
    my ($m, $M, $e, $E) = @_;
    $_ ||= [] for ($m, $M, $e, $E);
    my @out;
    for my $arg (@$m) { push @out, _use_line($arg, 0) }
    for my $arg (@$M) { push @out, _use_line($arg, 1) }
    # perl -E enables all features; the ':all' bundle only exists from perl
    # 5.16, so fall back to ':5.10' (say/state/switch) on older perls.
    if (@$E) { push @out, q{BEGIN{require feature;eval{feature->import(':all');1}or feature->import(':5.10')}} }
    if (@$e || @$E) { push @out, join("\n", @$e, @$E) }
    return join("\n", @out) . "\n";
}

sub _use_line {
    my ($arg, $with_imports) = @_;
    my ($mod, $terms) = $arg =~ /^([^=\s]+)(?:=(.*))?$/;
    die "bad -m/-M argument: '$arg'\n" unless defined $mod;
    $terms = '' unless defined $terms;
    return "use $mod ();" unless $with_imports;
    return "use $mod;" unless length $terms;
    my @t = split /,/, $terms;
    if (@t == 1 && $t[0] =~ /^(?:\d[\d.]*|v[\d.]+)$/) {
        return "use $mod $t[0];";
    }
    return "use $mod qw(@t);";
}

# Extract the Module::Pluggable search_path(s) from a program's
# 'use Module::Pluggable (...)' statement. Returns a hashref of namespace => 1.
sub plugin_search_paths {
    my ($program) = @_;
    my %searched;
    if ($program =~ m{\buse\s+Module::Pluggable\s*\((.*?)\)\s*;}s) {
        my $args = $1;
        while ($args =~ m~search_path\s*=>\s*(?:(\[[^\]]*\])|("[^"]*")|('[^']*')|(q\{[^}]*\}|q\([^)]*\)|q\[[^\]]*\]|q<[^>]*>))~g) {
            my ($array, $double, $single, $q) = ($1, $2, $3, $4);
            my $spec = defined $array ? $array : defined $double ? $double
                     : defined $single ? $single : $q;
            if (defined $array) {
                $searched{$_} = 1 for _quoted_values($array);
            } else {
                my ($v) = _quoted_values($spec);
                $searched{$v} = 1 if defined $v;
            }
        }
    }
    return \%searched;
}

# Pull the string contents out of any common Perl quote form.
sub _quoted_values {
    my ($s) = @_;
    my @v;
    while ($s =~ m~(?:'([^']*)'|"([^"]*)"|q\{([^}]*)\}|q\(([^)]*)\)|q\[([^\]]*)\]|q<([^>]*)>)~g) {
        my @m = grep { defined } ($1, $2, $3, $4, $5, $6);
        push @v, $m[0];
    }
    return @v;
}