root/lang/perl/WebService-YouTube/tags/WebService-YouTube-1.0.2/lib/WebService/YouTube/Feeds.pm @ 202

Revision 202, 8.7 kB (checked in by otsune, 7 years ago)

import Ustreamer(broken XXX version)
dotfiles/vimperator/ : import otsune's ~/.vimperator

Line 
1#
2# $Id: Feeds.pm 11 2007-04-09 04:34:01Z hironori.yoshida $
3#
4package WebService::YouTube::Feeds;
5use strict;
6use warnings;
7use version; our $VERSION = qv('1.0.1');
8
9use Carp;
10use HTTP::Date;
11use LWP::UserAgent;
12use WebService::YouTube::Util;
13use WebService::YouTube::Video;
14use XML::Simple;
15
16use base qw(Class::Accessor::Fast);
17
18__PACKAGE__->mk_accessors(qw(ua));
19
20BEGIN {
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
45sub new {
46    my $class = shift;
47
48    my $self = $class->SUPER::new(@_);
49    if ( !$self->ua ) {
50        $self->ua( LWP::UserAgent->new );
51    }
52    return $self;
53}
54
55sub 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{.+<p>\s+(.+?)\s+</p>\s+<p>}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
145sub tag {
146    my ( $self, $tag ) = @_;
147
148    return $self->_process( tag => $tag );
149}
150
151sub user {
152    my ( $self, $user ) = @_;
153
154    return $self->_process( user => $user );
155}
156
157sub _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
1691;
170
171__END__
172
173=head1 NAME
174
175WebService::YouTube::Feeds - Perl interfece to YouTube RSS Feeds
176
177=head1 VERSION
178
179This document describes WebService::YouTube::Feeds version 1.0.1
180
181=head1 SYNOPSIS
182
183    use WebService::YouTube::Feeds;
184   
185    my $feeds = WebService::YouTube::Feeds->new( { ua => '...' } );
186   
187    my @videos = $feeds->tag($tag);
188    my @videos = $feeds->user($user);
189    my @videos = $feeds->recently_added;
190    my @videos = $feeds->recently_featured;
191    my @videos = $feeds->top_favorites;
192    my @videos = $feeds->top_rated;
193    my @videos = $feeds->most_discussed_month;
194    my @videos = $feeds->most_discussed_today;
195    my @videos = $feeds->most_discussed_week;
196    my @videos = $feeds->top_viewed;
197    my @videos = $feeds->top_viewed_month;
198    my @videos = $feeds->top_viewed_today;
199    my @videos = $feeds->top_viewed_week;
200
201=head1 DESCRIPTION
202
203This is a Perl interface to YouTube RSS Feeds.
204
205See B<About RSS> L<http://youtube.com/rssls> for details.
206
207=head1 SUBROUTINES/METHODS
208
209=head2 new( \%fields )
210
211Creates and returns a new WebService::YouTube::Feeds object.
212%fields can contain parameters enumerated in L</ACCESSORS> section.
213
214=head2 parse_rss($rss)
215
216Parses RSS and returns the result.
217$rss should be an object that L<XML::Simple> can understand.
218
219=head2 tag( $tag )
220
221Returns an array of L<WebService::YouTube::Video> object.
222$tag is a keyword string separated by a space.
223
224See L<http://youtube.com/rssls> for details.
225
226=head2 user( $user )
227
228Returns an array of L<WebService::YouTube::Video> object.
229$user is an username.
230
231See L<http://youtube.com/rssls> for details.
232
233=head2 recently_added( )
234
235Returns an array of L<WebService::YouTube::Video> object.
236
237See L<http://youtube.com/rssls> for details.
238
239=head2 recently_featured( )
240
241Returns an array of L<WebService::YouTube::Video> object.
242
243See L<http://youtube.com/rssls> for details.
244
245=head2 top_favorites( )
246
247Returns an array of L<WebService::YouTube::Video> object.
248
249See L<http://youtube.com/rssls> for details.
250
251=head2 top_rated( )
252
253Returns an array of L<WebService::YouTube::Video> object.
254
255See L<http://youtube.com/rssls> for details.
256
257=head2 most_discussed_month( )
258
259Returns an array of L<WebService::YouTube::Video> object.
260
261See L<http://youtube.com/rssls> for details.
262
263=head2 most_discussed_today( )
264
265Returns an array of L<WebService::YouTube::Video> object.
266
267See L<http://youtube.com/rssls> for details.
268
269=head2 most_discussed_week( )
270
271Returns an array of L<WebService::YouTube::Video> object.
272
273See L<http://youtube.com/rssls> for details.
274
275=head2 top_viewed( )
276
277Returns an array of L<WebService::YouTube::Video> object.
278
279See L<http://youtube.com/rssls> for details.
280
281=head2 top_viewed_month( )
282
283Returns an array of L<WebService::YouTube::Video> object.
284
285See L<http://youtube.com/rssls> for details.
286
287=head2 top_viewed_today( )
288
289Returns an array of L<WebService::YouTube::Video> object.
290
291See L<http://youtube.com/rssls> for details.
292
293=head2 top_viewed_week( )
294
295Returns an array of L<WebService::YouTube::Video> object.
296
297See L<http://youtube.com/rssls> for details.
298
299=head2 ACCESSORS
300
301=head3 ua
302
303L<LWP::UserAgent> object
304
305=head1 DIAGNOSTICS
306
307=head1 CONFIGURATION AND ENVIRONMENT
308
309WebService::YouTube::Feeds requires no configuration files or environment variables.
310
311=head1 DEPENDENCIES
312
313L<HTTP::Date>, L<LWP::UserAgent>, L<XML::Simple>, L<WebService::YouTube::Util>, L<WebService::YouTube::Video>
314
315=head1 INCOMPATIBILITIES
316
317None reported.
318
319=head1 BUGS AND LIMITATIONS
320
321No bugs have been reported.
322
323Please report any bugs or feature requests to
324C<bug-webservice-youtube@rt.cpan.org>, or through the web interface at
325L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WebService-YouTube>.
326I will be notified, and then you'll automatically be notified of progress on
327your bug as I make changes.
328
329=head1 AUTHOR
330
331Hironori Yoshida <yoshida@cpan.org>
332
333=head1 LICENSE AND COPYRIGHT
334
335Copyright 2006, Hironori Yoshida <yoshida@cpan.org>. All rights reserved.
336
337This program is free software; you can redistribute it and/or modify it
338under the same terms as Perl itself. See L<perlartistic>.
339
340=cut
Note: See TracBrowser for help on using the browser.