Youtube からのダウンロードスクリプト

どうも Youtube の仕様が変わったみたいで、これまでのダウンロードスクリプトが使えなくなってしまいました。取り急ぎ今の Youtube に対応できるようにガーって書いて、まぁなんとか動くかという状態。
今みたいな感じでファイル一つずつ指定するとかマジめんどいし、ダウンノード中ブロックされるのを防ぎたい => Coro も使ってみたいので、また変わる。

使い方

$ ./download-from-youtube.pl -u 'http://www.youtube.com/watch?v=aaaaaaaaaaaa' -f test.flv

ソース

#!/usr/bin/perl
use strict;
use warnings;
use LWP::UserAgent;
use URI::Escape;
use Getopt::Long;

GetOptions( 
    "filename=s" => \my $filename,
    "url=s"      => \my $url,
 );
$url      ||   die "url must be specified";
$filename ||= "file$$.flv";

my $ua = LWP::UserAgent->new;
my $map = construct_map(
    download_html( $ua => $url )
);
$ua->get(
    $map->{18} || $map->{35} || $map->{34} || $map->{22} || $map->{6},
    ':content_file' => $filename
);


sub download_html {
    my ($ua, $url) = @_;
    my $response = $ua->get( $url );

    unless ( $response->is_success ) {
        die qq{cannot download url "$url": [}
            . $response->status_line
            . ']';
    }
    $response->decoded_content;
}

sub construct_map {
    my $html = shift;

    my ($mapinfo) = $html =~ /"fmt_url_map": "(.*?)"/ or die "cannot extract fmt_url_map";
        $mapinfo  = uri_unescape( $mapinfo );
    my %map = map { split '\|' => $_ } split ',' => $mapinfo;
    \%map
}