youtube-dl インスパイヤ

youtube-dl という Python script がありまして、firefox に flash player をインストールするのが面倒な僕にはぴったりのツールで、重宝して使わせていただいています。で、Python の勉強の為に source を眺めていたのですが、それだけでは寂しいので、Perl クローンを書いてみました。

#!/usr/local/bin/perl
#
# Perl test of youtube-dl Python script
# http://www.arrakis.es/~rggi3/youtube-dl/
#
# Original youtube-dl Copyright (c) 2006 Ricardo Garcia Gonzalez
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
# OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
# ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
#
# Except as contained in this notice, the name(s) of the above copyright
# holders shall not be used in advertising or otherwise to promote the
# sale, use or other dealings in this Software without prior written
# authorization.
#
use strict;
use warnings;
require bytes;
use FFmpeg::Command;
use Getopt::Long;
use IO::File;
use HTTP::Headers;
use HTTP::Request;
use LWP::UserAgent;

our $VERSION = "0.01";

# Globals
my $video_url_str = 'http://www.youtube.com/watch?v=%s';
my $video_url_re  = qr{http://(?:www\.)?youtube\.com/(?:v/|watch\?v=)([^&]+).*}o;
my $video_url_params_re = qr{player2\.swf\?video_id=([^&]+)&.*t=([^&]+)&}om;
my $video_url_real_str  = 'http://www.youtube.com/get_video?video_id=%s&t=%s';
my $read_size_hint      = 1024 * 14;
my $tempfile            = "/var/tmp/.youtube_dl_pl.flv" . $$;
my $video_url;
my $opt;
my $video_filename;

# Unlink tempfile if INT received
$SIG{INT} = sub {
    unlink $tempfile;
    exit(1);
};

# Create the command line options parser and parse command line
GetOptions(
    "help"       => \$opt->{help},
    "version"    => \$opt->{version},
    "username=s" => \$opt->{username},
    "password=s" => \$opt->{password},
    "output=s"   => \$opt->{output},
    "quiet"      => \$opt->{quiet},
    "simulate"   => \$opt->{simulate},
) or die "option parse error : $!\n";

die "print this help\n"     if $opt->{help};
die "version is $VERSION\n" if $opt->{version};

# Get video URL
my $video_url_cmd = shift or usage();

# Verify video URL format and convert to "standard" format
if ( $video_url_cmd =~ $video_url_re ) {
    my $real_id = $1;
    $video_url = sprintf "$video_url_str", $real_id;
    $video_filename = sprintf "%s.mpg", $real_id;
    $video_filename = $opt->{output} if $opt->{output};
}

# Check conflicting options
if ( $opt->{output} and $opt->{simulate} ) {
    cond_print("Warning: video file name given but will not be used.\n");
}

# Verify both or none present
if (   ( $opt->{username} and not $opt->{password} )
    or ( $opt->{password} and not $opt->{username} ) )
{
    die "Error: both username and password must be given, or none.\n";
}

# Define header
my $header = HTTP::Headers->new(
    User_Agent => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.6) Gecko/20060728 Firefox/1.5.0.6',
    Accept_Charset => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
    Accept => 'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
    Accept_Language => 'en-us,en;q=0.5',
);

my $request = HTTP::Request->new( 'GET', $video_url, $header );
my $ua = LWP::UserAgent->new;
my $real_url;

# Retrieve video webpage
my $response = $ua->request($request);
unless ( $response->is_success ) {
    error_exit( $response->status_line );
}

# Extract needed video URL parameters
cond_print('Extracting video URL parameters... ');
my( $real_id, $t_param ) = ( $response->as_string =~ $video_url_params_re );
if ( not $real_id ) {
    cond_print("failed\n");
    error_exit('unable to extract URL parameters');
}

$real_url = sprintf "$video_url_real_str", $real_id, $t_param;
cond_print("done\n");

# Retrieve video data
my $data_size;
my $fh = IO::File->new;
$fh->open(">$tempfile");
$request = HTTP::Request->new( 'GET', $real_url, $header );
$response = $ua->request( $request, \&content_cb, $read_size_hint );
$fh->close;

unless ( $response->is_success ) {
    error_exit( $response->status_line );
}
cond_print("done\n");

# Convert to mpeg
cond_print("try converting to $video_filename ... ");
my $ffmpeg = FFmpeg::Command->new('/usr/local/bin/ffmpeg');

$ffmpeg->input_options( { file => $tempfile } );
$ffmpeg->output_options( { file => $video_filename } );
my $result = $ffmpeg->exec;

die $ffmpeg->errstr unless $result;
unlink $tempfile;

cond_print("done\n");
cond_print("Video data saved to $video_filename");

######################################################################
# Sub
sub content_cb {
    my $buf      = shift;
    my $response = shift;

    $fh->print($buf);
    $data_size += bytes::length($buf);

    cond_print(
        sprintf(
            "\rRetrieving video data... %sk of %sk ",
            to_k($data_size), to_k( $response->content_length )
        )
    );
}

sub to_k {
    my $byte = shift;
    return int $byte / 1024;
}

sub cond_print {
    my $str = shift;
    return if $opt->{quiet};
    printf STDERR $str;
}

sub error_exit {
    my $error_text = shift;

    printf STDERR " Error : %s . \n ", $error_text;
    print STDERR <<__ERROR__;
Try again several times. It may be a temporal problem.
Other typical problems:

\tVideo no longer exists.
\tVideo requires age confirmation but you did not provide an account.
\tYou provided the account data, but it is not valid.
\tThe connection was cut suddenly for some reason.
\tYouTube changed their system, and the program no longer works.

Try to confirm you are able to view the video using a web browser.
Use the same video URL and account information, if needed, with this program.
Try again several times and contact me if the problem persists.
__ERROR__

    exit(1);
}

sub usage {
    print STDERR <<__USAGE__;
usage: youtube_dl.pl [options] video_url

options:
  -h, --help            print this help text and exit
  -v, --version         print program version and exit
  -u USERNAME, --username=USERNAME
                        account username
  -p PASSWORD, --password=PASSWORD
                        account password
  -o FILE, --output=FILE
                        output video file name
  -q, --quiet           activates quiet mode
  -s, --simulate        do not download video
__USAGE__
    exit(1);
}

本家の 100% クローンではないので注意してください(というかあまり本気で書いていない)。Cookie 認証とログインに対応してないし、開くファイルを真面目にテストしてません。あと、元の Python script がグローバル変数若干大目だったので、それをそのまま受け継いでいます。そのかわりといってはなんですが、FFmpeg::Command を使って flv を mpg に変えてくれます。
Python って大昔にちょろっと触って以来全然だったんだけど、LL 言語の source って結構似通っているのか、そんなに読むの難しくなかったですね。正規表現なんてほとんどコピペで済んだし。
source のコメントを読む限りではクローン書いて Blog に貼っても問題なさそうなので貼っておきます。問題あったらただちに消すので連絡下さい。If this page or script has any problem, I will delete it as soon as possible. Please contact to massa.hara at gmail.com .