The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package VK::MP3;

use strict;
use warnings;
use utf8;

use LWP;
use LWP::Protocol::https;
use HTML::Entities;
use URI::Escape;
use JSON::XS qw/decode_json/;
use Encode;

our $VERSION = 0.06;

sub new {
  my ($class, %args) = @_;
  die 'USAGE: VK::MP3->new(login => ..., password => ...)'
    unless _valid_new_args(\%args);

  my $self = { 
      ua => _create_ua(),
      login => $args{login},
      password => $args{password},
    };
  bless $self, $class;

  die 'ERROR: login failed' unless($self->_login());

  return $self;
}

sub search {
  my ($self, $query) = @_;

  my $res = $self->{ua}->get('http://vk.com/search?c[section]=audio&c[q]='.uri_escape_utf8($query));
  die 'LWP: '.$res->status_line unless $res->is_success;

  my @matches = $res->decoded_content =~  m'<input type="hidden" id="audio_info(.*?)</tbody></table>'sgi;

  my @rslt;
  push @rslt, $self->_parse_found_item($_) for(@matches);
  @rslt = grep { defined $_ } @rslt;

  return \@rslt;
}

sub get_playlist {
  my ($self) = @_;
  my $res;

  $res = $self->{ua}->post('http://vk.com/audio', {
        act => 'load_audios_silent',
        al => 1,
        gid => 0,
        id => $self->{id},
      }, 
    ); 
  die 'LWP: '.$res->status_line unless $res->is_success;

  my $json_str = (split /<!>/, $res->decoded_content)[5];
  $json_str =~ s/'/"/gs;
  $json_str = Encode::encode('utf-8', $json_str);
  my $json = decode_json($json_str);
  return 'Invalid response' unless defined $json->{all} && ref($json->{all}) eq 'ARRAY';

  my @rslt;
  for my $item(@{$json->{all}}) {
    next unless ref $item eq 'ARRAY' && scalar @{$item} > 7;
    my $name = decode_entities($item->[5].' – '.$item->[6]);
    $name =~ s/(^\s+|\s+$)//g;
    my $rslt_item = {
        name => $name,
        duration => $item->[3],
        link => $item->[2],
      };
    push @rslt, $rslt_item;
  }
  return \@rslt;
}

sub _parse_found_item {
  my ($self, $str) = @_;
  my ($name) = $str =~ m{<div class="title_wrap fl_l".*?>(.*?)</div>}si;
  return undef unless $name;
 
  $name =~ s/<[^>]+>//g;
  $name =~ s/ ?\([^\(]*$//;
  $name = decode_entities($name);

  my ($duration) = $str =~ m{<div class="duration fl_r".*?>(\d+:\d+)</div>}i;
  my ($link) = $str =~ m{value="(http://[^",]+\.mp3)}i;

  if($duration) {
    my ($min, $sec) = split /:/, $duration, 2;
    $duration = $min * 60 + $sec;
  } else {
    $duration = 0;
  }
  
  return { name => $name, duration => $duration, link => $link };
}

sub _login {
  my $self = shift;
  my $res = $self->{ua}->post('https://login.vk.com/?act=login', {
      email => $self->{login},
      pass => $self->{password},
    });  

  if(  $res->is_success &&
      ($res->decoded_content =~ /var\s+vk\s*=\s*\{[^\{\}]*?id\s*\:\s*(\d+)/i) ) {
    $self->{id} = $1;
    return 1;
  }
  return 0;
}

sub _create_ua {
  my $ua = LWP::UserAgent->new();

  push @{ $ua->requests_redirectable }, 'POST';
  $ua->ssl_opts(verify_hostname => 0);
  $ua->cookie_jar( {} );

  return $ua;
}

sub _valid_new_args {
  my $args = shift;
  return 0 unless ref($args) eq 'HASH';
  for(qw/login password/) {
    return 0 unless defined($args->{$_}) && (ref($args->{$_}) eq '');
  }
  return 1;
}

1;

__END__

=head1 NAME

VK::MP3 - searches for mp3 on vkontakte.ru, also known as vk.com.

=head1 SYNOPSIS

    use VK::MP3;
     
    my $vk = VK::MP3->new(login => 'user', password => 'secret');
    
    my $rslt = $vk->search('Nightwish');
    for (@{$rslt}) {
        # $_->{name}, $_->{duration}, $_->{link}
    }
    
    my $playlist = $vk->get_playlist;
    for (@{$playlist}) {
        # $_->{name}, $_->{duration}, $_->{link}
    }

=head1 DESCRIPTION

B<VK::MP3> helps you to find direct URL's of audio files on vk.com (via regular expressions and LWP).

This package also includes B<vkmp3> utility, that allows you to download found mp3.

=head1 METHODS

=head2 C<new>

    my $vk = VK::MP3->new(login => $login, password => $password)

Constructs a new C<VK::MP3> object and logs on vk.com. Throws exception in case of any error.

=head2 C<search>

    my $rslt = $vk->search($query)

Results, found by $query.

=head2 C<get_playlist>

    my $rslt = $vk->get_playlist()

Returns your playlist.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc VK::MP3

You can also look for information at:

=over 3

=item * GitHub

L<https://github.com/afiskon/p5-vk-mp3>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/VK-MP3>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/VK-MP3>

=back

=head1 SEE ALSO

L<VK>, L<VKontakte::API>, L<LWP::UserAgent>.

=head1 AUTHOR

Alexandr Alexeev, <eax at cpan.org> (L<http://eax.me/>)

=head1 COPYRIGHT

Copyright 2011-2012 by Alexandr Alexeev

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut