#!/usr/bin/perl -w
#
# mplayer-lastfm - plays stuff with mplayer and scrobbles to last.fm
#
# Published under the terms of the GNU General Public License (GPL)
#
# [2007-05-19, 04:10-09:52] v0.1 - written by Zrajm C Akfohg, but heavily based
# on the "post.fm" script written Jonas Kramer <lizer@gmx.net> in 2006 (can be
# found on: http://nex.scrapping.cc/post-fm/)
#
# [2007-05-20, 05:19-05:39] v0.1.1 - began read_config()
#
# [2007-05-20, 12:02-12:38] v0.1.2 - finished read_config()
#
# [2007-05-20, 13:15-17:58] v0.2 - renamed some settings for clarity (since
# these setting names will now be set by the end user in the rcfile): cache ->
# cache_file, now_playing -> status_file; implemented read_cache()
#
# [2007-05-23, 16:16-16:38] v0.2.1 - bugfix, now only tries to scrobble files
# which contains complete artist/album/track tags
#
# [2007-05-24, 03:16-04:49] v0.2.2 - added CLIENT_{IDENTITY,VERSION} constants,
# references to the protocol definition dcument, and cleaned up code a little,
# added start/end times to (human-)readable output
#
# [2008-01-28, 09:34-09:40] v0.2.3 - bugfix.

# FIXME:
#   o should run mplayer, even if there is no config file (in which case no
#     scrobbling could be made since we don't have the user info)
#   o should warn, but not error terribly if `taginfo' is not installed
#
# TODO:
#   o follow last.fm's scrobbling instructions more closely.
#

# used by handshake process
sub CLIENT_VERSION  { '0.1' } #
sub CLIENT_IDENTITY { 'dcp' } #

# Protocol specs:
# http://www.audioscrobbler.net/wiki/Protocol1.1.merged

# TODO:
#
#   o display error message on failed last.fm login
#
#   o register a CLIENT_IDENTITY (with Ross on last.fm) and use that instead of
#     the above.
#
#   o Scrobbling should occur at the intervals specified in the protocol.
#     (after 50% or 4 minute(?) -- whichever comes first).
#

use strict;
use warnings;
use POSIX qw/strftime/;
use Digest::MD5 qw/md5_hex/;
use LWP::UserAgent;
our %cfg = ();



###############################################################################
##                                                                           ##
##  Functions                                                                ##
##                                                                           ##
###############################################################################


# Usage: $ENCODED = url_encode($STRING);
#
# Returns an URL encoded version of $STRING where i.e. all non-[a-z0-9_]
# characters are encoded as (one or more, in the case of UTF8 strings) %XX
# (where XX is a hexadecimal digit).

sub url_encode($) {                            # [2007-05-19]
    my ($str) = @_;                            #   get arg
    $str =~ s/([^A-Za-z0-9_])/                 #   url-encode it
        sprintf("%%%02X", ord $1);             #
    /gex;                                      #
    return $str;                               #
}


# Usage: $OK = write_cache($FILE, $TRACK);
#
# Appends $TRACK (a track identifier string for a last.fm query) to the
# playlist cache. returns 1 (true) on success, 0 (false) otherwise.

sub write_cache($$) {
    my ($file, $track) = @_;                   #   get args
    return 1 unless defined $file;             #   do nada if no filename
    return 1 if $file eq '';                   #     or track string was
    return 1 unless $track;                    #     provided
    if (open FILE, '>>', $file) {              #   open file
        print FILE "$track\n";                 #     write track string
        close FILE;                            #     close
        return 1;                              #     return OK
    }                                          #   or
    return 0;                                  #     return FALSE
}                                              #


# Usage: @TRACK = read_cache($FILE);
#
# Reads $FILE and returns a list with it's contents. Returns empty list fi
# $FILE is undefined, zero or does not exist.

sub read_cache($) {                            # [2007-05-20]
    my ($file) = @_;                           #   get args
    return () unless defined $file;            #   return empty list
    return () if $file eq '';                  #     if no filename or
    return () unless -e $file && -r $file;     #     file doesn't exist
    my @track = ();                            #   clear tracklist
    if (open CACHE, $file) {                   #   open cache file
        @track = <CACHE>;                      #     read contens
        close(CACHE);                          #     close
        return @track;                         #     and return contents
    }                                          #
    return ();                                 #   ERROR: couldn't open file
}                                              #     return empty list


sub debug(@) {                                 #
    if (exists($cfg{debug_file}) and           #   if debug_file option exists
        $cfg{debug_file} and                   #     and is set
        open DEBUG, '>>', $cfg{debug_file}     #     and could be appended to
    ) {                                        #   then
        print DEBUG join("", @_), "\n";        #     write to it
        return 1 if close DEBUG;               #     return true on success
    }                                          #
    return 0;                                  #   ERROR
}                                              #     something failed


# Usage: %CFG = read_config($FILE)
#
# Reads the config file and returns the result as a hash.

sub read_config($) {                       # [2007-05-20]
    my ($file) = @_;                       #   get arg
    # FIXME: make sure file is "chmod 700"!
    # FIXME: write sketch rcfile if none present (w/ only explanatory comments)
    #        (include url to mplayer-lastfm in some comment!)
    open RCFILE, '<', $file or             #   open file
        return undef;                      #     ERROR
    my %tag = ();                          #   empty tag hash
    while (<RCFILE>) {                     #   for each read line
        /^ *#/ and next;                   #     ignore comments
        if (/^ \s* ([^=\s]+)               #       value name ($1)
               \s* =                       #       "="
               \s* (?:                     #       value contents
                   (["'])((?:[^\"]|\\.)*)\2 | #      quoted ($3)
                         ((?:[^\s]|\\.)*)  #         or unquoted ($4)
               )                           #
               \s* (?:\#.*) ?$/x) {        #       ignore trailing comment
            $tag{lc $1}=(defined $3 ne ""?$3:$4);# put into tag hash
        } else {                           #
            warn "syntax error in config file `$file', line $.";
            return undef;                  #
        }                                  #
    }                                      #
    close RCFILE;                          #   close file
    # FIXME: expand ~ -> $END{HOME} in $tag{status_file} and $tag{cache_file}
    #   (general ~user expansion?)
    return %tag;                           #   return tags
}                                          #



# Usage: %TAG = read_tags($FILE)
#
# Reads an audiofile (by means of command `taginfo') and returns a hash with
# the read tags. If file couldn't be read (e.g. because it wasn't an audio
# file) an empty hash is returned.

sub read_tags($) {                         # [2007-05-19]
    my ($file) = @_;                       #   get arg
    open TAG, '-|', 'taginfo', "$1" or     #   open file to read args
        return ();                         #     ERROR: abort
    my %tag = ();                          #   empty tag hash
    while (<TAG>) {                        #   for each read line
        /^([^=]+)="(.*)"$/ and             #     that contains a tag
            $2 and                         #     with a non-zero value
            $tag{lc $1}=$2;                #     put into tag hash
    }                                      #
    close TAG;                             #   close file
    return %tag;                           #   return tags
}                                          #


# Usage: write_status($FILE, %TAG);
#
# Writes TAGs in hash to $FILE. Returns true or false depending on success. If
# filename is undef or zero, nothing is written and TRUE is returned (since it,
# of course, always will succeed with writing *nothing*).

sub write_status($%) {                         # [2007-05-19]
    my ($file, %tag) = @_;                     #   get args
    return 1 unless defined $file;             #     do nada if no filename
    return 1 if $file eq '';                   #       was provided
    if (open NP, ">", $file) {                 #   open now-playing file
        print NP "\U$_\E: $tag{$_}\n"          #     write tags
            for sort keys %tag;                #
        close(NP);                             #     close file
    } else {                                   #   ERROR
        debug("Failed to open $file: $!.");    #     couldn't open file
        return 0;                              #
    }                                          #
    return 1;                                  #
}                                              #



# Usage: scrobble($USER, $PASS, $CACHEFILE, %TAGS)
#
# Returns PID of forked child process (kill it to abort scrobbling).
#
# Forks a side process which hangs around for the rest of the song, and then,
# if still alive, scrobbles the song.


# does the scrobble thingy
sub scrobble(%) {                              # [2007-05-19]
    my ($user, $pass, $cache, %tag) = @_;      #   get args
    my $time = time;
    $tag{'~time_beg'} = POSIX::strftime '%F %T', gmtime $time;
    if (exists $tag{length}) {
        $tag{'~time_end'} = POSIX::strftime '%F %T', gmtime $time+$tag{length};
        $tag{'~length'}   = POSIX::strftime '%T',    gmtime $tag{length};
    }
    print "    \U$_\E: $tag{$_}\n"             #   output tags
        for sort keys %tag;                    #
    if (not                                    #   abort unless 
        exists $tag{artist} ||                 #     artist,
        exists $tag{title}  ||                 #     title
        exists $tag{album}                     #     and album are
    ) {                                        #     all set
        warn "WON'T SCROBBLE: ARTIST/TITLE/ALBUM TAG(S) NOT FOUND\n";
        return 0;                              #
    }                                          #
    my $pid = fork;                            #   fork
    return $pid unless $pid == 0;              #   parent immediately returns



    # Read track data given from CMUS from @ARGV into a hash. Also get the
    # current time and store it (we will give this timestamp to last.fm later
    # as the time at which we started playing the current track). $timeout is
    # used for two things: 1) as timeout (in seconds) for our GET and POST
    # operations and 2) as the number of seconds we'll have to submit our
    # track data before our successor is going to kill us.
    my $timeout = 10;

    for ($tag{artist}, $tag{title}, $tag{album}, $tag{length}) {
        $_ = '' unless defined($_);
    }
    my $track = "$tag{artist}|$tag{title}|$tag{album}|$tag{length}|$time";

    debug(
        "Called with arguments:\n\t",
        join "\n\t", map { "\"$_\"" } @_
    );


    my $agent = new LWP::UserAgent(timeout => $timeout);

    # Prepare $user and $password before sleeping; maybe we need to hurry
    # later.

    $user = url_encode($user);                  # url-encode user name
    $pass = md5_hex $pass;                      # turn password into MD5

    # Sleep until we've reached the end of the song - $timeout - 2 seconds.
    sleep($tag{length} - $timeout - 2);
    print "NOW SCROBBLING: $track\n";

    # FIXME: 
    my $url='http://post.audioscrobbler.com/?'.#   scrobbler url
        join('&',                              #   args
            'hs=true',                         #     request handshake
            'p=1.1',                           #     protocol version 1.1
            'c=' . CLIENT_IDENTITY,            #     client ID string
            'v=' . CLIENT_VERSION,             #     client version string
            'u=' . $user                       #     last.fm user name
        );                                     #
    my $response = $agent->get($url);          #
    debug(                                     #
        "Handshake response was:\n\t",         #
        join("\n\t", split(/\r?\n/, $response->content))
    );                                         #

    ## If we're killed before we've finished or have to give up because last.fm
    ## is down or something, we append our track data to the cache, so our
    ## successor can try it again.
    if (not $response->is_success) {           #   scrobble failed
        write_cache $cache, $track;            #     write track data to cache
        exit 0;                                #     and exit
    }                                          #

    my @response = split(/[\r\n]+/, $response->content);
    exit 0 if(shift(@response) ne "UPTODATE"); #
    my ($challenge, $submitURL) = splice(@response, 0, 2);
    my $md5 = md5_hex $pass.$challenge;        #

    # Read older tracks from cache.
    my @tracks = read_cache $cache;
#    my @tracks = ();                           #   clear tracklist
#    if (-e $cache && -r $cache) {              #   if tracklist cache exists
#        if (open CACHE, $cache) {              #     open it
#            @tracks = <CACHE>;                 #     read contens
#            close(CACHE);                      #     and close
#        }                                      #
#    }                                          #
    push(@tracks, $track);                     #   add current song to list

    # Put the POST string together.
    my $query = "u=$user&s=$md5&";             #
    my $ntrack = 0;                            #
    foreach(@tracks) {                         #
        my @splt = split(/\|/);                #
        next if($splt[-2] < 30);               #
        foreach (qw/a t b/) {                  #
            my $val = (shift(@splt) or "");    #
            $val = url_encode $val;            #
            $query .= $_."[$ntrack]=$val&";    #
        }                                      #

        # a[0] - artist name
        # t[0] - track title
        # b[0] - album name
        # m[0] - MusicBrainz? ID (send empty id if you don't know it, don't skip it)
        # l[0] - track length in seconds
        # i[0] - UTC date/time in YYYY-MM-DD hh:mm:ss format

        $query .= "m[$ntrack]=&l[$ntrack]=".shift(@splt)."&i[$ntrack]=";
        my $time = POSIX::strftime("\%F \%T", gmtime(shift(@splt)));
        $time = url_encode $time;              #
        $query .= "$time&";                    #
        $ntrack ++;                            #
    }                                          #

    debug("Post data is: $query");

    # POST the data to last.fm.
    my $post = HTTP::Request->new("POST", $submitURL);
    $post->content_type("application/x-www-form-urlencoded; charset=\"UTF\"");
    $post->content($query);
    $response = $agent->request($post);

    debug(
        "Post response was:\n\t",
        join("\n\t", split(/\r?\n/, $response->content))
    );

    # On success we can delete the cache, 'cause all the data in it has been
    # submitted. Otherwise we add the new track to the cache, so it can be
    # submitted later.
    if ($response->content =~ /^OK/) {
        unlink $cache if defined $cache;
    } else {
        write_cache $cache, $track;
    }
    exit 0;
}



###############################################################################
##                                                                           ##
##  Initialization                                                           ##
##                                                                           ##
###############################################################################


my $track = "";                                #
$SIG{CHLD} = 'IGNORE';                         # auto-reap children



# default rcfile name
my $rcfile = '';
for (qw(.mplayer-lastfmrc .mplayer/mplayer-lastfm.conf)) {
    if (-e "$ENV{HOME}/$_") {
        $rcfile = "$ENV{HOME}/$_";
        last;
    }
}
%cfg = read_config($rcfile) if $rcfile;

# no cache file name given in config
unless (exists($cfg{cache_file}) && $cfg{cache_file}) {
    # cache file exist; use that one
    $cfg{cache_file} = '';
    for (qw(.mplayer/mplayer-lastfm.cache .mplayer-lastfm.cache)) {
        if (-e "$ENV{HOME}/$_") {
            $cfg{cache_file} = "$ENV{HOME}/$_";
            last;
        }
    }
    # no existing cache; use one in ~/.mplayer if dir exists; otherwise in $HOME
    if (not $cfg{cache_file}) {
        if (-d "$ENV{HOME}/.mplayer") {
            $cfg{cache_file} = "$ENV{HOME}/.mplayer/mplayer-lastfm.cache"
        } else {
            $cfg{cache_file} = "$ENV{HOME}/.mplayer-lastfm.cache"
        }
    }
}
die "mplayer-lastfm: no last.fm user name given in config `$rcfile'.\n"
    unless $cfg{user};
die "mplayer-lastfm: no last.fm password given in config `$rcfile'.\n"
    unless $cfg{pass};



###############################################################################
##                                                                           ##
##  Main Program                                                             ##
##                                                                           ##
###############################################################################


if (not @ARGV) {
    warn <<'EOT';
Usage: mplayer-last.fm <mplayer-options>

This is an mplayer/last.fm wrapper script. It monitors mplayers output on the
terminal, and scrobbles all audio files (that can be read by the `taginfo'
command) as they're being played.

All command line arguments are being passed directly to mplayer. (Optionally,
if the first argument is an existing executable file, it is assumed to be the
name of the mplayer binary.)
EOT
    exit 10;
}

# add mplayer command to @ARGV if need be
unshift @ARGV, "mplayer" unless -x $ARGV[0];

# start mplayer
open(MPLAYER, "-|", @ARGV) or
    die "mplayer-last.fm: cannot start mplayer.\n";

my ($child_pid);                               # tag data
while (<MPLAYER>) {                            # read mplayer STDOUT
    print;                                     #   output to our STDOUT
    if (/^Playing (.*)\.$/) {                  #   get "Playing <FILE>." lines
        my %tag = read_tags($1);               #     read tags from <FILE>
        kill('TERM', $child_pid)               #     kill any lingering child
            if defined $child_pid;             #       from previous song
        write_status($cfg{status_file}, %tag); # write status file
        $child_pid = scrobble(                 #    scrobble!
            $cfg{user}, $cfg{pass},            #
            $cfg{cache_file}, %tag);           #
    }                                          #
}                                              #
close MPLAYER;                                 #
unlink $cfg{status_file}                       # remove "now playing" file
    if -e $cfg{status_file};                   #
kill('TERM', $child_pid)                       # kill any lingering child
    if defined $child_pid;                     #   processes
exit 0;                                        #

#[[eof]]
