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