File Coverage

blib/lib/WWW/YouTube/Info/Simple.pm
Criterion Covered Total %
statement 64 102 62.7
branch 19 56 33.9
condition 3 15 20.0
subroutine 11 14 78.5
pod 5 5 100.0
total 102 192 53.1


line stmt bran cond sub pod time code
1             package WWW::YouTube::Info::Simple;
2              
3 8     8   270191 use 5.008;
  8         33  
  8         449  
4 8     8   50 use strict;
  8         16  
  8         375  
5 8     8   49 use warnings;
  8         19  
  8         904  
6              
7             require Exporter;
8             require WWW::YouTube::Info;
9              
10             our @ISA = qw(
11             Exporter
12             WWW::YouTube::Info
13             );
14              
15             our @EXPORT = qw(
16             );
17              
18             our $VERSION = '0.08';
19              
20 8     8   47 use Carp;
  8         12  
  8         831  
21 8     8   16851 use Data::Dumper;
  8         122584  
  8         20106  
22              
23             =head1 NAME
24              
25             WWW::YouTube::Info::Simple - simple interface to WWW::YouTube::Info
26              
27             =head1 SYNOPSIS
28              
29             =head2 Perhaps a little code snippet?
30              
31             #!/usr/bin/perl
32            
33             use strict;
34             use warnings;
35            
36             use WWW::YouTube::Info::Simple;
37            
38             # id taken from YouTube video URL
39             my $id = 'foobar';
40            
41             my $yt = WWW::YouTube::Info::Simple->new($id);
42            
43             # hash reference holds values gained via http://youtube.com/get_video_info?video_id=foobar
44             my $info = $yt->get_info();
45             # this is basically an inheritance to get_info() at WWW::YouTube::Info
46             # $info->{title} # e.g.: Foo+bar+-+%27Foobar%27
47             # $info->{author} # e.g.: foobar
48             # $info->{keywords} # e.g.: Foo%2Cbar%2CFoobar
49             # $info->{length_seconds} # e.g.: 60
50             # $info->{fmt_map} # e.g.: 22%2F1280x720%2F9%2F0%2F115%2C35%2F854x480%2F9%2F0%2F115%2C34%2F640x360%2F9%2 ..
51             # $info->{fmt_url_map} # e.g.: 22%7Chttp%3A%2F%2Fv14.lscache1.c.youtube.com%2Fvideoplayback%3Fip%3D131.0.0.0 ..
52             # $info->{fmt_stream_map} # e.g.: 22%7Chttp%3A%2F%2Fv14.lscache1.c.youtube.com%2Fvideoplayback%3Fip%3D131.0.0.0 ..
53            
54             # array reference holds values keywords
55             my $keys = $yt->get_keywords();
56             # $keys->[0] # e.g.: Foo
57             # $keys->[1] # e.g.: bar
58             # ..
59            
60             # hash reference holds values quality -> resolution
61             my $res = $yt->get_resolution();
62             # $res->{35} # e.g.: 854x480
63             # $res->{22} # e.g.: 1280x720
64             # ..
65            
66             # URL and masquerading decoded title
67             my $title = $yt->get_title(); # e.g.: Foo bar - 'Foobar'
68            
69             # hash reference holds values quality -> url
70             my $url = $yt->get_url();
71             # $url->{35} e.g.: http://v14.lscache1.c.youtube.com/videoplayback?ip=131.0.0.0 ..
72             # $url->{22} e.g.: http://v14.lscache1.c.youtube.com/videoplayback?ip=131.0.0.0 ..
73             # ..
74            
75             # URL decoded RTMPE URL
76             my $conn = $yt->get_conn(); # e.g.: rtmpe://cp59009.edgefcs.net/youtube?auth=daEcaboc8dvawbcbxazdobDcZajcDdgcfae ..
77            
78             # Remark:
79             # You might want to check $info->{status} before further workout,
80             # as some videos have copyright issues indicated, for instance, by
81             # $info->{status} ne 'ok'.
82              
83             =head1 DESCRIPTION
84              
85             I guess its pretty much self-explanatory ..
86              
87             =head1 METHODS
88              
89             =cut
90              
91             =head2 get_keywords
92              
93             Returns undef if status ne 'ok'.
94             Croaks if not available.
95              
96             =cut
97              
98             sub get_keywords {
99 0     0 1 0 my ($self) = @_;
100              
101 0 0       0 $self->get_info() unless exists($self->{info});
102 0 0       0 return if ( $self->{info}->{status} ne 'ok' );
103              
104 0         0 my $keywords = $self->{info}->{'keywords'};
105 0 0       0 croak "no keywords found!" unless $keywords;
106              
107 0         0 my @keywords_parts = split /%2C/, $keywords;
108 0         0 foreach my $item ( @keywords_parts ) {
109 0 0       0 next unless $item;
110 0         0 $item = _url_decode($item);
111 0         0 push @{$self->{keywords}}, $item;
  0         0  
112             }
113              
114 0         0 return $self->{keywords};
115             }
116              
117             =head2 get_resolution
118              
119             Returns undef if status ne 'ok'.
120             Croaks if not available.
121              
122             =cut
123              
124             sub get_resolution {
125 2     2 1 296325 my ($self) = @_;
126              
127 2 50       12 $self->get_info() unless exists($self->{info});
128 2 50       10 return if ( $self->{info}->{status} ne 'ok' );
129              
130             # quality and resolution
131 2         7 my $fmt_map = $self->{info}->{'fmt_map'};
132 2 50       7 unless ( $fmt_map ) {
133             # fallback to fmt_list
134             # as fmt_map doesnt't seem to be supported any more
135 2 50       8 croak "no resolutions found!" unless $self->_fmt_list();
136             }
137             else {
138             # process fmt_map
139 0         0 my @fmt_map_parts = split /%2F9%2F0%2F115%2C/, $fmt_map;
140 0         0 foreach my $item ( @fmt_map_parts ) {
141 0         0 my ($quality, $resolution) = split /%2F/, $item;
142 0 0 0     0 next unless $quality and $resolution;
143 0         0 $self->{resolution}->{$quality} = $resolution;
144             }
145             }
146              
147 2         102 return $self->{resolution};
148             }
149              
150             =head2 get_title
151              
152             Returns undef if status ne 'ok'.
153             Croaks if not available.
154              
155             =cut
156              
157             sub get_title {
158 0     0 1 0 my ($self) = @_;
159              
160 0 0       0 $self->get_info() unless exists($self->{info});
161 0 0       0 return if ( $self->{info}->{status} ne 'ok' );
162              
163 0         0 my $title = $self->{info}->{'title'};
164 0 0       0 croak "no title found!" unless $title;
165              
166 0         0 $title = _url_decode($title);
167 0         0 $title =~ s/\+/ /g;
168 0         0 $self->{title} = $title;
169              
170 0         0 return $self->{title};
171             }
172              
173             =head2 get_url
174              
175             Returns undef if status ne 'ok'.
176             Croaks if not available.
177              
178             use WWW::YouTube::Info::Simple;
179            
180             # id taken from YouTube video URL
181             my $id = 'foobar';
182            
183             my $yt = WWW::YouTube::Info::Simple->new($id);
184            
185             # hash reference holds values quality -> url
186             my $url = $yt->get_url();
187             # $url->{35} e.g.: http://v14.lscache1.c.youtube.com/videoplayback?ip=131.0.0.0 ..
188             # $url->{22} e.g.: http://v14.lscache1.c.youtube.com/videoplayback?ip=131.0.0.0 ..
189             # ..
190              
191             YouTube videos can be downloaded in given qualities by means of these URLs and the usual suspects (C, ..).
192              
193             =cut
194              
195             sub get_url {
196 2     2 1 300915 my ($self) = @_;
197              
198 2 50       13 $self->get_info() unless exists($self->{info});
199 2 50       13 return if ( $self->{info}->{status} ne 'ok' );
200              
201             # quality and URL
202 2         6 my $fmt_url_map = $self->{info}->{'fmt_url_map'};
203 2 50       11 unless ( $fmt_url_map ) {
204             # fallback to url_encoded_fmt_stream_map
205             # as fmt_url_map doesnt't seem to be supported any more
206 2 50       9 croak "no URLs found!" unless $self->_url_encoded_fmt_stream_map();
207             }
208             else {
209             # process fmt_url_map
210 0         0 my @fmt_url_map_parts = split /%2C/, $fmt_url_map;
211 0         0 foreach my $item ( @fmt_url_map_parts ) {
212 0         0 my ($quality, $url) = split /%7C/, $item;
213 0 0 0     0 next unless $quality and $url;
214 0         0 $url = _url_decode($url);
215 0         0 $self->{url}->{$quality} = $url;
216             }
217             }
218              
219 2         18 return $self->{url};
220             }
221              
222             =head2 get_conn
223              
224             Returns undef if status ne 'ok'.
225             Croaks if not available.
226              
227             use WWW::YouTube::Info::Simple;
228            
229             # id taken from YouTube video URL
230             my $id = 'foobar';
231            
232             my $yt = WWW::YouTube::Info::Simple->new($id);
233            
234             # URL decoded RTMPE URL
235             my $conn = $yt->get_conn(); # e.g.: rtmpe://cp59009.edgefcs.net/youtube?auth=daEcaboc8dvawbcbxazdobDcZajcDdgcfae ..
236              
237             A YouTube RTMPE stream can be accessed via this URL and downloaded by
238             means of the usual suspects (C, ..).
239             The URL looses its validity after approx. 30 seconds (experimental value).
240             Gathering a fresh RTMPE URL regarding the same VIDEO_ID and the
241             C capability might circumvent this inconvenience.
242              
243             =cut
244              
245             sub get_conn {
246 1     1 1 278083 my ($self) = @_;
247              
248 1 50       8 $self->get_info() unless exists($self->{info});
249 1 50       6 return if ( $self->{info}->{status} ne 'ok' );
250              
251 1         3 my $conn = $self->{info}->{'conn'};
252 1 50       251 croak "no conn found!" unless $conn;
253              
254 0         0 $self->{conn} = _url_decode($conn);
255              
256 0         0 return $self->{conn};
257             }
258              
259              
260             sub _url_encoded_fmt_stream_map {
261 2     2   5 my ($self) = @_;
262              
263 2 50       11 $self->get_info() unless exists($self->{info});
264 2 50       10 return if ( $self->{info}->{status} ne 'ok' );
265              
266             # quality and URL
267 2         5 my $url_encoded_fmt_stream_map = $self->{info}->{'url_encoded_fmt_stream_map'};
268 2 50       7 return unless $url_encoded_fmt_stream_map;
269              
270 2         45 my @url_encoded_fmt_stream_map_parts = split /%2C/, $url_encoded_fmt_stream_map;
271 2         7 foreach my $item ( @url_encoded_fmt_stream_map_parts ) {
272 10         26 $item = _url_decode($item);
273 10         308 (my $url = $item) =~ s/.*url=(.*)&fallback_host=.*/$1/;
274 10         23 $url = _url_decode($url);
275 10         238 (my $quality = $url) =~ s/.*&itag=(\d+)&.*/$1/;
276 10         38 (my $signature = $item) =~ s/.*&sig=([\d\w.]+)&.*/$1/;
277 10 50 33     88 next unless $quality and $url and $signature;
      33        
278 10         114 $self->{url}->{$quality} = $url.'&signature='.$signature;
279             }
280              
281 2         14 return $self->{url};
282             }
283              
284             sub _fmt_list {
285 2     2   5 my ($self) = @_;
286              
287 2 50       12 $self->get_info() unless exists($self->{info});
288 2 50       9 return if ( $self->{info}->{status} ne 'ok' );
289              
290             # quality and resolution
291 2         6 my $fmt_list = $self->{info}->{'fmt_list'};
292 2 50       6 return unless $fmt_list;
293              
294 2         13 my @fmt_list_parts = split /%2C/, $fmt_list;
295 2         4 foreach my $item ( @fmt_list_parts ) {
296 10         42 my ($quality, $resolution, @rest) = split /%2F/, $item;
297 10 50 33     53 next unless $quality and $resolution;
298 10         39 $self->{resolution}->{$quality} = $resolution;
299             }
300              
301 2         13 return $self->{resolution};
302             }
303              
304             sub _url_encode {
305 0     0   0 my $string = shift;
306              
307             # URLencode
308 0         0 $string =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
  0         0  
309              
310 0         0 return $string;
311             }
312              
313             sub _url_decode {
314 20     20   39 my $string = shift;
315              
316             # URLdecode
317 20         106 $string =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;
  1530         7728  
318              
319 20         92 return $string;
320             }
321              
322             1;
323              
324             __END__