А не заняться ли мне общественно полезным делом?
Есть тут у меня скриптик один (ну вообще-то не один) для хорошей такой вещи - закачивание видео с
YouTube.com. Как и для любого скрипта его ценность в том, что его можно вставлять в другие скрипты и в итоге замутить автоматизацию.
Скриптик написан на Perl-е, юзает LWP, wget и fork
Отлично работает как минимум на FreeBSD
#!/usr/bin/perl
$|++;
###################################################
# Perl youtube.com downloader
# [email]dmzkrsk@yandex.ru[/email] [email]trofimov@kspu.ru[/email]
###################################################
use Text::Iconv;
use LWP::UserAgent;
use LWP::Simple;
use HTTP::Request::Common qw(GET POST);
use HTTP::Response;
use URI::URL;
use HTML::LinkExtor;
sub file_size {
my($bytes) = @_;
my $l = 0;
my @px = ("k", "M", "G", "T");
$bytes=$bytes*1.0+0.0;
while($bytes>=1000) {
$bytes/=1024.0;
$l++;
}
if($l==0) {
return "$bytes B";
}
else {
return sprintf("%.1f%sB", $bytes, $px[$l-1]);
}
}
$g_ua =" Opera/9.01 (; U; ru)";
$downloaded = 0;
sub c2t
{ ($_)=@_;
#
# Fonetic correct translit
#
s/Сх/S'h/; s/сх/s'h/; s/СХ/S'H/;
s/Ш/Sh/g; s/ш/sh/g;
s/Сцх/Sc'h/; s/сцх/sc'h/; s/СЦХ/SC'H/;
s/Щ/Sch/g; s/щ/sch/g;
s/Цх/C'h/; s/цх/c'h/; s/ЦХ/C'H/;
s/Ч/Ch/g; s/ч/ch/g;
s/Йа/J'a/; s/йа/j'a/; s/ЙА/J'A/;
s/Я/Ja/g; s/я/ja/g;
s/Йо/J'o/; s/йо/j'o/; s/ЙО/J'O/;
s/Ё/Jo/g; s/ё/jo/g;
s/Йу/J'u/; s/йу/j'u/; s/ЙУ/J'U/;
s/Ю/Ju/g; s/ю/ju/g;
s/Э/E'/g; s/э/e'/g;
s/Е/E/g; s/е/e/g;
s/Зх/Z'h/g; s/зх/z'h/g; s/ЗХ/Z'H/g;
s/Ж/Zh/g; s/ж/zh/g;
tr/
абвгдзийклмнопрстуфхцъыьАБВГДЗИЙКЛМHОПРСТУФХЦЪЫЬ/
abvgdzijklmnoprstufhc\"y'ABVGDZIJKLMNOPRSTUFHC\"Y'/;
return $_;
}
sub page_title {
my ($url) = @_;
my ($request, $response, $status);
my $headers = new HTTP::Headers;
my $ua = LWP::UserAgent->new;
$ua->agent($g_ua);
for (1 .. 5) {
$request = HTTP::Request->new('GET', $url, $headers);
$response = $ua->request($request);
if (!$response->is_error()) {
return $response->title();
}
}
return "";
}
sub get_size {
my ($url, $ref) = @_;
my ($request, $response, $status);
my $ua = LWP::UserAgent->new;
$ua->agent($g_ua);
my $result = $ua->head($url);
my $rh = $result->headers;
return $rh->content_length;
}
sub kv_get {
my ($url) = @_;
my ($request, $response, $status);
$url=~s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;
$poststring="url=$url&site=aa";
my $headers = new HTTP::Headers;
$headers->referer("http://keepvid.com/");
$headers->header('Content-Length' => length($poststring));
my $ua = LWP::UserAgent->new;
$ua->agent($g_ua);
for (1 .. 5) {
$request = HTTP::Request->new('POST', "http://s1947.gridserver.com/keepvid.php", $headers, $poststring);
$request->content_type('application/x-www-form-urlencoded');
$downloaded = 0;
$response = $ua->request($request);
if (!$response->is_error()) {
return $response->content;
}
else {
}
}
return "";
}
my $g_url = shift @ARGV;
$cv = Text::Iconv->new('UTF-8', 'WINDOWS-1251');
$g_url =~ s|//www\.youtube|//youtube|;
die "wrong youtube link [$g_url]\n" unless($g_url =~ m|^http://youtube\.com\/watch\?v\=([^&]+)(\&.*)?$|);
my $g_id = $1;
my $data = kv_get ($g_url);
my $g_title = lc( c2t( $cv->convert( page_title ($g_url) ) ) );
$g_title =~ s/^YouTube[ \-]+/youtube_/i;
$g_title =~ s/[^a-zA-Z0-9]+/_/g;
$g_title =~ s/^_+//g;
$g_title =~ s/_+$//g;
$g_title = $g_id if $g_title eq "";
die "no data recieved\n" if length($data) == 0;
die "no link found [$g_url]\n" unless $data =~ m/\.flv/i;
$data =~ s/Original\slink:.*?<br\s\/>//i;
if($data=~m/flv/)
{
$parser=HTML::LinkExtor->new(\&pl);
$parser->parse($data);
}
sub pl
{
my($tag, %links) = @_;
my @el = @{[%links]};
my $link = $el[1];
print "$link => $g_title.flv\n" ;
unlink("${g_title}.flv");
my $ts = get_size($link, $g_url);
my $pstart = time;
unless(($pid = fork()) == undef) {
system("wget \"--user-agent=$g_ua\" \"--referer=$g_url\" -o /dev/null -O \"${g_title}.flv\" \"$link\"");
kill(9, $pid);
print "\n";
exit;
}
else {
my $pc, $etad, $eta, @s, $avg, $spd, $now;
my $last = 0;
while(1) {
$now = time;
@s = stat("${g_title}.flv");
$pc = 100.0*$s[7]/$ts;
$etad = int($pc==0?0$now-$pstart) * (100/$pc - 1));
$eta = sprintf("%02d:%02d:%02d", $etad/3600, ($etad%3600)/60, $etad%60);
if($now!=$pstart) {
$avg = sprintf("%.1f kB/s", $s[7] / (time-$pstart) / 1024);
}
$spd = sprintf("%.1f kB/s", ($s[7] - $last) / 1024);
printf("\tDownloading: %s / %s [%.2f%%] ETA: %s RATE: %s (%s) \r", file_size($s[7]), file_size($ts), $pc, $eta, $spd, $avg);
$last = $s[7];
sleep(1);
}
}
}
или
ссылкой
Использовать его очень даже просто:
Допустим нам охота скачать рекламку макинтоша, известную под кодовым названием "1984". На сайте YouTube.com находим ссылку вида
http://youtube.com/watch?v=OYecfV3ubP8
пишем в консоли:
$ ./vdl.pl
http://youtube.com/watch?v=OYecfV3ubP8
Процесс пошел.
Скрипт лезет на
keepvid.com за прямой ссылкой, потом снова на
YouTube.com за названием ролика, а потом запускает
wget на скачивание ролика.
Причем скрипт сразу будет записывать в красивое имя файла (транслитерация кириллицы тоже есть)
http://youtube-609.vo.llnwd.net/d1/...OYecfV3ubP8.flv => youtube_1984_apple_s_macintosh_commercial.flv
и показывать статистику
Downloading: 1.9MB / 2.2MB [86.59%] ETA: 00:00:02 RATE: 1261.4 kB/s (990.4 kB/s)
----===============------
Скрипт свободно распротроняем и модифифцируем.