File Coverage

blib/lib/VK/MP3.pm

Criterion	Covered	Total	%
statement	93	93	100.0
branch	17	22	77.2
condition	8	15	53.3
subroutine	17	17	100.0
pod	3	3	100.0
total	138	150	92.0

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.09;

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'
40

  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},
        please_dont_ddos => '2',
      },
    );
  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{(.*?)}si;
  return undef unless $name;

  $name =~ s/<[^>]+>//g;
  $name =~ s/ ?\([^\(]*$//;
  $name = decode_entities($name);

  my ($duration) = $str =~ m{(\d+:\d+)}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
       || $res->decoded_content =~ m#login\.vk\.com/\?act=logout#i ) ) {
    $self->{id} = $1;
    return 1;
  }
  return 0;
}

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

  push @{ $ua->requests_redirectable }, 'POST';
  $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__