Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 236 lines (184 sloc) 5.217 kb
#!/usr/bin/perl
# Post.FM 1.2, Track Submission Script (CMUS -> Last.FM)
#
# Copyright (C) 2007-2009 by Jonas Kramer. All rights reserved.
# Published under the term of the GNU General Public License (GPL).
#
# Copy this script somewhere and make it executable. Then configure CMUS to use
# it as status display program. Bug reports and feedback are always welcome.
use strict;
use warnings;
use Digest::MD5;
use LWP::UserAgent;
use Storable;
use POSIX qw( strftime );
use File::Basename;
# Globals. {{{
our %rc = (
login => "your-login",
password => "your-password",
pid => "$ENV{HOME}/.cmus/last-pid",
cache => "$ENV{HOME}/.cmus/last-cache",
timeout => 10,
debug => undef, # glob(q|~/post-debug|),
host => 'post.audioscrobbler.com',
# host => 'turtle.libre.fm',
);
our $agent = new LWP::UserAgent(
timeout => $rc{timeout},
agent => q|Post.FM/1.0,p1.2|
);
our $time = time;
our $tracks = [];
# }}}
# Check if paths are available first.
for my $file ($rc{pid}, $rc{cache}) {
my $path = dirname($file);
die "$path does not exist or is not a directory.\n" unless(-d $path);
}
# Kill our old self. {{{
# If our predecessor is still alive, send it the ALRM signal to wake it up (if
# it's sleeping). Give it 10 seconds to submit it's track data and exit. If
# nothing happens, kill it.
if(-r $rc{pid}) {
open PID, "<", $rc{pid};
my $pid = <PID>;
close PID;
if($pid) {
chomp $pid;
&log("Found PID $pid.");
kill q|ALRM|, $pid;
my $second = 0;
for(1 .. 10) {
last unless kill(0, $pid);
++$second;
sleep 1;
}
&log("Predecessor lived further $second seconds.");
if(kill 0, $pid) {
kill 'KILL', $pid;
&log("Had to kill predecessor.");
}
}
unlink $rc{pid} if -e $rc{pid};
}
# }}}
my %data = @ARGV;
# Only submit tracks of 30 seconds or longer.
&abort("Track too short.") if int($data{duration}) < 30;
# Fork to background. {{{
# We fork and write the PID of our child into a PID file for the reasons
# named above. Then we exit, so CMUS can start playing the next song.
my $pid = fork;
if($pid) {
open PID, ">", $rc{pid} or die "Can't write $rc{pid}. $!.\n";
print PID $pid, "\n";
close PID;
exit;
}
# }}}
my @keys = qw(artist title album duration);
&abort("Track data incomplete.") if grep { ! exists $data{$_} } @keys;
my %track = (
a => $data{artist},
t => $data{title},
i => $time,
r => "", # Rating, unused for offline players.
o => "P", # Source => (P)layer.
l => $data{duration},
b => $data{album},
n => $data{tracknumber} || '',
m => "", # MusicBrainz Id - unused.
);
if($rc{debug}) {
my $track = join("; ", map { "$_=<$track{$_}>" } keys %track);
&log($track);
}
$tracks = retrieve($rc{cache}) if -r $rc{cache};
&log($#{$tracks} + 1, " tracks in cache, plus the new one.");
push @{$tracks}, \%track;
if(!&shake) {
store($tracks, $rc{cache});
&abort("Handshake failed.");
}
# Generate a hash with form data for the POST request.
my ($n, %form) = 0;
for my $track (@{$tracks}) {
my %track = %{$track};
$form{s} = $rc{session}->{id};
$form{"$_\[$n\]"} = $track{$_} for(keys %track);
++$n;
}
# --
# Sleep until the track ends (or should end if it's not skipped).
&log("Going to sleep now.");
$SIG{ALRM} = sub {
&log("Sleep interrupted by followup process.")
};
sleep($track{l} - (time - $time));
# Our sleep might have been interrupted by an ALRM signal, so check if we've
# sleeped long enough (-> track has been playing long enough).
my $played = (time - $time);
&log("Woke up after $played second(s) of playing.");
&abort("Track skipped too soon.")
if($played < 240 and $played < $track{l} / 2);
# Finally, post the track data.
my $resp = $agent->post($rc{session}->{post}, \%form);
# If the post was successful, we can delete the cache file. Otherwise we store
# the cache data together with our new track so a followup process can submit
# our track data.
if($resp->content =~ /^\s*OK/) {
unlink $rc{cache} if -f $rc{cache};
&log("Submission successful.");
} else {
store($tracks, $rc{cache});
&abort("Submission failed. (", $resp->content, ")");
}
&abort("Exited normally.");
# sub:abort {{{
# Write debug messages to some file and exit.
sub abort {
&log(@_ ? @_ : "Abort.");
unlink $rc{pid};
exit;
}
# }}}
# Authenticate to the scrobbling server.
sub shake {
my $ctx = new Digest::MD5;
$ctx->add($rc{password});
my $password = $ctx->hexdigest;
$ctx->add($password, $time);
my $url = &urify(
"http://$rc{host}/?",
hs => 'true',
p => '1.2',
c => 'tst',
v => '1.0',
u => $rc{login},
t => $time,
a => $ctx->hexdigest,
);
my $resp = $agent->get($url);
my %session;
my @lines = split /\r?\n/, $resp->content;
return undef if $lines[0] ne "OK";
@session{qw|id np post|} = @lines[1 .. 3];
$rc{session} = \%session;
return !0;
}
# Take a base URL and a hash containing parameters and generate a URL.
sub urify {
my ($base, %p) = @_;
s/(\W)/sprintf(q|%%%02X|, ord($1))/egi for(values %p);
$base .= join("&", map { "$_=$p{$_}" } keys %p);
return $base;
}
# Write a message to a log file.
sub log {
if(@_ and $rc{debug} and open LOG, ">>", $rc{debug}) {
my $date = strftime q|%F %T|, localtime;
print LOG $date, " (", $$, "): ", @_, "\n";
close LOG;
}
}
Jump to Line
Something went wrong with that request. Please try again.