net-lastfmapi/lib/Net/LastFMAPI.pm
package Net::LastFMAPI;
use strict;
use warnings;
use v5.10;
use LWP::UserAgent;
use Digest::MD5 'md5_hex';
use JSON::XS;
use YAML::Syck;
use File::Slurp;
use File::Path 'make_path';
use File::HomeDir 'my_home';
use URI;
use Exporter 'import';
our @EXPORT = ('lastfm', 'lastfm_config', 'lastfm_iter');
use Carp;
our $VERSION = 0.5;
our $url = 'http://ws.audioscrobbler.com/2.0/';
our $api_key = 'dfab9b1c7357c55028c84b9a8fb68880';
our $secret = 'd004c86dcfa8ef4c3977b04f558535f2';
our $session_key; # see load_save_sessionkey()
our $ua = new LWP::UserAgent(agent => "Net::LastFMAPI/$VERSION");
our $username; # not important
our $xml = 0;
our $cache = 0;
our $cache_dir = my_home()."/.net-lastfmapi-cache/";
our $sk_symlink = my_home()."/.net-lastfmapi-sessionkey";
sub load_save_sessionkey { # see get_session_key()
my $key = shift;
if ($key) {
symlink($key, $sk_symlink)
}
else {
$key = readlink($sk_symlink);
}
$session_key = $key;
}
sub lastfm_config {
my %configs = @_;
for my $k (qw{api_key secret session_key ua xml cache cache_dir sk_symlink}) {
my $v = delete $configs{$k};
if (defined $v) {
no strict 'refs';
${$k} = $v;
}
}
croak "invalid config items: ".join(", ", keys %configs) if keys %configs;
}
sub dumpfile {
my $file = shift;
my $json = encode_json(shift);
write_file($file, $json);
}
sub loadfile {
my $file = shift;
my $json = read_file($file);
decode_json($json);
}
#{{{
our $methods = {
'album.addtags' => {auth => 1, post => 1, signed => 1, id => 302},
'album.getbuylinks' => {id => 429},
'album.getinfo' => {id => 290},
'album.getshouts' => {page => 1, id => 450},
'album.gettags' => {auth => 1, signed => 1, id => 317},
'album.gettoptags' => {id => 438},
'album.removetag' => {auth => 1, post => 1, signed => 1, id => 314},
'album.search' => {page => 1, id => 357},
'album.share' => {auth => 1, post => 1, signed => 1, id => 436},
'artist.addtags' => {auth => 1, post => 1, signed => 1, id => 303},
'artist.getcorrection' => {id => 446},
'artist.getevents' => {page => 1, id => 117},
'artist.getimages' => {page => 1, id => 407},
'artist.getinfo' => {id => 267},
'artist.getpastevents' => {page => 1, id => 428},
'artist.getpodcast' => {id => 118},
'artist.getshouts' => {page => 1, id => 397},
'artist.getsimilar' => {id => 119},
'artist.gettags' => {auth => 1, signed => 1, id => 318},
'artist.gettopalbums' => {page => 1, id => 287},
'artist.gettopfans' => {id => 310},
'artist.gettoptags' => {id => 288},
'artist.gettoptracks' => {page => 1, id => 277},
'artist.removetag' => {auth => 1, post => 1, signed => 1, id => 315},
'artist.search' => {page => 1, id => 272},
'artist.share' => {auth => 1, post => 1, signed => 1, id => 306},
'artist.shout' => {auth => 1, post => 1, signed => 1, id => 408},
'auth.getmobilesession' => {signed => 1, id => 266},
'auth.getsession' => {signed => 1, id => 125},
'auth.gettoken' => {signed => 1, id => 265},
'chart.gethypedartists' => {page => 1, id => 493},
'chart.gethypedtracks' => {page => 1, id => 494},
'chart.getlovedtracks' => {page => 1, id => 495},
'chart.gettopartists' => {page => 1, id => 496},
'chart.gettoptags' => {page => 1, id => 497},
'chart.gettoptracks' => {page => 1, id => 498},
'event.attend' => {auth => 1, post => 1, signed => 1, id => 307},
'event.getattendees' => {page => 1, id => 391},
'event.getinfo' => {id => 292},
'event.getshouts' => {page => 1, id => 399},
'event.share' => {auth => 1, post => 1, signed => 1, id => 350},
'event.shout' => {auth => 1, post => 1, signed => 1, id => 409},
'geo.getevents' => {page => 1, id => 270},
'geo.getmetroartistchart' => {id => 421},
'geo.getmetrohypeartistchart' => {id => 420},
'geo.getmetrohypetrackchart' => {id => 422},
'geo.getmetrotrackchart' => {id => 423},
'geo.getmetrouniqueartistchart' => {id => 424},
'geo.getmetrouniquetrackchart' => {id => 425},
'geo.getmetroweeklychartlist' => {id => 426},
'geo.getmetros' => {id => 435},
'geo.gettopartists' => {page => 1, id => 297},
'geo.gettoptracks' => {page => 1, id => 298},
'group.gethype' => {id => 259},
'group.getmembers' => {page => 1, id => 379},
'group.getweeklyalbumchart' => {id => 293},
'group.getweeklyartistchart' => {id => 294},
'group.getweeklychartlist' => {id => 295},
'group.getweeklytrackchart' => {id => 296},
'library.addalbum' => {auth => 1, post => 1, signed => 1, id => 370},
'library.addartist' => {auth => 1, post => 1, signed => 1, id => 371},
'library.addtrack' => {auth => 1, post => 1, signed => 1, id => 372},
'library.getalbums' => {page => 1, id => 321},
'library.getartists' => {page => 1, id => 322},
'library.gettracks' => {page => 1, id => 323},
'library.removealbum' => {auth => 1, post => 1, signed => 1, id => 523},
'library.removeartist' => {auth => 1, post => 1, signed => 1, id => 524},
'library.removescrobble' => {auth => 1, post => 1, signed => 1, id => 525},
'library.removetrack' => {auth => 1, post => 1, signed => 1, id => 526},
'playlist.addtrack' => {auth => 1, post => 1, signed => 1, id => 337},
'playlist.create' => {auth => 1, post => 1, signed => 1, id => 365},
'radio.getplaylist' => {auth => 1, signed => 1, id => 256},
'radio.search' => {id => 418},
'radio.tune' => {auth => 1, post => 1, signed => 1, id => 160},
'tag.getinfo' => {id => 452},
'tag.getsimilar' => {id => 311},
'tag.gettopalbums' => {page => 1, id => 283},
'tag.gettopartists' => {page => 1, id => 284},
'tag.gettoptags' => {id => 276},
'tag.gettoptracks' => {page => 1, id => 285},
'tag.getweeklyartistchart' => {id => 358},
'tag.getweeklychartlist' => {id => 359},
'tag.search' => {page => 1, id => 273},
'tasteometer.compare' => {id => 258},
'tasteometer.comparegroup' => {id => 500},
'track.addtags' => {auth => 1, post => 1, signed => 1, id => 304},
'track.ban' => {auth => 1, post => 1, signed => 1, id => 261},
'track.getbuylinks' => {id => 431},
'track.getcorrection' => {id => 447},
'track.getfingerprintmetadata' => {id => 441},
'track.getinfo' => {id => 356},
'track.getshouts' => {page => 1, id => 453},
'track.getsimilar' => {id => 319},
'track.gettags' => {auth => 1, signed => 1, id => 320},
'track.gettopfans' => {id => 312},
'track.gettoptags' => {id => 289},
'track.love' => {auth => 1, post => 1, signed => 1, id => 260},
'track.removetag' => {auth => 1, post => 1, signed => 1, id => 316},
'track.scrobble' => {auth => 1, post => 1, signed => 1, id => 443},
'track.search' => {page => 1, id => 286},
'track.share' => {auth => 1, post => 1, signed => 1, id => 305},
'track.unban' => {auth => 1, post => 1, signed => 1, id => 449},
'track.unlove' => {auth => 1, post => 1, signed => 1, id => 440},
'track.updatenowplaying' => {auth => 1, post => 1, signed => 1, id => 454},
'user.getartisttracks' => {page => 1, id => 432},
'user.getbannedtracks' => {page => 1, id => 448},
'user.getevents' => {page => 1, id => 291},
'user.getfriends' => {page => 1, id => 263},
'user.getinfo' => {auth => 1, id => 344},
'user.getlovedtracks' => {page => 1, id => 329},
'user.getneighbours' => {id => 264},
'user.getnewreleases' => {id => 444},
'user.getpastevents' => {page => 1, id => 343},
'user.getpersonaltags' => {page => 1, id => 455},
'user.getplaylists' => {id => 313},
'user.getrecentstations' => {auth => 1, signed => 1, page => 1, id => 414},
'user.getrecenttracks' => {page => 1, id => 278},
'user.getrecommendedartists' => {auth => 1, signed => 1, page => 1, id => 388},
'user.getrecommendedevents' => {auth => 1, signed => 1, page => 1, id => 375},
'user.getshouts' => {page => 1, id => 401},
'user.gettopalbums' => {page => 1, id => 299},
'user.gettopartists' => {page => 1, id => 300},
'user.gettoptags' => {id => 123},
'user.gettoptracks' => {page => 1, id => 301},
'user.getweeklyalbumchart' => {id => 279},
'user.getweeklyartistchart' => {id => 281},
'user.getweeklychartlist' => {id => 280},
'user.getweeklytrackchart' => {id => 282},
'user.shout' => {auth => 1, post => 1, signed => 1, id => 411},
'venue.getevents' => {id => 394},
'venue.getpastevents' => {page => 1, id => 395},
'venue.search' => {page => 1, id => 396},
};
#}}}
our %last_params;
our $last_response;
our %last_response_meta;
sub lastfm {
my ($method, @params) = @_;
$method = lc($method);
my %params;
my $i = 0;
while (my $p = shift @params) {
if (ref $p eq "HASH") {
while (my ($k,$v) = each %$p) {
$params{$k."[".$i."]"} = $v;
}
croak "too multitudinous (limit 50)" if $i > 49;
$i++
}
else {
$params{$p} = shift @params;
}
}
$params{method} = $method;
$params{api_key} = $api_key;
$params{format} = "json" unless $params{format} || $xml;
delete $params{format} if $params{format} && $params{format} eq "xml";
unless (exists $methods->{$method}) {
carp "method $method is not known to Net::LastFMAPI"
}
elsif (defined $params{page} && !$methods->{$method}->{page}) {
carp "method $method is not known to be paginated, but hey"
}
sessionise(\%params);
sign(\%params);
%last_params = %params;
my $cache = $cache;
if ( $cache ) {
unless ( -d $cache ) {
$cache = $cache_dir;
make_path( $cache );
}
my $cache_key_json = encode_json( [ map { $_, $params{$_} } sort keys %params ] );
my $file = "$cache/" . md5_hex( $cache_key_json );
if ( -f $file ) {
my $data = loadfile( $file );
return _rowify_content( $data->{content} );
}
$cache = $file;
}
my $res;
if ($methods->{$method}->{post}) {
$res = $ua->post($url, Content => \%params);
}
else {
my $uri = URI->new($url);
$uri->query_form(%params);
$res = $ua->get($uri);
}
$params{format} ||= "xml";
my $content = $res->decoded_content;
my $decoded_json = sub { $content = decode_json($content); };
unless ($res->is_success &&
($params{format} eq "json" && !exists($decoded_json->()->{error})
|| $params{format} eq "xml" && $content =~ /<lfm status="ok">/)) {
my @clues;
if ($res->is_success) {
if ($res->decoded_content =~ /Invalid session key - Please re-authenticate/) {
push @clues, "Set NET_LASTFMAPI_REAUTH=1 to re-authenticate";
}
elsif ($methods->{$method}) {
push @clues, "Documentation for the '$method' method:\n"
." http://www.last.fm/api/show/?service=$methods->{$method}->{id}"
}
}
if (ref $content eq "HASH") {
$content = "Content translated JSON->YAML:\n".Dump($content);
}
else {
$content = "Content:\n$content";
}
croak join("\n",
"Something went wrong.",
"HTTP Status: ".$res->status_line,
@clues,
"",
$content,
""
);
}
if ($cache) {
dumpfile($cache, {content => $content});
}
$last_response = $content;
return _rowify_content( $content );
}
sub _rowify_content {
my ( $content ) = @_;
return extract_rows( $content ) if wantarray;
return $content;
}
sub extract_rows {
my ( $rs ) = @_;
if (!$last_params{format}) {
croak "returning rows from xml is not supported";
}
my @rk = keys %$rs;
my $r = $rs->{$rk[0]};
my @ks = sort keys %$r;
unless (@rk == 1 && @ks == 2 && $ks[0] eq '@attr') {
carp "extracting rows may be broken";
if (defined $r->{'#text'} && $r->{'#text'} =~ /^\s+$/
&& defined $r->{total} && $r->{total} == 0) { # no rows
return ();
};
}
%last_response_meta = %{ $r->{$ks[0]} };
my $rows = $r->{$ks[1]};
if (ref $rows ne "ARRAY") {
# schemaless translation of xml to data creates these cases
if (ref $rows eq "HASH") { # 1 row
$rows = [ $rows ];
}
elsif ($rows =~ /^\s+$/) { # no rows
$rows = [];
carp "got whitespacey string instead of empty row array, this happens"
}
else {
carp "not an array of rows... '$rows' returning ()";
}
}
return @$rows;
}
sub lastfm_iter {
my @rows = lastfm(@_, page => 1);
my $params = { %last_params };
if (!$params->{format}) {
croak "paginating xml is not supported";
}
if (@rows == 0) {
return sub { };
}
my $page = $last_response_meta{page};
my $totalpages = $last_response_meta{totalPages};
my $next_page = sub {
return () if $page++ >= $totalpages;
my %params = %$params;
$params{page} = $page;
my $method = delete $params{method};
my @rows = lastfm($method, %params);
return @rows;
};
return sub {
unless (@rows) {
push @rows, $next_page->();
}
return shift @rows;
}
}
sub sessionise {
my $params = shift;
my $m = $methods->{$params->{method}};
unless (delete $params->{auth} || $m && $m->{auth}) {
return
}
$params->{sk} = get_session_key();
}
sub get_session_key {
unless (defined $session_key) {
load_save_sessionkey()
}
unless (defined $session_key) {
my $key;
eval { $key = request_session(); };
if ($@) {
die "--- Died while making requests to get a session:\n$@";
}
load_save_sessionkey($key);
}
return $session_key || die "unable to acquire session key...";
}
sub request_session {
my $res = lastfm("auth.gettoken", format => "xml");
my ($token) = $res =~ m{<token>(.+)</token>}
or die "no foundo token: $res";
talk_authorisation($token);
my $sess = lastfm("auth.getSession", token => $token, format => "xml");
($username) = $sess =~ m{<name>(.+)</name>}
or die "no name!? $sess";
my ($key) = $sess =~ m{<key>(.+)</key>}
or die "no key!? $sess";
return $key;
}
sub talk_authorisation {
my $token = shift;
say "Sorry about this but could you go over here: "
."http://www.last.fm/api/auth/?api_key="
.$api_key."&token=".$token;
say "Hit enter to continue...";
<STDIN>;
}
sub sign {
my $params = shift;
return unless $methods->{$params->{method}}->{signed};
my $jumble = join "", map { $_ => $params->{$_} }
grep { !($_ eq "format" || $_ eq "callback") } sort keys %$params;
my $hash = md5_hex($jumble.$secret);
$params->{api_sig} = $hash;
}
if ($ENV{NET_LASTFMAPI_REAUTH}) {
say "Re-authenticatinging...";
if (readlink($sk_symlink)) {
unlink($sk_symlink);
}
undef $session_key;
get_session_key();
say "Got session key: $session_key";
say "Unsetting NET_LASTFMAPI_REAUTH...";
delete $ENV{NET_LASTFMAPI_REAUTH};
say "Done";
exit;
}
1;
__END__
=head1 NAME
Net::LastFMAPI - LastFM API 2.0
=head1 SYNOPSIS
use Net::LastFMAPI;
my $perl_data = lastfm("artist.getSimilar", artist => "Robbie Basho");
# sets up a session/gets authorisation when needed for write actions:
my $res = lastfm(
"track.scrobble",
artist => "Robbie Basho",
track => "Wounded Knee Soliloquy",
timestamp => time(),
);
$success = $res->{scrobbles}->{'@attr'}->{accepted} == 1;
my $xml = lastfm(...); # with config value: xml => 1
my $xml = lastfm(..., format => "xml");
$success = $xml =~ m{<scrobbles accepted="1"};
# paginated data can be iterated through per row
my $iter = lastfm_iter("artist.getTopTracks", artist => "John Fahey");
while (my $row = $iter->()) {
say $row->{playcount} .": ". $row->{name};
my $whole_response = $Net::LastFMAPI::last_response;
}
# wantarray? tries to extract the rows of data for you
my @rows = lastfm(...);
# see also:
# bin/cmd.pl album.getInfo artist=Laddio Bolocko album=As If In Real Time
# bin/scrobble.pl Artist - Track
# bin/portablog-scrobbler.pl
=head1 DESCRIPTION
Makes requests to http://ws.audioscrobbler.com/2.0/ and returns the result.
Takes care of POSTing to write methods, doing authorisation when needed.
Dies if something went obviously wrong.
Can return xml if you like, defaults to returning perl data (requesting json).
Beware of "@attr" and empty elements turned into whitespace strings instead of
empty arrays, single elements turned into a hash instead of an array of one hash.
=head1 SESSION KEY AND AUTHORISATION
lastfm_config(
session_key => $key,
);
The session key will be sought when an authorised request is needed. See L<CONFIG>.
If it is not configured or saves in a symlink then on-screen instructions should
be followed to authorise in a web browser with whoever is logged in to L<last.fm>.
See L<http://www.last.fm/api/desktopauth>.
It is saved in the symlink B<File::HomeDir::my_home()/.net-lastfmapi-sessionkey>
by default. This is probably fine.
Consider altering the subroutines B<talk_authentication>, B<load_save_sessionkey>,
or simply configuring (see L<CONFIG>) before needing it.
=head1 CACHING
lastfm_config(
# to enable caching
cache => 1,
# default:
cache_dir => File::HomeDir::my_home()."/.net-lastfmapi-cache/",
);
Good for development.
=head1 RETURNING ROWS
my @artists = lastfm("artist.getSimilar", ...);
Call C<lastfm> in list context. Attempts to extract for you the rows inside the
response. The whole response is in C<$Net::LastFMAPI::last_response>. See also
L<PAGINATION>
=head1 RETURN XML
lastfm_config(xml => 1);
# or
lastfm(..., format => "xml"):
This will return an xml string to you. You can also set B<format =E<gt> "xml">
for a particular request. Default format is JSON, as getting perl data is much
from the C<lastfm> method is more casual.
=head1 PAGINATION
my $iter = lastfm_iter(...);
while (my $row = $iter->()) {
...
}
Will attempt to extract rows from a response, passing you one at a time,
keeping going into the next page, and the next...
=head1 CONFIG
lastfm_config(
# associates the request with a user
# got with their permission initially
session_key => $key,
# these are explained elsewhere in this pod
xml => 1,
cache => 1,
cache_dir => $path,
# for your own api account see http://www.last.fm/api/account
# you can use this module's (default) api account fine
api_key => $your_api_key,
secret => $your_secret,
# LWP::UserAgent-sorta thing
ua => $ua,
# default File::HomeDir::my_home()/.net-lastfmapi-sessionkey
sk_symlink => $path,
);
B<cache> and B<cache_dir> are likely most popular, see L<CACHING>.
This module can handle the B<session_key> fine, see L<SESSION KEY AND AUTHORISATION>.
B<api_key> and B<secret> are for representing this module on the page where the
user authorises their account in the process of acquiring a new B<session_key>.
You might want to have your own identity in there.
=head1 SEE ALSO
L<Net::LastFM> doesn't handle sessions for you, won't POST to write methods
I had no luck with the 1.2 API modules: L<WebService::LastFM>,
L<Music::Audioscrobbler::Submit>, L<Net::LastFM::Submission>
=head1 BUGS/CODE
L<https://github.com/st3vil/Net-LastFMAPI>
=head1 AUTHOR
Steev Eeeriumn <drsteve@cpan.org>
=head1 COPYRIGHT
Copyright (c) 2011, Steev Eeeriumn. All Rights Reserved.
This module is free software. It may be used, redistributed
and/or modified under the terms of the Perl Artistic License
(see http://www.perl.com/perl/misc/Artistic.html)