| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# $Id$ |
|
2
|
|
|
|
|
|
|
# |
|
3
|
|
|
|
|
|
|
# Copyright (c) 2005-2007 Daisuke Maki |
|
4
|
|
|
|
|
|
|
# All rights reserved. |
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package XML::RSS::LibXML::ImplBase; |
|
7
|
1
|
|
|
1
|
|
6
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
25
|
|
|
8
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
21
|
|
|
9
|
1
|
|
|
1
|
|
5
|
use base qw(Class::Accessor::Fast); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
74
|
|
|
10
|
1
|
|
|
1
|
|
11
|
use Carp qw(croak); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
52
|
|
|
11
|
1
|
|
|
1
|
|
506
|
use XML::RSS::LibXML::MagicElement; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
7
|
|
|
12
|
1
|
|
|
1
|
|
445
|
use XML::RSS::LibXML::Namespaces; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
2719
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
sub rss_accessor |
|
15
|
|
|
|
|
|
|
{ |
|
16
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
17
|
0
|
|
|
|
|
|
my $name = shift; |
|
18
|
0
|
|
|
|
|
|
my $c = shift; |
|
19
|
|
|
|
|
|
|
|
|
20
|
0
|
0
|
|
|
|
|
if (! exists $c->{$name}) { |
|
21
|
0
|
|
|
|
|
|
croak "Unregistered entity: Can't access $name field in object of class " . ref($self); |
|
22
|
|
|
|
|
|
|
} |
|
23
|
|
|
|
|
|
|
|
|
24
|
0
|
|
|
|
|
|
my $ret; |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
|
27
|
0
|
0
|
|
|
|
|
if (@_ == 1) { |
|
|
|
0
|
|
|
|
|
|
|
28
|
0
|
0
|
|
|
|
|
if (ref $_[0]) { # eval { $_[0]->isa('XML::RSS::LibXML::MagicElement') }) { |
|
29
|
0
|
|
|
|
|
|
$ret = $c->{$name}; |
|
30
|
0
|
|
|
|
|
|
$c->{$name} = $_[0]; |
|
31
|
|
|
|
|
|
|
} else { |
|
32
|
0
|
|
|
|
|
|
$ret = $c->{$name}->{$_[0]}; |
|
33
|
0
|
0
|
0
|
|
|
|
if (ref $ret && eval { $ret->isa('XML::RSS::LibXML::ElementSpec') }) { |
|
|
0
|
|
|
|
|
|
|
|
34
|
0
|
|
|
|
|
|
$ret = undef; |
|
35
|
|
|
|
|
|
|
} |
|
36
|
|
|
|
|
|
|
} |
|
37
|
|
|
|
|
|
|
} elsif (@_ > 1) { |
|
38
|
0
|
|
|
|
|
|
my %hash = @_; |
|
39
|
0
|
|
|
|
|
|
my $definition = $self->accessor_definition; |
|
40
|
|
|
|
|
|
|
|
|
41
|
0
|
|
|
|
|
|
foreach my $key (keys %hash) { |
|
42
|
0
|
0
|
|
|
|
|
$self->validate_accessor($definition, $name, $key, $hash{$key}) if $definition; |
|
43
|
|
|
|
|
|
|
|
|
44
|
0
|
0
|
|
|
|
|
if ($key =~ /^(?:rdf|dc|syn|taxo|admin|content|cc)$/) { |
|
45
|
0
|
0
|
|
|
|
|
if (! exists $c->namespaces->{$key}) { |
|
46
|
0
|
|
|
|
|
|
$c->add_module(prefix => $key, uri => XML::RSS::LibXML::Namespaces::lookup_uri($key)); |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
} |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# $self->store_element($c, $c->{$name}, $key, $hash{$key}); |
|
51
|
0
|
|
|
|
|
|
$self->set_value($c, $name, $key, $hash{$key}); |
|
52
|
0
|
0
|
|
|
|
|
if (my $uri = $c->namespaces->{$key}) { |
|
53
|
0
|
|
|
|
|
|
$self->set_value($c, $name, $uri, $hash{$key}); |
|
54
|
|
|
|
|
|
|
# $self->store_element($c, $c->{$name}, $uri, $hash{$key}); |
|
55
|
|
|
|
|
|
|
} |
|
56
|
|
|
|
|
|
|
} |
|
57
|
0
|
|
|
|
|
|
$ret = $c->{$name}; |
|
58
|
|
|
|
|
|
|
} else { |
|
59
|
0
|
|
|
|
|
|
$ret = $c->{$name}; |
|
60
|
0
|
0
|
0
|
|
|
|
if (ref $ret && eval { $ret->isa('XML::RSS::LibXML::ElementSpec') }) { |
|
|
0
|
|
|
|
|
|
|
|
61
|
0
|
|
|
|
|
|
$ret = undef; |
|
62
|
|
|
|
|
|
|
} |
|
63
|
|
|
|
|
|
|
} |
|
64
|
|
|
|
|
|
|
|
|
65
|
0
|
|
|
|
|
|
return $ret; |
|
66
|
|
|
|
|
|
|
} |
|
67
|
|
|
|
|
|
|
|
|
68
|
0
|
|
|
0
|
0
|
|
sub definition {} |
|
69
|
0
|
|
|
0
|
0
|
|
sub accessor_definition { } |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub validate_accessor |
|
72
|
|
|
|
|
|
|
{ |
|
73
|
0
|
|
|
0
|
0
|
|
my ($self, $definition, $prefix, $key, $value) = @_; |
|
74
|
|
|
|
|
|
|
|
|
75
|
0
|
0
|
|
|
|
|
if (! defined $value) { |
|
76
|
0
|
|
|
|
|
|
croak "Undefined value in XML::RSS::LibXML::validate_accessor"; |
|
77
|
|
|
|
|
|
|
} |
|
78
|
0
|
|
|
|
|
|
my $spec = $definition->{$prefix}{$key}; |
|
79
|
0
|
0
|
0
|
|
|
|
croak "$key cannot exceed " . $spec->[1] . " characters in length" |
|
80
|
|
|
|
|
|
|
if defined $spec->[1] && length($value) > $spec->[1]; |
|
81
|
|
|
|
|
|
|
} |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub set_value |
|
84
|
|
|
|
|
|
|
{ |
|
85
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $prefix, $key, $value) = @_; |
|
86
|
|
|
|
|
|
|
|
|
87
|
0
|
0
|
|
|
|
|
if (eval { $c->{$prefix}->isa('XML::RSS::LibXML::ElementSpec') }) { |
|
|
0
|
|
|
|
|
|
|
|
88
|
0
|
|
|
|
|
|
$c->{$prefix} = +{ %{ $c->{$prefix} } }; |
|
|
0
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
} |
|
90
|
0
|
|
|
|
|
|
$c->{$prefix}{$key} = $value; |
|
91
|
|
|
|
|
|
|
} |
|
92
|
|
|
|
|
|
|
|
|
93
|
0
|
|
|
0
|
0
|
|
sub validate_item { } |
|
94
|
|
|
|
|
|
|
|
|
95
|
0
|
|
|
0
|
0
|
|
sub channel { shift->rss_accessor('channel', @_) } |
|
96
|
0
|
|
|
0
|
0
|
|
sub image { shift->rss_accessor('image', @_) } |
|
97
|
0
|
|
|
0
|
0
|
|
sub textinput { shift->rss_accessor('textinput', @_) } |
|
98
|
0
|
|
|
0
|
0
|
|
sub skipDays { shift->rss_accessor('skipDays', @_) } |
|
99
|
0
|
|
|
0
|
0
|
|
sub skipHours { shift->rss_accessor('skipHours', @_) } |
|
100
|
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub reset |
|
102
|
|
|
|
|
|
|
{ |
|
103
|
0
|
|
|
0
|
0
|
|
my ($self, $c) = @_; |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# internal hash |
|
106
|
0
|
|
|
|
|
|
$c->_internal({}); |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# init num of items to 0 |
|
109
|
0
|
|
|
|
|
|
$c->num_items(0); |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# initialize items |
|
112
|
0
|
|
|
|
|
|
$c->{items} = []; |
|
113
|
|
|
|
|
|
|
|
|
114
|
0
|
|
|
|
|
|
my $definition = $self->definition; |
|
115
|
0
|
|
|
|
|
|
while (my ($k, $v) = each(%$definition)) { |
|
116
|
0
|
|
|
|
|
|
$c->{$k} = +{%{$v}}; |
|
|
0
|
|
|
|
|
|
|
|
117
|
0
|
0
|
|
|
|
|
bless($c->{$k}, 'XML::RSS::LibXML::ElementSpec') |
|
118
|
|
|
|
|
|
|
if (ref($v) eq 'XML::RSS::LibXML::ElementSpec'); |
|
119
|
|
|
|
|
|
|
} |
|
120
|
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
|
return; |
|
122
|
|
|
|
|
|
|
} |
|
123
|
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub store_element |
|
125
|
|
|
|
|
|
|
{ |
|
126
|
0
|
|
|
0
|
0
|
|
my ($self, $container, $name, $value) = @_; |
|
127
|
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
my $v = $container->{$name}; |
|
129
|
0
|
0
|
0
|
|
|
|
if (! $v || eval { $v->isa('XML::RSS::LibXML::ElementSpec') }) { |
|
|
0
|
0
|
|
|
|
|
|
|
130
|
0
|
|
|
|
|
|
$container->{$name} = $value; |
|
131
|
|
|
|
|
|
|
} elsif (ref($v) eq 'ARRAY') { |
|
132
|
0
|
|
|
|
|
|
push @$v, $value; |
|
133
|
|
|
|
|
|
|
} else { |
|
134
|
0
|
|
|
|
|
|
$container->{$name} = [ $v, $value ]; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
} |
|
137
|
|
|
|
|
|
|
|
|
138
|
0
|
|
|
0
|
0
|
|
sub parse_dom { } |
|
139
|
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub parse_base |
|
141
|
|
|
|
|
|
|
{ |
|
142
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $dom) = @_; |
|
143
|
0
|
|
|
|
|
|
my $xc = $c->create_xpath_context(scalar $c->namespaces); |
|
144
|
0
|
0
|
|
|
|
|
if (my $b = $xc->findvalue('/rss/@xml:base', $dom)) { |
|
145
|
0
|
|
|
|
|
|
$c->base($b); |
|
146
|
|
|
|
|
|
|
} else { |
|
147
|
0
|
|
|
|
|
|
$c->base(undef); |
|
148
|
|
|
|
|
|
|
} |
|
149
|
|
|
|
|
|
|
} |
|
150
|
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
sub parse_namespaces |
|
152
|
|
|
|
|
|
|
{ |
|
153
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $dom) = @_; |
|
154
|
|
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
|
my %namespaces = $self->parse_namespaces_recurse($c, $dom->documentElement()); |
|
156
|
|
|
|
|
|
|
|
|
157
|
0
|
|
|
|
|
|
while (my ($prefix, $uri) = each %namespaces) { |
|
158
|
0
|
|
|
|
|
|
$c->add_module(prefix => $prefix, uri => $uri); |
|
159
|
|
|
|
|
|
|
} |
|
160
|
|
|
|
|
|
|
} |
|
161
|
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub parse_namespaces_recurse |
|
163
|
|
|
|
|
|
|
{ |
|
164
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $parent) = @_; |
|
165
|
|
|
|
|
|
|
|
|
166
|
0
|
|
|
|
|
|
my %namespaces; |
|
167
|
0
|
|
|
|
|
|
foreach my $node ($parent->findnodes('./*')) { |
|
168
|
0
|
|
|
|
|
|
my %h = $self->parse_namespaces_recurse($c, $node); |
|
169
|
0
|
|
|
|
|
|
%namespaces = (%namespaces, %h); |
|
170
|
|
|
|
|
|
|
} |
|
171
|
0
|
|
|
|
|
|
return (%namespaces, $c->get_namespaces($parent)); |
|
172
|
|
|
|
|
|
|
} |
|
173
|
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
sub parse_taxo |
|
175
|
|
|
|
|
|
|
{ |
|
176
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $dom, $container, $parent) = @_; |
|
177
|
|
|
|
|
|
|
|
|
178
|
0
|
|
|
|
|
|
my $xc = $c->create_xpath_context(scalar $c->namespaces); |
|
179
|
0
|
|
|
|
|
|
my @nodes = $xc->findnodes('taxo:topics/rdf:Bag/rdf:li', $parent); |
|
180
|
0
|
0
|
|
|
|
|
return unless @nodes; |
|
181
|
|
|
|
|
|
|
|
|
182
|
0
|
|
|
|
|
|
my $uri = XML::RSS::LibXML::Namespaces::lookup_uri('taxo'); |
|
183
|
0
|
0
|
|
|
|
|
if (! exists $c->namespaces->{taxo}) { |
|
184
|
0
|
|
|
|
|
|
$c->add_module(prefix => 'taxo', uri => $uri); |
|
185
|
|
|
|
|
|
|
} |
|
186
|
|
|
|
|
|
|
|
|
187
|
0
|
|
0
|
|
|
|
$container->{taxo} ||= []; |
|
188
|
0
|
|
|
|
|
|
foreach my $p (@nodes) { |
|
189
|
0
|
|
|
|
|
|
push @{ $container->{taxo} }, $p->findvalue('@resource'); |
|
|
0
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
} |
|
191
|
0
|
|
|
|
|
|
$container->{$uri} = $container->{taxo}; |
|
192
|
|
|
|
|
|
|
} |
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub parse_misc_simple |
|
195
|
0
|
|
|
0
|
0
|
|
{ |
|
196
|
|
|
|
|
|
|
} |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub may_have_children { |
|
199
|
0
|
|
|
0
|
0
|
|
qw(channel item image textinput skipHours skipDays) |
|
200
|
|
|
|
|
|
|
} |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub parse_children |
|
203
|
|
|
|
|
|
|
{ |
|
204
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $node, $xpath) = @_; |
|
205
|
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
my %h; |
|
207
|
|
|
|
|
|
|
|
|
208
|
0
|
|
0
|
|
|
|
$xpath ||= './*'; |
|
209
|
0
|
|
|
|
|
|
my $xc = $c->create_xpath_context(scalar $c->namespaces); |
|
210
|
0
|
|
|
|
|
|
foreach my $child ($xc->findnodes($xpath, $node)) { |
|
211
|
0
|
|
|
|
|
|
my $prefix = $child->getPrefix(); |
|
212
|
0
|
|
|
|
|
|
my $name = $child->localname(); |
|
213
|
|
|
|
|
|
|
# XXX - this is probably the only case where we need to explicitly |
|
214
|
|
|
|
|
|
|
# normalize a name |
|
215
|
0
|
0
|
|
|
|
|
$name = 'textinput' if ($name eq 'textInput'); |
|
216
|
0
|
|
|
|
|
|
my $val = undef; |
|
217
|
0
|
0
|
|
|
|
|
if ($child->findnodes('./*')) { |
|
218
|
0
|
0
|
|
|
|
|
if (!grep { $_ eq $name } $self->may_have_children) { |
|
|
0
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
# Urk. Should have been encoded and wasn't! Stupid thing. |
|
220
|
0
|
|
|
|
|
|
$val = join '', map { $_->toString } $child->childNodes; |
|
|
0
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
} else { |
|
222
|
0
|
|
|
|
|
|
$val = $self->parse_children($c, $child); |
|
223
|
|
|
|
|
|
|
} |
|
224
|
|
|
|
|
|
|
} else { |
|
225
|
0
|
|
|
|
|
|
my $text = $child->textContent(); |
|
226
|
0
|
0
|
|
|
|
|
$text = '' if $text !~ /\S/ ; |
|
227
|
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
# argh. it has attributes. we do our little hack... |
|
229
|
0
|
0
|
|
|
|
|
if ($child->hasAttributes) { |
|
230
|
0
|
|
|
|
|
|
$val = XML::RSS::LibXML::MagicElement->new( |
|
231
|
|
|
|
|
|
|
content => $text, |
|
232
|
|
|
|
|
|
|
attributes => [ $child->attributes ] |
|
233
|
|
|
|
|
|
|
); |
|
234
|
|
|
|
|
|
|
} else { |
|
235
|
0
|
|
|
|
|
|
$val = $text; |
|
236
|
|
|
|
|
|
|
} |
|
237
|
|
|
|
|
|
|
} |
|
238
|
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# XXX - XML::RSS now can store multiple elements in a slot. |
|
240
|
|
|
|
|
|
|
# This we detect and change the underlying structure from a |
|
241
|
|
|
|
|
|
|
# scalar to an array |
|
242
|
|
|
|
|
|
|
|
|
243
|
0
|
0
|
|
|
|
|
if ($prefix) { |
|
244
|
0
|
|
0
|
|
|
|
$h{$prefix} ||= {}; |
|
245
|
0
|
|
|
|
|
|
$self->store_element($h{$prefix}, $name, $val); |
|
246
|
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
# XML::RSS requires us to allow access to elements both from |
|
248
|
|
|
|
|
|
|
# the prefix and the namespace |
|
249
|
0
|
|
0
|
|
|
|
$h{$c->{namespaces}{$prefix}} ||= {}; |
|
250
|
0
|
|
|
|
|
|
$self->store_element($h{$c->{namespaces}{$prefix}}, $name, $val); |
|
251
|
|
|
|
|
|
|
} else { |
|
252
|
0
|
|
|
|
|
|
$self->store_element(\%h, $name, $val); |
|
253
|
|
|
|
|
|
|
} |
|
254
|
|
|
|
|
|
|
} |
|
255
|
0
|
0
|
|
|
|
|
return wantarray ? %h : \%h; |
|
256
|
|
|
|
|
|
|
} |
|
257
|
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub as_string |
|
259
|
|
|
|
|
|
|
{ |
|
260
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $format) = @_; |
|
261
|
|
|
|
|
|
|
|
|
262
|
0
|
|
|
|
|
|
my $dom = $self->create_dom($c); |
|
263
|
0
|
|
|
|
|
|
return $dom->toString($format); |
|
264
|
|
|
|
|
|
|
} |
|
265
|
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
sub create_dom |
|
267
|
|
|
|
|
|
|
{ |
|
268
|
0
|
|
|
0
|
0
|
|
my ($self, $c) = @_; |
|
269
|
|
|
|
|
|
|
|
|
270
|
0
|
|
|
|
|
|
my $dom = $self->create_document($c); |
|
271
|
0
|
|
|
|
|
|
$self->create_dtd($c, $dom); |
|
272
|
0
|
|
|
|
|
|
$self->create_pi($c, $dom); |
|
273
|
0
|
|
|
|
|
|
$self->create_rootelement($c, $dom); |
|
274
|
0
|
|
|
|
|
|
$self->create_namespaces($c, $dom); |
|
275
|
0
|
|
|
|
|
|
$self->create_channel($c, $dom); |
|
276
|
0
|
|
|
|
|
|
$self->create_items($c, $dom); |
|
277
|
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
|
return $dom; |
|
279
|
|
|
|
|
|
|
} |
|
280
|
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub create_pi |
|
282
|
|
|
|
|
|
|
{ |
|
283
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $dom) = @_; |
|
284
|
|
|
|
|
|
|
|
|
285
|
0
|
|
|
|
|
|
my $styles = $c->stylesheets; |
|
286
|
0
|
|
|
|
|
|
foreach my $style (@$styles) { |
|
287
|
0
|
|
|
|
|
|
my $pi = $dom->createProcessingInstruction('xml-stylesheet'); |
|
288
|
0
|
|
|
|
|
|
$pi->setData(type => 'text/xsl', href => $style); |
|
289
|
0
|
|
|
|
|
|
$dom->appendChild($pi); |
|
290
|
|
|
|
|
|
|
} |
|
291
|
|
|
|
|
|
|
} |
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub create_document |
|
294
|
|
|
|
|
|
|
{ |
|
295
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
296
|
0
|
|
|
|
|
|
my $c = shift; |
|
297
|
0
|
|
|
|
|
|
return XML::LibXML::Document->new('1.0', $c->encoding); |
|
298
|
|
|
|
|
|
|
} |
|
299
|
|
|
|
|
|
|
|
|
300
|
0
|
|
|
0
|
0
|
|
sub create_rootelement {} |
|
301
|
0
|
|
|
0
|
0
|
|
sub create_dtd {} |
|
302
|
0
|
|
|
0
|
0
|
|
sub create_channel {} |
|
303
|
0
|
|
|
0
|
0
|
|
sub create_items {} |
|
304
|
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub create_misc_simple |
|
306
|
|
|
|
|
|
|
{ |
|
307
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $dom, $parent) = @_; |
|
308
|
|
|
|
|
|
|
|
|
309
|
0
|
|
|
|
|
|
my $definition = $self->definition; |
|
310
|
0
|
|
|
|
|
|
while (my($p, $children) = each %$definition) { |
|
311
|
0
|
0
|
|
|
|
|
next if ! $c->{$p}; |
|
312
|
|
|
|
|
|
|
|
|
313
|
0
|
|
|
|
|
|
my @nodes; |
|
314
|
0
|
|
|
|
|
|
while (my($e, $value) = each %$children) { |
|
315
|
0
|
0
|
|
|
|
|
if (defined $value) { |
|
316
|
0
|
|
|
|
|
|
my $node = $dom->createElement($e); |
|
317
|
0
|
|
|
|
|
|
$node->appendText($value); |
|
318
|
0
|
|
|
|
|
|
push @nodes, $node; |
|
319
|
|
|
|
|
|
|
} |
|
320
|
|
|
|
|
|
|
} |
|
321
|
|
|
|
|
|
|
|
|
322
|
0
|
0
|
|
|
|
|
if (@nodes) { |
|
323
|
0
|
|
|
|
|
|
my $local_parent = $dom->createElement($p); |
|
324
|
0
|
|
|
|
|
|
$local_parent->appendChild($_) for @nodes; |
|
325
|
0
|
|
|
|
|
|
$parent->appendChild($local_parent); |
|
326
|
|
|
|
|
|
|
} |
|
327
|
|
|
|
|
|
|
} |
|
328
|
|
|
|
|
|
|
} |
|
329
|
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub create_taxo |
|
331
|
|
|
|
|
|
|
{ |
|
332
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $dom, $parent) = @_; |
|
333
|
|
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
my $list = $c->{taxo}; |
|
335
|
0
|
0
|
0
|
|
|
|
if (! $list || @$list <= 0) { |
|
336
|
0
|
|
|
|
|
|
return; |
|
337
|
|
|
|
|
|
|
} |
|
338
|
|
|
|
|
|
|
|
|
339
|
0
|
|
|
|
|
|
my $topic = $dom->createElement('taxo:topics'); |
|
340
|
0
|
|
|
|
|
|
my $bag = $dom->createElement('rdf:Bag'); |
|
341
|
0
|
|
|
|
|
|
foreach my $taxo (@$list) { |
|
342
|
0
|
|
|
|
|
|
my $node = $dom->createElement('rdf:li'); |
|
343
|
0
|
|
|
|
|
|
$node->setAttribute(resource => $taxo); |
|
344
|
0
|
|
|
|
|
|
$bag->appendChild($node); |
|
345
|
|
|
|
|
|
|
} |
|
346
|
0
|
|
|
|
|
|
$topic->appendChild($bag); |
|
347
|
0
|
|
|
|
|
|
$parent->appendChild($topic); |
|
348
|
|
|
|
|
|
|
} |
|
349
|
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
sub create_extra_modules |
|
351
|
|
|
|
|
|
|
{ |
|
352
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $dom, $parent, $namespaces) = @_; |
|
353
|
|
|
|
|
|
|
|
|
354
|
0
|
|
|
|
|
|
while (my ($prefix, $uri) = each %$namespaces) { |
|
355
|
0
|
0
|
|
|
|
|
next if $prefix =~ /^(?:dc|syn|taxo|rss\d\d)$/; |
|
356
|
0
|
0
|
|
|
|
|
next if ! defined $c->{$prefix}; |
|
357
|
|
|
|
|
|
|
|
|
358
|
0
|
|
|
|
|
|
while (my($e, $value) = each %{ $c->{$prefix} }) { |
|
|
0
|
|
|
|
|
|
|
|
359
|
0
|
|
|
|
|
|
my $node = $dom->createElement("$prefix:$e"); |
|
360
|
0
|
|
|
|
|
|
$node->appendText($value); |
|
361
|
0
|
|
|
|
|
|
$parent->appendChild($node); |
|
362
|
|
|
|
|
|
|
} |
|
363
|
|
|
|
|
|
|
} |
|
364
|
|
|
|
|
|
|
} |
|
365
|
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub create_namespaces |
|
367
|
|
|
|
|
|
|
{ |
|
368
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
369
|
0
|
|
|
|
|
|
my $c = shift; |
|
370
|
0
|
|
|
|
|
|
my $dom = shift; |
|
371
|
0
|
0
|
|
|
|
|
my $root = $dom->getDocumentElement() or |
|
372
|
|
|
|
|
|
|
croak "No document element found?!"; |
|
373
|
0
|
|
|
|
|
|
my $namespaces = $c->namespaces; |
|
374
|
0
|
|
|
|
|
|
while (my($prefix, $url) = each %$namespaces) { |
|
375
|
0
|
0
|
|
|
|
|
next if $prefix =~ /^rss\d\d$/; |
|
376
|
0
|
0
|
|
|
|
|
next if $prefix =~ /^#default$/; |
|
377
|
0
|
|
|
|
|
|
$root->setNamespace($url, $prefix, 0); |
|
378
|
|
|
|
|
|
|
} |
|
379
|
|
|
|
|
|
|
} |
|
380
|
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub create_element_from_spec |
|
382
|
|
|
|
|
|
|
{ |
|
383
|
0
|
|
|
0
|
0
|
|
my ($self, $c, $dom, $parent, $specs) = @_; |
|
384
|
|
|
|
|
|
|
|
|
385
|
0
|
|
|
|
|
|
my $root = $dom->getDocumentElement(); |
|
386
|
|
|
|
|
|
|
|
|
387
|
0
|
|
|
|
|
|
my $node; |
|
388
|
0
|
|
|
|
|
|
while (my ($e, $spec) = each %$specs) { |
|
389
|
0
|
|
|
|
|
|
my( $callback, $list ); |
|
390
|
0
|
0
|
|
|
|
|
if (ref $spec eq 'HASH') { |
|
|
|
0
|
|
|
|
|
|
|
391
|
0
|
|
|
|
|
|
$callback = $spec->{callback}; |
|
392
|
0
|
|
|
|
|
|
$list = $spec->{candidates}; |
|
393
|
|
|
|
|
|
|
} elsif (ref $spec eq 'ARRAY') { |
|
394
|
0
|
|
|
|
|
|
$list = $spec; |
|
395
|
|
|
|
|
|
|
} |
|
396
|
0
|
|
|
|
|
|
foreach my $p (@$list) { |
|
397
|
0
|
|
|
|
|
|
my ($prefix, $value); |
|
398
|
0
|
0
|
0
|
|
|
|
if (ref $p && ref $p eq 'HASH') { |
|
399
|
0
|
0
|
|
|
|
|
if ($c->{$p->{module}}) { |
|
400
|
0
|
|
|
|
|
|
$prefix = $p->{module}; |
|
401
|
0
|
|
|
|
|
|
$value = $c->{$p->{module}}{$p->{element}}; |
|
402
|
|
|
|
|
|
|
} |
|
403
|
|
|
|
|
|
|
} else { |
|
404
|
0
|
|
|
|
|
|
$value = $c->{$p}; |
|
405
|
|
|
|
|
|
|
} |
|
406
|
|
|
|
|
|
|
|
|
407
|
0
|
0
|
|
|
|
|
if (defined $value) { |
|
408
|
0
|
0
|
|
|
|
|
if ($prefix) { |
|
409
|
0
|
|
|
|
|
|
$root->setNamespace( |
|
410
|
|
|
|
|
|
|
XML::RSS::LibXML::Namespaces::lookup_uri($prefix), |
|
411
|
|
|
|
|
|
|
$prefix, |
|
412
|
|
|
|
|
|
|
0 |
|
413
|
|
|
|
|
|
|
); |
|
414
|
|
|
|
|
|
|
} |
|
415
|
|
|
|
|
|
|
|
|
416
|
0
|
|
|
|
|
|
$node = $dom->createElement($e); |
|
417
|
0
|
0
|
0
|
|
|
|
if (ref $value && eval { $value->isa('XML::RSS::LibXML::MagicElement') }) { |
|
|
0
|
0
|
|
|
|
|
|
|
418
|
0
|
|
|
|
|
|
foreach my $attr ($value->attributes) { |
|
419
|
0
|
|
|
|
|
|
$node->setAttribute($attr, $value->{$attr}); |
|
420
|
|
|
|
|
|
|
} |
|
421
|
|
|
|
|
|
|
} elsif ($callback) { |
|
422
|
0
|
|
|
|
|
|
$callback->($value); |
|
423
|
|
|
|
|
|
|
} |
|
424
|
0
|
|
|
|
|
|
$node->appendText($value); |
|
425
|
0
|
|
|
|
|
|
$parent->appendChild($node); |
|
426
|
0
|
|
|
|
|
|
last; |
|
427
|
|
|
|
|
|
|
} |
|
428
|
|
|
|
|
|
|
} |
|
429
|
|
|
|
|
|
|
} |
|
430
|
|
|
|
|
|
|
} |
|
431
|
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
sub add_item |
|
433
|
|
|
|
|
|
|
{ |
|
434
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
435
|
0
|
|
|
|
|
|
my $c = shift; |
|
436
|
0
|
0
|
|
|
|
|
my $h = ref($_[0]) eq 'HASH' ? $_[0] : {@_}; |
|
437
|
|
|
|
|
|
|
|
|
438
|
0
|
|
|
|
|
|
$self->validate_item($c, $h); |
|
439
|
|
|
|
|
|
|
|
|
440
|
0
|
|
|
|
|
|
my $guid = $h->{guid}; |
|
441
|
0
|
0
|
|
|
|
|
if (defined $guid) { |
|
|
|
0
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
# guid should *only* be MagicElement |
|
443
|
0
|
0
|
|
|
|
|
if (! eval { $guid->isa('XML::RSS::LibXML::MagicElement') }) { |
|
|
0
|
|
|
|
|
|
|
|
444
|
0
|
|
|
|
|
|
$h->{permaLink} = $guid; |
|
445
|
|
|
|
|
|
|
} else { |
|
446
|
0
|
0
|
|
|
|
|
if (my $is_permalink = $guid->{isPermaLink}) { |
|
447
|
0
|
0
|
|
|
|
|
if ($is_permalink eq 'true') { |
|
448
|
0
|
|
|
|
|
|
$h->{permaLink} = $guid->{_content}; |
|
449
|
|
|
|
|
|
|
} |
|
450
|
|
|
|
|
|
|
} else { |
|
451
|
0
|
|
|
|
|
|
$h->{permaLink} = $guid->{_content}; |
|
452
|
|
|
|
|
|
|
} |
|
453
|
|
|
|
|
|
|
} |
|
454
|
|
|
|
|
|
|
} elsif (defined (my $permaLink = $h->{permaLink})) { |
|
455
|
0
|
|
|
|
|
|
$h->{guid} = XML::RSS::LibXML::MagicElement->new( |
|
456
|
|
|
|
|
|
|
content => $permaLink, |
|
457
|
|
|
|
|
|
|
attributes => { isPermaLink => 'true' } |
|
458
|
|
|
|
|
|
|
); |
|
459
|
|
|
|
|
|
|
} |
|
460
|
|
|
|
|
|
|
|
|
461
|
0
|
|
|
|
|
|
my $namespaces = $c->namespaces; |
|
462
|
0
|
|
|
|
|
|
foreach my $p (keys %$namespaces) { |
|
463
|
0
|
0
|
|
|
|
|
if ($h->{$p}) { |
|
464
|
0
|
|
|
|
|
|
$h->{ $namespaces->{$p} } = $h->{$p}; |
|
465
|
|
|
|
|
|
|
} |
|
466
|
|
|
|
|
|
|
} |
|
467
|
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
# add the item to the list |
|
469
|
0
|
0
|
0
|
|
|
|
if (defined($h->{mode}) && delete $h->{mode} eq 'insert') { |
|
470
|
0
|
|
|
|
|
|
unshift(@{$c->items}, $h); |
|
|
0
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
} |
|
472
|
|
|
|
|
|
|
else { |
|
473
|
0
|
|
|
|
|
|
push(@{$c->items}, $h); |
|
|
0
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
} |
|
475
|
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
# return reference to the list of items |
|
477
|
0
|
|
|
|
|
|
return $c->{items}; |
|
478
|
|
|
|
|
|
|
} |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
1; |
|
481
|
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
__END__ |