[SCM] Debian packaging of libwww-youtube-download-perl branch, master, updated. debian/0.53-1-3-g985a6aa

Angel Abad angelabad at gmail.com
Fri Jul 12 08:54:27 UTC 2013


The following commit has been merged in the master branch:
commit 089b41c2fc7d97646eeed54ab4a0f2c2badfed99
Author: Angel Abad <angelabad at gmail.com>
Date:   Fri Jul 12 10:47:40 2013 +0200

    Imported Upstream version 0.54

diff --git a/Build.PL b/Build.PL
index 72f773d..5bf8a05 100644
--- a/Build.PL
+++ b/Build.PL
@@ -25,9 +25,10 @@ my %args = (
 
     name            => 'WWW-YouTube-Download',
     module_name     => 'WWW::YouTube::Download',
-    allow_pure_perl => 0,
+    allow_pureperl => 0,
 
     script_files => [glob('script/*'), glob('bin/*')],
+    c_source     => [qw()],
 
     test_files           => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/',
     recursive_test_files => 1,
diff --git a/Changes b/Changes
index 518d8df..fb75b80 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for Perl extension WWW::YouTube::Download
 
+0.54 2013-07-05T18:29:31Z
+        - If unavailable video, croak with an appropriate error message. (kucharskim++)
+        - Support encrypted signature video. (kucharskim++)
+
 0.53 2013-06-05T16:05:56Z
         - Various improvements to youtube-playlists (kucharskim++)
 
diff --git a/META.json b/META.json
index e69da17..1123fd6 100644
--- a/META.json
+++ b/META.json
@@ -4,7 +4,7 @@
       "xaicron <xaicron {@} cpan.org>"
    ],
    "dynamic_config" : 0,
-   "generated_by" : "Minilla/v0.4.6",
+   "generated_by" : "Minilla/v0.5.5",
    "license" : "perl_5",
    "meta-spec" : {
       "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
@@ -59,7 +59,7 @@
    "provides" : {
       "WWW::YouTube::Download" : {
          "file" : "lib/WWW/YouTube/Download.pm",
-         "version" : "0.53"
+         "version" : "0.54"
       }
    },
    "release_status" : "stable",
@@ -69,11 +69,11 @@
       },
       "homepage" : "https://github.com/xaicron/p5-www-youtube-download",
       "repository" : {
-         "url" : "git://github.com/xaicron/p5-www-youtube-download.git",
+         "url" : "git://github.com/xaicron/p5-www-youtube-download",
          "web" : "https://github.com/xaicron/p5-www-youtube-download"
       }
    },
-   "version" : "0.53",
+   "version" : "0.54",
    "x_contributors" : [
       "akiym <akiyama at 8ant.org>",
       "Maurice <mauricemengel at gmail.com>",
diff --git a/META.yml b/META.yml
index 22ccc4d..070b99d 100644
--- a/META.yml
+++ b/META.yml
@@ -9,7 +9,7 @@ configure_requires:
   CPAN::Meta::Prereqs: 0
   Module::Build: 0.38
 dynamic_config: 0
-generated_by: 'Minilla/v0.4.6, CPAN::Meta::Converter version 2.131490'
+generated_by: 'Minilla/v0.5.5, CPAN::Meta::Converter version 2.130880'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -27,7 +27,7 @@ no_index:
 provides:
   WWW::YouTube::Download:
     file: lib/WWW/YouTube/Download.pm
-    version: 0.53
+    version: 0.54
 requires:
   HTML::Entities: 0
   JSON: 0
@@ -40,8 +40,8 @@ requires:
 resources:
   bugtracker: https://github.com/xaicron/p5-www-youtube-download/issues
   homepage: https://github.com/xaicron/p5-www-youtube-download
-  repository: git://github.com/xaicron/p5-www-youtube-download.git
-version: 0.53
+  repository: git://github.com/xaicron/p5-www-youtube-download
+version: 0.54
 x_contributors:
   - 'akiym <akiyama at 8ant.org>'
   - 'Maurice <mauricemengel at gmail.com>'
diff --git a/bin/youtube-download b/bin/youtube-download
index c33ef27..5d92a96 100644
--- a/bin/youtube-download
+++ b/bin/youtube-download
@@ -17,6 +17,8 @@ GetOptions(
     'U|url!'       => \my $playback_url,
     'o|output=s'   => \my $output,
     'F|fmt=i',     => \my $fmt,
+    's|skip'       => \my $skip,
+    'n|dry-run'    => \my $dry_run,
     'v|verbose!'   => \$verbose,
     'i|interval=i' => \$interval,
     'e|encode=s'   => \$encode,
@@ -57,13 +59,26 @@ main: {
 
         # multibyte fixes
         my $filename = $client->_format_filename($output, {
-            video_id => $meta_data->{video_id},
-            title    => decode_utf8($meta_data->{title}),
-            suffix   => $fmt ? $meta_data->{video_url_map}{$fmt}{suffix} : $meta_data->{suffix},
+            video_id   => $meta_data->{video_id},
+            user       => $meta_data->{user},
+            resolution => $meta_data->{resolution},
+            title      => decode_utf8($meta_data->{title}),
+            suffix     => $fmt ? $meta_data->{video_url_map}{$fmt}{suffix} : $meta_data->{suffix},
+            fmt        => $fmt || $meta_data->{fmt},
         });
         $filename = filename_normalize($filename);
         $filename = $encoder->encode($filename, sub { sprintf 'U+%x', shift });
 
+        if ($dry_run) {
+            print "$filename\n";
+            next;
+        }
+
+        if ($skip && -e $filename) {
+            print "Skipping existing file: $filename\n";
+            next;
+        }
+
         eval {
             $client->download($video_id, {
                 filename  => $filename,
@@ -142,9 +157,11 @@ Options:
     -e, --encode        File system encoding (e.g. cp932)
     -F, --fmt           Video quality (SEE ALSO Wikipedia)
     -f, --force         Force overwrite output file
+    -s, --skip          Skip download when output file exists
     -i, --interval      Download interval
     -p, --proxy         Use the stated proxy
-    -v, --verbose       Turns on chatty output (default: enable)
+    -n, --dry-run       Do not download any videos, print target filenames
+    -v, --verbose       Turns on chatty output (default: enabled)
     -q, --quiet         Turns off progress
     -U, --url           Display playback URL for a video
     -h, --help          Display help
@@ -152,7 +169,7 @@ Options:
     -V, --version       Display version
 
 supported `{$value}` format are:
-    {video_id} / {title} / {fmt} / {suffix}
+    {video_id} / {user} / {title} / {fmt} / {suffix} / {resolution}
 
     Examples:
         $ youtube-download -o "[{video_id}] {title}.{suffix}"
@@ -198,10 +215,20 @@ Use the given proxy. Requires LWP::Protocol::socks to be installed for socks pro
 
 File system encoding (default: utf8)
 
+=item -s, --skip
+
+Skip downloading a video, if target file exists.
+
 =item -f, --force
 
 Force overwrite output file (default: disabled)
 
+=item -n, --dry-run
+
+Do not download any videos, but print their target filenames,
+as defined by -o option. This option still sends query to
+Google servers to fetch details about given video.
+
 =item -F, --fmt
 
 Video quality (SEE ALSO Wikipedia)
@@ -234,7 +261,7 @@ Display version
 
 =head2 supported `{$value}` format
 
-{video_id} / {title} / {fmt} / {suffix} / {resolution}
+{video_id} / {user} / {title} / {fmt} / {suffix} / {resolution}
 
   Example:
   $ youtube-download -o "[{video_id}] {title}.{suffix}"
diff --git a/lib/WWW/YouTube/Download.pm b/lib/WWW/YouTube/Download.pm
index 20aaa3f..f1fd23e 100644
--- a/lib/WWW/YouTube/Download.pm
+++ b/lib/WWW/YouTube/Download.pm
@@ -4,18 +4,20 @@ use strict;
 use warnings;
 use 5.008001;
 
-our $VERSION = '0.53';
+our $VERSION = '0.54';
 
-use Carp ();
+use Carp qw(croak);
 use URI ();
 use LWP::UserAgent;
 use JSON;
 use HTML::Entities qw/decode_entities/;
+use HTTP::Request;
+
+$Carp::Intrenal{ (__PACKAGE__) }++;
 
 use constant DEFAULT_FMT => 18;
 
 my $base_url = 'http://www.youtube.com/watch?v=';
-my $info     = 'http://www.youtube.com/get_video_info?video_id=';
 
 sub new {
     my $class = shift;
@@ -32,7 +34,7 @@ for my $name (qw[video_id video_url title user fmt fmt_list suffix]) {
     *{"get_$name"} = sub {
         use strict 'refs';
         my ($self, $video_id) = @_;
-        Carp::croak "Usage: $self->get_$name(\$video_id|\$watch_url)" unless $video_id;
+        croak "Usage: $self->get_$name(\$video_id|\$watch_url)" unless $video_id;
         my $data = $self->prepare_download($video_id);
         return $data->{$name};
     };
@@ -40,26 +42,26 @@ for my $name (qw[video_id video_url title user fmt fmt_list suffix]) {
 
 sub playback_url {
     my ($self, $video_id, $args) = @_;
-    Carp::croak "Usage: $self->playback_url('[video_id|video_url]')" unless $video_id;
+    croak "Usage: $self->playback_url('[video_id|video_url]')" unless $video_id;
     $args ||= {};
 
     my $data = $self->prepare_download($video_id);
     my $fmt  = $args->{fmt} || $data->{fmt} || DEFAULT_FMT;
-    my $video_url = $data->{video_url_map}{$fmt}{url} || Carp::croak "this video has not supported fmt: $fmt";
+    my $video_url = $data->{video_url_map}{$fmt}{url} || croak "this video has not supported fmt: $fmt";
 
     return $video_url;
 }
 
 sub download {
     my ($self, $video_id, $args) = @_;
-    Carp::croak "Usage: $self->download('[video_id|video_url]')" unless $video_id;
+    croak "Usage: $self->download('[video_id|video_url]')" unless $video_id;
     $args ||= {};
 
     my $data = $self->prepare_download($video_id);
 
     my $fmt = $args->{fmt} || $data->{fmt} || DEFAULT_FMT;
 
-    my $video_url = $data->{video_url_map}{$fmt}{url} || Carp::croak "this video has not supported fmt: $fmt";
+    my $video_url = $data->{video_url_map}{$fmt}{url} || croak "this video has not supported fmt: $fmt";
     $args->{filename} ||= $args->{file_name};
     my $filename = $self->_format_filename($args->{filename}, {
         video_id   => $data->{video_id},
@@ -77,7 +79,7 @@ sub download {
     }) unless ref $args->{cb} eq 'CODE';
 
     my $res = $self->ua->get($video_url, ':content_cb' => $args->{cb});
-    Carp::croak "!! $video_id download failed: ", $res->status_line if $res->is_error;
+    croak "!! $video_id download failed: ", $res->status_line if $res->is_error;
 }
 
 sub _format_filename {
@@ -97,8 +99,8 @@ sub _default_cb {
     my ($self, $args) = @_;
     my ($file, $verbose, $overwrite) = @$args{qw/filename verbose overwrite/};
 
-    Carp::croak "file exists! $file" if -f $file and !$overwrite;
-    open my $wfh, '>', $file or Carp::croak $file, " $!";
+    croak "file exists! $file" if -f $file and !$overwrite;
+    open my $wfh, '>', $file or croak $file, " $!";
     binmode $wfh;
 
     print "Downloading `$file`\n" if $verbose;
@@ -117,13 +119,11 @@ sub _default_cb {
 
 sub prepare_download {
     my ($self, $video_id) = @_;
-    Carp::croak "Usage: $self->prepare_download('[video_id|watch_url]')" unless $video_id;
+    croak "Usage: $self->prepare_download('[video_id|watch_url]')" unless $video_id;
     $video_id = $self->video_id($video_id);
 
     return $self->{cache}{$video_id} if ref $self->{cache}{$video_id} eq 'HASH';
 
-    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
-
     my $content       = $self->_get_content($video_id);
     my $title         = $self->_fetch_title($content);
     my $user          = $self->_fetch_user($content);
@@ -154,6 +154,7 @@ sub prepare_download {
         fmt           => $hq_data->{fmt},
         fmt_list      => $fmt_list,
         suffix        => $hq_data->{suffix},
+        resolution    => $hq_data->{resolution},
     };
 }
 
@@ -174,11 +175,9 @@ sub _fetch_user {
 sub _fetch_video_url_map {
     my ($self, $content) = @_;
 
-    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
-
     my $args = $self->_get_args($content);
     unless ($args->{fmt_list} and $args->{url_encoded_fmt_stream_map}) {
-        Carp::croak 'failed to find video urls';
+        croak 'failed to find video urls';
     }
 
     my $fmt_map     = _parse_fmt_map($args->{fmt_list});
@@ -201,11 +200,15 @@ sub _fetch_video_url_map {
 sub _get_content {
     my ($self, $video_id) = @_;
 
-    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
-
     my $url = "$base_url$video_id";
-    my $res = $self->ua->get($url);
-    Carp::croak "GET $url failed. status: ", $res->status_line if $res->is_error;
+
+    my $req = HTTP::Request->new;
+    $req->method('GET');
+    $req->uri($url);
+    $req->header('Accept-Language' => 'en-US');
+
+    my $res = $self->ua->request($req);
+    croak "GET $url failed. status: ", $res->status_line if $res->is_error;
 
     return $res->content;
 }
@@ -216,13 +219,16 @@ sub _get_args {
     my $data;
     for my $line (split "\n", $content) {
         next unless $line;
-        if ($line =~ /^.+ytplayer\.config\s*=\s*({.*})/) {
+        if ($line =~ /the uploader has not made this video available in your country/i) {
+            Carp::croak 'Video not available in your country.';
+        }
+        elsif ($line =~ /^.+ytplayer\.config\s*=\s*({.*})/) {
             $data = JSON->new->utf8(1)->decode($1);
             last;
         }
     }
 
-    Carp::croak 'failed to extract JSON data.' unless $data->{args};
+    croak 'failed to extract JSON data.' unless $data->{args};
 
     return $data->{args};
 }
@@ -238,6 +244,27 @@ sub _parse_fmt_map {
     return $fmt_map;
 }
 
+sub _swapelement {
+    my ($pos, @list) = @_;
+    my $first = $list[0];
+    my $other = $list[$pos % scalar(@list)];
+    $list[0] = $other;
+    $list[$pos] = $first;
+    return @list;
+}
+
+# taken from https://gist.github.com/anonymous/e40cb4a1ba3c71f16c05
+sub _sigdecode {
+    my $sig = shift;
+    Carp::croak 'Unable to find signature.' unless $sig;
+    my @sig = split(//, $sig);
+    @sig = reverse(_swapelement(52, @sig));
+    @sig = @sig[3..$#sig];
+    @sig = reverse(_swapelement(21, @sig));
+    @sig = @sig[3..$#sig];
+    return join('', reverse(@sig));
+}
+
 sub _parse_stream_map {
     my $param       = shift;
     my $fmt_url_map = {};
@@ -245,7 +272,7 @@ sub _parse_stream_map {
         my $uri = URI->new;
         $uri->query($stuff);
         my $query = +{ $uri->query_form };
-        my $sig = $query->{sig};
+        my $sig = $query->{sig} || _sigdecode($query->{s});
         my $url = $query->{url};
         $fmt_url_map->{$query->{itag}} = $url.'&signature='.$sig;
     }
@@ -256,7 +283,7 @@ sub _parse_stream_map {
 sub ua {
     my ($self, $ua) = @_;
     return $self->{ua} unless $ua;
-    Carp::croak "Usage: $self->ua(\$LWP_LIKE_OBJECT)" unless eval { $ua->isa('LWP::UserAgent') };
+    croak "Usage: $self->ua(\$LWP_LIKE_OBJECT)" unless eval { $ua->isa('LWP::UserAgent') };
     $self->{ua} = $ua;
 }
 

-- 
Debian packaging of libwww-youtube-download-perl



More information about the Pkg-perl-cvs-commits mailing list