#!/usr/bin/perl

=head1 NAME

cgi_prove - Web based interface to /usr/bin/prove

=cut

use base qw(CGI::Ex::App);
use strict;
use warnings;
use vars qw($BASE_DIR $LIB_DIR $PROVE_PROG);
use CGI::Ex::Dump qw(debug);

BEGIN {
    require config;
    $BASE_DIR = $config::config{'rootdir_server'} .'/t';
    $LIB_DIR  = $config::config{'rootdir_server'} .'/lib';
    $PROVE_PROG = '/usr/bin/prove';
}

###----------------------------------------------------------------###

__PACKAGE__->navigate;

sub main_file_print {
    return \ qq {
        <h1>Run t/tests <span style=font-size:smaller>(<a href=[% script_name %]?test=all>Run All</a>)</span></h1>
        [% rows = [];
           FOREACH dir IN files.keys.sort ;
             rows.push("<b><a href=\$script_name?test=\${dir.uri}>\${dir.html}</a></b><br>");
             FOREACH file IN files.\$dir ;
               rows.push("&nbsp;&nbsp;&nbsp;&nbsp;<a href=\$script_name?test=\${dir.uri}/\${file.uri}>\${file.html}</a><br>");
             END;
           END;
           cols = 4;
           n_per_col = rows.size / cols;
           IF n_per_col - n_per_col.int;  n_per_col = n_per_col.int + 1; END;
           FOREACH j = [0 .. cols - 1] %]
             <div style="float:left; width:24%">
             [% min = j * n_per_col;
                max = min + n_per_col - 1;
                IF max > rows.max; max = rows.max; END;
                FOREACH i IN [min .. max]
                rows.\$i;
                END %]
             </div>
        [% END %]
    };
}

sub main_hash_swap {
    my $self = shift;
    my $dir  = $BASE_DIR;
    require File::Find;
    my $files = {};
    File::Find::find(sub {
        return if -d;
        return if $File::Find::name !~ m|^\Q$dir\E/(.+)/(.+\.t)$|;
        $files->{$1}->{$2} = 1;
    }, $dir);
    $files->{$_} = [sort keys %{$files->{$_}}] foreach keys %$files;

    return {files => $files};
}

sub main_info_complete {
    my $self = shift;
    my $file = $self->form->{'test'} || return 0;
    return 0 if $file =~ /\.\./;
    return 0 if $file !~ /^([\w\.\/\-]+)$/;
    $file = $1;
    $file =~ s|^/+||;

    my $dir  = $BASE_DIR;
    return 0 if ! -e "$dir/$file" && lc $file ne 'all';

    $self->stash->{'test'} = $self->form->{'test'} = $file;
    $self->append_path('_run');
    return 1;
}

sub _run_file_print {
    return \ qq {
        <h1>Test - [% test %]</h1><br>
    };
}

sub _run_info_complete { 0 }

sub _run_post_print {
    my $self = shift;
    my $file = $self->stash->{'test'} || die "Missing test";
    my $exe  = $PROVE_PROG;
    $file = '' if lc($file) eq 'all';
    open(my $fh, "$exe -v -I$LIB_DIR -r $BASE_DIR/$file 2>&1 |") || do { debug "Couldn't exec", $exe, $!; die "Couldn't exec: $!" };

    my $r;
    if ($self->cgix->is_mod_perl_2) {
        $r = $self->cgix->apache_request;
    } else {
        $| = 1;
    }

    print "<span style=\"font-family:monospace;color:green\">\n";
    while (defined(my $line = <$fh>)) {
        $line =~ s/\s+$//;
        if ($line =~ /^\s*not/) {
            $line = "<span style=color:red>$line</span>";
        } elsif ($line !~ /^\s*ok/) {
            $line = "<span style=color:blue>$line</span>";
        }
        print $line."<br>\n";
        $r->rflush if $r;
    }
    print "</span>\n";
}