line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Treex::PML::Schema::Reader; |
2
|
|
|
|
|
|
|
|
3
|
6
|
|
|
6
|
|
36
|
use strict; |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
154
|
|
4
|
6
|
|
|
6
|
|
27
|
use warnings; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
137
|
|
5
|
|
|
|
|
|
|
|
6
|
6
|
|
|
6
|
|
26
|
use vars qw($VERSION); |
|
6
|
|
|
|
|
17
|
|
|
6
|
|
|
|
|
243
|
|
7
|
|
|
|
|
|
|
BEGIN { |
8
|
6
|
|
|
6
|
|
115
|
$VERSION='2.24'; # version template |
9
|
|
|
|
|
|
|
} |
10
|
6
|
|
|
6
|
|
30
|
no warnings 'uninitialized'; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
187
|
|
11
|
6
|
|
|
6
|
|
33
|
use Carp; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
329
|
|
12
|
|
|
|
|
|
|
|
13
|
6
|
|
|
6
|
|
40
|
use Scalar::Util qw(weaken blessed); |
|
6
|
|
|
|
|
19
|
|
|
6
|
|
|
|
|
314
|
|
14
|
6
|
|
|
6
|
|
2562
|
use XML::LibXML::Reader; |
|
6
|
|
|
|
|
224199
|
|
|
6
|
|
|
|
|
7916
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub new { |
17
|
63
|
|
|
63
|
0
|
186
|
my ($class,$opts)=@_; |
18
|
63
|
|
|
|
|
167
|
my $URL = $opts->{URL}; |
19
|
63
|
|
|
|
|
341
|
my @common = ( |
20
|
|
|
|
|
|
|
no_xinclude_nodes => 1, |
21
|
|
|
|
|
|
|
no_cdata => 1, |
22
|
|
|
|
|
|
|
expand_xinclude => 1, |
23
|
|
|
|
|
|
|
no_blanks => 1, |
24
|
|
|
|
|
|
|
expand_entities => 1, |
25
|
|
|
|
|
|
|
suppress_errors => 0, |
26
|
|
|
|
|
|
|
suppress_warnings => 0, |
27
|
|
|
|
|
|
|
); |
28
|
63
|
50
|
|
|
|
179
|
if ($opts->{validate}) { |
29
|
0
|
|
0
|
|
|
0
|
my $rng = $opts->{relaxng_schema} || Treex::PML::FindInResources('pml_schema_inline.rng'); |
30
|
0
|
0
|
|
|
|
0
|
if (defined $rng) { |
31
|
0
|
|
|
|
|
0
|
push @common, (RelaxNG => $rng); |
32
|
|
|
|
|
|
|
} else { |
33
|
0
|
|
|
|
|
0
|
warn __PACKAGE__.": Validation requested, but 'pml_schema_inline.rng' was not found in the ResourcePath: ".Treex::PML::ResourcePath()."\n"; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
} |
36
|
63
|
|
|
|
|
150
|
my ($reader,$fh); |
37
|
|
|
|
|
|
|
# print "loading schema $opts->{URL}\n"; |
38
|
63
|
50
|
33
|
|
|
640
|
if ($opts->{string}) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
39
|
0
|
|
0
|
|
|
0
|
$URL ||= 'string://'; |
40
|
|
|
|
|
|
|
$reader = XML::LibXML::Reader->new(string => $opts->{string}, |
41
|
0
|
0
|
|
|
|
0
|
@common, |
42
|
|
|
|
|
|
|
URI => $URL, |
43
|
|
|
|
|
|
|
) |
44
|
|
|
|
|
|
|
or die "Error reading string ($URL)"; |
45
|
|
|
|
|
|
|
} elsif ($opts->{fh}) { |
46
|
0
|
|
0
|
|
|
0
|
$URL ||= 'fh://'; |
47
|
0
|
0
|
|
|
|
0
|
$reader = XML::LibXML::Reader->new(IO => $opts->{string}, @common ) |
48
|
|
|
|
|
|
|
or die "Error reading file-handle $fh ($URL)"; |
49
|
|
|
|
|
|
|
} elsif (blessed($opts->{reader}) and $opts->{reader}->isa('XML::LibXML::Reader')) { |
50
|
0
|
|
|
|
|
0
|
$reader = $opts->{reader}; |
51
|
0
|
|
0
|
|
|
0
|
$URL ||= $reader->document->URI; |
52
|
|
|
|
|
|
|
} else { |
53
|
63
|
|
|
|
|
156
|
my $file = $opts->{URL}; |
54
|
63
|
50
|
|
|
|
180
|
print STDERR "parsing schema $file\n" if $Treex::PML::Debug; |
55
|
63
|
|
|
|
|
141
|
$fh = eval { Treex::PML::IO::open_uri($file) }; |
|
63
|
|
|
|
|
257
|
|
56
|
63
|
50
|
33
|
|
|
446
|
croak "Couldn't open PML schema file '$file'\n".$@ if (!$fh || $@); |
57
|
63
|
50
|
|
|
|
543
|
$reader = XML::LibXML::Reader->new(FD => $fh, @common, URI => $URL ) |
58
|
|
|
|
|
|
|
or die "Error reading $file"; |
59
|
|
|
|
|
|
|
} |
60
|
63
|
|
|
|
|
12064
|
return bless [$reader,$opts,$fh], $class; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
sub DESTROY { |
63
|
63
|
|
|
63
|
|
154
|
my ($self)=@_; |
64
|
63
|
|
|
|
|
192
|
my $fh = $self->file_handle; |
65
|
63
|
50
|
|
|
|
375
|
Treex::PML::IO::close_uri($fh) if $fh; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
sub reader { |
68
|
2807
|
|
33
|
2807
|
0
|
7707
|
return ref($_[0]) && $_[0][0]; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
sub options { |
71
|
2744
|
|
33
|
2744
|
0
|
5903
|
return ref($_[0]) && $_[0][1]; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
sub file_handle { |
74
|
63
|
|
33
|
63
|
0
|
322
|
return ref($_[0]) && $_[0][2]; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub parse_element { |
78
|
2744
|
|
|
2744
|
0
|
4629
|
my ($self,$parent)=@_; |
79
|
2744
|
|
|
|
|
4594
|
my $reader = $self->reader; |
80
|
2744
|
|
|
|
|
4882
|
my $opts = $self->options; |
81
|
2744
|
|
|
|
|
3950
|
my (@children,@attrs); |
82
|
2744
|
|
|
|
|
7435
|
my $el_ns = $reader->namespaceURI; |
83
|
2744
|
|
|
|
|
5977
|
my $el_name = $reader->localName; |
84
|
2744
|
50
|
|
|
|
5809
|
my $has_default_ns = $el_ns eq $opts->{DefaultNs} ? 1 : 0; |
85
|
2744
|
50
|
|
|
|
4588
|
my $el_ns_name = ($has_default_ns) ? $el_name : '{'.$el_ns.'}'.$el_name; |
86
|
2744
|
|
|
|
|
4518
|
my $prefix = $reader->prefix; |
87
|
2744
|
50
|
33
|
|
|
11554
|
my %val = ( |
|
|
50
|
|
|
|
|
|
88
|
|
|
|
|
|
|
-xml_name => $el_ns_name, |
89
|
|
|
|
|
|
|
($has_default_ns ? () : (-xml_ns => $el_ns)), |
90
|
|
|
|
|
|
|
(defined($prefix) && length($prefix) ? (-xml_prefix => $prefix) : ()), |
91
|
|
|
|
|
|
|
-parent => $parent, |
92
|
|
|
|
|
|
|
-attributes => \@attrs, |
93
|
|
|
|
|
|
|
); |
94
|
2744
|
100
|
|
|
|
9291
|
weaken($val{-parent}) if $val{-parent}; |
95
|
|
|
|
|
|
|
|
96
|
2744
|
100
|
|
|
|
5982
|
if ($reader->moveToFirstAttribute==1) { |
97
|
1907
|
|
|
|
|
2270
|
do {{ |
98
|
2938
|
|
|
|
|
3805
|
my $name = $reader->name; |
|
2938
|
|
|
|
|
6259
|
|
99
|
2938
|
|
|
|
|
5121
|
push @attrs,$name; |
100
|
2938
|
|
|
|
|
10970
|
$val{$name} = $reader->value; |
101
|
|
|
|
|
|
|
}} while ($reader->moveToNextAttribute); |
102
|
1907
|
|
|
|
|
3569
|
$reader->moveToElement; |
103
|
|
|
|
|
|
|
} |
104
|
2744
|
|
|
|
|
4078
|
my $obj = \%val; |
105
|
|
|
|
|
|
|
{ |
106
|
2744
|
|
66
|
|
|
3811
|
my $class = $opts->{Bless}{$el_ns_name} || $opts->{Bless}{'*'}; |
|
2744
|
|
|
|
|
7490
|
|
107
|
2744
|
50
|
|
|
|
4829
|
if (defined $class) { |
108
|
2744
|
|
|
|
|
5927
|
bless $obj,$class; |
109
|
2744
|
100
|
|
|
|
10644
|
$obj->init($opts) if $obj->can('init'); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
} |
112
|
2744
|
|
|
|
|
5205
|
my $depth = $reader->depth; |
113
|
2744
|
|
|
|
|
3511
|
my $status; |
114
|
2744
|
|
|
|
|
12098
|
while (($status = $reader->read==1)) { |
115
|
8022
|
100
|
|
|
|
18111
|
last unless $reader->depth > $depth; |
116
|
5278
|
|
|
|
|
8900
|
my $nodeType = $reader->nodeType; |
117
|
5278
|
|
|
|
|
6333
|
my $chld; |
118
|
5278
|
|
|
|
|
6395
|
my $redo = 0; |
119
|
5278
|
100
|
66
|
|
|
14960
|
if ($nodeType == XML_READER_TYPE_ELEMENT) { |
|
|
100
|
33
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
120
|
2681
|
|
|
|
|
5083
|
$chld = $self->parse_element($obj); |
121
|
2681
|
|
|
|
|
3910
|
$redo = 1; |
122
|
|
|
|
|
|
|
} elsif ($nodeType == XML_READER_TYPE_TEXT or |
123
|
|
|
|
|
|
|
$nodeType == XML_READER_TYPE_CDATA) { |
124
|
553
|
|
|
|
|
2169
|
$chld = bless { |
125
|
|
|
|
|
|
|
-xml_name => '#text', |
126
|
|
|
|
|
|
|
-value => $reader->value, |
127
|
|
|
|
|
|
|
}, 'Treex::PML::Schema::XMLNode'; |
128
|
|
|
|
|
|
|
} elsif ($nodeType == XML_READER_TYPE_COMMENT) { |
129
|
224
|
|
|
|
|
911
|
$chld = bless { |
130
|
|
|
|
|
|
|
-xml_name => '#comment', |
131
|
|
|
|
|
|
|
-value => $reader->value, |
132
|
|
|
|
|
|
|
}, 'Treex::PML::Schema::XMLNode'; |
133
|
|
|
|
|
|
|
} elsif ($nodeType == XML_READER_TYPE_PROCESSING_INSTRUCTION) { |
134
|
0
|
|
|
|
|
0
|
$chld = bless { |
135
|
|
|
|
|
|
|
-xml_name => '#processing-instruction', |
136
|
|
|
|
|
|
|
-name => $reader->name, |
137
|
|
|
|
|
|
|
-value => $reader->value, |
138
|
|
|
|
|
|
|
}, 'Treex::PML::Schema::XMLNode'; |
139
|
|
|
|
|
|
|
} elsif ($nodeType == XML_READER_TYPE_END_ELEMENT or |
140
|
|
|
|
|
|
|
$nodeType == XML_READER_TYPE_SIGNIFICANT_WHITESPACE or |
141
|
|
|
|
|
|
|
$nodeType == XML_READER_TYPE_WHITESPACE) { |
142
|
1820
|
|
|
|
|
8725
|
next; |
143
|
|
|
|
|
|
|
} else { |
144
|
0
|
0
|
|
|
|
0
|
$chld = bless { |
145
|
|
|
|
|
|
|
-xml_name => '#other', |
146
|
|
|
|
|
|
|
-xml_nodetype => $nodeType, |
147
|
|
|
|
|
|
|
-name => $reader->name, |
148
|
|
|
|
|
|
|
($reader->hasValue ? (-value => $reader->value) : ()), |
149
|
|
|
|
|
|
|
-xml => $reader->readOuterXml, |
150
|
|
|
|
|
|
|
}, 'Treex::PML::Schema::XMLNode'; |
151
|
|
|
|
|
|
|
} |
152
|
3458
|
50
|
|
|
|
7050
|
push @children, $chld if defined $chld; |
153
|
3458
|
100
|
|
|
|
7554
|
redo if $redo; |
154
|
|
|
|
|
|
|
} |
155
|
2744
|
50
|
|
|
|
4768
|
if ($status == -1) { |
156
|
0
|
|
|
|
|
0
|
croak "XMLReader error in $opts->{URL} near line ".$reader->lineNumber; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
2744
|
|
|
|
|
3394
|
my $i=0; |
160
|
2744
|
|
|
|
|
3325
|
my %try_data; |
161
|
2744
|
100
|
|
|
|
6172
|
if (my $cont = $opts->{TextOnly}{$el_ns_name}) { |
162
|
553
|
|
|
|
|
734
|
my $text; |
163
|
553
|
|
|
|
|
1242
|
foreach my $c (@children) { |
164
|
553
|
50
|
|
|
|
1056
|
if ($c->{'-xml_name'} ne '#text') { |
165
|
0
|
|
|
|
|
0
|
warn "Ignoring unexpected node ".$c->{'-xml_name'}." in a text-only element $el_ns_name\n"; |
166
|
|
|
|
|
|
|
} else { |
167
|
553
|
|
|
|
|
1214
|
$text.=$c->{-value}; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
} |
170
|
553
|
|
|
|
|
1107
|
$val{$cont} = $text; |
171
|
|
|
|
|
|
|
} else { |
172
|
2191
|
|
|
|
|
3676
|
foreach my $c (@children) { |
173
|
2905
|
|
|
|
|
5103
|
$c->{'-#'} = $i++; |
174
|
2905
|
|
|
|
|
4181
|
my $name = $c->{-xml_name}; |
175
|
2905
|
100
|
|
|
|
5978
|
if (!ref($val{$name})) { |
176
|
1680
|
50
|
|
|
|
3040
|
if (exists $val{$name}) { |
177
|
0
|
|
|
|
|
0
|
warn "Collision between an attribute and child-element $name\n"; |
178
|
0
|
|
|
|
|
0
|
$val{'@'.$name} = delete $val{$name} |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
} |
181
|
2905
|
|
|
|
|
3647
|
my $value; |
182
|
2905
|
100
|
|
|
|
5596
|
if (my $cont = $opts->{Stringify}{$name}) { |
183
|
551
|
|
|
|
|
882
|
$value = $c->{$cont}; |
184
|
551
|
50
|
|
|
|
1003
|
$value='' unless defined $value; |
185
|
|
|
|
|
|
|
} else { |
186
|
2354
|
|
|
|
|
3179
|
$value = $c; |
187
|
|
|
|
|
|
|
} |
188
|
2905
|
100
|
|
|
|
6467
|
if ($opts->{Solitary}{$name}) { |
|
|
100
|
|
|
|
|
|
189
|
1086
|
50
|
|
|
|
2075
|
if (exists $val{$name}) { |
190
|
0
|
|
|
|
|
0
|
warn "Multiple occurences of the child-element '$name'\n"; |
191
|
|
|
|
|
|
|
} |
192
|
1086
|
|
|
|
|
2222
|
$val{$name} = $value |
193
|
|
|
|
|
|
|
} elsif (my $key = $opts->{KeyAttr}{$name}) { |
194
|
1099
|
|
|
|
|
1787
|
my $val = delete $c->{$key}; |
195
|
1099
|
|
|
|
|
1973
|
$c->{-name}=$val; |
196
|
1099
|
|
|
|
|
3086
|
$val{$name}{$val} = $value; |
197
|
|
|
|
|
|
|
} else { |
198
|
720
|
|
|
|
|
914
|
push @{$val{$name}}, $value; |
|
720
|
|
|
|
|
1487
|
|
199
|
|
|
|
|
|
|
} |
200
|
2905
|
|
|
|
|
7043
|
weaken($c->{-parent} = $obj); |
201
|
|
|
|
|
|
|
} |
202
|
2191
|
|
|
|
|
3596
|
$obj->{'-##'} = $i; |
203
|
|
|
|
|
|
|
} |
204
|
2744
|
100
|
|
|
|
7483
|
if (UNIVERSAL::can($obj,'post_process')) { |
205
|
141
|
|
|
|
|
533
|
$obj->post_process($opts); |
206
|
|
|
|
|
|
|
} |
207
|
2744
|
|
|
|
|
8951
|
return $obj; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
1; |
212
|
|
|
|
|
|
|
__END__ |