#!/usr/bin/perl -w
#
# playomatic:
# Thing to play the Audioscrobbler radio stream.
#
#
# Copyright (c) 2005 Chris Lightfoot & Julian T. J. Midgley. 
# Email: chris@ex-parrot.com; WWW: http://www.ex-parrot.com/~chris/
# Email: jtjm@xenoclast.org; WWW: http://www.xenoclast.org/
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# A copy of version 2 of the GNU General Public License may be found
# at: http://www.gnu.org/licenses/gpl.txt
#---------------------------------------------------------------------------

# CONFIG FILE FORMAT
# Config file ~/.playomaticrc should contain username and password in format:
# username = foobar
# password = somepassword

my $rcsid = ''; $rcsid .= '$Id:$';

my $VERSION = "0.3.17";

my $DEBUG = 1;

my $CONFIG_FILE   = "$ENV{HOME}/.playomaticrc";
my $CURRENT       = "$ENV{HOME}/.playomatic.current";
my $LOG           = "$ENV{HOME}/.playomatic.log";
my $DOTUPDATE     = "$ENV{HOME}/.playomatic.update";
my $DOTLOVE       = "$ENV{HOME}/.playomatic.love";
my $DOTBAN        = "$ENV{HOME}/.playomatic.ban";
my $DOTSKIP       = "$ENV{HOME}/.playomaticskip";
my $DOTNEWSESSION = "$ENV{HOME}/.playomatic.newsession";
my $DOTDUMP       = "$ENV{HOME}/.playomatic.dump";
my $DOTSTATION    = "$ENV{HOME}/.playomatic.station";

my %MODES = ( 1 => "random",
              3 => "profile",
              4 => "personal");

package Oops;

use Error qw(:try);
@Oops::ISA = qw(Error::Simple);

package main;

use strict;

use Data::Dumper;
use Digest::MD5 qw(md5_hex);
use Error qw(:try);
use LWP::UserAgent;
use POSIX ":sys_wait_h";
use Time::HiRes qw(sleep);

#---------------------------------------------------------------------------
# HTTP functions

my $ua = LWP::UserAgent->new;
$ua -> agent("Playomatic/$VERSION");

sub doget ($$) {
    my ($url, $params_ref) = @_;
    if (keys(%$params_ref) > 0) {
        $url .= "?";
        foreach my $k (keys %$params_ref) {
            $url .= "$k=$$params_ref{$k}&";
        }
        $url =~ s/&$//;
    }
    my $response  = $ua->get($url);
    throw Oops("GET of $url failed".$response->status_line) unless ($response->is_success);
    return $response->content;
}

sub dopost ($$) {
    my ($url, $postdata_ref) = @_;
    my $response = $ua->post($url, $postdata_ref);
    throw Oops("Post to $url failed: ".$response->status_line) unless ($response->is_success);
    return $response->content;
}

sub http_escape (%) {
    my (%param) = @_;
    my %esc_param;
    if (keys(%param) > 0) {
        foreach my $k (keys %param) {
            my $v = $param{$k};
            $k =~ s/([^a-z0-9-])/sprintf('%%%02x', ord($1))/ge;
            $v =~ s/([^a-z0-9-])/sprintf('%%%02x', ord($1))/ge;
            $esc_param{$k} = $v;
        }
    }
    return \%esc_param;
}

sub parse_response ($) {
    my ($text) = @_;
    return map { m/([^=]+)=(.*)/ } split(/\r?\n/, $text);
}

sub do_post_request ($%) {
    my ($where, %param) = @_;
    my %response = parse_response(dopost($where, http_escape(%param)));
    warn Dumper(\%response);
    return %response;
}

sub do_get_request ($%) {
    my ($where, %param) = @_;
    return parse_response(doget($where, http_escape(%param)));
}


#--------------------------------------------------------------------------
# get_config($cfg_file, $config_ref)
#
# Reads the config file, and returns the configuration as a hash.
# returns undef if the configuration file cannot be found or read

sub get_config 
{
    my ($cfg_file, $config_ref) = @_;
    my %config;
    if ($config_ref) {
        %config = %$config_ref;
    }

    unless (open (IN,$cfg_file)) {
        warn "Unable to open $cfg_file: $!\n";
        return %config;
    }
    
    while (<IN>) {
	# Throw away comments and blank lines
	next if (/^\#.*|^\s+$|^\s+\#|^$/);
	
	# Check for valid key-value pair and extract key into $1, value into $2
	unless (/^\s*([a-zA-Z][a-zA-Z_0-9\-]*?)\s*=\s*(\S.*?)\s*$/) {
	    warn "Warning - invalid line in '$cfg_file':'$_'\n";
	    next;
	}
	
	if (defined $config{$1}) {
	    warn "Warning, duplicate definition in '$cfg_file'\n ".
                 " - parameter '$1' defined more than once, \n ignoring '$1'='$2'\n";
	    next;
	}
	$config{$1}=$2;
        $config{$1} =~ s/\\n/\n/g;
    }
    unless (%config) {
        warn "Config file '$CONFIG_FILE' contains no configuration\n";
    }
    return %config;
}



sub get_session_key ($$) {
    if (exists($ENV{AS_SESSION})) {
        return ($ENV{AS_SESSION}, "http://moses.last.fm/last.mp3?Session=$ENV{AS_SESSION}");
    }
    my ($u, $p) = @_;
    my %s = do_get_request('http://wsdev.audioscrobbler.com/radio/getsession.php',
                username => $u,
                passwordmd5 => md5_hex($p)
            );
    if (!exists($s{session}) || $s{session} eq 'FAILED') {
        warn Dumper(\%s) if $DEBUG;
        throw Oops("Unable to create session");
    }
    unless (exists($s{stream_url}) and $s{stream_url} =~ m,^http://,) {
        warn Dumper(\%s) if $DEBUG;
        throw Oops("No stream URL in session response");
    }
    return ($s{session}, $s{stream_url});
}

sub get_current_track_info ($) {
    my $session = shift;
    my %track = do_get_request('http://wsdev.audioscrobbler.com/radio/np.php',
                'session',
                $session
            );
    my @text_fields = qw(albumcover_medium albumcover_small albumcover_large 
                         track_url artist album track);
    foreach my $field (@text_fields) {
        if (defined $track{$field}) {
            $track{$field} = strip($track{$field});
        } else {
            $track{$field} = "???";
        }
    }
    return %track;
}

sub mins_secs 
{
    my $tm = shift;
    unless ($tm) {return "???:??"};
    my $secs = ($tm % 60);
    my $mins = int ($tm / 60);
    return sprintf( "% 3d:%02d", $mins , $secs);
}

sub strip
{
    my $str = shift;
    $str =~ s/[\x00-\x1f]/\./g;
    return $str;
}


#---------------------------------------------------------------------------
# iso_format_time ($epoch)
#
# Returns the ISO 8601 formatted representation of $epoch (being a
# time in seconds since the epoch).  We don't use DateTime because
# it's around 50 times slower than this, adds a third of second to the
# start up time, and really doesn't add a great deal for our purposes.

sub iso_format_time ($)
{
    my $epoch = shift;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime($epoch);
    $mon ++;
    $year += 1900;
    return sprintf("%04d-%02d-%02d %02d:%02d:%02d Z", 
                   $year, $mon, $mday, $hour, $min, $sec);
}

sub write_log ($) {
    my $msg = shift;
    unless (open(LOG, ">>$LOG")) {
        warn "Unable to open log file: $LOG: $!\n";
        return;
    }
    print LOG $msg;
    close LOG;
}


sub escape_logstr {    
    my $string = shift;
    $string =~ s/_/=/g;
    return $string;
}

sub log_details ($$) {
    my ($track_r, $loved) = @_;
    my $star;
    # [**] = loved ("love" command sent to last.fm
    # [*]  = comment only
    if ($loved) {
        if ($loved eq "1") {
            $star = "[**]";
        } else {
            $star = ($loved =~ /\!/) ? "[*] " : "[**] ";
            $loved =~ s/^\!//;
            $star .= $loved;
        }
    } else { $star = ""; }
    my $tm = iso_format_time(time());
    write_log(sprintf("%s _ %s _ %s _ %s _ %s\n",
                      map (escape_logstr($_), 
                           $$track_r{artist},
                           $$track_r{album},
                           $$track_r{track}),
                      $tm,
                      $star));
}

sub update_track (@) {
    my %track = @_;
    if ($track{track} eq "???" and $track{album} eq "???") {
        $track{finishtime} = $track{starttime} = $track{trackduration} = -1;
    } else {
        $track{finishtime} = time() + $track{trackduration} - $track{trackprogress};
        $track{starttime} = $track{finishtime} - $track{trackduration};
    }
    $track{last_updated} = time();
    return %track;
}

sub hash_copy {
    my %hash = @_;
    return \%hash;
}

sub check_for_updates {
    my ($status_r, $track_r) = @_;
    my $now = time();
                                                                      # Update the track status when: 
    if ( ($$track_r{trackduration} == -1)                             # We're changing stations
         || (($now - $$track_r{starttime}) >= $$track_r{trackduration})  # We think we've reached the end of a track
         || ($$track_r{last_updated} == 0)                            # A track is skipped
         || -e $DOTUPDATE                                             # A user touches $DOTUPDATE 
         || ($now < $$status_r{last_time})                            # Time runs backwards ...
         || (abs ($now - $$status_r{last_time}) > 5)) {               # or skips
        
        my %new_track = get_current_track_info($$status_r{session}); 

        if ($new_track{track}) {
            if ($new_track{track} ne $$track_r{track}) {
                $$status_r{still_this_track} = 0;
                print STDERR "\n";
            }
            $track_r = {update_track(%new_track)};
            unlink($DOTUPDATE);
        } else {
            # Some problem retrieving track data, sleep a couple of seconds 
            # to let the remote server recover, and log the problem
            warn  localtime(time()) . ": get_current_track_info failed\n";
            warn Dumper(\%new_track) if $DEBUG;
            sleep 2;
        }
    }
    $$status_r{last_time} = $now;
}

sub send_command {
    my ($status_r, $command) = @_;
    # should be do_post_request
    my %r = do_get_request(
                      'http://wsdev.audioscrobbler.com/radio/control.php',
                      command => $command,
                      session => $$status_r{session}
                      );
    if (($r{response} ne 'OK') && $DEBUG) {
        warn "send_command: '$command' failed\n". Dumper(\%r);
    }
    return %r;
}

sub process_commands {
    my ($status_r, $track_r) = @_;
    
    if (-e $DOTSKIP) {
        #print STDERR "attempting to skip track... ";
        #print STDERR "$r{response}\n";
        send_command($status_r, 'skip');
        $$status_r{played_to_completion} = 0;
        $$track_r{last_updated} = 0;
        unlink($DOTSKIP);

    } elsif (-e $DOTLOVE) {
        my $note = "";
        if (open(DL, $DOTLOVE)) {
            $note = <DL>;
            close(DL);
            chomp($note) if ($note);
        } else { 
            warn "unable to read $DOTLOVE: $!; ignoring contents\n";
        }
        $$status_r{love} = $note ? $note : 1;
        # send "love track" command
        unless ($$status_r{love} =~ /^\!/) { # unless the note starts with '!'
            warn "Sending love command\n" if $DEBUG;
            send_command($status_r, 'love');
        }
        unlink($DOTLOVE);

    } elsif (-e $DOTBAN) {
        send_command($status_r, 'ban');
        $$status_r{played_to_completion} = 0;
        $$track_r{last_updated} = 0;
        unlink($DOTBAN);

    } elsif (-e $DOTNEWSESSION) {
        # The following is the correct way to do it, but doesn't appear to work ...
        # my %r = do_post_request(
        #                   'http://wsdev.audioscrobbler.com/radio/tune.php',
        #                   mode => 'random',
        #                   session => $$status_r{session}
        #                   );
        # warn Dumper (\%r);
        # undef ($$status_r{current}); 
        # $$track_r{last_updated} = 0;
        unlink $DOTNEWSESSION;
        # ... so instead we use the quick and ugly way:
        kill(15, $$status_r{playerpid});
        sleep(1);
        kill(9, $$status_r{playerpid});
        exec ($0);
    } elsif (-e $DOTSTATION) {
        if (open (IN, $DOTSTATION)) {
            my $cmd = <IN>;
            close (IN);
            if ($cmd) {
                chomp($cmd);
                my ($station, $mode) = split(/\s+/, $cmd);
                $mode = 'profile' unless defined ($mode);
                print "---------------------------------------------\n";
                print "Changing station to $station ($mode)\n\n";
                # This should be do_post_request
                my %r = do_get_request(
                                  'http://wsdev.audioscrobbler.com/radio/tune.php',
                                  mode => $mode,
                                  session => $$status_r{session},
                                  subject => $station
                                  );
                if ($r{response} ne 'OK') {
                    warn "Change station failed:\n";
                    warn Dumper (\%r);
                    # but carry blithely on anyway...
                }
                $$status_r{played_to_completion} = 0;
                $$status_r{still_this_track}     = 0;
                $$track_r{last_updated}          = 0;
            } else {
                warn "No station specified\n";
            }
        } else {
            warn "Unable to read $DOTSTATION: $!\n";
        }
        unlink $DOTSTATION;

    } elsif (-e $DOTDUMP) {
        warn "\nstatus = " . Dumper($status_r).
            "track = " . Dumper($track_r);
        unlink $DOTDUMP;
    }
        
}        

sub command_line {
    my ($cmd, @args) = @_;
    my %valid_cmds = (help => undef,
                      log => undef,
                      love => $DOTLOVE,
                      ban  => $DOTBAN,
                      skip => $DOTSKIP,
                      dump => $DOTDUMP,
                      update => $DOTUPDATE,
                      station => $DOTSTATION,
                      newsession => $DOTNEWSESSION,
                      restart => $DOTNEWSESSION);
    
    unless (exists $valid_cmds{$cmd}) {
        die "Usage: ./playomatic [love|ban|skip|update|station|restart|dump|help]\n";
    }
    
    if ($cmd eq 'help') {
        exec("perldoc", "$0");
    } elsif ($cmd eq 'log') {
        my $logfile = defined $args[0] ? $args[0] : $LOG;
        my $log_ref = read_log($logfile);
        basic_stats($log_ref);
        exit(0);
    }

    my $file = $valid_cmds{$cmd};
    open(TOUCH, ">$file")
        or die "unable to open '$file': $!\n";
    if ($valid_cmds{$cmd} eq $DOTLOVE) {
        print TOUCH join(' ', @args);
    } elsif ($valid_cmds{$cmd} eq $DOTSTATION) {
        print TOUCH join (' ', @args);
    }
    close(TOUCH);
}

sub delete_dotfiles {
    foreach my $file ($DOTSKIP, $DOTLOVE, $DOTBAN,
                      $DOTDUMP, $DOTUPDATE, $DOTSTATION, 
                      $DOTNEWSESSION) {
        unlink($file);
    }
}

#---------------------------------------------------------------------------
# log parsing

sub read_log {
    my $logfile = shift;
    my %log;

    open (LOG, $logfile) 
        or die "Unable to read $logfile: $!";
    while(<LOG>) {
        chomp;
        my ($artist, $album, $track, $time, $comment) = split(/ _ /, $_);
        next unless defined ($artist);
        $log{$artist}->{logs}->{$album}->{$track}->{$time} = $comment || "";
        $log{$artist}->{count}++;
    }
    close(LOG);
    return \%log;
}

sub basic_stats  {
    my $log_ref = shift;
    foreach my $artist (sort {$$log_ref{$a}->{count} <=> $$log_ref{$b}->{count}} keys %$log_ref) {
        print "$artist: $$log_ref{$artist}->{count}\n";
    }
}

sub read_known
{
    my $knownfile = shift;
    open(IN, $knownfile)
        or die "Unable to read $knownfile: $!\n";
}    



sub display_track_data {
    my %track = @_;
    $track{station} = defined $track{station} ? $track{station} : "";
    my $text =  "\nStation: $track{station} ($MODES{$track{radiomode}})\n";
    $text .=  "$track{artist} - $track{track}\n";
    $text .=  "    from $track{album}\n";
    if (open (OUT, ">$CURRENT")) {
        print OUT $text;
        close OUT;
    } else {
        warn "Unable to open $CURRENT for writing: $!";
    }
    # Xterm title
    $text .=  "\033]0;playomatic - $track{artist} - $track{track}\007\n";
    print $text;
}
       
#===========================================================================
# Main

if (@ARGV) {
    command_line(@ARGV);
    exit(0);
}

delete_dotfiles();

print "Playomatic $VERSION\n";
    
my %config = get_config($CONFIG_FILE);
die "Failed to read config file\n" unless (%config);

unless (defined $config{username} && defined $config{password}) {
    die "Username or password not defined in $CONFIG_FILE\n";
}
my %status;
$status{love} = 0;
($status{session}, $status{streamurl}) = get_session_key($config{username}, 
                                            $config{password});

# Spawn mpg123 to play it.
my $ret = 0;
my @mpg123_args = $config{mpg123_args} ? split(/\s/, $config{mpg123_args}) : ();



try {
    if (0 == ($status{playerpid} = fork())) {
        warn $status{streamurl}."\n" if $DEBUG;
        exec('mpg123', @mpg123_args, $status{streamurl});
        exit(255);
    } elsif (!defined($status{playerpid})) {
        throw Oops("fork: $!");
    }
    print "";
    while (1) {
        $status{still_this_track} = 1;

        my %track = get_current_track_info($status{session});
        $status{last_time} = time();

        if (($track{streaming} || "") eq 'false') {
            print "No track info yet...\n";
            warn Dumper(\%track) if ($DEBUG > 1);
            sleep 1;
            next;
        }
        
        %track = update_track(%track);
        if ($track{trackduration} == -1) {
             $status{still_this_track} = 0; # Changing station
        } else {
            display_track_data(%track);
        }
        
        $status{current} = hash_copy(%track);
        $status{played_to_completion} = 0;

        while ($status{still_this_track}) {
            $status{played_to_completion} = 1;
            printf STDERR ("%s / %s                \r", 
                           mins_secs(time() - $track{starttime}), 
                           mins_secs($track{trackduration}));
            
            check_for_updates(\%status, \%track);

            # Process skip/ban/love commands
            process_commands(\%status, \%track);
            sleep(0.1);

            if (waitpid($status{playerpid}, WNOHANG) == $status{playerpid}) {
                $status{playerpid} = undef;
                throw Oops("Player expired with status $?");
                $status{played_to_completion} = 0;
            }
        } # end while($status{still_this_track})

        # Log the last track played, unless it was skipped
        if ($status{played_to_completion}) {
            log_details($status{current}, $status{love});
            $status{love}=0;
        }

        sleep(0.1);
    }
} catch Oops with {
    my $E = shift;
    print STDERR "playomatic: ", $E->text(), "\n";
    kill(15, $status{playerpid}) if (defined($status{playerpid}));
    $ret = 1;
    die;
};

exit($ret);

=head1 NAME

playomatic 

=head1 SYNOPSIS

B<playomatic> [I<command> [I<message>]]

=head1 DESCRIPTION

Run without arguments, plays the last.fm (http://www.last.fm/) radio
station. You'll need to register for an audioscrobbler account first
(http://www.audioscrobbler.com). Your username and password are read
from the configuration file.

Run with arguments, issues the supplied command to the running
playomatic - see COMMANDS, below.

Before first use, you should create the configuration file
I<~/.playomaticrc> containing your last.fm username and password - see
the CONFIGURATION FILE section (below) for details.

=head1 CONTROLS

For ease of use (yes, really*), you control playomatic by touching
various files in your home directory.  The files and their effects are
as follows:

=over 4

=item .playomaticskip

Skips the current track.

=item .playomatic.love

Sends the 'love' command. 

=item .playomatic.ban

Sends the 'ban' command, and skips this track.

=item .playomatic.station

Switches stations.  The first line of the file must contain
"I<station> [I<mode>]" where I<mode> can be "personal" or "profile"
(the default), and I<station> is the name of station you want to
change to.

=item .playomatic.newsession

Starts a new session (switches last.fm radio stations, randomly).

=item .playomatic.update

Forces the track name and title to be updated.  Useful if you have
skipped track by some other means, such as the last.fm web control
panel.  

=item .dump

Dumps status information.

These commands can also be sent from the command line - see the
following section for details.

=back

=head1 COMMANDS

Any of the I<commmand>s below may be supplied (instead of touching the
approriate file into existence):

=over 4

=item skip

Skips a track

=item love [I<message>]

Sends the love command to the lastfm server, and marks the file in the logs
with '[**]'.  If I<message> is supplied, it will be logged to the log
file.  If I<message> starts with an exclamation mark the message will
be logged with '[*]' but the love command will not be sent to the server.

=item ban

Skips the track and sends the ban command to the lastfm server.

=item update

Updates the track information

=item station I<station>  [I<mode>]

Changes stations - see .playomatic.station above for details.

=item restart

Restarts playomatic

=item log

Analyses the playomatic log and produces some basic statistics
(currently merely the number of tracks listened to per artist).

=item dump

Dumps status information (useful primarily for debugging)

=back

=head1 ENVIRONMENT

=over

=item B<AS_SESSION>

If the environment variable AS_SESSION exists, its value will be used
as the session key, instead of a new session's being created.  This
allows you to connect playomatic to a session that you have initiated
from last.fm's web interface, for example.

=back

=head1 FILES

=over

=item I<~/.playomatic.current>

Contains details of the track currently being played.


=item I<~/.playomaticrc>

The configuration file I<~/.playomaticrc> should contain a series of
key/value pairs separated by '=', one per line.  The following are
known to be useful (and perusers of the source may discern yet others
if/when the documentation starts to lag the code):

 username    = [audioscrobbler username]
 password    = [audioscrobbler password] 
 mpg123_args = [additional arguments to pass to mpg123, 
                separated by spaces]

=back

=head1 *

If you can't work out why these make playomatic easy to use, you
should probably be using a different last.fm player.  (But see also
COMMANDS before giving up entirely.)

=head1 AUTHORS

Chris Lightfoot (chris@ex-parrot.com) and Julian T. J. Midgley
(jtjm@xenoclast.org).

=head1 BUGS

Probably present in profuse quantity - please email details to:
jtjm@xenoclast.org

=cut