pre-commit

#!/usr/bin/env perl

use strict;
use warnings;
use autodie qw{open};
use Cwd qw{getcwd chdir};

my $dir = getcwd;

my $rakudodir = $1 if $dir =~ m!^(.+)/t/spec.*$!;

my @git_status_lines = `git status`;
my @changed_files;

for my $statuslines (@git_status_lines) {
    push @changed_files, $1 if $statuslines =~ /^\s*modified:\s+(.+)$/;
}

chdir $rakudodir;
my @outputs;
my %plans_wrong;
for my $file (@changed_files) {
    my @output = `make t/spec/$file`;
    $plans_wrong{$file}{'plan'} = "";
    $plans_wrong{$file}{'not_ok'} = [];
    $plans_wrong{$file}{'exit'} = 0;
    $plans_wrong{$file}{'died'} = 0;
    for my $line (@output) {
         $plans_wrong{$file}{'plan'} = 
            $line =~ /(You planned \d+ but ran \d+\.)/ 
            if $line =~ /Bad plan\./;
         push $plans_wrong{$file}{'not_ok'}, $line 
            if $line =~ /^not ok.+$/ && $line !~ /TODO/;
         $plans_wrong{$file}{'exit'}++ 
            if $line =~ /Non-zero exit status: (\d+)/;
         $plans_wrong{$file}{'died'}++ 
            if $line =~ m!  in .+ at t/spec/$file:\d+!;
    }
}

chdir $dir;

my $retVal = 0;
if(keys(%plans_wrong) > 0) {
    for my $file (keys %plans_wrong) {
        if( @{ $plans_wrong{$file}{'not_ok'} } > 0 ) {
            warn "Failed tests in $file:";
            warn "\t" . $_ for @{$plans_wrong{$file}{'not_ok'}};
            warn "Unstaging $file.";
            `git reset HEAD $file`;
            delete $plans_wrong{$file};
        } elsif( $plans_wrong{$file}{'exit'} != 0 ) {
            warn "Non-zero exit status on $file.";
            warn "Unstaging $file.";
            `git reset HEAD $file`;
            delete $plans_wrong{$file};
        } elsif( $plans_wrong{$file}{'died'} != 0 ) {
            warn "It looks like $file died.";
            warn "Unstaging $file.";
            `git reset HEAD $file`;
            delete $plans_wrong{$file};
        } elsif( $plans_wrong{$file}{'plan'} ne "") {
            warn "$file apparently has a wrong plan (" 
                . $plans_wrong{$file}{'plan'} . "), please check and restage.";
            warn "Unstaging $file.";
            `git reset HEAD $file`;
            delete $plans_wrong{$file};
        } else {
            warn "$file seems fine.";
        }
    }
}

if (keys(%plans_wrong) > 0) {
    warn "Passing staged files present, committing.";
    warn "Previous output should indicate files that didn't get commited.";
} else {
    warn "No passing or fixable files staged, aborting commit.";
    exit(1);
}