The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#! /usr/bin/perl
#---------------------------------------------------------------------

use strict;
use warnings;
use autodie ':io';

use Test::More 0.88;            # done_testing

BEGIN {
  eval "use Git::Wrapper; 1"
      or plan skip_all => "Git::Wrapper required for testing GitVersionCheckCJM";

  # RECOMMEND PREREQ: Test::Fatal
  eval "use Test::Fatal; 1"
      or plan skip_all => "Test::Fatal required for testing GitVersionCheckCJM";
}

use Test::DZil 'Builder';
use File::pushd 'pushd';
use File::Temp ();
use Path::Class qw(dir file);
use Try::Tiny qw(try catch);

my $stoppedRE = qr/Stopped because of errors/;

#---------------------------------------------------------------------
# Initialise Git working copy:

my $fakeHome   = File::Temp->newdir;
$ENV{HOME}     = "$fakeHome"; # Don't want user's ~/.gitconfig to interfere

my $tempdir    = File::Temp->newdir;
my $gitRoot    = dir("$tempdir")->absolute;
my $gitHistory = file("corpus/gitvercheck.git")->absolute;

my $git;

try {
  my $wd = pushd($gitRoot);
  system "git init --quiet" and die "Couldn't init repo\n";
  system "git fast-import --quiet <\"$gitHistory\""
      and die "Couldn't import repo\n";

  $git = Git::Wrapper->new("$gitRoot");

  $git->config('user.email', 'example@example.org');
  $git->config('user.name',  'E. Xavier Ample');
  $git->checkout(qw(--force --quiet master));
} catch {
  chomp;
  plan skip_all => $_;
};

plan tests => 18;

#---------------------------------------------------------------------
sub edit
{
  my ($file, $edit) = @_;

  my $fn = $gitRoot->subdir("lib/DZT")->file("$file.pm");

  local $_ = do {
    local $/;
    open my $fh, '<:raw', $fn;
    <$fh>;
  };

  $edit->();

  open my $fh, '>:raw', $fn;
  print $fh $_;
  close $fh;
} # end edit

#---------------------------------------------------------------------
sub set_version
{
  my $version = shift;

  foreach my $file (@_) {
    edit($file, sub { s/(\$VERSION\s*=)\s*'[^']*'/$1 '$version'/ or die });
  }
} # end set_version

#---------------------------------------------------------------------
sub new_tzil
{
  my $tzil = Builder->from_config(
    { dist_root => $gitRoot },
  );

  $tzil->plugin_named('GitVersionCheckCJM')->logger->set_debug(1);

  # Something about the copy dzil makes seems to confuse git into
  # thinking files are modified when they aren't.
  # Run "git reset --mixed" in the source directory to unconfuse it:
  Git::Wrapper->new( $tzil->tempdir->subdir("source")->stringify )
              ->reset('--mixed');

  $tzil;
} # end new_tzil

#------------------------------------------------------n---------------
# Extract the errors reported by GitVersionCheckCJM:

sub errors
{
  my ($tzil) = @_;

  my @messages = grep { s/^.*GitVersionCheckCJM.*ERROR:\s*// }
                      @{ $tzil->log_messages };
  my %error;

  for (@messages) {
    s!\s*lib/DZT/(\S+)\.pm\b:?\s*!! or die "Can't find filename in $_";
    $error{$1} = $_;
  }

  #use YAML::XS;  print Dump $tzil->log_events;

  return \%error;
} # end errors

#---------------------------------------------------------------------
# Write the log messages as diagnostics:

sub diag_log
{
  my $tzil = shift;

  # Output nothing if all tests passed:
  my $all_passed = shift;
  $all_passed &&= $_ for @_;

  return if $all_passed;

  diag(map { "$_\n" } @{ $tzil->log_messages });

  {
    my $wd = pushd($tzil->tempdir->subdir("source"));
    diag(
      `git --version`,
      "git diff-index:\n", `git diff-index HEAD --name-only`,
      "git ls-files:\n",   `git ls-files -o --exclude-standard`,
      "git status:\n",     `git status`,
    );
  }
} # end diag_log

#---------------------------------------------------------------------
{
  my $tzil = new_tzil;
  diag_log($tzil,
    is(exception { $tzil->build }, undef, "build 0.04"),
    is_deeply(errors($tzil), {}, "no errors in 0.04"),
  );
#  print "$_\n" for @{ $tzil->log_messages };
#  print $tzil->tempdir,"\n"; my $wait = <STDIN>;
}

{
  set_version('0.04', 'Sample/Second');

  my $tzil = new_tzil;
  diag_log($tzil,
    like(exception { $tzil->build }, $stoppedRE, "can't build modified 0.04"),

    is_deeply(errors($tzil),
              { 'Sample/Second' => 'dist version 0.04 needs to be updated' },
              "errors in modified 0.04"),
  );
}

{
  set_version('0.05', 'Sample');

  my $tzil = new_tzil;
  diag_log($tzil,
    like(exception { $tzil->build }, $stoppedRE, "can't build 0.05 yet"),

    is_deeply(errors($tzil),
              { 'Sample/Second' => '0.04 needs to be updated' },
              "errors in 0.05"),
  );
}

{
  set_version('0.05', 'Sample/Second');

  my $tzil = new_tzil;
  diag_log($tzil,
    is(exception { $tzil->build }, undef, "can build 0.05 now"),
    is_deeply(errors($tzil), {}, "no errors in 0.05 now"),
  );
}

#---------------------------------------------------------------------
$git->reset(qw(--hard --quiet)); # Restore to checked-in state

{
  set_version('0.045', 'First');

  my $tzil = new_tzil;
  diag_log($tzil,
    like(exception { $tzil->build }, $stoppedRE, "can't build with 0.045"),
    is_deeply(errors($tzil), { First => '0.045 exceeds dist version 0.04' },
              "errors with 0.045"),
  );
}

{
  set_version('0.05', 'Sample');

  my $tzil = new_tzil;
  diag_log($tzil,
    like(exception { $tzil->build }, $stoppedRE, "can't build 0.05 with 0.045"),
    is_deeply(errors($tzil), {
      First => '0.045 needs to be updated',
    }, "errors in 0.05 with 0.045"),
  );
}

{
  $git->add('lib/DZT/First.pm');
  $git->commit(-m => 'checking in DZT::First 0.045');

  my $tzil = new_tzil;
  diag_log($tzil,
    like(exception { $tzil->build }, $stoppedRE,
         "can't build 0.05 with 0.045 committed"),
    is_deeply(errors($tzil), {
      First => '0.045 does not seem to have been released, but is not current',
    }, "errors in 0.05 with 0.045 committed"),
  );
}

{
  set_version('0.05', 'First');

  my $tzil = new_tzil;
  diag_log($tzil,
    is(exception { $tzil->build }, undef, "can build with First 0.05"),
    is_deeply(errors($tzil), {}, "no errors with First 0.05"),
  );
}

{
  edit('First', sub { s/^.*VERSION.*\n//m or die });

  my $tzil = new_tzil;
  diag_log($tzil,
    like(exception { $tzil->build }, qr/ERROR: Can't find version/,
         "can't build with First unversioned"),
    is_deeply(errors($tzil), { First => "Can't find version in" },
              "errors with First unversioned"),
  );
}

undef $tempdir;                 # Clean up temporary directory

done_testing;