Frey/Test/Runner.pm

package Frey::Test::Runner;
use Moose;

extends 'Frey';
with 'Frey::Web';
with 'Frey::Storage';

use TAP::Harness;
use TAP::Formatter::HTML;
use Data::Dump qw/dump/;

use Frey::SVK;

has tests => (
        is => 'rw',
        isa => 'ArrayRef[Str]',
        required => 1,
        lazy => 1, # FIXME ask users which tests to run
        default => sub {
#               [ glob('t/*.t') ] # all tests
                [ Frey::SVK->modified ]
        },
);

sub as_markup {
        my ($self) = @_;

        my $f = TAP::Formatter::HTML->new({
                silent => 1,

                inline_css => 1,
                inline_js => 1,
        });
        my $h = TAP::Harness->new({
                merge => 1,
                formatter => $f,
        });

        my @tests =
                grep { ! m{$0} } # FIXME privitive way to break recursion
                grep { m{\.t$} } # take just tests
                @{ $self->tests };
        warn "testing ",dump( @tests );
        $h->runtests( @tests );

        $self->store( 'var/test.yaml', $h );

        my $html = ${ $f->html };
#       warn $html;
        warn "got ",length($html), " bytes";
#       $html =~ s{^.*<body>}{}s;
#       $html =~ s{</body>.*$}{}s;
        return $self->editor_links( $html );
}

1;
1	package Frey::Test::Runner;
2	use Moose;
3
4	extends 'Frey';
5	with 'Frey::Web';
6	with 'Frey::Storage';
7
8	use TAP::Harness;
9	use TAP::Formatter::HTML;
10	use Data::Dump qw/dump/;
11
12	use Frey::SVK;
13
14	has tests => (
15	is => 'rw',
16	isa => 'ArrayRef[Str]',
17	required => 1,
18	lazy => 1, # FIXME ask users which tests to run
19	default => sub {
20	# [ glob('t/*.t') ] # all tests
21	[ Frey::SVK->modified ]
22	},
23	);
24
25	sub as_markup {
26	my ($self) = @_;
27
28	my $f = TAP::Formatter::HTML->new({
29	silent => 1,
30
31	inline_css => 1,
32	inline_js => 1,
33	});
34	my $h = TAP::Harness->new({
35	merge => 1,
36	formatter => $f,
37	});
38
39	my @tests =
40	grep { ! m{$0} } # FIXME privitive way to break recursion
41	grep { m{\.t$} } # take just tests
42	@{ $self->tests };
43	warn "testing ",dump( @tests );
44	$h->runtests( @tests );
45
46	$self->store( 'var/test.yaml', $h );
47
48	my $html = ${ $f->html };
49	# warn $html;
50	warn "got ",length($html), " bytes";
51	# $html =~ s{^.*<body>}{}s;
52	# $html =~ s{</body>.*$}{}s;
53	return $self->editor_links( $html );
54	}
55
56	1;