#!perl -w
package T;
use Carp qw(cluck);
no strict 'vars';
sub new {
    my($class, $data, $input) = @_;
    $class ||= 'T';
    bless {
           'data' => $data, 
           'input' => $input,
           't' => 0
        }, $class;
}    
sub skip {
    my $self = shift;
    $self->{t}++;
    $self->{buffer} .= "ok $self->{t} # skip\n";
}
sub ok {
    $_[0]->{t}++;
    $_[0]->{buffer} .= "ok\n";
}
*not = *not_ok;
sub not_ok {
    my($self, $warn) = @_;
    if($warn) {
        warn "[failure] $warn";
    }
     
    $self->{t}++;
    $self->{buffer} .= "not ok\n";
}
sub add {
    $_[0]->{buffer} .= "$_[1]\n";
}
sub test {
    my($self) = @_;
    my($k, $v);
    while(($k, $v) = each %{$self->{data}}) {
        $test = "$k=$v";
        if($self->{input} =~ /\[\[$test\]\]/) {
            $self->ok();
        } else {
            $self->not_ok();
            print "$test data not found\n";
        }
    }
}
sub done {
    my $self = shift;
    return if $self->{done}++;
    print "1..$self->{t}\n";
    print $self->{buffer};
}
sub do {
    my($class, $data, $input) = @_;
    my $self = new($class, $data, $input);
    $self->test();
    $self->done();
    1;
}
*eok = *eval_ok;
sub eval_ok {
    my($self, $test, $error) = @_;
    my $result = (ref($test) =~ /CODE/) ? eval { &$test } : eval { $test };
    if($result) {
        $self->ok();
    } else {
        my $tail = $@ ? ", $@" : '';
        $self->not($error.$tail);
    }
    $result;
}
1;