use strict;
use warnings;

use POSIX;
use Tie::File;
use File::Basename;
use FindBin qw( $Bin $Script );

$| ++;

our ( $HIST, $MAKE, $LIST, $INST ) = qw( Changes Makefile.PL MANIFEST INSTALL );

=head3 update

 $0 [minor|major]

=cut
chdir $Bin;

my $manifest = Manifest->new( $INST );
my $module = basename( $Bin ); $module =~ s/-[\d.]+$//g;

if ( @ARGV && $ARGV[0] eq $INST && -f $INST )
{
    $manifest->munge( $ENV{MUNGE_PERL} )->install( $ENV{ uc $module } );
}
else
{
    ## version
    my @module = split '-', $module;
    my $module = join( '/', @module ) . '.pm';
    my $path = "$Bin/lib/$module";

    require $path;
    my $version = eval '$' . join '::', @module, 'VERSION';
    my @version = $version =~ /(\d+)\.(\d+)/;

    if ( @ARGV && @version )
    {
        my $bump = lc shift @ARGV;

        if ( $bump =~ /minor/ ) { $version[-1] ++ }
        elsif ( $bump =~ /major/ ) { $version[-1] =~ s/./0/g; $version[0] ++ }

        system sprintf "$^X -pi -e 's/$version/%s/' $path",
            ( $version = join '.', @version );
    }

    my $time = POSIX::strftime( '%Y.%m.%d', localtime( ( stat $path )[9] ) );

    tie my @hist, 'Tie::File', $HIST;
    for ( my $i = 0; $i < @hist; $i ++ )
    {
        next unless $hist[$i] =~ /^(\d+\S+)/;
        last if $1 eq $version;
        splice @hist, $i, 0, "$version    $time\n\n"; last;
    }
    untie @hist;

    ## manifest
    my @inst = $manifest->inst();

    if ( $version[-1] % 2 == 0 ) ## remove alpha for even version
    {
        my @alpha = map { chomp; $_ =~ s/\s*#.+//; qr{^$_} }
            grep { $_ =~ /^[^-#]/ } `egrep '# *alpha' $INST`;

        @inst = grep { my $path = $_; ! grep { $path =~ $_ } @alpha } @inst;
    }

    die $! unless open my $handle, '>', $LIST;
    map { print $handle "$_\n" }
        'README', $HIST, $MAKE, $LIST, $INST, "$INST.PL", $Script;

    my %inst = map { $_ => 1 } map { `find $_ -type f -not -name .*.swp` }
        qw( lib t ), @inst;

    print $handle sort keys %inst;
    close $handle;

    ## changes
    system "vi $HIST && cat $LIST"; ## update changes
    warn << "MEMO";

*** Be sure that the following are up to date ***

    $module : VERSION and MODULES
    $MAKE : PREREQ_PM
    $INST : installation list

MEMO
}

exit 0;

package Manifest;

sub new
{
    my ( $class, $inst ) = splice @_;
    my ( %inst, @inst, %list ) = map { $_ => {} } my @ext = qw( in ex );

    if ( $inst && open my $fh => $inst )
    {
        for my $path ( <$fh> )
        {
            $path =~ s/#.*//; $path =~ s/^\s*//; $path =~ s/\s*$//;
            next if $path =~ /^$/;
    
            my $inst = $path =~ s/^-\s*// ? $inst{ex} : $inst{in};
            map { $inst->{$_} = 1 } glob $path;
        }
    
        close $fh;
        map { delete $inst{in}{$_} if $inst{in}{$_} } keys %{ $inst{ex} };
    
        for my $ext ( @ext )
        {
            my @inst = sort keys %{ $inst{$ext} };
            open my $handle, '>', ( $list{$ext} = join '.', $inst , $ext );
            print $handle join( "\n", @inst ), "\n";
            close $handle;
    
            $inst{$ext} = \@inst;
        }
    
        @inst = @{ $inst{in} };
        chomp @inst;
    }

    bless { inst => \@inst, list => \%list }, ref $class || $class;
}

sub list
{
    my $self = shift;
    return wantarray ? %{ $self->{list} } : $self->{list};
}

sub inst
{
    my $self = shift;
    return wantarray ? @{ $self->{inst} } : $self->{inst};
}

sub install
{
    my $self = shift;
    my %list = $self->list();

    return $self unless my $dir = shift;
    return $self unless my @inst = $self->inst();

    my $inst = "tar -T $list{in} -X $list{ex} -cf - | \(cd $dir && tar xvf -\)";

    warn "$inst\n";
    system "mkdir -p $dir && $inst";
    map { system "cd $dir && sudo chown -R root:root $_" } @inst;
    return $self;
}

sub munge
{
    my $self = shift;

    return $self unless shift;
    warn "Munging invocation perl path to $^X ..\n";

    for my $file ( map { `find $_ -type f` } $self->inst() )
    {
        chomp $file;
        tie my ( @file ), 'Tie::File', $file;

        next unless @file && $file[0] =~ /#![^#]*perl(.*$)/o;
        $file[0] = "#!$^X$1";
        warn "$file\n";
        untie @file;
    }
    return $self;
}

sub DESTROY
{
    my $self = shift;
    my %list = $self->list();
    unlink values %list;
}

1;