--- trunk/lib/Frey/Test/Runner.pm 2008/11/24 14:28:43 484 +++ trunk/lib/Frey/Test/Runner.pm 2008/11/24 21:25:28 497 @@ -3,43 +3,105 @@ extends 'Frey'; with 'Frey::Web'; +with 'Frey::Storage'; use TAP::Harness; use TAP::Formatter::HTML; use Data::Dump qw/dump/; +use Frey::SVK; +use Frey::PPI; + has tests => ( is => 'rw', isa => 'ArrayRef[Str]', required => 1, lazy => 1, # FIXME ask users which tests to run - default => sub { [ glob('t/*.t') ] }, + default => sub { +# [ glob('t/*.t') ] # all tests + [ Frey::SVK->modified ] + }, ); sub as_markup { my ($self) = @_; my $f = TAP::Formatter::HTML->new({ - silent => 1, +# silent => 1, inline_css => 1, - inline_js => 1, + inline_js => 0, }); my $h = TAP::Harness->new({ merge => 1, formatter => $f, }); - my @tests = grep { ! m{$0} } @{ $self->tests }; # FIXME privitive way to break recursion + my $tests; + + map { + $tests->{$_}++ if m{\.t$}; + } @{ $self->tests }; + + map { + if ( m{(.+)\.pm$} ) { + my $class = $1; + $class =~ s{^lib/}{}; + $class =~ s{/}{::}g; + warn "extract tests from $_ class $class"; + $tests->{$_}->{$class}++ foreach Frey::PPI->new( class => $class )->has_tests; + } + } @{ $self->tests }; + + my @tests = grep { + ! m{$0} # break recursion + } sort keys %$tests; + die "no tests for files ", dump( $self->tests ),dump( $tests ) unless @tests; + warn "testing ",dump( @tests ); $h->runtests( @tests ); + $self->store( 'var/test/' . time() . '.yaml', $h ); + + push @{ $self->status }, { test => $tests }; + my $html = ${ $f->html }; # warn $html; warn "got ",length($html), " bytes"; -# $html =~ s{^.*}{}s; -# $html =~ s{.*$}{}s; - return $self->editor_links( $html ); + + while ( $html =~ s{()}{}gs ) { + $self->add_head( $1 ); + } + + $self->add_head(qq| + + |); + + $html =~ s{^.*}{}s; + $html =~ s{.*$}{}s; + + $html =~ s{(t/(.+?)}{$3}sg; + + return + $self->editor_links( $html ) + . qq|| + ; + } 1;