view release on metacpan or  search on metacpan

lib/Audio/Scrobbler.pm  view on Meta::CPAN

Also, the L<submit> method requires that the following configuration
parameters be set for this C<Audio::Scrobbler> 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<err>
method.

If the B<fake> configuration parameter is set, the L<submit> 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<verbose> configuration parameter is set, the L<submit>
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<LWP::UserAgent> object used by
the C<Audio::Scrobbler> class for access to the AudioScrobbler API.