| 27 |
my ($self) = @_; |
my ($self) = @_; |
| 28 |
|
|
| 29 |
my $f = TAP::Formatter::HTML->new({ |
my $f = TAP::Formatter::HTML->new({ |
| 30 |
silent => 1, |
# silent => 1, |
| 31 |
|
|
| 32 |
inline_css => 1, |
inline_css => 1, |
| 33 |
inline_js => 1, |
inline_js => 0, |
| 34 |
}); |
}); |
| 35 |
my $h = TAP::Harness->new({ |
my $h = TAP::Harness->new({ |
| 36 |
merge => 1, |
merge => 1, |
| 37 |
formatter => $f, |
formatter => $f, |
| 38 |
}); |
}); |
| 39 |
|
|
| 40 |
my @tests = |
my $tests; |
| 41 |
grep { ! m{$0} } # FIXME privitive way to break recursion |
|
| 42 |
grep { m{\.t$} } # take just tests |
map { |
| 43 |
map { |
$tests->{$_}++ if m{\.t$}; |
| 44 |
if ( m{(.+)\.pm$} ) { |
} @{ $self->tests }; |
| 45 |
my $class = $1; |
|
| 46 |
$class =~ s{^lib/}{}; |
map { |
| 47 |
$class =~ s{/}{::}g; |
if ( m{(.+)\.pm$} ) { |
| 48 |
warn "extract $_ tests $class"; |
my $class = $1; |
| 49 |
Frey::PPI->new( class => $class )->has_tests; |
$class =~ s{^lib/}{}; |
| 50 |
} else { |
$class =~ s{/}{::}g; |
| 51 |
$_ |
warn "extract tests from $_ class $class"; |
| 52 |
} |
$tests->{$_}->{$class}++ foreach Frey::PPI->new( class => $class )->has_tests; |
| 53 |
} |
} |
| 54 |
@{ $self->tests }; |
} @{ $self->tests }; |
| 55 |
|
|
| 56 |
die "no tests for files ", dump( $self->tests ) unless @tests; |
my @tests = grep { |
| 57 |
|
! m{$0} # break recursion |
| 58 |
|
} sort keys %$tests; |
| 59 |
|
die "no tests for files ", dump( $self->tests ),dump( $tests ) unless @tests; |
| 60 |
|
|
| 61 |
warn "testing ",dump( @tests ); |
warn "testing ",dump( @tests ); |
| 62 |
$h->runtests( @tests ); |
$h->runtests( @tests ); |
| 63 |
|
|
| 64 |
$self->store( 'var/test.yaml', $h ); |
$self->store( 'var/test/' . time() . '.yaml', $h ); |
| 65 |
|
|
| 66 |
|
push @{ $self->status }, { test => $tests }; |
| 67 |
|
|
| 68 |
my $html = ${ $f->html }; |
my $html = ${ $f->html }; |
| 69 |
# warn $html; |
# warn $html; |
| 70 |
warn "got ",length($html), " bytes"; |
warn "got ",length($html), " bytes"; |
| 71 |
# $html =~ s{^.*<body>}{}s; |
|
| 72 |
# $html =~ s{</body>.*$}{}s; |
while ( $html =~ s{(<style.+?/style>)}{}gs ) { |
| 73 |
return $self->editor_links( $html ); |
$self->add_head( $1 ); |
| 74 |
|
} |
| 75 |
|
|
| 76 |
|
$self->add_head(qq| |
| 77 |
|
<style type="text/css"> |
| 78 |
|
/* CSS to show-hide full text results */ |
| 79 |
|
ul.test-out { display: none; } |
| 80 |
|
td.results:hover ul.test-out { display: block; } |
| 81 |
|
</style> |
| 82 |
|
|); |
| 83 |
|
|
| 84 |
|
$html =~ s{^.*<body>}{}s; |
| 85 |
|
$html =~ s{</body>.*$}{}s; |
| 86 |
|
|
| 87 |
|
$html =~ s{(<a class="file") href="#"(.+?)>t/(.+?)</a>}{<a target="editor" href="/editor+t/$3.t+1" name="t/$3.t" $2>$3</a>}sg; |
| 88 |
|
|
| 89 |
|
return |
| 90 |
|
$self->editor_links( $html ) |
| 91 |
|
. qq|<ul><li>| |
| 92 |
|
. join("</li>\n<li>", |
| 93 |
|
map { |
| 94 |
|
qq|<a href="#$_"><tt>$_</tt></a> ← | |
| 95 |
|
. |
| 96 |
|
join(' ', |
| 97 |
|
map { |
| 98 |
|
# qq|<a target="editor" href="/editor+$_+1" title="edit">$_</a>| |
| 99 |
|
qq|<a target="introspect" href="/$_" title="introspect">$_</a>| |
| 100 |
|
} keys %{ $tests->{$_} } |
| 101 |
|
) |
| 102 |
|
} @tests ) |
| 103 |
|
. qq|</li></ul>| |
| 104 |
|
; |
| 105 |
|
|
| 106 |
} |
} |
| 107 |
|
|
| 108 |
1; |
1; |
Parent Directory
| 
Revision Log
| 
Patch