Categories: Perl

vk-get-mp3/

В сети есть много сервисов для скачивания mp3 из Вконтакта, но мне они не нравятся. Например, vMuke.ru часто возвращает пустой результат, а MP3-Search.su постоянно перегружен (и недавно затребовал регистрацию). Поэтому мне кажется, что юниксоиды оценят следующий скрипт.

Важно! Эта заметка устарела и имеет разве что историческую ценность. Описанный здесь скрипт был полностью переписан, а основной его функционал — вынесен в модуль VK::MP3 . Утилиту и модуль вы можете установить из CPAN .

Вот его код:

#!/usr/bin/perl

# vk-get-mp3.pl script v 0.9.12
# (c) Alexandr A Alexeev 2011-2012 | http://remontka.com/
# Special thanks to Bekenev Ruslan

use strict ;
use URI :: Escape ;
use Text :: Iconv ;
use MP3 :: Info ;
use utf8 ;
use constant VERSION => «0.9.12» ;

use constant DEFAULT_LOGIN => ‘billy@microsoft.com’ ;
use constant DEFAULT_PASSWORD => ‘qwerty’ ;
use constant DEFAULT_SAVE_DIR => ‘./’ ;
use constant DEFAULT_MAX_SHOW => 20 ;

#### проверяем наличие всех необходимых утилит ####
{
my @depends = qw/wget/ ;
my $not_found ;
for ( @depends ) {
print «ERROR: $_ not found n » and ++ $not_found
if system ( «which $_ > /dev/null» ) ;
}
exit 1 if $not_found ;
}

my ( $login , $password , $save_dir , $max_show ) ;
for my $x ( qw/login password save_dir max_show/ ) {
my $X = » U $x» ;
my $cmd = qq {
$$x = $ENV { VKMP3_ $X } ;
$$x = DEFAULT_ $X unless ( defined ( $$x ) ) ;
} ;
eval $cmd ;
}

my $hidden_pass = «*» x length ( $password ) ;

my $tmp = «/tmp/vkmp3_$$» ;
my $wget_cmd = «wget —save-cookies $tmp —load-cookies $tmp» ;

my $query = join » » , @ ARGV ;
die «vk-get-mp3.pl ver » . VERSION .
» n Usage: n $0 <query> n $0 —dialog n »
unless $query ;

if ( $query eq «—dialog» ) {
print «Dialog mode, enter query or ‘exit’ n vkmp3> » ;
while ( $query = <STDIN> ) {
chomp ( $query ) ;
if ( length ( $query ) ) {
last if ( » L $query» eq «exit» ) or ( » L $query» eq «quit» ) ;
$query = quotemeta $query ;
system ( «$0 $query» ) unless $query eq «—dialog» ;
print » n » ;
}
print «vkmp3> » ;
}
exit ;
}

print «Looking for ‘$query’… n » ;
$_ = uri_escape ( $_ ) for ( ( $login , $password ) ) ;

utf8 :: decode ( $query ) ;
my $win2utf = Text :: Iconv -> new ( «cp1251» , «utf-8» ) ;

# логинимся
my $url = «https://login.vk.com/?act=login» ;
my $data = `$wget_cmd -q ‘$url’ —post-data ’email=$login&pass=$password’ -O -` ;

if ( $? ) {
unlink $tmp ;
die «Login: wget returns $? n » ;
}

unless ( $data =~ m #<a[^>]+href=»https://login.vk.com/?act=logout&hash=#i) {
unlink $tmp ;
die «Login failed ($login:$hidden_pass)! n » ;
}

# ищем музыку
$url = «http://vk.com/search?c[section]=audio&c[q]=» . uri_escape_utf8 ( $query ) ;
$data = `$wget_cmd -q ‘$url’ -O -` ;
if ( $? ) {
unlink $tmp ;
die «Search: wget returns $? n » ;
}

# парсим результат
my @matches = $data =~ m ‘<input type=»hidden» id=»audio_info(.*?)</span></div>’ sgi ;
@matches = @matches [ 0 .. $max_show 1 ] if ( scalar ( @matches ) > $max_show ) ;

my ( $i , @links , @names ) ;
for my $t ( @matches ) {
# получаем продолжительность и название песни
$t =~ m { < div class = «duration fl_r» onmousedown = «if ( window.audioPlayer ) audioPlayer . switchTimeFormat ( ‘[^’]+’, event ) > ( d +: d + ) </ div > } i ;
my $duration = $1 ;
$t =~ m { < div class = «audio_title_wrap» > <b> ( .+ ) </ a > } si ;
my $name = $1 ;
if ( $duration ) {
my ( $m , $s ) = split /:/ , $duration ;
$duration = sprintf «%02d:%02d» , $m , $s ;
} else {
$duration = «??:??» ;
}
# получаем ссылку
my ( $link ) = $t =~ m { value = «(http://[^» , ] + . mp3 ) } i ;

# очищаем название от мусора
$name =~ s/<[^>]+>//g ;
$name =~ s/(^s+|s+$|s{2,})//gs ;
$name =~ s/&#(d+);/chr($1)/ge ;
$name =~ s/&amp;/&/g ;
$name = substr ( $name , 0 , 64 ) . «…» if ( length ( $name ) > 64 ) ;
# cp1251 —> utf8
$name = $win2utf -> convert ( $name ) ;

print sprintf ( «%02d» , ++ $i ) . » [$duration] $name n » ;
push @links , $link ;
push @names , $name ;
}

unless ( scalar @links ) {
unlink $tmp ;
die «Nothing found n » ;
}

print «Your choice(s) [none]: » ;
chomp ( my $choice = <STDIN> ) ;
my @ch = split /D/ , $choice ;

for $choice ( @ch ) {
print «$choice — ignored» and next
unless ( $choice >= 1 and $choice <= scalar ( @links ) ) ;
# определяем ссылку и имя файла
$url = $links [ $choice 1 ] ;
my $name = $names [ $choice 1 ] ;
utf8 :: decode ( $name ) ;
my $fname = $save_dir . rus_to_lat ( $name ) . «.mp3» ;

# скачиваем
print «Downloading $url to $fname… n » ;
system ( «$wget_cmd ‘$url’ -O $fname» ) ;
if ( $? ) {
unlink $tmp ;
die «Download: wget returns $? n »
}

# выводим битрейт
my $bitrate = abs ( get_mp3info ( $fname ) -> { BITRATE } ) ;
print «Bitrate = » . sprintf ( «%d» , $bitrate ) . » kbps n » ;
print «$fname n » ;
}

# генерируем имя файла на основе названия песни
sub rus_to_lat {
my ( $str ) = @_ ;
$str = » L $str» ;
$str =~ tr/абвгдезийклмнопрстуфхцыэ /abvgdezijklmnoprstufxcye-/ ;
$str =~ s/ё/yo/g ;
$str =~ s/ж/zh/g ;
$str =~ s/ч/ch/g ;
$str =~ s/ш/sh/g ;
$str =~ s/щ/shh/g ;
$str =~ s/ю/yu/g ;
$str =~ s/я/ya/g ;
$str =~ s/./-/g ;
$str =~ s/([^a-z0-9-])//g ;
$str =~ s/-{2,}/-/g ;
$str =~ s/(^-|-$)//g ;
$str ;
}

В отличие от аналогов здесь мы имеем полноценную, законченную программу (правда, без GUI). Настраивается скрипт с помощью переменных окружения:

# просто алиас для удобства
alias vkmp3 = «~/scripts/vk-get-mp3.pl»
# логин
export VKMP3_LOGIN =mysuperemail @ example.ru
# пароль
export VKMP3_PASSWORD =mysuperpassword
# куда сохраняем mp3
export VKMP3_SAVE_DIR = / home / eax / mp3 / vk /
# сколько результатов поиска отображать
export VKMP3_MAX_SHOW = 10

Если есть вопросы/предложения — не стесняйтесь отписываться в комментариях. Также вас может заинтересовать скрипт для просмотра видео с YouTube без Flash .

admin

Share
Published by
admin
Tags: Perl

Recent Posts

vim-commands/

Самое главное — побороть боязнь белого листа. Я всегда говорю это себе, когда нужно начать…

1 месяц ago

firefox-thunderbird-en-ru-dict/

По не вполне ясным причинам, Firefox умеет проверять орфографию либо только в русских, либо только…

1 месяц ago

perl-hacks/

Около месяца собирал разные «хаки» на языке программирования Perl. Эта подборка наглядно демонстрирует, как в…

1 месяц ago

perl-cy-check/

C недавних пор я стал увлекаться SEO. Порой передо мной встает задача быстро проверить индекс…

1 месяц ago

which-cms-perl/

Недавно написал несколько скриптов, позволяющих автоматически определять, какая CMS (Content Management System, система управления контентом)…

1 месяц ago

smtp-descr/

Я так подозреваю, что среди вас найдется те, кто скажет, что этот пост боян и…

1 месяц ago