pack_janken.pl

use strict;
use feature ":5.10";
use ExtUtils::Installed;
use File::Spec;
use Portable;
use Win32::Unicode;

my $TO_DIR = 'C:\Janken';
my $FROM_DIR = Portable->default->dist_root;

main: {
    export_perl();    # C:\Jankenへperlファイルをコピー
    export_modules(); # C:\Jankenへ必要なモジュールをコピー
    export_app();     # C:\Jankenへjanken.plをコピー
    pack_exe();       # urladerでexeに固める
}

sub export_app {
    _copy_file( 'janken.pl' );
}

sub export_modules {
    my ($inst) = ExtUtils::Installed->new;
    my @required = qw(
        Alien::wxWidgets
        Wx

        Carp
        Exporter
        XSLoader
    );

    for my $module (@required) {
        sayW $module;
        my @files = $inst->files($module);
        for my $abs (@files) {
            # .hのヘッダファイルなど、実行には不要なものをスキップ
            next if $abs =~ m{(include[\\/]wx|\.(a|h|pl|pod)$)};

            my $rel = do {
                my @parts = File::Spec->splitdir($abs);
                File::Spec->catdir( @parts[2 .. $#parts] );
            };
            _copy_file($rel);
        }
    }
}

sub export_perl {
    my ($inst) = ExtUtils::Installed->new;
    my @perl_files = map { _abs_to_rel($_) } $inst->files("Perl");
    my @module_files = map { _abs_to_rel($_) } map { $inst->files($_) } grep { $_ ne "Perl" } $inst->modules;

    use List::Compare;
    my $lc = List::Compare->new(\@perl_files, \@module_files);
    my @core_files = $lc->get_Lonly;

    for my $rel (@core_files) {
        # .hのヘッダファイルなど、実行には不要なものをスキップ
        next if $rel =~ m{(include[\\/]wx|\.(a|h|pod)$)};

        _copy_file($rel);
    }

    #_copy_file('c\bin\libeay32_.dll');
    _copy_file('perl/bin/libgcc_s_sjlj-1.dll');
    _copy_file('portable.perl');
    _copy_file('portableshell.bat');
    _copy_file('perl\bin\wperl.exe');
}

sub pack_exe {
    use Urlader;

    my $ver     = time;
    my $urlader = File::Spec->catfile("windows-x86");
    my $output  = File::Spec->catfile("janken.exe");

    system(
        join(" ",
            "urlader-util",
            "--urlader $urlader",
            "--output $output",
            "--pack Janken $ver C:\\Janken perl\\bin\\wperl.exe janken.pl",
        )
    );
}

sub _abs_to_rel {
    my @parts = File::Spec->splitdir($_[0]);
    File::Spec->catdir( @parts[2 .. $#parts] );
}

sub _copy_file {
    my $rel_from_file = shift;
    my $rel_to_file = shift || $rel_from_file;

    my $abs_from_file = File::Spec->catfile($FROM_DIR,$rel_from_file);
    my $abs_from_dir  = do {
        my ($volume,$directories,$file) = File::Spec->splitpath($abs_from_file);
        File::Spec->catdir($volume,$directories);
    };
    my $abs_to_file = File::Spec->catfile($TO_DIR,$rel_to_file);
    my $abs_to_dir  = do {
        my ($volume,$directories,$file) = File::Spec->splitpath($abs_to_file);
        File::Spec->catdir($volume,$directories);
    };

    unless ( file_type('f', $abs_from_file) ) {
        warnW "$abs_from_file not found.";
    }
    unless ( file_type('d', $abs_to_dir) ) {
        unless ( mkpathW($abs_to_dir) ) {
            die $abs_to_dir;
        }
    }
    unless ( copyW($abs_from_file, $abs_to_file) ) {
        #die "$abs_from_file, $abs_to_file, $!";
    }

    #sayW "\t$abs_from_file -> $abs_to_file";
}