File Coverage

blib/lib/PITA/XML/Install.pm
Criterion Covered Total %
statement 56 56 100.0
branch 15 18 83.3
condition 6 7 85.7
subroutine 15 15 100.0
pod 8 8 100.0
total 100 104 96.1


line stmt bran cond sub pod time code
1             package PITA::XML::Install;
2              
3             =pod
4              
5             =head1 NAME
6              
7             PITA::XML::Install - A PITA report on a single distribution install
8              
9             =head1 DESCRIPTION
10              
11             C is a data object that contains the complete
12             set of information on a single test/install run for a distribution on a
13             single host of an arbitrary platform.
14              
15             =cut
16              
17 10     10   179 use 5.006;
  10         34  
  10         408  
18 10     10   55 use strict;
  10         19  
  10         299  
19 10     10   52 use Carp ();
  10         18  
  10         198  
20 10     10   48 use Params::Util qw{ _INSTANCE _SET0 };
  10         19  
  10         692  
21              
22 10     10   62 use vars qw{$VERSION};
  10         493  
  10         470  
23             BEGIN {
24 10     10   5667 $VERSION = '0.52';
25             }
26              
27              
28              
29              
30              
31             #####################################################################
32             # Constructor and Accessors
33              
34             =pod
35              
36             =head2 new
37              
38             # Create a new Install object
39             my $install = PITA::XML::Install->new(
40             request => $request
41             platform => $platform,
42             analysis => $analysis,
43             );
44              
45             The C constructor is used to create a new installation report, a
46             collection of which are serialized to the L XML file.
47              
48             Returns a new C object, or dies on error.
49              
50             =cut
51              
52             sub new {
53 17     17 1 10558 my $class = shift;
54 17         82 my $self = bless { @_ }, $class;
55              
56             # Check the object
57 17         40 $self->_init;
58              
59 3         9 $self;
60             }
61              
62             sub _init {
63 18     18   25 my $self = shift;
64              
65             # We must have a platform spec
66 18 100       38 unless ( _INSTANCE($self->platform, 'PITA::XML::Platform') ) {
67 2         236 Carp::croak('Invalid or missing platform');
68             }
69              
70             # We must have a testing request
71 16 100       198 unless ( _INSTANCE($self->request, 'PITA::XML::Request') ) {
72 2         205 Carp::croak('Invalid or missing request');
73             }
74              
75             # The platform scheme should match the platform scheme
76             # (ignoring any part after the dot in the request)
77 14         141 my $scheme_regexp = '^' . quotemeta($self->platform->scheme) . '\\b';
78 14 100       33 unless ( $self->request->scheme =~ /$scheme_regexp/ ) {
79 1         163 Carp::croak('Platform scheme does not match request scheme');
80             }
81              
82             # Zero or more commands
83 13   100     59 $self->{commands} ||= [];
84 13 100       384 unless ( _SET0( $self->{commands}, 'PITA::XML::Command') ) {
85 4         479 Carp::croak('Invalid commands');
86             }
87              
88             # Zero or more tests
89 9   100     197 $self->{tests} ||= [];
90 9 100       219 unless ( _SET0( $self->{tests}, 'PITA::XML::Test') ) {
91 4         406 Carp::croak('Invalid tests');
92             }
93              
94             # Analysis is optional
95 5 100 66     93 if ( defined $self->analysis or exists $self->{analysis} ) {
96 1 50       5 unless ( _INSTANCE($self->analysis, 'PITA::XML::Analysis') ) {
97 1         137 Carp::croak('Invalid analysis object');
98             }
99             } else {
100 4         10 $self->{analysis} = undef;
101             }
102              
103 4         8 $self;
104             }
105              
106              
107              
108              
109              
110             #####################################################################
111             # Main Methods
112              
113             =pod
114              
115             =head2 request
116              
117             The C accessor returns testing request information.
118              
119             Returns a L object.
120              
121             =cut
122              
123             sub request {
124 33     33 1 1032 $_[0]->{request};
125             }
126              
127             =pod
128              
129             =head2 platform
130              
131             The C accessor returns the platform specification for the install.
132              
133             Returns a L object.
134              
135             =cut
136              
137             sub platform {
138 35     35 1 198 $_[0]->{platform};
139             }
140              
141             =pod
142              
143             =head2 add_command
144              
145             $install->add_command( $command );
146              
147             The C method adds a L object to the
148             list of commands in the install object.
149              
150             Returns true, or dies is you do not pass a L object.
151              
152             =cut
153              
154             sub add_command {
155 1     1 1 532 my $self = shift;
156 1 50       7 my $command = _INSTANCE(shift, 'PITA::XML::Command')
157             or Carp::croak("Did not provide a PITA::XML::Command to add_command");
158 1         13 push @{ $self->{commands} }, $command;
  1         3  
159 1         6 1;
160             }
161              
162             =pod
163              
164             =head2 commands
165              
166             The C accessor returns the commands executed during the testing.
167              
168             Returns a list of zero or more L objects.
169              
170             =cut
171              
172             sub commands {
173 3     3 1 6 @{ $_[0]->{commands} };
  3         79  
174             }
175              
176             =pod
177              
178             =head2 add_test
179              
180             $install->add_test( $test );
181              
182             The C method adds a L object to the
183             list of test results in the install object.
184              
185             Returns true, or dies is you do not pass a L object.
186              
187             =cut
188              
189             sub add_test {
190 1     1 1 2 my $self = shift;
191 1 50       8 my $test = _INSTANCE(shift, 'PITA::XML::Test')
192             or Carp::croak("Did not provide a PITA::XML::Test to add_test");
193 1         13 push @{ $self->{tests} }, $test;
  1         3  
194 1         5 1;
195             }
196              
197             =pod
198              
199             =head2 tests
200              
201             The C accessor returns the results of the individual tests run during the testing.
202              
203             Returns a list of zero or more L objects.
204              
205             =cut
206              
207             sub tests {
208 3     3 1 8 @{ $_[0]->{tests} };
  3         16  
209             }
210              
211             =pod
212              
213             =head2 analysis
214              
215             The C accessor returns the analysis object for the test run.
216              
217             Returns a L object, or C if no analysis
218             performed during the testing.
219              
220             =cut
221              
222             sub analysis {
223 8     8 1 49 $_[0]->{analysis};
224             }
225              
226             1;
227              
228             =pod
229              
230             =head1 SUPPORT
231              
232             Bugs should be reported via the CPAN bug tracker at
233              
234             L
235              
236             For other issues, contact the author.
237              
238             =head1 AUTHOR
239              
240             Adam Kennedy Eadamk@cpan.orgE, L
241              
242             =head1 SEE ALSO
243              
244             L
245              
246             The Perl Image-based Testing Architecture (L)
247              
248             =head1 COPYRIGHT
249              
250             Copyright 2005 - 2013 Adam Kennedy.
251              
252             This program is free software; you can redistribute
253             it and/or modify it under the same terms as Perl itself.
254              
255             The full text of the license can be found in the
256             LICENSE file included with this module.
257              
258             =cut