line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PITA::XML; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# See POD at end for docs. |
4
|
|
|
|
|
|
|
|
5
|
10
|
|
|
10
|
|
277838
|
use 5.006; |
|
10
|
|
|
|
|
38
|
|
|
10
|
|
|
|
|
409
|
|
6
|
10
|
|
|
10
|
|
54
|
use strict; |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
315
|
|
7
|
10
|
|
|
10
|
|
136
|
use Carp (); |
|
10
|
|
|
|
|
26
|
|
|
10
|
|
|
|
|
216
|
|
8
|
10
|
|
|
10
|
|
8717
|
use Params::Util (); |
|
10
|
|
|
|
|
57882
|
|
|
10
|
|
|
|
|
215
|
|
9
|
10
|
|
|
10
|
|
10013
|
use IO::File (); |
|
10
|
|
|
|
|
119119
|
|
|
10
|
|
|
|
|
235
|
|
10
|
10
|
|
|
10
|
|
9838
|
use IO::String (); |
|
10
|
|
|
|
|
30106
|
|
|
10
|
|
|
|
|
435
|
|
11
|
|
|
|
|
|
|
BEGIN { |
12
|
|
|
|
|
|
|
# Temporary Hack: |
13
|
|
|
|
|
|
|
# IO::String looks like a duck and quacks liks a duck, but we need it |
14
|
|
|
|
|
|
|
# to be a real duck. So lets make it a duck (if it didn't turn into a |
15
|
|
|
|
|
|
|
# real duck while we weren't looking.) |
16
|
10
|
50
|
|
10
|
|
94
|
unless ( @IO::String::ISA ) { |
17
|
10
|
|
|
|
|
361
|
@IO::String::ISA = qw{ IO::Handle IO::Seekable }; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
} |
20
|
10
|
|
|
10
|
|
10927
|
use File::ShareDir (); |
|
10
|
|
|
|
|
81489
|
|
|
10
|
|
|
|
|
406
|
|
21
|
10
|
|
|
10
|
|
9797
|
use XML::SAX::ParserFactory (); |
|
10
|
|
|
|
|
52055
|
|
|
10
|
|
|
|
|
390
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# Optionally load the schema validator |
24
|
|
|
|
|
|
|
BEGIN { |
25
|
10
|
|
|
10
|
|
26
|
local $@; |
26
|
10
|
|
|
|
|
120
|
eval { |
27
|
10
|
|
|
|
|
5990
|
require XML::Validator::Schema; |
28
|
|
|
|
|
|
|
}; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
10
|
|
|
10
|
|
47
|
use vars qw{$VERSION}; |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
438
|
|
32
|
|
|
|
|
|
|
BEGIN { |
33
|
10
|
|
|
10
|
|
206
|
$VERSION = '0.52'; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# The XML Schema File |
37
|
|
|
|
|
|
|
# Locate the Schema at use-time (instead of compile-time) and |
38
|
|
|
|
|
|
|
# allow the specification of a custom schema. |
39
|
10
|
|
|
10
|
|
44
|
use vars qw{$SCHEMA}; |
|
10
|
|
|
|
|
17
|
|
|
10
|
|
|
|
|
607
|
|
40
|
|
|
|
|
|
|
$SCHEMA ||= File::ShareDir::dist_file('PITA-XML', 'pita-xml.xsd'); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# While in development, use a version-specific namespace. |
43
|
|
|
|
|
|
|
# In theory, this ensures documents are only truly valid with the |
44
|
|
|
|
|
|
|
# version they were created with. |
45
|
10
|
|
|
10
|
|
53
|
use constant XMLNS => "http://ali.as/xml/schema/pita-xml/$VERSION"; |
|
10
|
|
|
|
|
27
|
|
|
10
|
|
|
|
|
653
|
|
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# The list of core schemes |
48
|
10
|
|
|
10
|
|
56
|
use vars qw{%SCHEMES}; |
|
10
|
|
|
|
|
14
|
|
|
10
|
|
|
|
|
687
|
|
49
|
|
|
|
|
|
|
BEGIN { |
50
|
10
|
|
|
10
|
|
248
|
%SCHEMES = ( |
51
|
|
|
|
|
|
|
'perl5' => 1, |
52
|
|
|
|
|
|
|
'perl5.make' => 1, |
53
|
|
|
|
|
|
|
'perl5.build' => 1, |
54
|
|
|
|
|
|
|
'perl6' => 1, |
55
|
|
|
|
|
|
|
); |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# Load the various classes |
59
|
10
|
|
|
10
|
|
6582
|
use PITA::XML::Storable (); |
|
10
|
|
|
|
|
23
|
|
|
10
|
|
|
|
|
160
|
|
60
|
10
|
|
|
10
|
|
5325
|
use PITA::XML::Command (); |
|
10
|
|
|
|
|
20
|
|
|
10
|
|
|
|
|
175
|
|
61
|
10
|
|
|
10
|
|
5300
|
use PITA::XML::Test (); |
|
10
|
|
|
|
|
27
|
|
|
10
|
|
|
|
|
169
|
|
62
|
10
|
|
|
10
|
|
5854
|
use PITA::XML::Request (); |
|
10
|
|
|
|
|
31
|
|
|
10
|
|
|
|
|
203
|
|
63
|
10
|
|
|
10
|
|
5625
|
use PITA::XML::Platform (); |
|
10
|
|
|
|
|
27
|
|
|
10
|
|
|
|
|
176
|
|
64
|
10
|
|
|
10
|
|
5097
|
use PITA::XML::File (); |
|
10
|
|
|
|
|
31
|
|
|
10
|
|
|
|
|
201
|
|
65
|
10
|
|
|
10
|
|
11793
|
use PITA::XML::Guest (); |
|
10
|
|
|
|
|
28
|
|
|
10
|
|
|
|
|
188
|
|
66
|
10
|
|
|
10
|
|
6034
|
use PITA::XML::Install (); |
|
10
|
|
|
|
|
29
|
|
|
10
|
|
|
|
|
1513
|
|
67
|
10
|
|
|
10
|
|
5448
|
use PITA::XML::Report (); |
|
10
|
|
|
|
|
27
|
|
|
10
|
|
|
|
|
1424
|
|
68
|
10
|
|
|
10
|
|
6594
|
use PITA::XML::SAXParser (); |
|
10
|
|
|
|
|
37
|
|
|
10
|
|
|
|
|
261
|
|
69
|
10
|
|
|
10
|
|
7487
|
use PITA::XML::SAXDriver (); |
|
10
|
|
|
|
|
45
|
|
|
10
|
|
|
|
|
8509
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
##################################################################### |
76
|
|
|
|
|
|
|
# Main Methods |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub validate { |
79
|
0
|
|
|
0
|
0
|
0
|
my $class = shift; |
80
|
0
|
|
|
|
|
0
|
my $fh = $class->_FH(shift); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# Make schema validation dependant on module availability |
83
|
0
|
0
|
|
|
|
0
|
$XML::Validator::Schema::VERSION or return 1; |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# Create the validator |
86
|
0
|
|
|
|
|
0
|
my $parser = XML::SAX::ParserFactory->parser( |
87
|
|
|
|
|
|
|
Handler => XML::Validator::Schema->new( |
88
|
|
|
|
|
|
|
file => $SCHEMA, |
89
|
|
|
|
|
|
|
), |
90
|
|
|
|
|
|
|
); |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# Validate the document |
93
|
0
|
|
|
|
|
0
|
$parser->parse_file( $fh ); |
94
|
|
|
|
|
|
|
|
95
|
0
|
|
|
|
|
0
|
1; |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
##################################################################### |
102
|
|
|
|
|
|
|
# Support Methods |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub _FH { |
105
|
10
|
|
|
10
|
|
24
|
my $class = shift; |
106
|
10
|
|
|
|
|
22
|
my $file = shift; |
107
|
10
|
100
|
|
|
|
66
|
if ( Params::Util::_SCALAR($file) ) { |
108
|
8
|
|
|
|
|
84
|
$file = IO::String->new( $file ); |
109
|
|
|
|
|
|
|
} |
110
|
10
|
100
|
|
|
|
596
|
if ( Params::Util::_INSTANCE($file, 'IO::Handle') ) { |
111
|
8
|
50
|
|
|
|
339
|
if ( $file->can('seek') ) { |
112
|
|
|
|
|
|
|
# Reset the file handle |
113
|
8
|
50
|
|
|
|
64
|
$file->seek( 0, 0 ) or Carp::croak( |
114
|
|
|
|
|
|
|
'Failed to reset file handle (seek to 0)', |
115
|
|
|
|
|
|
|
); |
116
|
8
|
|
|
|
|
187
|
return $file; |
117
|
|
|
|
|
|
|
} |
118
|
0
|
|
|
|
|
0
|
Carp::croak('IO::Handle is not seekable'); |
119
|
|
|
|
|
|
|
} |
120
|
2
|
50
|
33
|
|
|
29
|
unless ( defined $file and ! ref $file and length $file ) { |
|
|
|
33
|
|
|
|
|
121
|
0
|
|
|
|
|
0
|
Carp::croak('Did not provide a file name or handle'); |
122
|
|
|
|
|
|
|
} |
123
|
2
|
50
|
33
|
|
|
62
|
unless ( $file and -f $file and -r _ ) { |
|
|
|
33
|
|
|
|
|
124
|
0
|
|
|
|
|
0
|
Carp::croak('Did not provide a readable file name'); |
125
|
|
|
|
|
|
|
} |
126
|
2
|
|
|
|
|
26
|
my $fh = IO::File->new( $file ); |
127
|
2
|
50
|
|
|
|
235
|
unless ( $fh ) { |
128
|
0
|
|
|
|
|
0
|
Carp::croak("Failed to open PITA::XML file '$file'"); |
129
|
|
|
|
|
|
|
} |
130
|
2
|
|
|
|
|
11
|
$fh; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub _OUTPUT { |
134
|
11
|
|
|
11
|
|
21
|
my ($class, $object, $name) = @_; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# If provided as a param, clean it up |
137
|
11
|
50
|
|
|
|
32
|
if ( exists $object->{$name} ) { |
138
|
|
|
|
|
|
|
# Convert from array to scalar ref |
139
|
11
|
50
|
|
|
|
43
|
if ( Params::Util::_ARRAY0($object->{$name}) ) { |
140
|
|
|
|
|
|
|
# Clean up newlines and merge into SCALAR |
141
|
0
|
|
|
|
|
0
|
my $param = $object->{$name}; |
142
|
0
|
|
|
|
|
0
|
foreach my $i ( 0 .. $#$param ) { |
143
|
0
|
|
|
|
|
0
|
$param->[$i] =~ s/[\012\015]+$/\n/; |
144
|
|
|
|
|
|
|
} |
145
|
0
|
|
|
|
|
0
|
$param = join '', @$param; |
146
|
0
|
|
|
|
|
0
|
$object->{$name} = \$param; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# Check for scalarness |
151
|
11
|
50
|
|
|
|
41
|
Params::Util::_SCALAR0($object->$name()) ? 1 : undef; |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub _SCHEME { |
155
|
60
|
|
|
60
|
|
91
|
my $class = shift; |
156
|
60
|
100
|
|
|
|
295
|
my $string = Params::Util::_STRING(shift) or return undef; |
157
|
33
|
100
|
100
|
|
|
251
|
($SCHEMES{$string} or $string =~ /x_/) ? $string : undef; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub _MD5SUM { |
161
|
0
|
|
|
0
|
|
0
|
my $class = shift; |
162
|
0
|
0
|
|
|
|
0
|
my $md5sum = Params::Util::_STRING(shift) or return undef; |
163
|
0
|
0
|
|
|
|
0
|
($md5sum =~ /^[0-9a-f]{32}$/i) ? lc($md5sum) : undef; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub _DISTNAME { |
167
|
21
|
|
|
21
|
|
35
|
my $class = shift; |
168
|
21
|
100
|
|
|
|
81
|
my $distname = Params::Util::_STRING(shift) or return undef; |
169
|
20
|
100
|
|
|
|
168
|
($distname =~ /^[a-z]\w*(?:\-[a-z]\w*)+$/is) ? $distname : undef; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub _GUID { |
173
|
6
|
|
|
6
|
|
15
|
my $class = shift; |
174
|
6
|
50
|
|
|
|
33
|
my $guid = Params::Util::_STRING(shift) or return undef; |
175
|
6
|
50
|
|
|
|
66
|
($guid =~ /^[0-9A-F]{8}-[0-9A-F]{4}-[0-9A-F]{4}-[0-9A-F]{4}-[0-9A-F]{12}$/) ? $guid : undef; |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
1; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
__END__ |