#!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, $message) = @_; $message ||= ''; $self->{t}++; $self->{buffer} .= "ok $self->{t} # skip\n"; print STDERR "skipping test: $message; "; $self->done; exit; } sub ok { my $self = shift; $self->{t}++; $self->{buffer} .= "ok $self->{t}\n"; } *not = *not_ok; sub not_ok { my($self, $warn) = @_; if($warn) { die "[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;