fatpack-tree.pl

#!/usr/bin/env perl
use strict;
use warnings;
use File::Copy qw(copy);
use File::Path qw(mkpath rmtree);
use File::Spec::Functions qw(splitpath catdir catfile);

my @fatlib_list = qw(
    HTTP::Tiny
    local/lib/perl5/darwin-2level/auto/Test/Simple/.packlist
    local/lib/perl5/darwin-2level/auto/IO/Socket/SSL/.packlist
);

if (!caller) {
    main(@fatlib_list);
    exit;
}

sub main {
    my @fatlib_list = @_;
    my @modules = map { resolve($_) } @fatlib_list;
    @modules = uniq(@modules);
    fatlib(@modules);
}

sub resolve {
    my $want = shift;
    if ($want =~ /\.packlist/) {
        read_packlist($want);
    }
    else {
        Module->new(mod => $want);
    }
}

sub read_packlist {
    my $packlist = shift;
    open my $fh, "<", $packlist or die "cannot open $packlist: $!";
    my %seen;
    my @modules;
    for my $line (reverse <$fh>) {
        chomp $line;
        next if $line !~ /\.pm$/;
        my $module = Module->new(path => $line);
        $seen{ $module->mod }++ or push @modules, $module;
    }
    return @modules;
}

sub uniq {
    my %in = map { $_->mod => $_ } @_;
    values %in;
}

sub fatlib {
    my @modules = @_;
    my $dist = 'fatlib';
    -d $dist and rmtree $dist;
    for my $module (@modules) {
        my $dir = catdir $dist, (splitpath($module->pm))[1];
        if (!-d $dir) {
            mkpath $dir or die "mkpath $dir: $!";
        }
        my $file = catfile $dist, $module->pm;
        copy $module->path, $file
            or die sprintf "copy %s %s: %s", $module->path, $file, $!;
    }
}

package Module;
use Carp qw(confess);
use File::Spec::Functions qw(catfile);
sub new {
    my $class = shift;
    my $self  = bless +{ @_ }, $class;
    $self->mod  or $self->resolve_mod;
    $self->path or $self->resolve_path;
    return $self;
}
sub mod {
    my $self = shift;
    @_ ? $self->{mod} = shift : $self->{mod};
}
sub pm  {
    my $self = shift;
    @_ ? $self->{pm} = shift : $self->{pm};
}
sub path  {
    my $self = shift;
    @_ ? $self->{path} = shift : $self->{path};
}
sub resolve_mod {
    my $self = shift;
    local $_ = $self->path or confess "missing path";
    for my $inc (@INC) {
        s/^$inc//;
    }
    s{^.*local/lib/perl5/}{};
    $self->pm($_);
    s{/}{::}g; s/\.pm$//;
    $self->mod($_);
}
sub resolve_path {
    my $self = shift;
    local $_ = $self->mod or confess "missing mod";
    s{::}{/}g;
    $self->pm("$_.pm");
    my $pm = $self->pm;
    my $path;
    for my $dir ('.', 'local/lib/perl5', @INC) {
        my $cand = catfile $dir, $pm;
        if (-f $cand) {
            $path = $cand;
            last;
        }
    }
    confess "cannot find file " . $self->pm unless $path;
    $self->path($path);
}