Music::Audioscrobbler::MPD - Module providing routines to submit songs to last.fm from MPD.

	use Music::Audioscrobbler::MPD
	my $mpds = Music::Audioscrobbler::MPD->new(\%options); 
	$mpds->monitor_mpd();

    musicmpdscrobble --longhelp

package Music::Audioscrobbler::MPD;
our $VERSION = 0.13;
require 5.006;

# Copyright (c) 2007 Edward J. Allen III
# Some code and inspiration from Audio::MPD Copyright (c) 2005 Tue Abrahamsen, Copyright (c) 2006 Nicholas J. Humfrey, Copyright (c) 2007 Jerome Quelin

#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
#


# the GNU Public License.  Both are distributed with Perl.

use strict;
use warnings;
use Music::Audioscrobbler::Submit;
use File::Spec;
use Digest::MD5 qw(md5_hex);
use Encode qw(encode);
use IO::Socket;
use IO::File;
use Config::Options;
use POSIX qw(WNOHANG);
#use Storable;


sub _default_options {
    {  lastfm_username    => undef,
       lastfm_password    => undef,
       mdb_opts           => {},
       musictag           => 0,
       musictag_overwrite => 0,
       verbose            => 1,
       monitor            => 1,
       daemonize          => 0,
       timeout            => 15,      # Set low to prevent missing a scrobble.  Rather retry submit.
       pidfile            => "/var/run/musicmpdscrobble.pid",
       logfile            => undef,
       default_cache_time => 86400,
       mpd_password       => undef,
       allow_stream       => 0,
       mpd_server         => $ENV{MPD_HOST} || 'localhost',
       mpd_port           => $ENV{MPD_PORT} || 6600,
       music_directory    => "/mnt/media/music/MP3s",
       scrobble_queue     => $ENV{HOME} . "/.musicaudioscrobbler_queue",
       optionfile       => [ "/etc/musicmpdscrobble.conf", $ENV{HOME} . "/.musicmpdscrobble.conf" ],
       runonstart       => [],
       runonsubmit      => [],
       lastfm_client_id => "mam",
       lastfm_client_version => "0.1",
       music_tag_opts        => {
                           quiet     => 1,
                           verbose   => 0,
                           ANSIColor => 0,
                         },
    };
}

sub new {
    my $class   = shift;
    my $options = shift || {};
    my $self    = {};
    bless $self, $class;
    $self->options( $self->_default_options );
	if ($options->{optionfile}) {
		$self->options->options("optionfile", $options->{optionfile});
	}
    $self->options->fromfile_perl( $self->options->{optionfile} );
    $self->options($options);
    $self->{scrobble_ok} = 1;
    $self->_convert_password();

	if ($self->options->{lastfm_client_id} eq "tst") {
		$self->status(0, "WARNING: Using client id 'tst' is NO LONGER approved.  Please use 'mam' or other assigned ID");
	}
    if ($self->options("mpd_server") =~ /^(.*)@(.*)/) {
    	$self->options->{"mpd_server"} = $2;
    	$self->options->{"mpd_password"} = $1;
    }
    return $self;
}

sub _convert_password {
    my $self = shift;
    unless ( $self->options('lastfm_md5password') ) {
        if ( $self->options('lastfm_password') ) {
            $self->options->{lastfm_md5password} =
              Digest::MD5::md5_hex( $self->options->{lastfm_password} );
            delete $self->options->{lastfm_password};
        }
    }
}

sub monitor_mpd {
    my $self = shift;
    $self->status( 1, "Starting Music::Audioscrobbler::MPD version $VERSION" );
    while (1) {
        if ( $self->is_connected ) {
            $self->update_info();
            sleep 1;
        }
        else {
            $self->connect;
            sleep 4;
        }
        unless ( $self->{scrobble_ok} ) {
            if ( ( time - $self->{lastscrobbled} ) > 600 ) {
                $self->{scrobble_ok}   = $self->mas->process_scrobble_queue();
                $self->{lastscrobbled} = time;
            }
        }
		$self->_reaper();
    }
}

sub options {
    my $self = shift;
    if ( exists $self->{_options} ) {
        return $self->{_options}->options(@_);
    }
    else {
        $self->{_options} = Config::Options->new();
        return $self->{_options}->options(@_);
    }
}

sub mpdsock {
    my $self = shift;
    my $new  = shift;
    if ($new) {
        $self->{mpdsock} = $new;
    }
    unless ( exists $self->{mpdsock} ) {
        $self->{mpdsock} = undef;
    }
    return $self->{mpdsock};
}

sub connect {
    my $self = shift;
    if ( ( $self->mpdsock ) && ( $self->is_connected ) ) {
        $self->status( 3, "Already connected just fine." );
        return 1;
    }

    $self->mpdsock(
                    IO::Socket::INET->new( PeerAddr => $self->options("mpd_server"),
                                           PeerPort => $self->options("mpd_port"),
                                           Proto    => 'tcp',
                                         )
                  );

    unless ( ( $self->mpdsock ) && ( $self->mpdsock->connected ) ) {
        $self->status( 1, "Could not create socket to mpd: $!" );
        return 0;
    }

    if ( $self->mpdsock->getline() =~ /^OK MPD (.+)$/ ) {
        $self->{mpd_sever_version} = $1;
    }
    else {
        $self->status( 1, "Bad response from mpd ($!)" );
        return 0;
    }
    $self->send_password if $self->options("mpd_password");
    return 1;
}

sub is_connected {
    my $self = shift;
    if ( ( $self->mpdsock ) && ( $self->mpdsock->connected ) ) {
        $self->mpdsock->print("ping\n");
        return ( $self->mpdsock->getline() =~ /^OK/ );
    }
    return undef;
}

sub process_feedback {
    my $self = shift;
    my @output;
    if ( ( $self->mpdsock ) && ( $self->mpdsock->connected ) ) {
        while ( my $line = $self->mpdsock->getline() ) {
            chomp($line);

            # Did we cause an error? Save the data!
            if ( $line =~ /^ACK \[(\d+)\@(\d+)\] {(.*)} (.+)$/ ) {
                $self->{ack_error_id}         = $1;
                $self->{ack_error_command_id} = $2;
                $self->{ack_error_command}    = $3;
                $self->{ack_error}            = $4;
                $self->status( 1, "Error sent to MPD: $line" );
                return undef;
            }
            last if ( $line =~ /^OK/ );
            push( @output, $line );
        }
    }

    # Let's return the output for post-processing
    return @output;
}

sub send_command {
    my $self = shift;
    if ( $self->is_connected ) {
        $self->mpdsock->print( @_, "\n" );
        return $self->process_feedback;
    }
}

sub send_password {
    my $self = shift;
    $self->send_command( "password ", $self->options("mpd_password"));
}

sub get_info {
    my $self    = shift;
    my $command = shift;
    my $ret     = {};
    foreach ( $self->send_command($command) ) {
        if (/^(.[^:]+):\s(.+)$/) {
            $ret->{$1} = $2;
        }
    }
    return $ret;
}

sub get_status {
    my $self = shift;
    $self->get_info("status");
}

sub get_current_song_info {
    my $self = shift;
    $self->get_info("currentsong");
}

sub status {
    my $self  = shift;
    my $level = shift;
    if ( $level <= $self->options->{verbose} ) {
        my $out = $self->logfileout;
        print $out scalar localtime(), " ", @_, "\n";
    }
}

sub logfileout {
    my $self = shift;
    my $fh   = shift;
    if ($fh) {
        $self->{logfile} = $fh;
    }
	if ((not $self->options->{logfile}) or ($self->options->{logfile} eq "STDERR" )) {
        return \*STDERR;
	}
	elsif ($self->options->{logfile} eq "STDOUT" ) {
        return \*STDOUT;
	}
    unless ( ( exists $self->{logfile} ) && ( $self->{logfile} ) ) {
        my $fh = IO::File->new( $self->options->{logfile}, ">>" );
        unless ($fh) {
            print STDERR "Error opening log, using STDERR: $!";
            return \*STDERR;
        }
        $fh->autoflush(1);
        $self->{logfile} = $fh;
    }
    return $self->{logfile};
}

sub mas {
	my $self = shift;
    my $new = shift;
    if ($new) {
        $self->{mas} = $new;
    }
	unless ((exists $self->{mas}) && (ref $self->{mas})) {
		$self->{mas} = Music::Audioscrobbler::Submit->new($self->options);
		$self->{mas}->logfileout($self->logfileout);
	}
	return $self->{mas};
}

sub new_info {
    my $self  = shift;
    my $cinfo = shift;
    $self->{current_song} = $cinfo->{file};
    if ( $self->{current_song} =~ /^http/i ) {
        if ($self->options("allow_stream")) {
            $self->{current_file} = 0;
        }
        else {
            $self->{current_file} = undef;
        }
    }
    elsif ( -e File::Spec->rel2abs( $self->{current_song}, $self->options->{music_directory} ) ) {
        $self->{current_file} =
          File::Spec->rel2abs( $self->{current_song}, $self->options->{music_directory} );
    }
    else {
        $self->status(1, "File not found: ", File::Spec->rel2abs( $self->{current_song}, $self->options->{music_directory} ));
        $self->{current_file} = 0;
    }
    my $h = { album    => $cinfo->{Album},
                                           artist   => $cinfo->{Artist},
                                           title    => $cinfo->{Title},
                                           secs     => $cinfo->{Time},
                                         };
    if ($self->options->{musictag}) {
        $h->{filename} = $self->{current_file};
    }
    $self->{info} = $self->mas->info_to_hash( $h );

    #Prevent excessive calls to info_to_hash
    delete $self->{info}->{filename};

    $self->{song_duration}     = $cinfo->{Time};
    $self->{current_id}        = $cinfo->{Id};
    $self->{running_time}      = 0;
    $self->{last_running_time} = undef;
    $self->{state}             = "";
    $self->{started_at}        = time;
    $self->status( 1, "New Song: ", $self->{current_id}, " - ", ($self->{current_file} ? $self->{current_file} : "Unknown File: $self->{current_song}")  );
}

sub song_change {
    my $self  = shift;
    my $cinfo = shift;
    if ( ( defined $self->{current_file} )
         and (    ( $self->{running_time} >= 240 )
               or ( $self->{running_time} >= ( $self->{song_duration} / 2 ) ) )
         and ( ( $self->{song_duration} >= 30 ) or ( $self->{info}->{mbid} ) )
      ) {
        $self->scrobble();
        $self->run_commands( $self->options->{runonsubmit} );
    }
    else {
        $self->status( 4, "Not scrobbling ",
                       $self->{current_file}, " with run time of ",
                       $self->{running_time} );
    }
    my $state = $self->{state};
    $self->new_info($cinfo);
    if ( ( defined $self->{current_file} ) && ( $cinfo->{Time} ) && ( $state eq "play" ) ) {
        $self->status( 4, "Announcing start of play for: ", $self->{current_file} );
        $self->mas->now_playing( $self->{info} );
        $self->run_commands( $self->options->{runonstart} );
    }
    else {
        $self->status( 4, "Not announcing start of play for: ", $self->{current_file} );
    }
    $self->status("4", "Storing debug info");
    #$Storable::forgive_me = 1;
    #store($self, $self->options->{logfile}.".debug");
}

sub update_info {
    my $self   = shift;
    my $status = $self->get_status;
    my $cinfo  = $self->get_current_song_info();
    $self->{state} = $status->{state};
    my ( $so_far, $total ) = (0,0);
    if ($status->{'time'}) {
        ( $so_far, $total ) = split( /:/, $status->{'time'} );
    }
    my $time = time;
    if ( $self->{state} eq "play" ) {
        unless ( $cinfo->{Id} eq $self->{current_id} ) {
            $self->song_change($cinfo);
        }
        unless ( defined $self->{last_running_time} ) {
            $self->{last_running_time} = $so_far;
        }
        unless ( defined $self->{last_update_time} ) {
            $self->{last_update_time} = $time;
        }
        my $run_since_update = ( $so_far - $self->{last_running_time} );

        my $time_since_update =
          ( $time - $self->{last_update_time} ) + 5;    # Adding 5 seconds for rounding fudge

        if ( ( $run_since_update > 0 ) && ( $run_since_update <= $time_since_update ) ) {
            $self->{running_time} += $run_since_update;
        }
        elsif (    ( $run_since_update < -240 )
                or ( $run_since_update < ( -1 * ( $self->{song_duration} / 2 ) ) ) ) {
            $self->status(
                3,
                "Long skip back detected ( $run_since_update ).  You like this song.  Scrobbling... "
            );
            $self->song_change($cinfo);
        }
        elsif ($run_since_update) {
            $self->status( 3, "Skip detected, ignoring time change." );
        }
        $self->{last_running_time} = $so_far;
        $self->{last_update_time}  = $time;
    }
    elsif ( ( $self->{state} eq "stop" ) && ( $self->{running_time} ) ) {
        $self->song_change($cinfo);
    }
    if ( $self->options->{monitor} ) {
        $self->monitor();
    }
}

sub monitor {
    my $self = shift;
    printf STDERR "%5s ID: %4s  TIME: %5s             \r", $self->{state} ? $self->{state} : "", $self->{current_id} ? $self->{current_id} : "",
      $self->{running_time} ? $self->{running_time} : "";
}

sub scrobble {
    my $self = shift;
    if ( defined $self->{current_file} ) {
        $self->status( 2, "Adding ", $self->{current_file}, " to scrobble queue" );
        $self->{scrobble_ok} = $self->mas->submit( [ $self->{info}, $self->{started_at} ] );
        $self->{lastscrobbled} = time;
    }
    else {
        $self->status( 3, "Skipping stream: ", $self->{current_file} );
    }
}

sub run_commands {
    my $self     = shift;
    my $commands = shift;
    return unless ( ( ref $commands ) && ( scalar @{$commands} ) );
    my $pid = fork;
    if ($pid) {
		$self->_toreap($pid);
        $self->status( 4, "Forked to run commands\n" );
    }
    elsif ( defined $pid ) {
        if ( $self->options->{logfile} ) {
            my $out = $self->logfileout;
            open STDOUT, ">&", $out;
            select STDOUT;
            $| = 1;
            open STDERR, ">&", $out;
            select STDERR;
            $| = 1;
        }
        foreach my $c ( @{$commands} ) {
            $c =~ s/\%f/$self->{current_file}/e;
            $c =~ s/\%a/$self->{info}->{artist}/e;
            $c =~ s/\%b/$self->{info}->{album}/e;
            $c =~ s/\%t/$self->{info}->{title}/e;
            $c =~ s/\%l/$self->{info}->{secs}/e;
            $c =~ s/\%n/$self->{info}->{track}/e;
            $c =~ s/\%m/$self->{info}->{mbid}/e;
            my $s = system($c);
            delete $self->{fh};

            if ($s) {
                $self->status( 0, "Failed to run command: ${c}: $!" );
            }
            else {
                $self->status( 2, "Command ${c} successful" );
            }
        }
        exit;
    }
    else {
        $self->status( 0, "Failed to fork for commands: $!" );
    }
}

sub _toreap {
	my $self = shift;
	my $pid = shift;
	unless (exists $self->{reapme}) {
		$self->{reapme} = [];
	}
	push @{$self->{reapme}}, $pid;
}

sub _reaper {
	my $self = shift;
	if (exists $self->{reapme}) {
		my @newreap = ();
		foreach (@{$self->{reapme}}) {
			(waitpid $_, WNOHANG) or push @newreap, $_;
		}
		if (@newreap) {
			$self->{reapme} = \@newreap;
		}
		else {
			delete $self->{reapme};
		}
	}
}

1;