File Coverage

blib/lib/XAS/Lib/XML.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package XAS::Lib::XML;
2              
3             our $VERSION = '0.01';
4              
5 1     1   3 use Try::Tiny;
  1         2  
  1         43  
6 1     1   211 use XML::LibXML;
  0            
  0            
7             use XML::LibXML::XPathContext;
8              
9             use XAS::Class
10             debug => 0,
11             version => $VERSION,
12             base => 'XAS::Base',
13             import => 'class',
14             accessors => 'parser schema doc xpc',
15             utils => ':validation dotid compress',
16             constants => 'TRUE FALSE',
17             vars => {
18             PARAMS => {
19             -xsd => { optional => 1, default => undef },
20             -default_namespace => { optional => 1, default => 'def' },
21             },
22             XMLERR => '',
23             }
24             ;
25              
26             # ----------------------------------------------------------------------
27             # Public Methods
28             # ----------------------------------------------------------------------
29              
30             sub get_items {
31             my $self = shift;
32             my ($xpath) = validate_params(\@_, [1]);
33              
34             my @nodes;
35             my $xpc = $self->xpc;
36             my $node = $self->doc->documentElement();
37              
38             if (my ($key) = $xpc->findnodes($xpath, $node)) {
39              
40             if ($key->hasChildNodes()) {
41              
42             @nodes = $key->childNodes();
43              
44             }
45              
46             }
47              
48             return wantarray ? @nodes : \@nodes;
49              
50             }
51              
52             sub get_item {
53             my $self = shift;
54             my ($xpath) = validate_params(\@_, [1]);
55              
56             my $value = '';
57             my $xpc = $self->xpc;
58             my $node = $self->doc->documentElement();
59              
60             if (my ($key) = $xpc->findnodes($xpath, $node)) {
61            
62             $value = $key->textContent();
63              
64             }
65              
66             return $value;
67              
68             }
69              
70             sub get_node {
71             my $self = shift;
72             my ($xpath) = validate_params(\@_, [1]);
73            
74             my $xpc = $self->xpc;
75             my $node = $self->doc->documentElement();
76            
77             return $xpc->findnodes($xpath, $node);
78            
79             }
80              
81             sub is_valid {
82             my $self = shift;
83              
84             my $doc = $self->doc;
85              
86             return TRUE unless (defined($self->{'schema'}));
87              
88             try {
89              
90             $self->schema->validate($doc); # validate the document
91              
92             } catch {
93              
94             my $ex = $_;
95              
96             $self->class->var('XMLERR', $ex);
97              
98             $self->throw_msg(
99             dotid($self->class) . '.is_valid',
100             'xml_validate',
101             );
102              
103             };
104              
105             return TRUE;
106              
107             }
108              
109             sub load {
110             my $self = shift;
111             my ($xml) = validate_params(\@_, [1]);
112              
113             try {
114              
115             # load and parse the document
116              
117             $self->{'doc'} = $self->parser->load_xml(string => $xml, {no_blanks => 1});
118              
119             # find and register all namespaces
120              
121             $self->_load_namespace();
122              
123             } catch {
124              
125             my $ex = $_;
126              
127             $self->throw_msg(
128             dotid($self->class). '.parser',
129             'xml_parser',
130             $ex
131             );
132              
133             };
134              
135             }
136              
137             sub xmlerr {
138             my $class = shift;
139             my ($value) = validate_params(\@_, [
140             { optional => 1, default => undef }
141             ]);
142              
143             if (defined($value)) {
144              
145             class->var('XMLERR', $value);
146              
147             }
148            
149             return class->var('XMLERR');
150              
151             }
152              
153             # ----------------------------------------------------------------------
154             # Private Methods
155             # ----------------------------------------------------------------------
156              
157             sub init {
158             my $class = shift;
159              
160             my $self = $class->SUPER::init(@_);
161              
162             $self->{'parser'} = XML::LibXML->new();
163             $self->{'xpc'} = XML::LibXML::XPathContext->new();
164              
165             if (defined($self->{'xsd'})) {
166              
167             $self->{'schema'} = XML::LibXML::Schema->new(location => $self->xsd);
168              
169             }
170              
171             return $self;
172              
173             }
174              
175             sub _load_namespace {
176             my $self = shift;
177              
178             my $hash;
179             my $doc = $self->doc;
180             my $def = $self->default_namespace;
181              
182             foreach my $node ($doc->findnodes('//*/namespace::*')) {
183              
184             my $ns = $node->getLocalName() || $def;
185             my $uri = $node->getValue();
186              
187             $hash->{$ns} = $uri; # filter multiple namespaces
188              
189             }
190              
191             while (my ($key, $value) = each(%$hash)) {
192              
193             $self->xpc->registerNs($key, $value);
194              
195             }
196              
197             }
198              
199             1;
200              
201             __END__