#!/usr/bin/perl

use strict;
use warnings;

use FileHandle;
use Capture::Tiny(qw/:all/);
use Parallel::ForkManager 0.7.6;
use Text::JaroWinkler qw( strcmp95 );
use Digest::MD5::File qw(md5 md5_hex md5_base64);

use lib '/app/tools/admin/lib';
use Admin::App::ToolsDir;

use lib '/app/tools/common/lib';
use Common::Session;
use Common::ProgressBar;

my ( $opt, $usage ) = clopt(
    [ 'all|a'          => 'All pm/pl files in /app/tools' ],
    [ 'infile=s'       => 'In file of paths to check' ],
    [ 'directory|d=s'  => 'All files inside a diretory' ],
    [ 'filter|f=s'     => 'Filter to subdir of /app/tools' ],
    [ 'count|c=i'      => 'Parallel Process Count default 10', { 'default' => 10 } ],
    [ 'ignore=s'       => 'File of paths to ignore' ],
    [ 'pm|m'           => 'All pm files in /app/tools' ],
    [ 'pl|l'           => 'All pl files in /app/tools' ],
    [ 'misc|x'         => 'All misc files in /app/tools' ],
    [ 'verbose|v'      => 'Verbose output' ],
    [ 'very_verbose|V' => 'Very verbose output' ],
);

$opt->{'verbose'} = 1 if $opt->very_verbose;

## get a list of files to compile
my $td = Admin::App::ToolsDir->new;
my $files;
if ( $opt->all ) {
    $files = $td->all_perl_files;
} elsif ( $opt->pm ) {
    $files = $td->perl_modules;
} elsif ( $opt->pm ) {
    $files = $td->perl_scripts;
} elsif ( $opt->directory ) {
    $files = $td->all_perl_files( $opt->directory );
} elsif ( $opt->infile ) {
    my $fh = FileHandle->new( $opt->infile, 'r' );
    while (<$fh>) {
        chomp;
        push @{$files}, $_;
    }
    $fh->close;
} else {
    $files = $td->perl_misc;
}

## ignore paths with the file lists above
my $ignore;
if ( defined $opt->ignore ) {
    my $fh = FileHandle->new( $opt->ignore, 'r' );
    while (<$fh>) {
        chomp;
        $ignore->{$_}++;
    }
    $fh->close;
}

my $pm = Parallel::ForkManager->new( $opt->count, '/tmp' );

my $_cache;
my $_errs;

$pm->run_on_finish(
    sub {
        my ( $pid, $exit_code, $ident, $exit_signal, $core_dump, $href ) = @_;
        my $idx    = $href->{'idx'};
        my $file   = $href->{'file'};
        my $stderr = $href->{'stderr'};
        if ( $stderr !~ m/OK$/i ) {
            my $msg;
            my $score;
            my @lines = split "\n", $stderr;
            if ( defined $_errs ) {
                foreach my $k ( keys %{$_cache} ) {
                    my $cmp = strcmp95( $lines[0], $k, 80 );
                    if ( $cmp > .95 ) {
                        $score = $cmp;
                        $msg   = $k;
                        last;
                    }
                }
                $msg = $lines[0] if not defined $msg;
            } else {
                $msg = $lines[0];
            }
            $_cache->{$msg}++;
            my $id = md5_hex($msg);
            $_errs->{$id}->{'error'} = $msg;
            $_errs->{$id}->{'count'}++;
            push @{ $_errs->{$id}->{'files'} }, $file;
            $_errs->{$id}->{'scores'}->{$score}++ if $score;
            print STDERR "$idx $file - NOK\n" if $opt->verbose;
        } else {
            print STDERR "$idx $file - OK\n" if $opt->very_verbose;
        }
    }
);

my $i = 0;
my $c = scalar @{$files};
FILE:
foreach my $file ( @{$files} ) {
    my $idx = sprintf "(%04d/%04d)", ++$i, $c;

    if ( defined $opt->filter ) {
        my $filter = $opt->filter;
        next FILE if $file !~ m/\Q$filter/;
    }

    if ( defined $ignore ) {
        foreach my $k ( keys %{$ignore} ) {
            if ( $file =~ m/\Q$k/ ) {
                print STDERR "$idx $file - IGNORING\n" if $opt->very_verbose;
                next FILE;
            }
        }
    }

    if ( defined $opt->filter ) {
        my $filter = $opt->filter;
        next if $file !~ m/\Q$filter/;
    }

    $pm->start and next;
    my ( $stdout, $stderr, $exit ) = capture { system("perl -cw $file") };
    my $href = { 'idx' => $idx, 'file' => $file, 'stderr' => $stderr };
    $pm->finish( 0, $href );

}
$pm->wait_all_children;

foreach my $id ( keys %{$_errs} ) {
    my $href = $_errs->{$id};
    print "=" x 120 . "\n";
    print "$href->{'error'}";
    print "-" x 120 . "\n";
    print "$href->{'count'} total files affected\n";
    print "-" x 120 . "\n";
    map { print "$_\n" } @{ $href->{'files'} };
    print "=" x 120 . "\n";
}