File Coverage

blib/lib/Net/LastFM/Submission.pm

Criterion	Covered	Total	%
statement	90	103	87.3
branch	30	46	65.2
condition	21	40	52.5
subroutine	17	19	89.4
pod	2	2	100.0
total	160	210	76.1

package Net::LastFM::Submission;
use strict;
use warnings;

use LWP::UserAgent;
use HTTP::Request::Common 'GET', 'POST';
use Digest::MD5 'md5_hex';
use Carp 'croak';

use base 'Exporter'; our @EXPORT = 'encode_data';

use constant DEBUG => $ENV{'SUBMISSION_DEBUG'} || 0;

our $VERSION = '0.64';
our $URL     = 'http://post.audioscrobbler.com/';

sub new {
	my $class = shift;
	my $param = ref $_[0] eq 'HASH' ? shift : {@_};

	my $self  = {
		'proto'  => '1.2.1',
		'limit'  => 50, # last.fm limit

		'client' => {
			'id'  => $param->{'client_id' } || 'tst', # test client id
			'ver' => $param->{'client_ver'} || '1.0', # test client version
		},
		'user'   => {
			'name'     => $param->{'user'    } || croak('Need user name'),
			'password' => $param->{'password'},
		},
		'api'    => {
			'key'     => $param->{'api_key'    },
			'secret'  => $param->{'api_secret' },
		},
		'auth'   => {
			'session' => $param->{'session_key'},
		},

		'ua'     => $param->{'ua' } || LWP::UserAgent->new('timeout' => 10, 'agent' => join '/', __PACKAGE__, $VERSION),

		'enc'    => $param->{'enc'} || 'cp1251',
	};

	if (defined $self->{'user'}->{'password'}) {
		$self->{'auth'}->{'type'} = 'standard';
	} else {
		croak 'Need shared data (api_key/api_secret/session_key) for Web Services authentication' if grep { !$_ } @{$self->{'api'}}{'key', 'secret'}, $self->{'auth'}->{'session'};
		$self->{'auth'}->{'type'} = 'web';
	}

	if (DEBUG) {
		warn "Last.fm Submissions Protocol v$self->{'proto'}";
		warn "Client Identifier: $self->{'client'}->{'id'}/$self->{'client'}->{'ver'}";
		warn $self->{'auth'}->{'type'} eq 'web' ? 'Web Services Authentication' : 'Standard Authentication';
	}

	bless $self, ref $class || $class;
}

{
	no strict 'refs';
	for my $m ('handshake', 'now_playing', 'submit') {
		*{$m} = sub {
			my $self = shift;
			my $r    = $self->${\"_request_$m"}(@_);

			return $r unless ref $r eq 'HTTP::Request';

			my $data = $self->_response($self->{'ua'}->request($r));
			$self->_save_handshake($data) if $m eq 'handshake'; # spesial action for handshake

			return $data;
		};
	}
}

# save handshake data

sub _save_handshake {
	my $self = shift;
	my $data = shift;

	if ($data->{'status'} && $data->{'url'} && $data->{'sid'}) {
		DEBUG && warn "Save handshake data: $data->{'url'}->{'np'}, $data->{'sid'}";
		$self->{'hs'} = $data;
	}

	return $data;
}

# generate requests

sub _request_handshake {
	my $self = shift;
	my $time = time;

	$self->{'auth'}->{'token'} = md5_hex(($self->{'auth'}->{'type'} eq 'web' ? $self->{'api'}->{'secret'} : md5_hex $self->{'user'}->{'password'}).$time);

	my $r = GET(join '?', $URL, join '&',
		'hs=true',
		"p=$self->{'proto' }",
		"c=$self->{'client'}->{'id'  }",
		"v=$self->{'client'}->{'ver' }",
		"u=$self->{'user'  }->{'name'}",
		"t=$time",
		"a=$self->{'auth'}->{'token'}",
		$self->{'auth'}->{'type'} eq 'web' ? ("api_key=$self->{'api'}->{'key'}", "sk=$self->{'auth'}->{'session'}") : (),
	);

	DEBUG && warn $r->as_string;

	return $r;
}

sub _request_now_playing {
	my $self  = shift;
	my $param = ref $_[0] eq 'HASH' ? shift : {@_};

	return $self->_error('Need a now-playing URL returned by the handshake request') unless $self->{'hs'}->{'url'}->{'np'};
	return $self->_error('Need session ID string returned by the handshake request') unless $self->{'hs'}->{'sid'};
	return $self->_error('Need artist/title name') if grep { !$param->{$_} } 'artist', 'title';

	my $enc = $param->{'enc'} || $self->{'enc'};
	$_ = encode_data($_, $enc) for grep { $_ } @$param{'artist', 'title', 'album'};

	my $r = POST($self->{'hs'}->{'url'}->{'np'}, [
		's' => $self->{'hs'}->{'sid'},
		'a' => $param->{'artist'},
		't' => $param->{'title' },
		'b' => $param->{'album' },
		'l' => $param->{'length'},
		'n' => $param->{'id'    },
		'm' => $param->{'mb_id' },
	]);

	DEBUG && warn $r->as_string;

	return $r;
}

sub _request_submit {
	my $self = shift;
	my $list = ref $_[0] eq 'HASH' ? [@_] : [{@_}];

	return $self->_error('Need a submit URL returned by the handshake request'     ) unless $self->{'hs'}->{'url'}->{'sm'};
	return $self->_error('Need session ID string returned by the handshake request') unless $self->{'hs'}->{'sid'};
	DEBUG && warn "Use first $self->{'limit'} tracks for submissions";

	$list = [
		grep {
			my $enc = $_->{'enc'} || $self->{'enc'};
			$_ = encode_data($_, $enc) for grep { $_ } @$_{'artist', 'title', 'album'};
			1;
		}
		grep { $_->{'title'} && $_->{'artist'} }
		splice @$list, 0, $self->{'limit'}
	];
	return $self->_error('Need artist/title name') unless @$list;

	my $i;
	my $r = POST($self->{'hs'}->{'url'}->{'sm'}, [
		's' => $self->{'hs'}->{'sid'},
		map {
			$i = defined $i ? $i+1 : 0;
			(
				"a[$i]" => $_->{'artist'},
				"t[$i]" => $_->{'title' },
				"i[$i]" => $_->{'time'  } || time,
				"o[$i]" => $_->{'source'} ||  'R',
				"r[$i]" => $_->{'rating'},
				"l[$i]" => $_->{'length'},
				"b[$i]" => $_->{'album' },
				"n[$i]" => $_->{'id'    },
				"m[$i]" => $_->{'mb_id' },
			);
		}
		@$list
	]);

	DEBUG && warn $r->as_string;

	return $r;
}

# parse response

sub _response {
	my $self = shift;
	my $r    = shift;

	return $self->_error('No response object') unless $r && ref $r eq 'HTTP::Response';

	DEBUG && warn join "\n", $r->status_line, $r->content;

	return $r->is_success && $r->content =~ /^ (OK) ( \n (\w+) \n (\S+) \n (\S+) )? /sx
		? {'status' => $1, $2 ? ('sid' => $3, 'url' => {'np' => $4, 'sm' => $5} ) : ()}
		: {'code' => $r->code, map { ('error' => $_->[0], $_->[1] ? ('reason' => $_->[1]) : ()) } [$r->content =~ /^(\S+)(?:\s+(.*))?/]}
	;
}

# generate error

sub _error {
	shift;
	return {'error' => 'ERROR', 'reason' => shift};
}

# encode data

sub encode_data($$) {
	my $data = shift;
	my $enc  = shift;

	use Encode ();
	DEBUG && warn("Encode data $enc to utf8"), $data = Encode::encode_utf8 Encode::decode($enc, $data) unless Encode::is_utf8($data);
	Encode::_utf8_off($data);

	return $data;
}

1;

__END__