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


line stmt bran cond sub pod time code
1             package VK::MP3;
2              
3 1     1   1139 use strict;
  1         2  
  1         48  
4 1     1   6 use warnings;
  1         2  
  1         37  
5 1     1   25 use utf8;
  1         2  
  1         8  
6              
7 1     1   1112 use LWP;
  1         45  
  1         102  
8 1     1   969 use LWP::Protocol::https;
  1         2213959  
  1         474  
9 1     1   3309 use HTML::Entities;
  1         10203  
  1         114  
10 1     1   12 use URI::Escape;
  1         1  
  1         62  
11 1     1   1810 use JSON::XS qw/decode_json/;
  1         33158  
  1         100  
12 1     1   1216 use Encode;
  1         19018  
  1         1466  
13              
14             our $VERSION = 0.09;
15              
16             sub new {
17 4     4 1 3752 my ($class, %args) = @_;
18 4 100       9 die 'USAGE: VK::MP3->new(login => ..., password => ...)'
19             unless _valid_new_args(\%args);
20              
21 3         8 my $self = {
22             ua => _create_ua(),
23             login => $args{login},
24             password => $args{password},
25             };
26 3         13 bless $self, $class;
27              
28 3 100       8 die 'ERROR: login failed' unless($self->_login());
29              
30 1         3 return $self;
31             }
32              
33             sub search {
34 3     3 1 1936 my ($self, $query) = @_;
35              
36 3         12 my $res = $self->{ua}->get('http://vk.com/search?c[section]=audio&c[q]='.uri_escape_utf8($query));
37 3 100       326 die 'LWP: '.$res->status_line unless $res->is_success;
38              
39 2         90 my @matches = $res->decoded_content =~ m' 40              
41 2         141 my @rslt;
42 2         9 push @rslt, $self->_parse_found_item($_) for(@matches);
43 2         5 @rslt = grep { defined $_ } @rslt;
  3         9  
44              
45 2         12 return \@rslt;
46             }
47              
48             sub get_playlist {
49 1     1 1 17261 my ($self) = @_;
50 1         2 my $res;
51              
52 1         25 $res = $self->{ua}->post('http://vk.com/audio', {
53             act => 'load_audios_silent',
54             al => 1,
55             gid => 0,
56             id => $self->{id},
57             please_dont_ddos => '2',
58             },
59             );
60 1 50       93 die 'LWP: '.$res->status_line unless $res->is_success;
61              
62 1         60 my $json_str = (split //, $res->decoded_content)[5];
63 1         89 $json_str =~ s/'/"/gs;
64 1         7 $json_str = Encode::encode('utf-8', $json_str);
65 1         237 my $json = decode_json($json_str);
66 1 50 33     14 return 'Invalid response' unless defined $json->{all} && ref($json->{all}) eq 'ARRAY';
67              
68 1         3 my @rslt;
69 1         3 for my $item(@{$json->{all}}) {
  1         5  
70 3 50 33     11 next unless ref $item eq 'ARRAY' && scalar @{$item} > 7;
  3         14  
71 3         25 my $name = decode_entities($item->[5].' – '.$item->[6]);
72 3         33 $name =~ s/(^\s+|\s+$)//g;
73 3         15 my $rslt_item = {
74             name => $name,
75             duration => $item->[3],
76             link => $item->[2],
77             };
78 3         9 push @rslt, $rslt_item;
79             }
80 1         10 return \@rslt;
81             }
82              
83             sub _parse_found_item {
84 3     3   7 my ($self, $str) = @_;
85 3         87 my ($name) = $str =~ m{
(.*?)
}si;
86 3 50       9 return undef unless $name;
87            
88 3         84 $name =~ s/<[^>]+>//g;
89 3         19 $name =~ s/ ?\([^\(]*$//;
90 3         31 $name = decode_entities($name);
91              
92 1     1   7 my ($duration) = $str =~ m{
(\d+:\d+)
}i;
  1         1  
  1         13  
  3         97  
93 3         75122 my ($link) = $str =~ m{value="(http://[^",]+\.mp3)}i;
94              
95 3 100       12 if($duration) {
96 2         8 my ($min, $sec) = split /:/, $duration, 2;
97 2         7 $duration = $min * 60 + $sec;
98             } else {
99 1         2 $duration = 0;
100             }
101            
102 3         45 return { name => $name, duration => $duration, link => $link };
103             }
104              
105             sub _login {
106 3     3   4 my $self = shift;
107 3         27 my $res = $self->{ua}->post('https://login.vk.com/?act=login', {
108             email => $self->{login},
109             pass => $self->{password},
110             });
111              
112 3 100 66     173 if( $res->is_success &&
      66        
113             ($res->decoded_content =~ /var\s+vk\s*=\s*\{[^\{\}]*?id\s*\:\s*(\d+)/i
114             || $res->decoded_content =~ m#login\.vk\.com/\?act=logout#i ) ) {
115 1         83 $self->{id} = $1;
116 1         4 return 1;
117             }
118 2         254 return 0;
119             }
120              
121             sub _create_ua {
122 3     3   13 my $ua = LWP::UserAgent->new();
123              
124 3         9 push @{ $ua->requests_redirectable }, 'POST';
  3         25  
125 3         182 $ua->cookie_jar( {} );
126              
127 3         185 return $ua;
128             }
129              
130             sub _valid_new_args {
131 4     4   6 my $args = shift;
132 4 50       15 return 0 unless ref($args) eq 'HASH';
133 4         8 for(qw/login password/) {
134 7 100 66     49 return 0 unless defined($args->{$_}) && (ref($args->{$_}) eq '');
135             }
136 3         9 return 1;
137             }
138              
139             1;
140              
141             __END__