Audio-Scrobbler-0.01000755 001750 000000 00000000000 10356170042 014414 5ustar00roamwheel000000 000000 Audio-Scrobbler-0.01/lib000755 001750 000000 00000000000 10356170042 015162 5ustar00roamwheel000000 000000 Audio-Scrobbler-0.01/MANIFEST000644 001750 000000 00000000263 10355243251 015627 0ustar00roamwheel000000 000000 Changes Makefile.PL MANIFEST README bin/scrobbler-helper t/Audio-Scrobbler.t lib/Audio/Scrobbler.pm META.yml Module meta-data (added by MakeMaker) Audio-Scrobbler-0.01/META.yml000644 001750 000000 00000000651 10356170042 015746 0ustar00roamwheel000000 000000 # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Audio-Scrobbler version: 0.01 version_from: lib/Audio/Scrobbler.pm installdirs: site requires: Config::IniFiles: 2 Digest::MD5: 2 LWP: 5 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Audio-Scrobbler-0.01/t000755 001750 000000 00000000000 10356170042 014657 5ustar00roamwheel000000 000000 Audio-Scrobbler-0.01/Changes000644 001750 000000 00000000547 10356167321 016002 0ustar00roamwheel000000 000000 Revision history for Perl extension Audio::Scrobbler. 0.01 Mon Jan 2 09:12:30 GMT 2006 - later changed over to depending on Perl 5.6, since 5.00503 lacks the Unicode/UTF-8 processing features we need; - original version; created by h2xs 1.23 with options -AX -b 5.5.3 -n Audio::Scrobbler --skip-exporter $Id: Changes 86 2006-01-02 09:13:53Z roam $ Audio-Scrobbler-0.01/bin000755 001750 000000 00000000000 10356170042 015164 5ustar00roamwheel000000 000000 Audio-Scrobbler-0.01/README000644 001750 000000 00000002114 10356167560 015364 0ustar00roamwheel000000 000000 Audio-Scrobbler version 0.01 ============================ The Audio-Scrobbler module provides a Perl and command-line interface to Last.fm's AudioScrobbler - http://www.audioscrobbler.com/. For the present, only track submission is implemented, but more is planned for the future :) The Perl interface is the Audio::Scrobbler module, and the command-line tool is scrobbler-helper; see the respective manual pages for more information. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Config::IniFiles Digest::MD5 Encode (should be provided with the Perl runtime) Getopt::Std (should be provided with the Perl runtime) libwww-perl COPYRIGHT AND LICENCE Copyright (C) 2005, 2006 by Peter Pentchev This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.7 or, at your option, any later version of Perl 5 you may have available. $Id: README 88 2006-01-02 09:16:32Z roam $ Audio-Scrobbler-0.01/Makefile.PL000644 001750 000000 00000001174 10356167321 016456 0ustar00roamwheel000000 000000 use 5.006; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # $Id: Makefile.PL 86 2006-01-02 09:13:53Z roam $ WriteMakefile( NAME => 'Audio::Scrobbler', VERSION_FROM => 'lib/Audio/Scrobbler.pm', # finds $VERSION PREREQ_PM => { 'Config::IniFiles' => 2, 'Digest::MD5' => 2, 'LWP' => 5, }, EXE_FILES => [ qw{ bin/scrobbler-helper } ], ABSTRACT_FROM => 'lib/Audio/Scrobbler.pm', # retrieve abstract from module AUTHOR => 'Peter Pentchev ', ); Audio-Scrobbler-0.01/bin/scrobbler-helper000755 001750 000000 00000014216 10356167560 020442 0ustar00roamwheel000000 000000 #!/usr/bin/perl -w use 5.006; use strict; =head1 NAME scrobbler-helper - submit a track to AudioScrobbler =head1 SYNOPSIS scrobbler-helper [-nv] [-e encoding] [-f configfile] -P progname -V progver title artist album year comment genre length =head1 DESCRIPTION The B utility uses the C module to submit a single track's information to Last.fm's AudioScrobbler - http://www.audioscrobbler.com/. It requires the program (plug-in) name and version to be specified on the command line, and also requires all seven track attributes, although some of them may be omitted by supplying empty strings. The following command-line options are recognized: =over 4 =item -e encoding Specify the character encoding of the track info, if it is neither UTF-8 nor the one specified via B in the configuration file. =item -f configfile Specify a different configuration file, not ~/.scrobbler-helper.conf. =item -n Do not actually perform the handshake and submission (sets the C B<"fake"> option). =item -P progname Specify the name of the AudioScrobbler plug-in submitting the data. This option is B! =item -v Verbose operation - display diagnostic messages to the standard output (sets the C B<"verbose"> option). =item -V progver Specify the version of the AudioScrobbler plug-in submitting the data. This option is B! =back Besides the command line, the B utility also retrieves information from a per-user configuration file, usually ~/.scrobbler-helper.conf; it is a INI-style file, which must contain a secion named B<"global">. The following variables are recognized, with B and B being mandatory: =over 4 =item * default_encoding The encoding to assume for the track info, if none is supplied with the B<-e> command-line option. If neither B<-e> is given on the command line nor B specified in the configuration file, the B utility assumes UTF-8. =item * fix_track_name A boolean flag specifying whether to do some trivial fixes on the song name before submitting it. Currently, this only removes a "DD. " sequence at the start of the name, where 'D' is a digit. The values C, C, C, and C<1> are considered to be true. =item * password The password for the AudioScrobbler account. =item * username The username for the AudioScrobbler account. =back [global] username=jrandomlistener password=mylittlesecret # Optional (the default is UTF-8) default_encoding=windows-1251 # Optional (the default is "no") fix_track_name=yes =cut use Config::IniFiles; use Encode; use Getopt::Std; use Audio::Scrobbler; sub is_true($); my %infovars = ( 'cmdopts' => [ qw/P V/ ], 'cmdline' => [ qw/title artist album year comment genre length/ ], 'global' => [ qw/username password/ ], 'global_nc' => [ qw/default_encoding fix_track_name/ ], ); my $verbose = 0; MAIN: { my %info; my (%opts, %cfg) = (); my ($configfname) = "$ENV{HOME}/.scrobbler-helper.conf"; my ($scrob); getopts('nve:f:P:V:', \%opts) or die "Parsing options: $!\n"; $configfname = $opts{'f'} if $opts{'f'}; $verbose = 1 if $opts{'v'}; $info{'verbose'} = $verbose; $info{'fake'} = 1 if $opts{'n'}; @info{qw/progname progver encoding/} = @opts{@{$infovars{'cmdopts'}}}; if (!($info{'progname'} && $info{'progver'})) { die "Must specify program name (-P) and version (-V)!\n"; } if (@ARGV != @{$infovars{'cmdline'}}) { die 'Need '.@{$infovars{'cmdline'}}.' args: '. join(', ', @{$infovars{'cmdline'}}).".\n"; } @info{@{$infovars{'cmdline'}}} = @ARGV; map { s/^\s+//; s/\s+$//; } @info{@{$infovars{'cmdline'}}}; if (!tie %cfg, 'Config::IniFiles', (-file => $configfname, -allowcontinue => 1)) { my $err = join "\n", "Could not read $configfname: $!", @Config::IniFiles::errors; die "$err\n"; } @info{@{$infovars{'global'}}, @{$infovars{'global_nc'}}} = @{$cfg{'global'}}{@{$infovars{'global'}}, @{$infovars{'global_nc'}}}; for (@{$infovars{'global'}}) { die 'Missing variables in the config file, need at least '. join(', ', @{$infovars{'global'}}).".\n" unless defined($info{$_}); } # Recode the track info into UTF-8 if (defined($info{'default_encoding'}) && (!defined($info{'encoding'}) || $info{'encoding'} eq '')) { $info{'encoding'} = $info{'default_encoding'}; } if (defined($info{'encoding'}) && $info{'encoding'} !~ /^utf-?8$/i) { print "RDBG recoding track info from $info{encoding} to UTF8\n" if $verbose; foreach (@{$infovars{'cmdline'}}) { $info{$_} = decode($info{'encoding'}, $info{$_}); } } # Fix up the track name if requested if (defined($info{'fix_track_name'}) && is_true($info{'fix_track_name'})) { $info{'title'} =~ s/^\d\d?\. //; print "RDBG fixed up the track name to $info{title}\n" if $verbose; } # Rock'n'roll! $scrob = new Audio::Scrobbler('cfg' => \%info) or die "Could not create an Audio::Scrobbler object\n"; $scrob->handshake() or die "Scrobbler: ".$scrob->err()."\n"; print "RDBG handshake successful, it seems\n" if $verbose; $scrob->submit(\%info) or die "Scrobbler submit: ".$scrob->err()."\n"; print "RDBG submision successful, it seems\n" if $verbose; } sub is_true($) { my $s = lc $_[0]; return ($s eq '1' || $s eq 'on' || $s =~ /^[ty]/); } =head1 TODO =over 4 =item * Command-line options, so people don't have to submit everything... =item * Storing and caching of unsuccessful submissions for later retrying. =back =head1 SEE ALSO B =over 4 =item * http://www.last.fm/ =item * http://www.audioscrobbler.com/ =item * http://www.audioscrobbler.net/ =back The home site of the C module is http://devel.ringlet.net/audio/Audio-Scrobbler/ =head1 AUTHOR Peter Pentchev, Eroam@ringlet.netE =head1 COPYRIGHT AND LICENSE Copyright (C) 2005, 2006 by Peter Pentchev. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.7 or, at your option, any later version of Perl 5 you may have available. $Id: scrobbler-helper 88 2006-01-02 09:16:32Z roam $ =cut Audio-Scrobbler-0.01/t/Audio-Scrobbler.t000644 001750 000000 00000001100 10355031441 020065 0ustar00roamwheel000000 000000 # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Audio-Scrobbler.t' # # $Id: Audio-Scrobbler.t 76 2005-12-29 19:04:01Z roam $ ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test; BEGIN { plan tests => 1 }; use Audio::Scrobbler; ok(1); # If we made it this far, we're ok. ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. Audio-Scrobbler-0.01/lib/Audio000755 001750 000000 00000000000 10356170042 016223 5ustar00roamwheel000000 000000 Audio-Scrobbler-0.01/lib/Audio/Scrobbler.pm000644 001750 000000 00000024346 10356167560 020601 0ustar00roamwheel000000 000000 package Audio::Scrobbler; use 5.006; use strict; use bytes; =head1 NAME Audio::Scrobbler - Perl interface to audioscrobbler.com/last.fm =head1 SYNOPSIS use Audio::Scrobbler; $scrob = new Audio::Scrobbler(cfg => { ... }); $scrob->handshake(); $scrob->submit(artist => "foo", album => "hello", track => "world", length => 180); =head1 DESCRIPTION The C module provides a Perl interface to the track submission API of Last.fm's AudioScrobbler - http://www.audioscrobbler.com/. So far, only track submissions are handled; the future plans include access to the various statistics. =cut use Digest::MD5 qw/md5_hex/; use LWP::UserAgent; our @ISA = qw(); our $VERSION = '0.01'; sub err($ $); sub handshake($); sub get_ua($); sub URLEncode($); sub URLDecode($); =head1 METHODS The C class defines the following methods: =over 4 =item * new ( cfg => { ... } ) Create a new C object and initialize it with the provided configuration parameters. The parameters themselves are discussed in the description of the L and L methods below. =cut sub new { my $proto = shift; my $class = ref $proto || $proto; my $self = { }; my %args = @_; if (exists($args{'cfg'}) && ref $args{'cfg'} eq 'HASH') { $self->{'cfg'} = $args{'cfg'}; } else { $self->{'cfg'} = { }; } $self->{'cfg'} = $args{'cfg'} || { }; $self->{'ua'} = undef; $self->{'req'} = { }; $self->{'err'} = undef; bless $self, $class; return $self; } =item * err (message) Retrieves or sets the description of the last error encountered in the operation of this C object. =cut sub err($ $) { my ($self, $err) = @_; $self->{'err'} = $err if $err; return $self->{'err'}; } =item * handshake () Perfors a handshake with the AudioScrobbler API via a request to http://post.audioscrobbler.com/. This method requires that the following configuration parameters be set: =over 4 =item * progname The name of the program (or plug-in) performing the AudioScrobbler handshake. =item * progver The version of the program (or plug-in). =item * username The username of the user's AudioScrobbler registration. =back If the handshake is successful, the method returns a true value, and the L method may be invoked. Otherwise, an appropriate error message may be retrieved via the L method. If the B configuration parameter is set, the L method does not actually perform the handshake with the AudioScrobbler API, just simulates a successful handshake and returns a true value. If the B configuration parameter is set, the L method reports its progress with diagnostic messages to the standard output. =cut sub handshake($) { my ($self) = @_; my ($ua, $req, $resp, $c, $s); my (@lines); delete $self->{'nexturl'}; delete $self->{'md5ch'}; $ua = $self->get_ua() or return undef; $s = 'hs=true&p=1.1&c='. URLEncode($self->{'cfg'}{'progname'}).'&v='. URLEncode($self->{'cfg'}{'progver'}).'&u='. URLEncode($self->{'cfg'}{'username'}); print "RDBG about to send the handshake request: $s\n" if $self->{'cfg'}{'verbose'}; if ($self->{'cfg'}{'fake'}) { print "RDBG faking it...\n" if $self->{'cfg'}{'verbose'}; $self->{'md5ch'} = 'furrfu'; $self->{'nexturl'} = 'http://furrfu.furrblah/furrquux'; return 1; } $req = new HTTP::Request('GET', "http://post.audioscrobbler.com/?$s"); if (!$req) { $self->err('Could not create the handshake request object'); return undef; } $resp = $ua->request($req); print "RDBG resp is $resp, success is ".$resp->is_success()."\n" if $self->{'cfg'}{'verbose'}; if (!$resp) { $self->err('Could not get a handshake response'); return undef; } elsif (!$resp->is_success()) { $self->err('Could not complete the handshake: '. $resp->status_line()); return undef; } $c = $resp->content(); print "RDBG resp content is:\n$c\nRDBG ====\n" if $self->{'cfg'}{'verbose'}; @lines = split /[\r\n]+/, $c; $_ = $lines[0]; SWITCH: { /^FAILED\s+(.*)/ && do { $self->err("Could not complete the handshake: $1"); return undef; }; /^BADUSER\b/ && do { $self->err('Could not complete the handshake: invalid username'); return undef; }; /^UPTODATE\b/ && do { $self->{'md5ch'} = $lines[1]; $self->{'nexturl'} = $lines[2]; last SWITCH; }; /^UPDATE\s+(.*)/ && do { # See if we care. (FIXME) $self->{'md5ch'} = $lines[1]; $self->{'nexturl'} = $lines[2]; last SWITCH; }; $self->err("Unrecognized handshake response: $_"); return undef; } print "RDBG MD5 challenge '$self->{md5ch}', nexturl '$self->{nexturl}'\n" if $self->{'cfg'}{'verbose'}; return 1; } =item * submit ( info ) Submits a single track to the AudioScrobbler API. This method may only be invoked after a successful L. The track information is contained in the hash referenced by the B parameter; the following elements are used: =over 4 =item * title The track's title. =item * artist The name of the artist performing the track. =item * length The duration of the track in seconds. =item * album The name of the album (optional). =back Also, the L method requires that the following configuration parameters be set for this C object: =over 4 =item * username The username of the user's AudioScrobbler registration. =item * password The password for the AudioScrobbler registration. =back If the submission is successful, the method returns a true value. Otherwise, an appropriate error message may be retrieved via the L method. If the B configuration parameter is set, the L method does not actually submit the track information to the AudioScrobbler API, just simulates a successful submission and returns a true value. If the B configuration parameter is set, the L method reports its progress with diagnostic messages to the standard output. =cut sub submit($ \%) { my ($self, $info) = @_; my ($ua, $req, $resp, $s, $c, $datestr, $md5resp); my (@t, @lines); # A couple of sanity checks - those never hurt if (!defined($self->{'nexturl'}) || !defined($self->{'md5ch'})) { $self->err('Cannot submit without a successful handshake'); return undef; } if (!defined($info->{'title'}) || !defined($info->{'album'}) || !defined($info->{'artist'}) || !defined($info->{'length'}) || $info->{'length'} !~ /^\d+$/) { $self->err('Missing or incorrect submission info fields'); return undef; } # Init... @t = gmtime(); $datestr = sprintf('%04d-%02d-%02d %02d:%02d:%02d', $t[5] + 1900, $t[4] + 1, @t[3, 2, 1, 0]); # Let's hope md5_hex() always returns lowercase hex stuff $md5resp = md5_hex( md5_hex($self->{'cfg'}{'password'}).$self->{'md5ch'}); # Let's roll? $req = HTTP::Request->new('POST', $self->{'nexturl'}); if (!$req) { $self->err('Could not create the submission request object'); return undef; } $req->content_type('application/x-www-form-urlencoded; charset="UTF-8"'); $s = 'u='.URLEncode($self->{'cfg'}{'username'}). "&s=$md5resp&a[0]=".URLEncode($info->{'artist'}). '&t[0]='.URLEncode($info->{'title'}). '&b[0]='.URLEncode($info->{'album'}). '&m[0]='. '&l[0]='.$info->{'length'}. '&i[0]='.URLEncode($datestr). "\r\n"; $req->content($s); print "RDBG about to send a submission request:\n".$req->content(). "\n===\n" if $self->{'cfg'}{'verbose'}; if ($self->{'cfg'}{'fake'}) { print "RDBG faking it...\n" if $self->{'cfg'}{'verbose'}; return 1; } $ua = $self->get_ua() or return undef; $resp = $ua->request($req); if (!$resp) { $self->err('Could not get a submission response object'); return undef; } elsif (!$resp->is_success()) { $self->err('Could not complete the submission: '. $resp->status_line()); return undef; } $c = $resp->content(); print "RDBG response:\n$c\n===\n" if $self->{'cfg'}{'verbose'}; @lines = split /[\r\n]+/, $c; $_ = $lines[0]; SWITCH: { /^OK\b/ && last SWITCH; /^FAILED\s+(.*)/ && do { $self->err("Submission failed: $1"); return undef; }; /^BADUSER\b/ && do { $self->err('Incorrest username or password'); return undef; }; $self->err('Unrecognized submission response: '.$_); return undef; } print "RDBG submit() just fine and dandy!\n" if $self->{'cfg'}{'verbose'}; return 1; } =back There are also several methods and functions for the module's internal use: =over 4 =item * get_ua () Creates or returns the cached C object used by the C class for access to the AudioScrobbler API. =cut sub get_ua($) { my ($self) = @_; my ($ua); $self->{'ua'} ||= new LWP::UserAgent(); if (!$self->{'ua'}) { $self->err('Could not create a LWP UserAgent object'); return undef; } $self->{'ua'}->agent('scrobbler-helper/1.0pre1 '. $self->{'ua'}->_agent()); return $self->{'ua'}; } =item * URLDecode (string) Decode a URL-encoded string. Obtained from http://glennf.com/writing/hexadecimal.url.encoding.html =cut sub URLDecode($) { my $theURL = $_[0]; $theURL =~ tr/+/ /; $theURL =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg; $theURL =~ s///g; return $theURL; } =item * URLEncode (string) Return the URL-encoded representation of a string. Obtained from http://glennf.com/writing/hexadecimal.url.encoding.html =cut sub URLEncode($) { my $theURL = $_[0]; $theURL =~ s/([^a-zA-Z0-9_])/'%' . uc(sprintf("%2.2x",ord($1)));/eg; return $theURL; } =back =head1 TODO =over 4 =item * Do something with UPDATE responses to the handshake. =item * Honor INTERVAL in some way. =item * Figure out a way to cache unsuccesful submissions for later retrying. =item * Web services - stats! =back =head1 SEE ALSO B =over 4 =item * http://www.last.fm/ =item * http://www.audioscrobbler.com/ =item * http://www.audioscrobbler.net/ =back The home site of the C module is http://devel.ringlet.net/audio/Audio-Scrobbler/ =head1 AUTHOR Peter Pentchev, Eroam@ringlet.netE =head1 COPYRIGHT AND LICENSE Copyright (C) 2005, 2006 by Peter Pentchev. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.7 or, at your option, any later version of Perl 5 you may have available. $Id: Scrobbler.pm 88 2006-01-02 09:16:32Z roam $ =cut 1;