1 package App::Prove::State;
4 use vars qw($VERSION @ISA);
10 use App::Prove::State::Result;
11 use TAP::Parser::YAMLish::Reader ();
12 use TAP::Parser::YAMLish::Writer ();
16 @ISA = qw( TAP::Base );
17 __PACKAGE__->mk_methods('result_class');
20 use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
21 use constant NEED_GLOB => IS_WIN32;
25 App::Prove::State - State storage for the C<prove> command.
37 The C<prove> command supports a C<--state> option that instructs it to
38 store persistent state across runs. This module implements that state
39 and the operations that may be performed on it.
44 $ prove --state=fail,save -rbv
54 Accepts a hashref with the following key/value pairs:
60 The filename of the data store holding the data that App::Prove::State reads.
62 =item * C<extension> (optional)
64 The test name extension. Defaults to C<.t>.
66 =item * C<result_class> (optional)
68 The name of the C<result_class>. Defaults to C<App::Prove::State::Result>.
74 # override TAP::Base::new:
77 my %args = %{ shift || {} };
82 store => delete $args{store},
83 extension => ( delete $args{extension} || '.t' ),
85 ( delete $args{result_class} || 'App::Prove::State::Result' ),
88 $self->{_} = $self->result_class->new(
93 my $store = $self->{store};
95 if defined $store && -f $store;
100 =head2 C<result_class>
102 Getter/setter for the name of the class used for tracking test results. This
103 class should either subclass from C<App::Prove::State::Result> or provide an
110 Get or set the extension files must have in order to be considered
111 tests. Defaults to '.t'.
117 $self->{extension} = shift if @_;
118 return $self->{extension};
123 Get the results of the last test run. Returns a C<result_class()> instance.
129 $self->{_} || $self->result_class->new;
134 Save the test results. Should be called after all tests have run.
140 if ( $self->{should_save} ) {
145 =head2 Instance Methods
147 =head3 C<apply_switch>
149 $self->apply_switch('failed,save');
151 Apply a list of switch options to the state, updating the internal
152 object state as a result. Nothing is returned.
155 - "Illegal state option: %s"
161 Run in the same order as last time
165 Run only the failed tests from last time
169 Run only the passed tests from last time
173 Run all tests in normal order
177 Run the tests that most recently failed first
181 Run the tests ordered by number of todos.
185 Run the tests in slowest to fastest order.
189 Run test tests in fastest to slowest order.
193 Run the tests in newest to oldest order.
197 Run the tests in oldest to newest order.
201 Save the state on exit.
211 my $last_gen = $self->results->generation - 1;
212 my $last_run_time = $self->results->last_run_time;
213 my $now = $self->get_time;
215 my @switches = map { split /,/ } @opts;
220 where => sub { $_->generation >= $last_gen },
221 order => sub { $_->sequence }
226 where => sub { $_->result != 0 },
227 order => sub { -$_->result }
231 $self->_select( where => sub { $_->result == 0 } );
238 where => sub { $_->num_todo != 0 },
239 order => sub { -$_->num_todo; }
244 where => sub { defined $_->last_fail_time },
245 order => sub { $now - $_->last_fail_time }
249 $self->_select( order => sub { -$_->elapsed } );
252 $self->_select( order => sub { $_->elapsed } );
255 $self->_select( order => sub { -$_->mtime } );
258 $self->_select( order => sub { $_->mtime } );
261 $self->_select( where => sub { $_->mtime >= $last_run_time } );
264 $self->{should_save}++;
267 unshift @switches, qw( hot all save );
271 while ( defined( my $ele = shift @switches ) ) {
273 = ( $ele =~ /^([^:]+):(.*)/ )
276 my $code = $handler{$opt}
277 || croak "Illegal state option: $opt";
284 my ( $self, %spec ) = @_;
285 push @{ $self->{select} }, \%spec;
290 Given a list of args get the names of tests that should run
300 my @selected = $self->_query;
302 unless ( @argv || @{ $self->{select} } ) {
303 @argv = $recurse ? '.' : 't';
304 croak qq{No tests named and '@argv' directory not found}
308 push @selected, $self->_get_raw_tests( $recurse, @argv ) if @argv;
309 return grep { !$seen{$_}++ } @selected;
314 if ( my @sel = @{ $self->{select} } ) {
315 warn "No saved state, selection will be empty\n"
316 unless $self->results->num_tests;
317 return map { $self->_query_clause($_) } @sel;
323 my ( $self, $clause ) = @_;
325 my $results = $self->results;
326 my $where = $clause->{where} || sub {1};
329 for my $name ( $results->test_names ) {
330 next unless -f $name;
331 local $_ = $results->test($name);
332 push @got, $name if $where->();
336 if ( my $order = $clause->{order} ) {
337 @got = map { $_->[0] }
339 ( defined $b->[1] <=> defined $a->[1] )
340 || ( ( $a->[1] || 0 ) <=> ( $b->[1] || 0 ) )
343 do { local $_ = $results->test($_); $order->() }
357 # Do globbing on Win32.
358 @argv = map { glob "$_" } @argv if NEED_GLOB;
359 my $extension = $self->{extension};
361 for my $arg (@argv) {
363 push @argv => <STDIN>;
371 ? $self->_expand_dir_recursive( $arg, $extension )
372 : glob( File::Spec->catfile( $arg, "*$extension" ) )
378 sub _expand_dir_recursive {
379 my ( $self, $dir, $extension ) = @_;
383 { follow => 1, #21938
388 && push @tests => $File::Find::name;
396 =head3 C<observe_test>
398 Store the results of a test.
415 my ( $self, $test_info, $parser ) = @_;
416 my $name = $test_info->[0];
417 my $fail = scalar( $parser->failed ) + ( $parser->has_problems ? 1 : 0 );
418 my $todo = scalar( $parser->todo );
419 my $start_time = $parser->start_time;
420 my $end_time = $parser->end_time,
422 my $test = $self->results->test($name);
424 $test->sequence( $self->{seq}++ );
425 $test->generation( $self->results->generation );
427 $test->run_time($end_time);
428 $test->result($fail);
429 $test->num_todo($todo);
430 $test->elapsed( $end_time - $start_time );
432 $test->parser($parser);
435 $test->total_failures( $test->total_failures + 1 );
436 $test->last_fail_time($end_time);
439 $test->total_passes( $test->total_passes + 1 );
440 $test->last_pass_time($end_time);
446 Write the state to a file.
453 my $store = $self->{store} or return;
454 $self->results->last_run_time( $self->get_time );
456 my $writer = TAP::Parser::YAMLish::Writer->new;
458 open FH, ">$store" or croak "Can't write $store ($!)";
459 $writer->write( $self->results->raw, \*FH );
465 Load the state from a file
470 my ( $self, $name ) = @_;
471 my $reader = TAP::Parser::YAMLish::Reader->new;
473 open FH, "<$name" or croak "Can't read $name ($!)";
475 # XXX this is temporary
476 $self->{_} = $self->result_class->new(
480 defined $line && chomp $line;
486 # $writer->write( $self->{tests} || {}, \*FH );
489 $self->_prune_and_stamp;
490 $self->results->generation( $self->results->generation + 1 );
493 sub _prune_and_stamp {
496 my $results = $self->results;
497 my @tests = $self->results->tests;
498 for my $test (@tests) {
499 my $name = $test->name;
500 if ( my @stat = stat $name ) {
501 $test->mtime( $stat[9] );
504 $results->remove($name);
511 for my $test ( $self->results->tests ) {
512 $self->{seq} = $test->sequence + 1
513 if defined $test->sequence && $test->sequence >= $self->{seq};