#!/usr/bin/perl -w

# yukicoder tester ver.5.8 (2015/02/21)
# Copyright (C) 2014 naoki_kp
my $VERSION = "5.8";

# コマンドオプションに問題番号を指定すると
# サンプルケースをダウンロードするスクリプト。
# $PNAME への標準入力に各サンプルを突っ込んで一致判定します。
# 自分用なのでカスタマイズ性とか知らない。

# [オプション]
# -s : 改行込みで一致判定します。
# -f : サンプルケースを再ダウンロードします。
# -q : テストケースNG時に追加情報を表示しません。
# -v : 各動作メッセージを表示します。また、テストケースOK時でも追加情報を表示します。

# 問題番号の後に実行コマンドを指定できます。

use strict;
use HTML::TreeBuilder;
use LWP::Simple;
use Getopt::Std;
use File::Path qw/make_path/;
use Time::HiRes qw/gettimeofday/;
use utf8;
$Getopt::Std::STANDARD_HELP_VERSION = 1;

binmode STDERR, ':utf8';

$| = 1;
my $ESCCR = "\x1b[1;31m";
my $ESCCG = "\x1b[32m";
my $ESCCN = "\x1b[m";

# システム定数
my $URLBASE         = 'http://y...content-available-to-author-only...r.me/problems/no/';
my $PROBLEMDIR_FMT  = 'y%04u';      # $PROBLEM_NO
my $SAMPLEDIR_IN    = 'test_in';
my $SAMPLEDIR_OUT   = 'test_out';
my $SAMPLETXT_FMT   = '#sample%02u.txt';  # $CASE_NO
my $STDOUT          = 'stdout.txt';
my $STDERR          = 'stderr.txt';
my $PNAME           = './yukicoder.exe';

sub VERSION_MESSAGE{
    print <<"EOD";
## yukicoder tester ver.$VERSION ##
EOD
}

sub HELP_MESSAGE{
    print <<EOD;
[usage]
./tester.pl [-h | --help | --version]
./tester.pl [-efstqv] <problem_no> [execution command]
 -e : eps
 -f : force download
 -s : strict mode
 -t : all testcase download(zip)
 -q : quiet
 -v : verbose
EOD
    exit;
}

sub gettick {
    my ($sec, $usec) = gettimeofday();
    return $sec * 1000 + $usec / 1000;
}

# オプション解析
my %opt;
getopts('e:fhstqv', \%opt);
if($opt{h} || !@ARGV){
    HELP_MESSAGE();
}

my $PROBLEM_NO = 0 + shift @ARGV;
my $URL = $URLBASE . $PROBLEM_NO;

# 実行パス指定
$PNAME = join " ", @ARGV if(@ARGV);

my $dirp = sprintf $PROBLEMDIR_FMT, $PROBLEM_NO;
my $diri = $dirp . "/" . $SAMPLEDIR_IN;
my $diro = $dirp . "/" . $SAMPLEDIR_OUT;
if($opt{f} || ! -d $diri || ! -d $diro){
    print "downloading samples from $URL\n" if($opt{v});
    my $html = get($URL);
    my $tree = HTML::TreeBuilder->new;
    $tree->parse($html);

    my @case;
    foreach ($tree->look_down('class','sample')){
        my @sample;
        foreach ($_->look_down('_tag','pre')){
            if(ref $_->content eq 'ARRAY'){
                push @sample, $_->content->[0];
            } else {
                push @sample, "";
            }
        }
        while(@sample >= 2){
            my $in = shift @sample;
            my $out = shift @sample;
            push @case, [$in, $out];
        }
        if(@sample){
            print STDERR "warning: フォーマット異常\n";
        }
    }
    my $num = @case;
    if($num == 0){
        print STDERR "サンプルケースがありません。(非公開の問題かもしれません)\n";
        exit(1);
    }

    make_path($diri, $diro);
    print " directory: $diri\n" if($opt{v});
    print " directory: $diro\n" if($opt{v});

    for(my $i = 0; $i < $num; $i++){
        my $fn = sprintf $SAMPLETXT_FMT, $i+1;
        my $fni = $diri . '/' . $fn;
        my $fno = $diro . '/' . $fn;
        my ($in,$out) = @{$case[$i]};
        print " file: $fn\n" if($opt{v});
        fileout($fni, $in);
        fileout($fno, $out);
    }
    print "download OK.\n" if($opt{v});
}

if($opt{t}){
    my $zipname = 'testcase.zip';
    my $URL2 = $URL . "/$zipname";
    print "downloading testcases from $URL2\n" if($opt{v});
    my $data = get($URL2);
    if(substr($data,0,2) ne 'PK'){
        print STDERR "テストケースをダウンロードできませんでした。\n";
        exit(1);
    }
    fileout_raw("$dirp/$zipname", $data);
    if(system("unzip -oq -d $dirp $dirp/$zipname")){
        print STDERR "テストケースの展開に失敗しました。\n";
        exit(1);
    } else {
        print "download OK.\n" if($opt{v});
        unlink "$dirp/$zipname";
    }
}

my @caselist;
if(opendir my $dh, $diri){
    while(my $n = readdir $dh){
        next if($n =~ /^\.\.?$/);
        next if(! -f "$diri/$n");
        push @caselist, $n;
    }
    closedir $dh;
}
@caselist = sort {
    my($t1,$n1) = ($a =~ /^(\D*)(\d*)/);
    my($t2,$n2) = ($b =~ /^(\D*)(\d*)/);
    return $t1 ne $t2 ? $t1 cmp $t2 : $n1 <=> $n2;
} @caselist;
my $num = @caselist;
my $maxlen = 0;
foreach (@caselist){
    if($maxlen < length($_)){ $maxlen = length($_); }
}

if($PNAME =~ /\.exe$/){
    system("make $PNAME") and die;
}

for(my $i = 0; $i < $num; $i++){
    my $fn = $caselist[$i];
    my $fni = $diri . '/' . $fn;
    my $fno = $diro . '/' . $fn;

    my $cmd = "$PNAME < $fni > $STDOUT 2> $STDERR";
    my $st = gettick();
    my $ret = system($cmd);
    my $et = gettick();
    my $err = fileread2($STDERR);
    my $result = 1;
    if($ret == 0){
        if(! -f $fno){
            fileout_raw($fno, fileread($STDOUT));
            $result = 3;
        } elsif($opt{e}){
            my $r1 = fileread($fno);    normalize(\$r1);
            my $r2 = fileread($STDOUT); normalize(\$r2);
            my @r1 = split /\n/, $r1;
            my @r2 = split /\n/, $r2;
            if(@r1 == @r2){
                my $eps = $opt{e};
                my $n = @r1;
                my $f = 1;
                for(my $i = 0; $i < $n; $i++){
                    if(!epschk($r1[$i], $r2[$i], $eps)){ $f = 0; last; }
                }
                $result = 0 if $f;
            }
        } elsif($opt{s}){
            my $cmpcmd = "cmp -s $fno $STDOUT";
            my $cmpret = system($cmpcmd);
            $result = 0 if(!$cmpret);
        } else {
            my $r1 = fileread($fno);    normalize(\$r1);
            my $r2 = fileread($STDOUT); normalize(\$r2);
            $result = 0 if($r1 eq $r2);
        }
    } else {
        $result = 2;
    }
    $result = ('OK', 'NG', 'Runtime Error', 'New')[$result];
    if($result ne 'OK'){ $result = "$ESCCR$result$ESCCN"; }

    printf "%-*s %s %s\n", $maxlen, $fn, $result, $result eq 'OK' ? int($et-$st)."ms" : "";
    if($opt{v} || $result ne 'OK' && $result ne 'New' && !$opt{q}){
        my $idat = fileread2($fni);
        print "[Input]\n";
        print "$ESCCG$idat$ESCCN";
        my $edat = fileread2($fno);
        print "[Expected Output]\n";
        print "$ESCCG$edat$ESCCN";
        my $odat = fileread2($STDOUT);
        print "[Your Answer]\n";
        print "$ESCCG$odat$ESCCN";
        if($err){
            print "[STDERR]\n";
            print "$ESCCG$err$ESCCN";
        }
        print "\n";
    }
}
unlink $STDOUT, $STDERR;
exit;

sub fileread {
    my $fn = shift;
    open my $fh, '<', $fn or die;
    my $tmp = $/; $/ = ''; my $data = <$fh>; $/ = $tmp;
    close $fh;
    return defined $data ? $data : "";
}
sub fileread2 {
    my $fn = shift;
    open my $fh, '<', $fn or die;
    my $data;
    for(1..10){ if(my $l = <$fh>){chomp($l);if(length($l)>100){$l=substr($l,0,100)." ...";};$data.=$l."\n";}else{last;}}
    close $fh;
    return defined $data ? $data : "";
}

sub fileout_raw{
    my($fn, $dat) = @_;
    open my $fh, '>', $fn or die;
    binmode $fh;
    print $fh $dat;
    close $fh;
}
sub fileout{
    my($fn, $dat) = @_;
    normalize(\$dat);
    fileout_raw($fn, $dat);
}

sub normalize{
    my $ref = shift;
    my $data = "";
    $$ref =~ s/[\r\n]/\n/g;
    $$ref =~ s/^\n//g;
    foreach (split /\n/, $$ref){
        s/^\s+|\s+$//;
        $data .= "$_\n";
    }
    $$ref = $data;
}

sub epschk{
    my($p1,$p2,$eps) = @_;
    if($p1 =~ /[^\d\-\.]/){
        return ($p1 eq $p2)
    }
    my $aerr = abs($p1-$p2);
    my $rerr = $p1 != 0 ? abs(($p1-$p2)/$p1) : 0;
    return ($aerr < $eps || ($p1 && $rerr < $eps));
}