local-lib5/lib/perl5/App/Prove/State/Result.pm

   1 package App::Prove::State::Result;
   2
   3 use strict;
   4 use Carp 'croak';
   5
   6 use App::Prove::State::Result::Test;
   7 use vars qw($VERSION);
   8
   9 use constant STATE_VERSION => 1;
  10
  11 =head1 NAME
  12
  13 App::Prove::State::Result - Individual test suite results.
  14
  15 =head1 VERSION
  16
  17 Version 3.17
  18
  19 =cut
  20
  21 $VERSION = '3.17';
  22
  23 =head1 DESCRIPTION
  24
  25 The C<prove> command supports a C<--state> option that instructs it to
  26 store persistent state across runs. This module encapsulates the results for a
  27 single test suite run.
  28
  29 =head1 SYNOPSIS
  30
  31     # Re-run failed tests
  32     $ prove --state=fail,save -rbv
  33
  34 =cut
  35
  36 =head1 METHODS
  37
  38 =head2 Class Methods
  39
  40 =head3 C<new>
  41
  42     my $result = App::Prove::State::Result->new({
  43         generation => $generation,
  44         tests      => \%tests,
  45     });
  46
  47 Returns a new C<App::Prove::State::Result> instance.
  48
  49 =cut
  50
  51 sub new {
  52     my ( $class, $arg_for ) = @_;
  53     $arg_for ||= {};
  54     my %instance_data = %$arg_for;    # shallow copy
  55     $instance_data{version} = $class->state_version;
  56     my $tests = delete $instance_data{tests} || {};
  57     my $self = bless \%instance_data => $class;
  58     $self->_initialize($tests);
  59     return $self;
  60 }
  61
  62 sub _initialize {
  63     my ( $self, $tests ) = @_;
  64     my %tests;
  65     while ( my ( $name, $test ) = each %$tests ) {
  66         $tests{$name} = $self->test_class->new(
  67             {   %$test,
  68                 name => $name
  69             }
  70         );
  71     }
  72     $self->tests( \%tests );
  73     return $self;
  74 }
  75
  76 =head2 C<state_version>
  77
  78 Returns the current version of state storage.
  79
  80 =cut
  81
  82 sub state_version {STATE_VERSION}
  83
  84 =head2 C<test_class>
  85
  86 Returns the name of the class used for tracking individual tests.  This class
  87 should either subclass from C<App::Prove::State::Result::Test> or provide an
  88 identical interface.
  89
  90 =cut
  91
  92 sub test_class {
  93     return 'App::Prove::State::Result::Test';
  94 }
  95
  96 my %methods = (
  97     generation    => { method => 'generation',    default => 0 },
  98     last_run_time => { method => 'last_run_time', default => undef },
  99 );
 100
 101 while ( my ( $key, $description ) = each %methods ) {
 102     my $default = $description->{default};
 103     no strict 'refs';
 104     *{ $description->{method} } = sub {
 105         my $self = shift;
 106         if (@_) {
 107             $self->{$key} = shift;
 108             return $self;
 109         }
 110         return $self->{$key} || $default;
 111     };
 112 }
 113
 114 =head3 C<generation>
 115
 116 Getter/setter for the "generation" of the test suite run. The first
 117 generation is 1 (one) and subsequent generations are 2, 3, etc.
 118
 119 =head3 C<last_run_time>
 120
 121 Getter/setter for the time of the test suite run.
 122
 123 =head3 C<tests>
 124
 125 Returns the tests for a given generation. This is a hashref or a hash,
 126 depending on context called. The keys to the hash are the individual
 127 test names and the value is a hashref with various interesting values.
 128 Each k/v pair might resemble something like this:
 129
 130  't/foo.t' => {
 131     elapsed        => '0.0428488254547119',
 132     gen            => '7',
 133     last_pass_time => '1219328376.07815',
 134     last_result    => '0',
 135     last_run_time  => '1219328376.07815',
 136     last_todo      => '0',
 137     mtime          => '1191708862',
 138     seq            => '192',
 139     total_passes   => '6',
 140   }
 141
 142 =cut
 143
 144 sub tests {
 145     my $self = shift;
 146     if (@_) {
 147         $self->{tests} = shift;
 148         return $self;
 149     }
 150     my %tests = %{ $self->{tests} };
 151     my @tests = sort { $a->sequence <=> $b->sequence } values %tests;
 152     return wantarray ? @tests : \@tests;
 153 }
 154
 155 =head3 C<test>
 156
 157  my $test = $result->test('t/customer/create.t');
 158
 159 Returns an individual C<App::Prove::State::Result::Test> instance for the
 160 given test name (usually the filename).  Will return a new
 161 C<App::Prove::State::Result::Test> instance if the name is not found.
 162
 163 =cut
 164
 165 sub test {
 166     my ( $self, $name ) = @_;
 167     croak("test() requires a test name") unless defined $name;
 168
 169     my $tests = $self->{tests} ||= {};
 170     if ( my $test = $tests->{$name} ) {
 171         return $test;
 172     }
 173     else {
 174         my $test = $self->test_class->new( { name => $name } );
 175         $self->{tests}->{$name} = $test;
 176         return $test;
 177     }
 178 }
 179
 180 =head3 C<test_names>
 181
 182 Returns an list of test names, sorted by run order.
 183
 184 =cut
 185
 186 sub test_names {
 187     my $self = shift;
 188     return map { $_->name } $self->tests;
 189 }
 190
 191 =head3 C<remove>
 192
 193  $result->remove($test_name);            # remove the test
 194  my $test = $result->test($test_name);   # fatal error
 195
 196 Removes a given test from results.  This is a no-op if the test name is not
 197 found.
 198
 199 =cut
 200
 201 sub remove {
 202     my ( $self, $name ) = @_;
 203     delete $self->{tests}->{$name};
 204     return $self;
 205 }
 206
 207 =head3 C<num_tests>
 208
 209 Returns the number of tests for a given test suite result.
 210
 211 =cut
 212
 213 sub num_tests { keys %{ shift->{tests} } }
 214
 215 =head3 C<raw>
 216
 217 Returns a hashref of raw results, suitable for serialization by YAML.
 218
 219 =cut
 220
 221 sub raw {
 222     my $self = shift;
 223     my %raw  = %$self;
 224
 225     my %tests;
 226     foreach my $test ( $self->tests ) {
 227         $tests{ $test->name } = $test->raw;
 228     }
 229     $raw{tests} = \%tests;
 230     return \%raw;
 231 }
 232
 233 1;