blib/lib/WebService/YouTube/Feeds.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 25 | 27 | 92.5 |
branch | n/a | ||
condition | n/a | ||
subroutine | 9 | 9 | 100.0 |
pod | n/a | ||
total | 34 | 36 | 94.4 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # | ||||||
2 | # $Id: Feeds.pm 11 2007-04-09 04:34:01Z hironori.yoshida $ | ||||||
3 | # | ||||||
4 | package WebService::YouTube::Feeds; | ||||||
5 | 3 | 3 | 916 | use strict; | |||
3 | 6 | ||||||
3 | 107 | ||||||
6 | 3 | 3 | 16 | use warnings; | |||
3 | 6 | ||||||
3 | 320 | ||||||
7 | 3 | 3 | 17 | use version; our $VERSION = qv('1.0.3'); | |||
3 | 6 | ||||||
3 | 23 | ||||||
8 | |||||||
9 | 3 | 3 | 332 | use Carp; | |||
3 | 15 | ||||||
3 | 208 | ||||||
10 | 3 | 3 | 4917 | use HTTP::Date; | |||
3 | 16127 | ||||||
3 | 200 | ||||||
11 | 3 | 3 | 4653 | use LWP::UserAgent; | |||
3 | 156904 | ||||||
3 | 114 | ||||||
12 | 3 | 3 | 3069 | use WebService::YouTube::Util; | |||
3 | 15 | ||||||
3 | 129 | ||||||
13 | 3 | 3 | 2732 | use WebService::YouTube::Video; | |||
3 | 11 | ||||||
3 | 32 | ||||||
14 | 3 | 3 | 1882 | use XML::Simple; | |||
0 | |||||||
0 | |||||||
15 | |||||||
16 | use base qw(Class::Accessor::Fast); | ||||||
17 | |||||||
18 | __PACKAGE__->mk_accessors(qw(ua)); | ||||||
19 | |||||||
20 | BEGIN { | ||||||
21 | my @global_rss = qw( | ||||||
22 | recently_added | ||||||
23 | recently_featured | ||||||
24 | top_favorites | ||||||
25 | top_rated | ||||||
26 | most_discussed_month | ||||||
27 | most_discussed_today | ||||||
28 | most_discussed_week | ||||||
29 | top_viewed | ||||||
30 | top_viewed_month | ||||||
31 | top_viewed_today | ||||||
32 | top_viewed_week | ||||||
33 | ); | ||||||
34 | |||||||
35 | foreach my $global_rss (@global_rss) { | ||||||
36 | my $class = __PACKAGE__; | ||||||
37 | no strict qw(refs); ## no critic (ProhibitNoStrict) | ||||||
38 | *{"${class}::$global_rss"} = sub { | ||||||
39 | my $self = shift; | ||||||
40 | return $self->_process( global => $global_rss ); | ||||||
41 | }; | ||||||
42 | } | ||||||
43 | } | ||||||
44 | |||||||
45 | sub new { | ||||||
46 | my ( $class, @args ) = @_; | ||||||
47 | |||||||
48 | my $self = $class->SUPER::new(@args); | ||||||
49 | if ( !$self->ua ) { | ||||||
50 | $self->ua( LWP::UserAgent->new ); | ||||||
51 | } | ||||||
52 | return $self; | ||||||
53 | } | ||||||
54 | |||||||
55 | sub parse_rss { | ||||||
56 | my ( $self, $rss ) = @_; | ||||||
57 | |||||||
58 | # hack for a problem caused by control code. | ||||||
59 | $rss =~ s/(=KjYe06lbN7U[^\x03]+)\x03/$1/gmsx; | ||||||
60 | |||||||
61 | my $result = XMLin( $rss, NSExpand => 1 ); | ||||||
62 | |||||||
63 | # These are different between each RSS. | ||||||
64 | if ( !$result->{channel}->{link} ) { | ||||||
65 | carp qq{!$result->{channel}->{link}}; | ||||||
66 | } | ||||||
67 | if ( !$result->{channel}->{title} ) { | ||||||
68 | carp qq{!$result->{channel}->{title}}; | ||||||
69 | } | ||||||
70 | if ( !$result->{channel}->{description} ) { | ||||||
71 | carp qq{!$result->{channel}->{description}}; | ||||||
72 | } | ||||||
73 | |||||||
74 | my $mrss = 'http://search.yahoo.com/mrss/'; # namespace | ||||||
75 | |||||||
76 | # extract data | ||||||
77 | my @videos; | ||||||
78 | foreach my $item ( @{ $result->{channel}->{item} } ) { | ||||||
79 | my $author = $item->{"{$mrss}credit"}; | ||||||
80 | my $url = $item->{"{$mrss}player"}->{url}; | ||||||
81 | ( my $id = $url ) =~ s/^.+\?v=//msx; | ||||||
82 | my $title = $item->{"{$mrss}title"}; | ||||||
83 | my $length_seconds = $item->{enclosure}->{length}; | ||||||
84 | my $upload_time = str2time( $item->{pubDate} ); | ||||||
85 | my $tags = $item->{"{$mrss}category"}->{content}; | ||||||
86 | my $thumbnail_url = $item->{"{$mrss}thumbnail"}->{url}; | ||||||
87 | |||||||
88 | my $description_xhtml = $item->{description}; | ||||||
89 | my ($description) = | ||||||
90 | $description_xhtml =~ m{.+ \s+(.+?)\s+ \s+}msx; |
||||||
91 | |||||||
92 | my $thumbnail_width = $item->{"{$mrss}thumbnail"}->{width}; | ||||||
93 | my $thumbnail_height = $item->{"{$mrss}thumbnail"}->{height}; | ||||||
94 | |||||||
95 | # assertion | ||||||
96 | if ( $item->{"{$mrss}category"}->{label} ne 'Tags' ) { | ||||||
97 | carp qq{$item->{"{$mrss}category"}->{label} ne 'Tags'}; | ||||||
98 | } | ||||||
99 | if ( $item->{enclosure}->{url} ne "http://youtube.com/v/$id.swf" ) { | ||||||
100 | carp | ||||||
101 | qq{$item->{enclosure}->{url} ne "http://youtube.com/v/$id.swf"}; | ||||||
102 | } | ||||||
103 | if ( $item->{enclosure}->{type} ne 'application/x-shockwave-flash' ) { | ||||||
104 | carp | ||||||
105 | qq{$item->{enclosure}->{type} ne 'application/x-shockwave-flash'}; | ||||||
106 | } | ||||||
107 | if ( $item->{author} ne "rss\@youtube.com ($author)" ) { | ||||||
108 | carp qq{$item->{author} ne "rss\@youtube.com ($author)"}; | ||||||
109 | } | ||||||
110 | if ( $item->{title} ne $title ) { | ||||||
111 | carp qq{$item->{title} ne $title}; | ||||||
112 | } | ||||||
113 | if ( $item->{guid}->{isPermaLink} ne 'true' ) { | ||||||
114 | carp qq{$item->{guid}->{isPermaLink} ne 'true'}; | ||||||
115 | } | ||||||
116 | if ( $item->{guid}->{content} ne $url ) { | ||||||
117 | carp qq{$item->{guid}->{content} ne $url}; | ||||||
118 | } | ||||||
119 | if ( $item->{link} ne $url ) { | ||||||
120 | carp qq{$item->{link} ne $url}; | ||||||
121 | } | ||||||
122 | |||||||
123 | my $video = WebService::YouTube::Video->new( | ||||||
124 | { | ||||||
125 | author => $author, | ||||||
126 | id => $id, | ||||||
127 | title => $title, | ||||||
128 | length_seconds => $length_seconds, | ||||||
129 | rating_avg => undef, | ||||||
130 | rating_count => undef, | ||||||
131 | description => $description, | ||||||
132 | view_count => undef, | ||||||
133 | upload_time => $upload_time, | ||||||
134 | comment_count => undef, | ||||||
135 | tags => $tags, | ||||||
136 | url => $url, | ||||||
137 | thumbnail_url => $thumbnail_url, | ||||||
138 | } | ||||||
139 | ); | ||||||
140 | push @videos, $video; | ||||||
141 | } | ||||||
142 | return @videos; | ||||||
143 | } | ||||||
144 | |||||||
145 | sub tag { | ||||||
146 | my ( $self, $tag ) = @_; | ||||||
147 | |||||||
148 | return $self->_process( tag => $tag ); | ||||||
149 | } | ||||||
150 | |||||||
151 | sub user { | ||||||
152 | my ( $self, $user ) = @_; | ||||||
153 | |||||||
154 | return $self->_process( user => $user ); | ||||||
155 | } | ||||||
156 | |||||||
157 | sub _process { | ||||||
158 | my ( $self, $type, $arg ) = @_; | ||||||
159 | |||||||
160 | my $uri = WebService::YouTube::Util->rss_uri( $type, $arg ); | ||||||
161 | my $res = $self->ua->get($uri); | ||||||
162 | if ( !$res->is_success ) { | ||||||
163 | carp $res->status_line; | ||||||
164 | return; | ||||||
165 | } | ||||||
166 | return $self->parse_rss( $res->content ); | ||||||
167 | } | ||||||
168 | |||||||
169 | 1; | ||||||
170 | |||||||
171 | __END__ |