1 package App::Prove::State;
4 use vars qw($VERSION @ISA);
9 use TAP::Parser::YAMLish::Reader ();
10 use TAP::Parser::YAMLish::Writer ();
13 @ISA = qw( TAP::Base );
15 use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
16 use constant NEED_GLOB => IS_WIN32;
20 App::Prove::State - State storage for the C<prove> command.
32 The C<prove> command supports a C<--state> option that instructs it to
33 store persistent state across runs. This module implements that state
34 and the operations that may be performed on it.
39 $ prove --state=fail,save -rbv
51 # override TAP::Base::new:
54 my %args = %{ shift || {} };
63 store => delete $args{store},
64 extension => delete $args{extension} || '.t',
67 my $store = $self->{store};
69 if defined $store && -f $store;
76 Get or set the extension files must have in order to be considered
77 tests. Defaults to '.t'.
83 $self->{extension} = shift if @_;
84 return $self->{extension};
89 if ( $self->{should_save} && defined( my $store = $self->{store} ) ) {
94 =head2 Instance Methods
96 =head3 C<apply_switch>
98 Apply a list of switch options to the state.
104 Run in the same order as last time
108 Run only the failed tests from last time
112 Run only the passed tests from last time
116 Run all tests in normal order
120 Run the tests that most recently failed first
124 Run the tests ordered by number of todos.
128 Run the tests in slowest to fastest order.
132 Run test tests in fastest to slowest order.
136 Run the tests in newest to oldest order.
140 Run the tests in oldest to newest order.
144 Save the state on exit.
154 my $last_gen = $self->{_}->{generation} - 1;
155 my $now = $self->get_time;
157 my @switches = map { split /,/ } @opts;
162 where => sub { $_->{gen} >= $last_gen },
163 order => sub { $_->{seq} }
168 where => sub { $_->{last_result} != 0 },
169 order => sub { -$_->{last_result} }
173 $self->_select( where => sub { $_->{last_result} == 0 } );
180 where => sub { $_->{last_todo} != 0 },
181 order => sub { -$_->{last_todo}; }
186 where => sub { defined $_->{last_fail_time} },
187 order => sub { $now - $_->{last_fail_time} }
191 $self->_select( order => sub { -$_->{elapsed} } );
194 $self->_select( order => sub { $_->{elapsed} } );
197 $self->_select( order => sub { -$_->{mtime} } );
200 $self->_select( order => sub { $_->{mtime} } );
203 $self->{should_save}++;
206 unshift @switches, qw( hot all save );
210 while ( defined( my $ele = shift @switches ) ) {
212 = ( $ele =~ /^([^:]+):(.*)/ )
215 my $code = $handler{$opt}
216 || croak "Illegal state option: $opt";
222 my ( $self, %spec ) = @_;
223 push @{ $self->{select} }, \%spec;
228 Given a list of args get the names of tests that should run
238 my @selected = $self->_query;
240 unless ( @argv || @{ $self->{select} } ) {
241 @argv = $recurse ? '.' : 't';
242 croak qq{No tests named and '@argv' directory not found}
246 push @selected, $self->_get_raw_tests( $recurse, @argv ) if @argv;
247 return grep { !$seen{$_}++ } @selected;
252 if ( my @sel = @{ $self->{select} } ) {
253 warn "No saved state, selection will be empty\n"
254 unless keys %{ $self->{_}->{tests} };
255 return map { $self->_query_clause($_) } @sel;
261 my ( $self, $clause ) = @_;
263 my $tests = $self->{_}->{tests};
264 my $where = $clause->{where} || sub {1};
267 for my $test ( sort keys %$tests ) {
268 next unless -f $test;
269 local $_ = $tests->{$test};
270 push @got, $test if $where->();
274 if ( my $order = $clause->{order} ) {
275 @got = map { $_->[0] }
277 ( defined $b->[1] <=> defined $a->[1] )
278 || ( ( $a->[1] || 0 ) <=> ( $b->[1] || 0 ) )
281 do { local $_ = $tests->{$_}; $order->() }
295 # Do globbing on Win32.
296 @argv = map { glob "$_" } @argv if NEED_GLOB;
297 my $extension = $self->{extension};
299 for my $arg (@argv) {
301 push @argv => <STDIN>;
309 ? $self->_expand_dir_recursive( $arg, $extension )
310 : glob( File::Spec->catfile( $arg, "*$extension" ) )
316 sub _expand_dir_recursive {
317 my ( $self, $dir, $extension ) = @_;
321 { follow => 1, #21938
325 && push @tests => $File::Find::name;
333 =head3 C<observe_test>
335 Store the results of a test.
340 my ( $self, $test, $parser ) = @_;
342 $test, scalar( $parser->failed ) + ( $parser->has_problems ? 1 : 0 ),
343 scalar( $parser->todo ), $parser->start_time, $parser->end_time
358 my ( $self, $test, $fail, $todo, $start_time, $end_time ) = @_;
359 my $rec = $self->{_}->{tests}->{ $test->[0] } ||= {};
361 $rec->{seq} = $self->{seq}++;
362 $rec->{gen} = $self->{_}->{generation};
364 $rec->{last_run_time} = $end_time;
365 $rec->{last_result} = $fail;
366 $rec->{last_todo} = $todo;
367 $rec->{elapsed} = $end_time - $start_time;
370 $rec->{total_failures}++;
371 $rec->{last_fail_time} = $end_time;
374 $rec->{total_passes}++;
375 $rec->{last_pass_time} = $end_time;
381 Write the state to a file.
386 my ( $self, $name ) = @_;
387 my $writer = TAP::Parser::YAMLish::Writer->new;
389 open FH, ">$name" or croak "Can't write $name ($!)";
390 $writer->write( $self->{_} || {}, \*FH );
396 Load the state from a file
401 my ( $self, $name ) = @_;
402 my $reader = TAP::Parser::YAMLish::Reader->new;
404 open FH, "<$name" or croak "Can't read $name ($!)";
405 $self->{_} = $reader->read(
408 defined $line && chomp $line;
413 # $writer->write( $self->{tests} || {}, \*FH );
416 $self->_prune_and_stamp;
417 $self->{_}->{generation}++;
420 sub _prune_and_stamp {
422 for my $name ( keys %{ $self->{_}->{tests} || {} } ) {
423 if ( my @stat = stat $name ) {
424 $self->{_}->{tests}->{$name}->{mtime} = $stat[9];
427 delete $self->{_}->{tests}->{$name};
434 for my $rec ( values %{ $self->{_}->{tests} || {} } ) {
435 $self->{seq} = $rec->{seq} + 1
436 if defined $rec->{seq} && $rec->{seq} >= $self->{seq};