line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PITA::XML::SAXParser; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=pod |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
PITA::XML::SAXParser - Implements a SAX Parser for PITA::XML files |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 DESCRIPTION |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Although you won't need to use it directly, this class provides a |
12
|
|
|
|
|
|
|
"SAX Parser" class that converts a stream of SAX events (most likely from |
13
|
|
|
|
|
|
|
an XML file) and populates a L with L |
14
|
|
|
|
|
|
|
objects. |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Please note that this class is incomplete at this time. Although you |
17
|
|
|
|
|
|
|
can create objects and parse some of the tags, many are still ignored |
18
|
|
|
|
|
|
|
at this time (in particular the EoutputE and EanalysisE |
19
|
|
|
|
|
|
|
tags. |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 METHODS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
In addition to the following documented methods, this class implements |
24
|
|
|
|
|
|
|
a large number of methods relating to its implementation of a |
25
|
|
|
|
|
|
|
L subclass. These are not considered part of the |
26
|
|
|
|
|
|
|
public API, and so are not documented here. |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=cut |
29
|
|
|
|
|
|
|
|
30
|
10
|
|
|
10
|
|
48
|
use strict; |
|
10
|
|
|
|
|
17
|
|
|
10
|
|
|
|
|
284
|
|
31
|
10
|
|
|
10
|
|
45
|
use Carp (); |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
172
|
|
32
|
10
|
|
|
10
|
|
47
|
use Params::Util qw{ _INSTANCE }; |
|
10
|
|
|
|
|
13
|
|
|
10
|
|
|
|
|
423
|
|
33
|
10
|
|
|
10
|
|
16054
|
use XML::SAX::Base (); |
|
10
|
|
|
|
|
235090
|
|
|
10
|
|
|
|
|
316
|
|
34
|
|
|
|
|
|
|
|
35
|
10
|
|
|
10
|
|
139
|
use vars qw{$VERSION @ISA $XML_NAMESPACE @PROPERTIES %TRIM}; |
|
10
|
|
|
|
|
22
|
|
|
10
|
|
|
|
|
2263
|
|
36
|
|
|
|
|
|
|
BEGIN { |
37
|
10
|
|
|
10
|
|
23
|
$VERSION = '0.52'; |
38
|
10
|
|
|
|
|
330
|
@ISA = 'XML::SAX::Base'; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# Define the XML namespace we are a parser for |
41
|
10
|
|
|
|
|
68
|
$XML_NAMESPACE = 'http://ali.as/xml/schemas/PITA/1.0'; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# The name/tags for the simple properties |
44
|
10
|
|
|
|
|
45
|
@PROPERTIES = qw{ |
45
|
|
|
|
|
|
|
id driver |
46
|
|
|
|
|
|
|
scheme distname |
47
|
|
|
|
|
|
|
filename resource digest |
48
|
|
|
|
|
|
|
authority authpath |
49
|
|
|
|
|
|
|
cmd path system |
50
|
|
|
|
|
|
|
exitcode |
51
|
|
|
|
|
|
|
}; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# Set up the char strings to trim |
54
|
10
|
|
|
|
|
25
|
%TRIM = map { $_ => 1 } @PROPERTIES; |
|
130
|
|
|
|
|
319
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
# Create the property handlers |
57
|
10
|
|
|
2
|
0
|
45
|
foreach my $name ( @PROPERTIES ) { eval <<"END_PERL" } |
|
130
|
|
|
2
|
0
|
30467
|
|
|
2
|
|
|
1
|
0
|
7
|
|
|
2
|
|
|
7
|
0
|
12
|
|
|
2
|
|
|
3
|
0
|
9
|
|
|
2
|
|
|
4
|
0
|
7
|
|
|
2
|
|
|
1
|
0
|
11
|
|
|
2
|
|
|
7
|
0
|
10
|
|
|
1
|
|
|
1
|
0
|
2
|
|
|
1
|
|
|
2
|
0
|
8
|
|
|
1
|
|
|
2
|
0
|
4
|
|
|
7
|
|
|
5
|
0
|
19
|
|
|
7
|
|
|
0
|
0
|
35
|
|
|
7
|
|
|
2
|
0
|
51
|
|
|
3
|
|
|
2
|
0
|
7
|
|
|
3
|
|
|
1
|
0
|
17
|
|
|
3
|
|
|
7
|
0
|
15
|
|
|
4
|
|
|
3
|
0
|
9
|
|
|
4
|
|
|
4
|
0
|
27
|
|
|
4
|
|
|
1
|
0
|
19
|
|
|
1
|
|
|
7
|
0
|
2
|
|
|
1
|
|
|
1
|
0
|
5
|
|
|
1
|
|
|
2
|
0
|
6
|
|
|
7
|
|
|
2
|
0
|
22
|
|
|
7
|
|
|
5
|
0
|
41
|
|
|
7
|
|
|
0
|
0
|
300
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
10
|
|
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
30
|
|
|
5
|
|
|
|
|
22
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
10
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
4
|
|
|
7
|
|
|
|
|
25
|
|
|
7
|
|
|
|
|
34
|
|
|
3
|
|
|
|
|
13
|
|
|
3
|
|
|
|
|
15
|
|
|
4
|
|
|
|
|
17
|
|
|
4
|
|
|
|
|
23
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
4
|
|
|
7
|
|
|
|
|
123
|
|
|
7
|
|
|
|
|
32
|
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
19
|
|
|
5
|
|
|
|
|
20
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# Start capturing chars |
60
|
|
|
|
|
|
|
sub start_element_${name} { |
61
|
|
|
|
|
|
|
\$_[0]->{chars} = ''; |
62
|
|
|
|
|
|
|
1; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# Save those chars to the element |
66
|
|
|
|
|
|
|
sub end_element_${name} { |
67
|
|
|
|
|
|
|
my \$self = shift; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# Add the $name to the context |
70
|
|
|
|
|
|
|
\$self->_context->{$name} = delete \$self->{chars}; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
1; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
END_PERL |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
##################################################################### |
82
|
|
|
|
|
|
|
# Constructor |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=pod |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head2 new |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# Create the SAX parser |
89
|
|
|
|
|
|
|
my $parser = PITA::XML::SAXParser->new( $report ); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
The C constructor takes a single L object and creates |
92
|
|
|
|
|
|
|
a SAX Parser for it. When used, the SAX Parser object will fill the empty |
93
|
|
|
|
|
|
|
L object with L reporting objects. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
If used with a L that already has existing content, it |
96
|
|
|
|
|
|
|
will add the new install reports in addition to the existing ones. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Returns a new C object, or dies on error. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=cut |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub new { |
103
|
10
|
|
|
10
|
1
|
25
|
my $class = shift; |
104
|
10
|
|
|
|
|
75
|
my $root = _INSTANCE(shift, 'PITA::XML::Storable'); |
105
|
10
|
50
|
|
|
|
360
|
unless ( $root ) { |
106
|
0
|
|
|
|
|
0
|
Carp::croak("Did not provide a PITA::XML::Storable root element"); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# Create the basic parsing object |
110
|
10
|
|
|
|
|
56
|
my $self = bless { |
111
|
|
|
|
|
|
|
object => $root, |
112
|
|
|
|
|
|
|
root => $root->xml_entity, |
113
|
|
|
|
|
|
|
context => [], |
114
|
|
|
|
|
|
|
}, $class; |
115
|
|
|
|
|
|
|
|
116
|
10
|
|
|
|
|
108
|
$self; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# Add to the context |
120
|
|
|
|
|
|
|
sub _push { |
121
|
35
|
|
|
35
|
|
57
|
push @{shift->{context}}, @_; |
|
35
|
|
|
|
|
112
|
|
122
|
35
|
|
|
|
|
121
|
return 1; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# Remove from the context |
126
|
|
|
|
|
|
|
sub _pop { |
127
|
35
|
|
|
35
|
|
52
|
my $self = shift; |
128
|
35
|
50
|
|
|
|
47
|
unless ( @{$self->{context}} ) { |
|
35
|
|
|
|
|
105
|
|
129
|
0
|
|
|
|
|
0
|
die "Ran out of context"; |
130
|
|
|
|
|
|
|
} |
131
|
35
|
|
|
|
|
48
|
return pop @{$self->{context}}; |
|
35
|
|
|
|
|
189
|
|
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# Get the current context |
135
|
|
|
|
|
|
|
sub _context { |
136
|
79
|
|
|
79
|
|
1448
|
shift->{context}->[-1]; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# Convert full Attribute data into a simple hash |
140
|
|
|
|
|
|
|
sub _hash { |
141
|
78
|
|
|
78
|
|
115
|
my $self = shift; |
142
|
78
|
|
|
|
|
528
|
my $attrs = shift; |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# Shrink it |
145
|
26
|
|
|
|
|
127
|
my %hash = map { |
146
|
26
|
|
|
|
|
78
|
$_->{LocalName}, $_->{Value} |
147
|
|
|
|
|
|
|
} grep { |
148
|
26
|
|
|
|
|
96
|
$_->{Value} =~ s/^\s+//; |
149
|
26
|
|
|
|
|
76
|
$_->{Value} =~ s/\s+$//; |
150
|
26
|
|
|
|
|
63
|
1; |
151
|
|
|
|
|
|
|
} grep { |
152
|
78
|
|
|
|
|
191
|
not $_->{Prefix} |
153
|
|
|
|
|
|
|
} values %$attrs; |
154
|
|
|
|
|
|
|
|
155
|
78
|
|
|
|
|
183
|
return \%hash; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
##################################################################### |
163
|
|
|
|
|
|
|
# Simplification Layer |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub start_element { |
166
|
78
|
|
|
78
|
1
|
47436
|
my $self = shift; |
167
|
78
|
|
|
|
|
112
|
my $element = shift; |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
# We don't support namespaces. |
170
|
78
|
50
|
|
|
|
229
|
if ( $element->{Prefix} ) { |
171
|
0
|
|
|
|
|
0
|
Carp::croak( |
172
|
|
|
|
|
|
|
__PACKAGE__ . |
173
|
|
|
|
|
|
|
' does not support the use of XML namespaces (yet)', |
174
|
|
|
|
|
|
|
); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# If this is the root element, set up the initial context. |
178
|
|
|
|
|
|
|
# (and thus don't use the normal handler) |
179
|
78
|
100
|
|
|
|
97
|
unless ( @{$self->{context}} ) { |
|
78
|
|
|
|
|
233
|
|
180
|
10
|
50
|
|
|
|
54
|
unless ( $element->{LocalName} eq $self->{root} ) { |
181
|
0
|
|
|
|
|
0
|
Carp::croak( "Root element must be a <$self->{root}>" ); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# Support ids in the root object |
185
|
10
|
|
|
|
|
53
|
my $hash = $self->_hash($element->{Attributes}); |
186
|
10
|
100
|
|
|
|
43
|
if ( defined $hash->{id} ) { |
187
|
2
|
|
|
|
|
15
|
$self->{object}->{id} = $hash->{id}; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# Set up the root object as the root context |
191
|
10
|
|
|
|
|
73
|
$self->_push( $self->{object} ); |
192
|
10
|
|
|
|
|
46
|
return 1; |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
# Shortcut if we don't implement a handler |
196
|
68
|
|
|
|
|
205
|
my $handler = 'start_element_' . $element->{LocalName}; |
197
|
68
|
50
|
|
|
|
410
|
return 1 unless $self->can($handler); |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
# Hand off to the handler |
200
|
68
|
|
|
|
|
377
|
my $hash = $self->_hash($element->{Attributes}); |
201
|
68
|
|
|
|
|
1478
|
return $self->$handler( $hash ); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
sub end_element { |
205
|
78
|
|
|
78
|
1
|
12321
|
my $self = shift; |
206
|
78
|
|
|
|
|
93
|
my $element = shift; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# Handle the closing root element |
209
|
78
|
100
|
66
|
|
|
314
|
if ( $element->{LocalName} eq $self->{root} and @{$self->{context}} == 1 ) { |
|
10
|
|
|
|
|
61
|
|
210
|
10
|
|
|
|
|
38
|
$self->_pop->_init; |
211
|
9
|
|
|
|
|
30
|
return 1; |
212
|
|
|
|
|
|
|
} |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
# Hand off to the optional tag-specific handler |
215
|
68
|
|
|
|
|
163
|
my $handler = 'end_element_' . $element->{LocalName}; |
216
|
68
|
50
|
|
|
|
342
|
return 1 unless $self->can($handler); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# If there is anything in the character buffer, trim whitespace |
219
|
68
|
100
|
100
|
|
|
564
|
if ( exists $self->{chars} and defined $self->{chars} ) { |
220
|
51
|
100
|
|
|
|
190
|
if ( $TRIM{$element->{LocalName}} ) { |
221
|
37
|
|
|
|
|
154
|
$self->{chars} =~ s/^\s+//; |
222
|
37
|
|
|
|
|
293
|
$self->{chars} =~ s/\s+$//; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
|
226
|
68
|
|
|
|
|
1522
|
return $self->$handler(); |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# Because we don't know in what context this will be called, |
230
|
|
|
|
|
|
|
# we just store all character data in a character buffer |
231
|
|
|
|
|
|
|
# and deal with it in the various end_element methods. |
232
|
|
|
|
|
|
|
sub characters { |
233
|
70
|
|
|
70
|
1
|
4041
|
my $self = shift; |
234
|
70
|
|
|
|
|
95
|
my $element = shift; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
# Add to the buffer (if not null) |
237
|
70
|
100
|
66
|
|
|
361
|
if ( exists $self->{chars} and defined $self->{chars} ) { |
238
|
51
|
|
|
|
|
236
|
$self->{chars} .= $element->{Data}; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
70
|
|
|
|
|
184
|
return 1; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
##################################################################### |
249
|
|
|
|
|
|
|
# Handle the ... tag |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub start_element_install { |
252
|
1
|
|
|
1
|
0
|
9
|
$_[0]->_push( |
253
|
|
|
|
|
|
|
bless { |
254
|
|
|
|
|
|
|
commands => [], |
255
|
|
|
|
|
|
|
tests => [], |
256
|
|
|
|
|
|
|
}, 'PITA::XML::Install' |
257
|
|
|
|
|
|
|
); |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub end_element_install { |
261
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# Complete the install and add to the report |
264
|
1
|
|
|
|
|
4
|
my $install = $self->_pop->_init; |
265
|
1
|
|
|
|
|
4
|
$self->_context->add_install( $install ); |
266
|
|
|
|
|
|
|
|
267
|
1
|
|
|
|
|
3
|
return 1; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
##################################################################### |
275
|
|
|
|
|
|
|
# Handle the ... tag |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub start_element_request { |
278
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
279
|
1
|
|
|
|
|
5
|
my $request = bless { }, 'PITA::XML::Request'; |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
# Add the id if it has one |
282
|
1
|
|
|
|
|
2
|
my $attr = shift; |
283
|
1
|
50
|
|
|
|
6
|
if ( defined $attr->{id} ) { |
284
|
0
|
|
|
|
|
0
|
$request->{id} = $attr->{id}; |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
1
|
|
|
|
|
3
|
$self->_push( $request ); |
288
|
|
|
|
|
|
|
} |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
sub end_element_request { |
291
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# Complete the Request and add to the Install |
294
|
1
|
|
|
|
|
4
|
$self->_context->{request} = $self->_pop->_init; |
295
|
|
|
|
|
|
|
|
296
|
1
|
|
|
|
|
5
|
return 1; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
##################################################################### |
304
|
|
|
|
|
|
|
# Handle the ... tag |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
sub start_element_file { |
307
|
7
|
|
|
7
|
0
|
62
|
$_[0]->_push( |
308
|
|
|
|
|
|
|
bless { }, 'PITA::XML::File' |
309
|
|
|
|
|
|
|
); |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub end_element_file { |
313
|
7
|
|
|
7
|
0
|
18
|
my $self = shift; |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# Complete the Platform and add to the parent Install/Guest |
316
|
7
|
|
|
|
|
32
|
my $file = $self->_pop->_init; |
317
|
7
|
100
|
|
|
|
32
|
if ( _INSTANCE($self->_context, 'PITA::XML::Guest') ) { |
|
|
50
|
|
|
|
|
|
318
|
4
|
|
|
|
|
30
|
$self->_context->add_file( $file ); |
319
|
|
|
|
|
|
|
} elsif ( _INSTANCE($self->_context, 'PITA::XML::Request') ) { |
320
|
3
|
|
|
|
|
20
|
$self->_context->{file} = $file; |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
|
323
|
7
|
|
|
|
|
30
|
return 1; |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
##################################################################### |
331
|
|
|
|
|
|
|
# Handle the ... tag |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
sub start_element_platform { |
334
|
2
|
|
|
2
|
0
|
26
|
$_[0]->_push( |
335
|
|
|
|
|
|
|
bless { |
336
|
|
|
|
|
|
|
env => {}, |
337
|
|
|
|
|
|
|
config => {}, |
338
|
|
|
|
|
|
|
}, 'PITA::XML::Platform' |
339
|
|
|
|
|
|
|
); |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
sub end_element_platform { |
343
|
2
|
|
|
2
|
0
|
4
|
my $self = shift; |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# Complete the Platform and add to the parent Install/Guest |
346
|
2
|
|
|
|
|
6
|
my $platform = $self->_pop->_init; |
347
|
2
|
100
|
|
|
|
7
|
if ( _INSTANCE($self->_context, 'PITA::XML::Install') ) { |
|
|
50
|
|
|
|
|
|
348
|
1
|
|
|
|
|
2
|
$self->_context->{platform} = $platform; |
349
|
|
|
|
|
|
|
} elsif ( _INSTANCE($self->_context, 'PITA::XML::Guest') ) { |
350
|
1
|
|
|
|
|
4
|
$self->_context->add_platform( $platform ); |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
2
|
|
|
|
|
6
|
return 1; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
##################################################################### |
361
|
|
|
|
|
|
|
# Handle the ... tag |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub start_element_command { |
364
|
1
|
|
|
1
|
0
|
6
|
$_[0]->_push( |
365
|
|
|
|
|
|
|
bless {}, 'PITA::XML::Command' |
366
|
|
|
|
|
|
|
); |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
sub end_element_command { |
370
|
1
|
|
|
1
|
0
|
2
|
my $self = shift; |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# Complete the Command and add to the Install |
373
|
1
|
|
|
|
|
3
|
my $command = $self->_pop->_init; |
374
|
1
|
|
|
|
|
2
|
push @{ $self->_context->{commands} }, $command; |
|
1
|
|
|
|
|
3
|
|
375
|
|
|
|
|
|
|
|
376
|
1
|
|
|
|
|
3
|
return 1; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
##################################################################### |
384
|
|
|
|
|
|
|
# Handle the ... tag |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub start_element_test { |
387
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
388
|
1
|
|
|
|
|
2
|
my $hash = shift; |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
# Create the test object |
391
|
1
|
|
|
|
|
5
|
my $test = bless { |
392
|
|
|
|
|
|
|
language => $hash->{language}, |
393
|
|
|
|
|
|
|
}, 'PITA::XML::Test'; |
394
|
1
|
50
|
|
|
|
4
|
if ( $hash->{name} ) { |
395
|
1
|
|
|
|
|
2
|
$test->{name} = $hash->{name}; |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
1
|
|
|
|
|
2
|
$self->_push( $test ); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
sub end_element_test { |
402
|
1
|
|
|
1
|
0
|
3
|
my $self = shift; |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
# Complete the Command and add to the Install |
405
|
1
|
|
|
|
|
4
|
my $test = $self->_pop->_init; |
406
|
1
|
|
|
|
|
3
|
push @{ $self->_context->{tests} }, $test; |
|
1
|
|
|
|
|
4
|
|
407
|
|
|
|
|
|
|
|
408
|
1
|
|
|
|
|
5
|
return 1; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
##################################################################### |
416
|
|
|
|
|
|
|
# Handle the ... tag |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
# Start capturing the STDOUT content |
419
|
|
|
|
|
|
|
sub start_element_stdout { |
420
|
2
|
|
|
2
|
0
|
5
|
$_[0]->{chars} = ''; |
421
|
2
|
|
|
|
|
8
|
return 1; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
# Save those chars to the element by reference, not plain strings |
425
|
|
|
|
|
|
|
sub end_element_stdout { |
426
|
2
|
|
|
2
|
0
|
3
|
my $self = shift; |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
# Add the $name to the context |
429
|
2
|
|
|
|
|
6
|
my $stdout = delete $self->{chars}; |
430
|
2
|
|
|
|
|
9
|
$self->_context->{stdout} = \$stdout; |
431
|
|
|
|
|
|
|
|
432
|
2
|
|
|
|
|
7
|
return 1; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
##################################################################### |
440
|
|
|
|
|
|
|
# Handle the ... tag |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
# Start capturing the STDERR content |
443
|
|
|
|
|
|
|
sub start_element_stderr { |
444
|
2
|
|
|
2
|
0
|
6
|
$_[0]->{chars} = ''; |
445
|
2
|
|
|
|
|
6
|
return 1; |
446
|
|
|
|
|
|
|
} |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
# Save those chars to the element by reference, not plain strings |
449
|
|
|
|
|
|
|
sub end_element_stderr { |
450
|
2
|
|
|
2
|
0
|
5
|
my $self = shift; |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# Add the $name to the context |
453
|
2
|
|
|
|
|
4
|
my $stderr = delete $self->{chars}; |
454
|
2
|
|
|
|
|
6
|
$self->_context->{stderr} = \$stderr; |
455
|
|
|
|
|
|
|
|
456
|
2
|
|
|
|
|
7
|
return 1; |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
##################################################################### |
464
|
|
|
|
|
|
|
# Handle the ... tag |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# Start capturing the $ENV{key} content |
467
|
|
|
|
|
|
|
sub start_element_env { |
468
|
2
|
|
|
2
|
0
|
5
|
my $self = shift; |
469
|
2
|
|
|
|
|
4
|
my $hash = shift; |
470
|
2
|
|
|
|
|
5
|
$self->{chars} = ''; |
471
|
2
|
|
|
|
|
6
|
$self->_push( $hash->{name} ); |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# Save those chars to the element by reference, not plain strings |
475
|
|
|
|
|
|
|
sub end_element_env { |
476
|
2
|
|
|
2
|
0
|
4
|
my $self = shift; |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
# Add the vey/value pair to the env propery |
479
|
2
|
|
|
|
|
5
|
my $name = $self->_pop; |
480
|
2
|
|
|
|
|
5
|
my $value = delete $self->{chars}; |
481
|
2
|
|
|
|
|
7
|
$self->_context->{env}->{$name} = $value; |
482
|
|
|
|
|
|
|
|
483
|
2
|
|
|
|
|
6
|
return 1; |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
##################################################################### |
491
|
|
|
|
|
|
|
# Handle the ... tag |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# Start capturing the %Config::Config content |
494
|
|
|
|
|
|
|
sub start_element_config { |
495
|
10
|
|
|
10
|
0
|
19
|
my $self = shift; |
496
|
10
|
|
|
|
|
17
|
my $hash = shift; |
497
|
10
|
|
|
|
|
21
|
$self->{chars} = ''; |
498
|
10
|
|
|
|
|
31
|
$self->_push( $hash->{name} ); |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
# Save those chars to the element by reference, not plain strings |
502
|
|
|
|
|
|
|
sub end_element_config { |
503
|
10
|
|
|
10
|
0
|
17
|
my $self = shift; |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
# Add the vey/value pair to the config propery |
506
|
10
|
|
|
|
|
23
|
my $name = $self->_pop; |
507
|
10
|
|
|
|
|
25
|
my $value = delete $self->{chars}; |
508
|
10
|
|
|
|
|
24
|
$self->_context->{config}->{$name} = $value; |
509
|
|
|
|
|
|
|
|
510
|
10
|
|
|
|
|
35
|
return 1; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
##################################################################### |
518
|
|
|
|
|
|
|
# Handle tags in a variety of things |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
sub start_element_null { |
521
|
2
|
|
|
2
|
0
|
5
|
my $self = shift; |
522
|
2
|
|
|
|
|
5
|
my $hash = shift; |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# A null tag indicates that the currently-accumulating character |
525
|
|
|
|
|
|
|
# buffer should be set to undef. |
526
|
2
|
50
|
|
|
|
8
|
if ( exists $self->{chars} ) { |
527
|
2
|
|
|
|
|
5
|
$self->{chars} = undef; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
2
|
|
|
|
|
6
|
return 1; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
sub end_element_null { |
534
|
2
|
|
|
2
|
0
|
7
|
return 1; |
535
|
|
|
|
|
|
|
} |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
1; |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=pod |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
=head1 SUPPORT |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
Bugs should be reported via the CPAN bug tracker at |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
L |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
For other issues, contact the author. |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=head1 AUTHOR |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
Adam Kennedy Eadamk@cpan.orgE, L |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
=head1 SEE ALSO |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
L, L |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
The Perl Image-based Testing Architecture (L) |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=head1 COPYRIGHT |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
Copyright 2005 - 2013 Adam Kennedy. |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
This program is free software; you can redistribute |
564
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
The full text of the license can be found in the |
567
|
|
|
|
|
|
|
LICENSE file included with this module. |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
=cut |