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__ |