1package App::Prove::State::Result;
2
3use strict;
4use Carp 'croak';
5
6use App::Prove::State::Result::Test;
7use vars qw($VERSION);
8
9use constant STATE_VERSION => 1;
10
11=head1 NAME
12
13App::Prove::State::Result - Individual test suite results.
14
15=head1 VERSION
16
17Version 3.23
18
19=cut
20
21$VERSION = '3.23';
22
23=head1 DESCRIPTION
24
25The C<prove> command supports a C<--state> option that instructs it to
26store persistent state across runs. This module encapsulates the results for a
27single 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
47Returns a new C<App::Prove::State::Result> instance.
48
49=cut
50
51sub 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
62sub _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
78Returns the current version of state storage.
79
80=cut
81
82sub state_version {STATE_VERSION}
83
84=head2 C<test_class>
85
86Returns the name of the class used for tracking individual tests.  This class
87should either subclass from C<App::Prove::State::Result::Test> or provide an
88identical interface.
89
90=cut
91
92sub test_class {
93    return 'App::Prove::State::Result::Test';
94}
95
96my %methods = (
97    generation    => { method => 'generation',    default => 0 },
98    last_run_time => { method => 'last_run_time', default => undef },
99);
100
101while ( 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
116Getter/setter for the "generation" of the test suite run. The first
117generation is 1 (one) and subsequent generations are 2, 3, etc.
118
119=head3 C<last_run_time>
120
121Getter/setter for the time of the test suite run.
122
123=head3 C<tests>
124
125Returns the tests for a given generation. This is a hashref or a hash,
126depending on context called. The keys to the hash are the individual
127test names and the value is a hashref with various interesting values.
128Each 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
144sub 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
159Returns an individual C<App::Prove::State::Result::Test> instance for the
160given test name (usually the filename).  Will return a new
161C<App::Prove::State::Result::Test> instance if the name is not found.
162
163=cut
164
165sub 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
182Returns an list of test names, sorted by run order.
183
184=cut
185
186sub 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
196Removes a given test from results.  This is a no-op if the test name is not
197found.
198
199=cut
200
201sub remove {
202    my ( $self, $name ) = @_;
203    delete $self->{tests}->{$name};
204    return $self;
205}
206
207=head3 C<num_tests>
208
209Returns the number of tests for a given test suite result.
210
211=cut
212
213sub num_tests { keys %{ shift->{tests} } }
214
215=head3 C<raw>
216
217Returns a hashref of raw results, suitable for serialization by YAML.
218
219=cut
220
221sub raw {
222    my $self = shift;
223    my %raw  = %$self;
224
225    my %tests;
226    for my $test ( $self->tests ) {
227        $tests{ $test->name } = $test->raw;
228    }
229    $raw{tests} = \%tests;
230    return \%raw;
231}
232
2331;
234