#!/usr/bin/env perl

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 )
{
    $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';

    if ( @ARGV && ( my @version = $version =~ /(\d+)\.(\d+)/ ) )
    {
        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
    die $! unless open my $handle, '>', $LIST;
    map { print $handle "$_\n" }
        'README', $HIST, $MAKE, $LIST, $INST, "$INST.PL", $Script;

    print $handle map { `find $_ -type f -not -name .*.swp` }
        qw( lib t ), $manifest->list();
    close $handle;

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

Be sure that the following are up to date.

    VERSION and MODULES in $module and PREREQ_PM in $MAKE

MEMO
}

exit 0;

package Manifest;

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

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

    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 $self->{inst};
}

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

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

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

    warn "$inst\n";
    system "mkdir -p $dir && $inst";
    map { system "cd $dir && sudo chown -R root:root $_" } @list;
    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->list() )
    {
        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;
}

1;
