File Coverage

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__