use Log::Reproducible;

##</code><code>##

sample.pl -a 1 -b 2 -c 3 OTHER ARGUMENTS
#WHEN: YYYYMMDD.HHMMSS
#WORKDIR: /path/to/working/dir
#SCRIPTDIR: bin (/path/to/working/dir/bin)

##</code><code>##

perl sample.pl --reproduce rlog-sample.pl-YYYYMMDD.HHMMSS

##</code><code>##

perl sample.pl --repronote 'This is a note'

##</code><code>##

perl sample.pl --repronote "This is a multi-line note:
The moon had
a cat's mustache
For a second
  — from Book of Haikus by Jack Kerouac"

##</code><code>##

Reproducing archive: /path/to/repro-archive/rlog-sample.pl-20140321.144307
Created new archive: /path/to/repro-archive/rlog-sample.pl-20140321.144335

##</code><code>##

export REPRO_DIR=/path/to/archive

##</code><code>##

use Log::Reproducible '/path/to/archive';

##</code><code>##

perl sample.pl --reprodir /path/to/archive

##</code><code>##

#GITCOMMIT: develop f483a06 Awesome commit message
#GITSTATUS: M  staged-modified-file
#GITSTATUS:  M unstaged-modified-file
#GITSTATUS: A  newly-added-file
#GITSTATUS: ?? untracked-file
#GITDIFFSTAGED: diff --git a/staged-modified-file b/staged-modified-file
#GITDIFFSTAGED: index ce2f709..a04c0f6 100644
#GITDIFFSTAGED: --- a/staged-modified-file
#GITDIFFSTAGED: +++ b/staged-modified-file
#GITDIFFSTAGED: @@ -1,3 +1,3 @@
#GITDIFFSTAGED:  An unmodified line
#GITDIFFSTAGED: -A deleted line
#GITDIFFSTAGED: +An added line
#GITDIFFSTAGED:  Another unmodified line
#GITDIFF: diff --git a/unstaged-modified-file b/unstaged-modified-file
#GITDIFF: index ce2f709..a04c0f6 100644
#GITDIFF: --- a/unstaged-modified-file
#GITDIFF: +++ b/unstaged-modified-file
#GITDIFF: @@ -1,3 +1,3 @@
#GITDIFF:  An unmodified line
#GITDIFF: -A deleted line
#GITDIFF: +An added line
#GITDIFF:  Another unmodified line

##</code><code>##

package Log::Reproducible;
use strict;
use warnings;
use autodie;
use feature 'say';
use Cwd;
use File::Path 'make_path';
use File::Basename;
use POSIX qw(strftime);

# TODO: Add verbose (or silent) option
# TODO: Standalone script that can be used upstream of any command line functions
# TODO: Allow customizion of --repronote/--reprodir/--reproduce upon import (to avoid conflicts or just shorten)

sub import {
    my ( $pkg, $dir ) = @_;
    reproduce($dir);
}

sub _first_index (&@) {    # From v0.33 of the wonderful List::MoreUtils
    my $f = shift;         # https://metacpan.org/pod/List::MoreUtils
    foreach my $i ( 0 .. $#_ ) {
        local *_ = \$_[$i];
        return $i if $f->();
    }
    return -1;
}

sub reproduce {
    my $dir = shift;
    $dir = _set_dir($dir);
    make_path $dir;

    my ( $prog, $prog_dir, $cmd, $note ) = _parse_command();
    my ( $repro_file, $now ) = _set_repro_file( $dir, $prog );

    if ( $cmd =~ /\s-?-reproduce\s+(\S+)/ ) {
        my $old_repro_file = $1;
        $cmd = _reproduce_cmd( $prog, $old_repro_file, $repro_file );
    }
    _archive_cmd( $cmd, $repro_file, $note, $prog_dir, $now );
}

sub _set_dir {
    my $dir     = shift;
    my $cli_dir = _get_repro_arg("reprodir");

    if ( defined $cli_dir ) {
        $dir = $cli_dir;
    }
    elsif ( !defined $dir ) {
        if ( defined $ENV{REPRO_DIR} ) {
            $dir = $ENV{REPRO_DIR};
        }
        else {
            my $cwd = getcwd;
            $dir = "$cwd/repro-archive";
        }
    }
    return $dir;
}

sub _parse_command {
    my $note = _get_repro_arg("repronote");
    for (@ARGV) {
        $_ = "'$_'" if /\s/;
    }
    my ( $prog, $prog_dir ) = fileparse $0;
    my $cmd = join " ", $prog, @ARGV;
    return $prog, $prog_dir, $cmd, $note;
}

sub _get_repro_arg {
    my $repro_arg = shift;
    my $arg;
    my $arg_idx = _first_index { $_ =~ /^-?-$repro_arg$/ } @ARGV;
    if ( $arg_idx > -1 ) {
        $arg = $ARGV[ $arg_idx + 1 ];
        splice @ARGV, $arg_idx, 2;
    }
    return $arg;
}

sub _set_repro_file {
    my ( $dir, $prog ) = @_;
    my $now = strftime "%Y%m%d.%H%M%S", localtime;
    my $repro_file = "$dir/rlog-$prog-$now";
    return $repro_file, $now;
}

sub _reproduce_cmd {
    my ( $prog, $old_repro_file, $repro_file ) = @_;

    die "Reproducible archive file ($old_repro_file) does not exists.\n"
        unless -e $old_repro_file;
    open my $old_repro_fh, "<", $old_repro_file;
    my $cmd = <$old_repro_fh>;
    close $old_repro_fh;
    chomp $cmd;

    my ( $old_prog, @args ) = $cmd =~ /((?:\'[^']+\')|(?:\"[^"]+\")|(?:\S+))/g;
    @ARGV = @args;
    say STDERR "Reproducing archive: $old_repro_file";
    _validate_prog_name( $old_prog, $prog, @args );
    return $cmd;
}

sub _archive_cmd {
    my ( $cmd, $repro_file, $note, $prog_dir, $now ) = @_;
    my ( $gitcommit, $gitstatus, $gitdiff_cached, $gitdiff )
        = _git_info($prog_dir);
    my $cwd = cwd;
    my $full_prog_dir = $prog_dir eq "./" ? $cwd : "$cwd/$prog_dir";
    $full_prog_dir = "$prog_dir ($full_prog_dir)";

    open my $repro_fh, ">", $repro_file;
    say $repro_fh $cmd;
    _add_archive_comment( "NOTE",          $note,           $repro_fh );
    _add_archive_comment( "WHEN",          $now,            $repro_fh );
    _add_archive_comment( "WORKDIR",       $cwd,            $repro_fh );
    _add_archive_comment( "SCRIPTDIR",     $full_prog_dir,  $repro_fh );
    _add_archive_comment( "GITCOMMIT",     $gitcommit,      $repro_fh );
    _add_archive_comment( "GITSTATUS",     $gitstatus,      $repro_fh );
    _add_archive_comment( "GITDIFFSTAGED", $gitdiff_cached, $repro_fh );
    _add_archive_comment( "GITDIFF",       $gitdiff,        $repro_fh );
    close $repro_fh;
    say STDERR "Created new archive: $repro_file";
}

sub _git_info {
    my $prog_dir = shift;
    return if `which git` eq '';

    my $gitbranch = `cd $prog_dir; git rev-parse --abbrev-ref HEAD 2>&1;`;
    return if $gitbranch =~ /fatal: Not a git repository/;
    chomp $gitbranch;

    my $gitlog         = `cd $prog_dir; git log -n1 --oneline;`;
    my $gitcommit      = "$gitbranch $gitlog";
    my $gitstatus      = `cd $prog_dir; git status --short;`;
    my $gitdiff_cached = `cd $prog_dir; git diff --cached;`;
    my $gitdiff        = `cd $prog_dir; git diff;`;
    return $gitcommit, $gitstatus, $gitdiff_cached, $gitdiff;
}

sub _add_archive_comment {
    my ( $title, $comment, $repro_fh ) = @_;
    if ( defined $comment ) {
        my @comment_lines = split /\n/, $comment;
        say $repro_fh "#$title: $_" for @comment_lines;
    }
}

sub _validate_prog_name {
    my ( $old_prog, $prog, @args ) = @_;
    die <<EOF if $old_prog ne $prog;
Current ($prog) and archived ($old_prog) program names don't match!
If this was expected (e.g., filename was changed), please re-run as:

    perl $prog @args

EOF
}

1;