line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package WebService::Audioscrobbler::User;
|
2
|
1
|
|
|
1
|
|
5
|
use warnings FATAL => 'all';
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
37
|
|
3
|
1
|
|
|
1
|
|
5
|
use strict;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
20
|
|
4
|
1
|
|
|
1
|
|
4
|
use CLASS;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
33
|
use base 'WebService::Audioscrobbler::Base';
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1023
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
WebService::Audioscrobbler::User - An object-oriented interface to the Audioscrobbler WebService API
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=cut
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = '0.08';
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# postfix related accessors
|
17
|
|
|
|
|
|
|
CLASS->mk_classaccessor("base_resource_path" => "user");
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# neighbours related accessors
|
20
|
|
|
|
|
|
|
CLASS->mk_classaccessor("neighbours_postfix" => "neighbours.xml");
|
21
|
|
|
|
|
|
|
CLASS->mk_classaccessor("neighbours_class" => "WebService::Audioscrobbler::SimilarUser");
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
# friends related accessors
|
24
|
|
|
|
|
|
|
CLASS->mk_classaccessor("friends_postfix" => "friends.xml");
|
25
|
|
|
|
|
|
|
CLASS->mk_classaccessor("friends_class" => CLASS);
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# different postfix
|
28
|
|
|
|
|
|
|
CLASS->tags_postfix('tags.xml');
|
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# change the field used to sort stuff
|
31
|
|
|
|
|
|
|
CLASS->artists_sort_field('playcount');
|
32
|
|
|
|
|
|
|
CLASS->tracks_sort_field('playcount');
|
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# requiring stuff
|
35
|
|
|
|
|
|
|
CLASS->artists_class->require or die($@);
|
36
|
|
|
|
|
|
|
CLASS->tracks_class->require or die($@);
|
37
|
|
|
|
|
|
|
CLASS->tags_class->require or die($@);
|
38
|
|
|
|
|
|
|
CLASS->neighbours_class->require or die($@);
|
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# object accessors
|
41
|
|
|
|
|
|
|
CLASS->mk_accessors(qw/name picture_url url/);
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head1 SYNOPSIS
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
This module implements an object oriented abstraction of an user within the
|
46
|
|
|
|
|
|
|
Audioscrobbler database.
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
use WebService::Audioscrobbler;
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
my $ws = WebService::Audioscrobbler->new;
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# get an object for user named 'foo'
|
53
|
|
|
|
|
|
|
my $user = $ws->user('foo');
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# get user's top artists
|
56
|
|
|
|
|
|
|
my @artists = $user->artists;
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# get user's top tags
|
59
|
|
|
|
|
|
|
my @tags = $user->tags;
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# get user's top tracks
|
62
|
|
|
|
|
|
|
my @tracks = $user->tracks;
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# get user's neighbours
|
65
|
|
|
|
|
|
|
my @neighbours = $user->neighbours;
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
This module inherits from L.
|
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head1 FIELDS
|
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head2 C
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
The name of a given user as provided when constructing the object.
|
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=head2 C
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
URI object pointing to the location of the users's picture, if available.
|
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head2 C
|
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
URI object pointing to the location where's additional info might be available
|
83
|
|
|
|
|
|
|
about the user.
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=cut
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head1 METHODS
|
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=cut
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=head2 C
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head2 C
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Creates a new object using either the given C<$user_name> or the C<\%fields>
|
96
|
|
|
|
|
|
|
hashref. The data fetcher object is a mandatory parameter and must
|
97
|
|
|
|
|
|
|
be provided either as the second parameter or inside the C<\%fields> hashref.
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=cut
|
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub new {
|
102
|
0
|
|
|
0
|
1
|
|
my $class = shift;
|
103
|
0
|
|
|
|
|
|
my ($name_or_fields, $data_fetcher) = @_;
|
104
|
|
|
|
|
|
|
|
105
|
0
|
0
|
|
|
|
|
my $self = $class->SUPER::new(
|
106
|
|
|
|
|
|
|
ref $name_or_fields eq 'HASH' ?
|
107
|
|
|
|
|
|
|
$name_or_fields : { name => $name_or_fields, data_fetcher => $data_fetcher }
|
108
|
|
|
|
|
|
|
);
|
109
|
|
|
|
|
|
|
|
110
|
0
|
0
|
|
|
|
|
$self->croak("No data fetcher provided")
|
111
|
|
|
|
|
|
|
unless $self->data_fetcher;
|
112
|
|
|
|
|
|
|
|
113
|
0
|
0
|
|
|
|
|
unless (defined $self->name) {
|
114
|
0
|
0
|
|
|
|
|
if (defined $self->{username}) {
|
115
|
|
|
|
|
|
|
$self->name($self->{username})
|
116
|
0
|
|
|
|
|
|
}
|
117
|
|
|
|
|
|
|
else {
|
118
|
0
|
|
|
|
|
|
$self->croak("Can't create user without a name");
|
119
|
|
|
|
|
|
|
}
|
120
|
|
|
|
|
|
|
}
|
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
|
return $self;
|
123
|
|
|
|
|
|
|
}
|
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head2 C
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
Retrieves the user's top artists as available on Audioscrobbler's database.
|
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Returns either a list of artists or a reference to an array of artists when called
|
130
|
|
|
|
|
|
|
in list context or scalar context, respectively. The artists are returned as
|
131
|
|
|
|
|
|
|
L objects by default.
|
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=cut
|
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head2 C
|
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
Retrieves the user's top tracks as available on Audioscrobbler's database.
|
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
Returns either a list of tracks or a reference to an array of tracks when called
|
140
|
|
|
|
|
|
|
in list context or scalar context, respectively. The tracks are returned as
|
141
|
|
|
|
|
|
|
L objects by default.
|
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut
|
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=head2 C
|
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
Retrieves the user's top tags as available on Audioscrobbler's database.
|
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
Returns either a list of tags or a reference to an array of tags when called
|
150
|
|
|
|
|
|
|
in list context or scalar context, respectively. The tags are returned as
|
151
|
|
|
|
|
|
|
L objects by default.
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
=cut
|
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head2 C
|
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Retrieves musical neighbours from the Audioscrobbler database. $filter can be used
|
158
|
|
|
|
|
|
|
as a constraint for neighbours with a low similarity index (ie. users which have a
|
159
|
|
|
|
|
|
|
similarity index lower than $filter won't be returned).
|
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Returns either a list of users or a reference to an array of users when called
|
162
|
|
|
|
|
|
|
in list context or scalar context, respectively. The users are returned as
|
163
|
|
|
|
|
|
|
L objects by default.
|
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=cut
|
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
sub neighbours {
|
168
|
0
|
|
|
0
|
1
|
|
my $self = shift;
|
169
|
0
|
|
0
|
|
|
|
my $filter = shift || 1;
|
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
return $self->fetch_users($self->neighbours_postfix, sub {
|
172
|
0
|
|
|
0
|
|
|
my $users = shift;
|
173
|
|
|
|
|
|
|
map {
|
174
|
|
|
|
|
|
|
$self->neighbours_class->new({
|
175
|
|
|
|
|
|
|
name => $_->{username},
|
176
|
|
|
|
|
|
|
match => $_->{match},
|
177
|
|
|
|
|
|
|
url => URI->new($_->{url}),
|
178
|
0
|
|
|
|
|
|
picture_url => URI->new($_->{image}),
|
179
|
|
|
|
|
|
|
related_to => $self,
|
180
|
|
|
|
|
|
|
data_fetcher => $self->data_fetcher
|
181
|
|
|
|
|
|
|
})
|
182
|
0
|
|
|
|
|
|
} grep { $_->{match} >= $filter } @$users;
|
|
0
|
|
|
|
|
|
|
183
|
0
|
|
|
|
|
|
});
|
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
}
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head2 C
|
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Retrieves the user's friends from the Audioscrobbler / LastFM database.
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Returns either a list of users or a reference to an array of users when called
|
192
|
|
|
|
|
|
|
in list context or scalar context, respectively. The users are returned as
|
193
|
|
|
|
|
|
|
L objects by default.
|
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=cut
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
sub friends {
|
198
|
0
|
|
|
0
|
1
|
|
my $self = shift;
|
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
return $self->fetch_users($self->friends_postfix, sub {
|
201
|
0
|
|
|
0
|
|
|
my $users = shift;
|
202
|
|
|
|
|
|
|
map {
|
203
|
0
|
|
|
|
|
|
$self->friends_class->new({
|
204
|
|
|
|
|
|
|
name => $_->{username},
|
205
|
|
|
|
|
|
|
url => URI->new($_->{url}),
|
206
|
0
|
|
|
|
|
|
picture_url => URI->new($_->{image}),
|
207
|
|
|
|
|
|
|
data_fetcher => $self->data_fetcher
|
208
|
|
|
|
|
|
|
})
|
209
|
|
|
|
|
|
|
} @$users;
|
210
|
0
|
|
|
|
|
|
});
|
211
|
|
|
|
|
|
|
}
|
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
=head2 C
|
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
Internal method used to fetch users. $postfix should be the users data feed
|
216
|
|
|
|
|
|
|
postfix and $callback should be a function reference which will be called with
|
217
|
|
|
|
|
|
|
a arrayref of user data as the only parameter and should return user-derived
|
218
|
|
|
|
|
|
|
objects.
|
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
It returns either an arrayref or a list of objects depending on the calling
|
221
|
|
|
|
|
|
|
context.
|
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
=cut
|
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub fetch_users {
|
226
|
0
|
|
|
0
|
1
|
|
my ($self, $postfix, $callback) = @_;
|
227
|
|
|
|
|
|
|
|
228
|
0
|
|
|
|
|
|
my $data = $self->fetch_data($postfix);
|
229
|
|
|
|
|
|
|
|
230
|
0
|
|
|
|
|
|
my @users;
|
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# check if we've got any users
|
233
|
0
|
0
|
|
|
|
|
if (ref $data->{user} eq 'ARRAY') {
|
234
|
|
|
|
|
|
|
|
235
|
0
|
|
|
|
|
|
shift @{$data->{user}};
|
|
0
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
|
237
|
0
|
|
|
|
|
|
@users = $callback->($data->{user});
|
238
|
|
|
|
|
|
|
}
|
239
|
|
|
|
|
|
|
|
240
|
0
|
0
|
|
|
|
|
return wantarray ? @users : \@users;
|
241
|
|
|
|
|
|
|
}
|
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=head2 C
|
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Returns the URL from which other URLs used for fetching user info will be
|
246
|
|
|
|
|
|
|
derived from.
|
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=cut
|
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
sub resource_path {
|
251
|
0
|
|
|
0
|
1
|
|
my $self = shift;
|
252
|
0
|
|
|
|
|
|
$self->uri_builder( $self->name );
|
253
|
|
|
|
|
|
|
}
|
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head1 AUTHOR
|
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
Nilson Santos Figueiredo Junior, C<< >>
|
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE
|
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
Copyright 2006-2007 Nilson Santos Figueiredo Junior, all rights reserved.
|
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it
|
264
|
|
|
|
|
|
|
under the same terms as Perl itself.
|
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=cut
|
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
1; # End of WebService::Audioscrobbler::User
|