#!/usr/bin/env perl

use strict;
use warnings;
use English;
use feature qw(say);
use Benchmark;
use File::Path;
use File::Basename;
use File::Copy;
use Cwd;
use POSIX qw(nice);


sub MAIN {

    #let us play nice with others
    nice(19);

    print <<"WARNING";

My job is to run STD_syntax_highlight over all the tests in t/.

You can press CTRL-C when you feel bored.

WARNING

    #sanity check: working directory should end with src/perl6
    my $cwd = getcwd();
    unless($cwd =~ m{src/perl6$}) {
        die "Please run $PROGRAM_NAME in src/perl6\n";
    }

    #sanity check: make sure STD.pm is correctly built
    unless(-r 'STD.pmc') {
        die "Could not find 'STD.pmc'. Maybe your forgot to 'make'\n";
    }

    #sanity check: make sure unicode will work with your locale
    unless($ENV{LANG} =~ /\.UTF-8$/) {
        die "Unicode will not work. Please set your LANG environment variable.\n" .
            "(e.g. 'export LANG=en_US.UTF-8' in your ~/.bashrc)";
    }

    #make sure that the output html directory is there
    unless(-d 'html') {
        print "Creating html directory...\n";
        mkdir 'html' or die "Could not create html directory\n";
    }
 
    my $dir_to_test = '../../t/';
    my $fail = 0;
    my $success = 0;
    say "Finding *.t in $dir_to_test... Please wait";
    my @files = sort `find $dir_to_test -name '*.t'`;
    chomp(@files);
    $OUTPUT_AUTOFLUSH = 1;

    my $total = 0+@files;
    say "Going to run $total tests... Maybe watch a movie meanwhile?";

    my $HILITE = "std_hilite/STD_syntax_highlight";
    my $JQUERY_JS = "jquery-1.4.2.min.js";
    my $start_time = new Benchmark;
    my @failed;
    for my $file (@files) {
        my $myfile = $file;
        $myfile =~ s/^\.\.\/\.\.\/t/html/;   
        my ($simple_html,$snippet_html, $full_html) = (
            "$myfile.simple.html", 
            "$myfile.snippet.html",
            "$myfile.html");
        my ($html_filename,$html_path,$html_suffix) = fileparse($full_html);
        mkpath $html_path;

        my $dir = dirname(dirname($myfile));
        copy_resource("std_hilite/$JQUERY_JS", $dir);
        copy_resource("std_hilite/$HILITE.js", $dir);
        copy_resource("std_hilite/$HILITE.css", $dir);
        
        #run the process and time it
        print <<"OUT";

$file
    -> $full_html
    -> $simple_html
    -> $snippet_html
OUT
        my $t0 = new Benchmark;
        my $cmd = "./$HILITE --clean-html " .
                "--simple-html=$simple_html " .
                "--snippet-html=$snippet_html " .
                "--full-html=$full_html $file";
        my $log = `$cmd 2>&1`;
        say "It took " . 
            timestr(timediff(new Benchmark,$t0),"nop");

        if ($CHILD_ERROR) {
            push(@failed,$file);
            $fail++;
        
            # let us write something useful into those htmls
            # when an error occurs
            write_error_html($simple_html, $file, $log, 1);
            write_error_html($snippet_html, $file, $log, 0);
            write_error_html($full_html, $file, $log, 1);

            say "error";
        } else {
            $success++;
            say "ok";
        }
    }

    printf "\nPassed $success/$total, %6.2f%%\n", $success/$total * 100;
    say "It took " .
        timestr(timediff(new Benchmark,$start_time),"noc");

    if (@failed) {
        say "Failed tests:";
        for my $file (@failed) {
            say $file;
        }
    }
    say "\nThe output is now in the html directory. Thanks for your time ;-)";
}

# copy resource
sub copy_resource {
    my ($src,$dir) = @_;
    my $dst = File::Spec->catfile( $dir, basename($src));
    if(not -e $dst) {
        print "Copying $dst\n";
        copy($src, $dst) or warn "WARN: Could not copy: $OS_ERROR\n";
    }
}


# write the error log in the html file provided
sub write_error_html {
    my ($html_file, $file, $log, $is_full) = @ARG;

    my $error_html = "";
    if($is_full) {
        $error_html = "<html><title>Error</title><body>";
    }

    $error_html .= <<"ERROR";
<pre>

An error has occurred while processing this file:

filename: 
    $file
Reason:
    $log
</pre>
ERROR

    if($is_full) {
        $error_html .= "<body></html>";
    }

    open FILE, ">$html_file"
        or die "Could not open $html_file for writing: $OS_ERROR\n";
    print FILE $error_html;       
    close FILE;
}

MAIN(@ARGV);

