line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package XML::Feed; |
2
|
28
|
|
|
28
|
|
513298
|
use strict; |
|
28
|
|
|
|
|
64
|
|
|
28
|
|
|
|
|
798
|
|
3
|
28
|
|
|
28
|
|
142
|
use warnings; |
|
28
|
|
|
|
|
48
|
|
|
28
|
|
|
|
|
888
|
|
4
|
|
|
|
|
|
|
|
5
|
28
|
|
|
28
|
|
155
|
use base qw( Class::ErrorHandler ); |
|
28
|
|
|
|
|
53
|
|
|
28
|
|
|
|
|
21800
|
|
6
|
28
|
|
|
28
|
|
27595
|
use Feed::Find; |
|
28
|
|
|
|
|
1708065
|
|
|
28
|
|
|
|
|
955
|
|
7
|
28
|
|
|
28
|
|
22169
|
use URI::Fetch; |
|
28
|
|
|
|
|
2188181
|
|
|
28
|
|
|
|
|
1026
|
|
8
|
28
|
|
|
28
|
|
242
|
use LWP::UserAgent; |
|
28
|
|
|
|
|
59
|
|
|
28
|
|
|
|
|
614
|
|
9
|
28
|
|
|
28
|
|
180
|
use Carp; |
|
28
|
|
|
|
|
61
|
|
|
28
|
|
|
|
|
1849
|
|
10
|
28
|
|
|
28
|
|
158
|
use Scalar::Util 'blessed'; |
|
28
|
|
|
|
|
61
|
|
|
28
|
|
|
|
|
1605
|
|
11
|
28
|
|
|
|
|
204
|
use Module::Pluggable search_path => "XML::Feed::Format", |
12
|
|
|
|
|
|
|
require => 1, |
13
|
28
|
|
|
28
|
|
25159
|
sub_name => 'formatters'; |
|
28
|
|
|
|
|
357666
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = '0.53'; |
16
|
|
|
|
|
|
|
our $MULTIPLE_ENCLOSURES = 0; |
17
|
|
|
|
|
|
|
our @formatters; |
18
|
|
|
|
|
|
|
BEGIN { |
19
|
28
|
|
|
28
|
|
3634
|
@formatters = __PACKAGE__->formatters; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub new { |
23
|
7
|
|
|
7
|
1
|
1302
|
my $class = shift; |
24
|
7
|
|
100
|
|
|
42
|
my $format = shift || 'Atom'; |
25
|
7
|
|
|
|
|
23
|
my $format_class = 'XML::Feed::Format::' . $format; |
26
|
7
|
|
|
7
|
|
597
|
eval "use $format_class"; |
|
7
|
|
|
|
|
149
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
27
|
7
|
50
|
|
|
|
2441
|
Carp::croak("Unsupported format $format: $@") if $@; |
28
|
0
|
|
|
|
|
0
|
my $feed = bless {}, join('::', __PACKAGE__, "Format", $format); |
29
|
0
|
0
|
|
|
|
0
|
$feed->init_empty(@_) or return $class->error($feed->errstr); |
30
|
0
|
|
|
|
|
0
|
$feed; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
0
|
|
|
0
|
0
|
0
|
sub init_empty { 1 } |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
sub parse { |
36
|
17
|
|
|
17
|
1
|
4002
|
my $class = shift; |
37
|
17
|
|
|
|
|
50
|
my($stream, $specified_format) = @_; |
38
|
17
|
50
|
|
|
|
80
|
return $class->error("Stream parameter is required") unless $stream; |
39
|
17
|
|
|
|
|
57
|
my $feed = bless {}, $class; |
40
|
17
|
|
|
|
|
40
|
my $xml = ''; |
41
|
17
|
50
|
33
|
|
|
311
|
if (blessed($stream) and $stream->isa('URI')) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
42
|
0
|
|
|
|
|
0
|
my $ua = LWP::UserAgent->new; |
43
|
0
|
|
|
|
|
0
|
$ua->agent(__PACKAGE__ . "/$VERSION"); |
44
|
0
|
|
|
|
|
0
|
$ua->env_proxy; # force allowing of proxies |
45
|
0
|
0
|
|
|
|
0
|
my $res = URI::Fetch->fetch($stream, UserAgent => $ua) |
46
|
|
|
|
|
|
|
or return $class->error(URI::Fetch->errstr); |
47
|
0
|
0
|
|
|
|
0
|
return $class->error("This feed has been permanently removed") |
48
|
|
|
|
|
|
|
if $res->status == URI::Fetch::URI_GONE(); |
49
|
0
|
|
|
|
|
0
|
$xml = $res->content; |
50
|
|
|
|
|
|
|
} elsif (ref($stream) eq 'SCALAR') { |
51
|
0
|
|
|
|
|
0
|
$xml = $$stream; |
52
|
|
|
|
|
|
|
} elsif (ref($stream)) { |
53
|
0
|
|
|
|
|
0
|
while (read($stream, my($chunk), 8192)) { |
54
|
0
|
|
|
|
|
0
|
$xml .= $chunk; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
} else { |
57
|
17
|
50
|
|
|
|
790
|
open my $fh, $stream |
58
|
|
|
|
|
|
|
or return $class->error("Can't open $stream: $!"); |
59
|
17
|
|
|
|
|
598
|
while (read $fh, my($chunk), 8192) { |
60
|
18
|
|
|
|
|
131
|
$xml .= $chunk; |
61
|
|
|
|
|
|
|
} |
62
|
17
|
|
|
|
|
170
|
close $fh; |
63
|
|
|
|
|
|
|
} |
64
|
17
|
50
|
|
|
|
64
|
return $class->error("Can't get feed XML content from $stream") |
65
|
|
|
|
|
|
|
unless $xml; |
66
|
17
|
|
|
|
|
35
|
my $format; |
67
|
17
|
50
|
|
|
|
54
|
if ($specified_format) { |
68
|
0
|
|
|
|
|
0
|
$format = $specified_format; |
69
|
|
|
|
|
|
|
} else { |
70
|
17
|
50
|
|
|
|
86
|
$format = $feed->identify_format(\$xml) or return $class->error($feed->errstr); |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
0
|
my $format_class = join '::', __PACKAGE__, "Format", $format; |
74
|
0
|
|
|
|
|
0
|
eval "use $format_class"; |
75
|
0
|
0
|
|
|
|
0
|
return $class->error("Unsupported format $format: $@") if $@; |
76
|
0
|
|
|
|
|
0
|
bless $feed, $format_class; |
77
|
0
|
0
|
|
|
|
0
|
$feed->init_string(\$xml) or return $class->error($feed->errstr); |
78
|
0
|
|
|
|
|
0
|
$feed; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub identify_format { |
82
|
17
|
|
|
17
|
1
|
38
|
my $feed = shift; |
83
|
17
|
|
|
|
|
32
|
my($xml) = @_; |
84
|
17
|
|
|
|
|
63
|
foreach my $class (@formatters) { |
85
|
17
|
|
|
|
|
154
|
my ($name) = ($class =~ m!([^:]+)$!); |
86
|
|
|
|
|
|
|
# TODO ugly |
87
|
17
|
|
|
|
|
52
|
my $tmp = $$xml; |
88
|
17
|
50
|
|
|
|
33
|
return $name if eval { $class->identify(\$tmp) }; |
|
17
|
|
|
|
|
478
|
|
89
|
17
|
50
|
|
|
|
206
|
return $feed->error($@) if $@; |
90
|
|
|
|
|
|
|
} |
91
|
0
|
|
|
|
|
0
|
return $feed->error("Cannot detect feed type"); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub _get_first_tag { |
95
|
0
|
|
|
0
|
|
0
|
my $class = shift; |
96
|
0
|
|
|
|
|
0
|
my ($xml) = @_; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
## Auto-detect feed type based on first element. This is prone |
100
|
|
|
|
|
|
|
## to breakage, but then again we don't want to parse the whole |
101
|
|
|
|
|
|
|
## feed ourselves. |
102
|
0
|
|
|
|
|
0
|
my $tag; |
103
|
0
|
|
|
|
|
0
|
while ($$xml =~ /<(\S+)/sg) { |
104
|
0
|
|
|
|
|
0
|
(my $t = $1) =~ tr/a-zA-Z0-9:\-\?!//cd; |
105
|
0
|
|
|
|
|
0
|
my $first = substr $t, 0, 1; |
106
|
0
|
0
|
0
|
|
|
0
|
$tag = $t, last unless $first eq '?' || $first eq '!'; |
107
|
|
|
|
|
|
|
} |
108
|
0
|
0
|
|
|
|
0
|
die ("Cannot find first element") unless $tag; |
109
|
0
|
|
|
|
|
0
|
$tag =~ s/^.*://; |
110
|
0
|
|
|
|
|
0
|
return $tag; |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub find_feeds { |
114
|
0
|
|
|
0
|
1
|
0
|
my $class = shift; |
115
|
0
|
|
|
|
|
0
|
my($uri) = @_; |
116
|
0
|
0
|
|
|
|
0
|
my @feeds = Feed::Find->find($uri) |
117
|
|
|
|
|
|
|
or return $class->error(Feed::Find->errstr); |
118
|
0
|
|
|
|
|
0
|
@feeds; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
sub convert { |
122
|
0
|
|
|
0
|
1
|
0
|
my $feed = shift; |
123
|
0
|
|
|
|
|
0
|
my($format) = @_; |
124
|
0
|
|
|
|
|
0
|
my $new = XML::Feed->new($format); |
125
|
0
|
|
|
|
|
0
|
for my $field (qw( title link description language author copyright modified generator )) { |
126
|
0
|
|
|
|
|
0
|
my $val = $feed->$field(); |
127
|
0
|
0
|
|
|
|
0
|
next unless defined $val; |
128
|
0
|
|
|
|
|
0
|
$new->$field($val); |
129
|
|
|
|
|
|
|
} |
130
|
0
|
|
|
|
|
0
|
for my $entry ($feed->entries) { |
131
|
0
|
|
|
|
|
0
|
$new->add_entry($entry->convert($format)); |
132
|
|
|
|
|
|
|
} |
133
|
0
|
|
|
|
|
0
|
$new; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub splice { |
137
|
0
|
|
|
0
|
1
|
0
|
my $feed = shift; |
138
|
0
|
|
|
|
|
0
|
my($other) = @_; |
139
|
0
|
|
|
|
|
0
|
my %ids = map { $_->id => 1 } $feed->entries; |
|
0
|
|
|
|
|
0
|
|
140
|
0
|
|
|
|
|
0
|
for my $entry ($other->entries) { |
141
|
0
|
0
|
|
|
|
0
|
$feed->add_entry($entry) unless $ids{$entry->id}++; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub _convert_entry { |
146
|
0
|
|
|
0
|
|
0
|
my $feed = shift; |
147
|
0
|
|
|
|
|
0
|
my $entry = shift; |
148
|
0
|
|
|
|
|
0
|
my $feed_format = ref($feed); $feed_format =~ s!^XML::Feed::Format::!!; |
|
0
|
|
|
|
|
0
|
|
149
|
0
|
|
|
|
|
0
|
my $entry_format = ref($entry); $entry_format =~ s!^XML::Feed::Entry::Format::!!; |
|
0
|
|
|
|
|
0
|
|
150
|
0
|
0
|
|
|
|
0
|
return $entry if $entry_format eq $feed_format; |
151
|
0
|
|
|
|
|
0
|
return $entry->convert($feed_format); |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub base; |
155
|
|
|
|
|
|
|
sub format; |
156
|
|
|
|
|
|
|
sub title; |
157
|
|
|
|
|
|
|
sub link; |
158
|
|
|
|
|
|
|
sub self_link; |
159
|
|
|
|
|
|
|
sub description; |
160
|
|
|
|
|
|
|
sub language; |
161
|
|
|
|
|
|
|
sub author; |
162
|
|
|
|
|
|
|
sub copyright; |
163
|
|
|
|
|
|
|
sub modified; |
164
|
|
|
|
|
|
|
sub generator; |
165
|
|
|
|
|
|
|
sub add_entry; |
166
|
|
|
|
|
|
|
sub entries; |
167
|
|
|
|
|
|
|
sub as_xml; |
168
|
|
|
|
|
|
|
sub id; |
169
|
|
|
|
|
|
|
sub image; |
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
0
|
1
|
0
|
sub tagline { shift->description(@_) } |
172
|
0
|
|
|
0
|
1
|
0
|
sub items { $_[0]->entries } |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# RFC 5005 |
175
|
|
|
|
|
|
|
sub first_link; |
176
|
|
|
|
|
|
|
sub last_link; |
177
|
|
|
|
|
|
|
sub previous_link; |
178
|
|
|
|
|
|
|
sub next_link; |
179
|
|
|
|
|
|
|
sub current_link; |
180
|
|
|
|
|
|
|
sub prev_archive_link; |
181
|
|
|
|
|
|
|
sub next_archive_link; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
1; |
184
|
|
|
|
|
|
|
__END__ |