view release on metacpan or  search on metacpan

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

    require File::Find;

    my $self = shift;

    my $tempdir = $self->{tempdir};

    $self->{_included_modules} = {};
    my %pack_args;
    {
        local $CWD = "$tempdir/lib";
        File::Find::find(
            sub {
                return unless -f;
                return unless /\.pm$/i;
                my $mod_pm = $File::Find::dir eq '.' ? $_ : "$File::Find::dir/$_";
                $mod_pm =~ s!^\.[/\\]!!;
                $mod_pm =~ s!\\!/!g; # convert windows-style path

                my $mod = $mod_pm;
                $mod =~ s/\.pm$//;
                $mod =~ s!/!::!g;

                my $mod_ver = MM->parse_version($_);
                $mod_ver = undef if defined($mod_ver) && $mod_ver eq 'undef';

                $pack_args{module_srcs}{$mod_pm} = read_binary($_);
                $self->{_included_modules}{$mod} = $mod_ver;
            }, ".",
        );
    }

    my $script = read_binary($self->{abs_input_file});

    my $shebang = $self->{shebang} // '#!/usr/bin/perl';
    $shebang = "#!$shebang" unless $shebang =~ /^#!/;
    $shebang =~ s/\R+//g;

    # strip shebang from script
    $script =~ s/\A#![^\n]*\R?//;

    my $res;
    $pack_args{preamble}  = "$shebang\n\n";
    $pack_args{preamble} .= "# code after shebang\n$self->{code_after_shebang}\n\n" if defined $self->{code_after_shebang};
    $pack_args{postamble} = "\n$script";
    $pack_args{put_hook_at_the_end} = $self->{put_hook_at_the_end};
    if ($self->{pack_method} eq 'datapack') {
        require Module::DataPack;
        $res = Module::DataPack::datapack_modules(
            %pack_args,
        );
        return $res unless $res->[0] == 200;
    } else {
        require Module::FatPack;
        $res = Module::FatPack::fatpack_modules(
            %pack_args,
        );
        return $res unless $res->[0] == 200;
    }

    write_binary($self->{abs_output_file}, $res->[2]);
    chmod 0755, $self->{abs_output_file};

    log_info("  Produced %s (%.1f KB)",
                $self->{abs_output_file}, (-s $self->{abs_output_file})/1024);
}

sub _test {
    require Capture::Tiny;
    require IPC::System::Options;

    my $self = shift;
    die "Can't test: at least one test case ('--test-case-json') must be specified\n"
        unless $self->{test_cases} && @{ $self->{test_cases} };

    my $cases = $self->{test_cases};
    my $i = 0;
    for my $case (@$cases) {
        $i++;
        log_debug("  Test case %d/%d: %s ...", $i, scalar(@$cases), $case->{args});
        my @cmd = ($^X);
        push @cmd, @{ $case->{perl_args} } if $case->{perl_args} && @{ $case->{perl_args} };
        push @cmd, $self->{abs_output_file}, @{ $case->{args} };
        my $exit;
        # log statement by IPC::System::Options' log=1 will be eaten by
        # Capture::Tiny, so we log here
        log_trace("cmd: %s", \@cmd);
        my $output = Capture::Tiny::capture_merged(
            sub {
                IPC::System::Options::system({log=>0, shell=>0}, @cmd);
                $exit = $? >> 8;
            }
        );
        my $expected_exit = $case->{exit_code} // 0;
        if ($exit != $expected_exit) {
            die "  Test case $i failed: exit code is not $expected_exit ($exit),output: <<$output>>\n";
        }
        if (defined $case->{output_like}) {
            $output =~ /$case->{output_like}/
                or die "  Test case $i failed: output does not match $case->{output_like}, output: <<$output>>\n";
        }
    }
}

sub new {
    my $class = shift;
    bless { @_ }, $class;
}

my $trace_methods;
{
    my $sch = $App::tracepm::SPEC{tracepm}{args}{method}{schema};
    # XXX should've normalized schema
    if (ref($sch->[1]) eq 'HASH') {
        $trace_methods = $sch->[1]{in};
    } else {
        $trace_methods = $sch->[2];
    }
}

$SPEC{depak} = {
    v => 1.1,