#!/usr/bin/perl -w
# $Id: player,v 1.5 2006/11/10 10:59:10 tim Exp $
#############################################################################
# Original code Copyright 2006 Timothy Hunt - tim@timhunt.net
# See also acknowledgements below and in code.
#
# There is no warranty - Use at your own risk.
#
# This code distributed under the GNU General Public License version 2.
#
# Tested under Linux (Centos 4.2) and Cygwin with SlimServer 6.2.1
#
#############################################################################
#
# General purpose utility to execute a SlimServer player command
# on one, or more, SlimServer Squeezeboxes.
#
# Installation:
# Place this file somewhere in your PATH. I use /usr/local/bin.
#
# Usage: player -f -s [server[:port]] -u [user:password] -o secs \
#	name command args ...
#
#	-f => fork before executing - Use for fast asynchronous execution
#	-q => Quiet execution. Note -f implies -q.
#	-s => Defines hostname and port for SlimServer
#		Default current hostname, port 9090
#		This can also be defined using the SLIM_SERVER
#		environment variable.
#	-u => Defines username and password to login to SlimServer
#		Default nobody:password
#		This can also be defined by using the SLIM_USER
#		environment variable.
#	-o => If Squeezebox is powered off, power on, and sleep for
#		defined number of secs. If secs is 0, just power on.
#
#	name => Player name - This is used in a pattern match against
#		the name defined in SlimServer. Normally the name should
#		contain at least one letter.
#		'all' will use all players
#		Name can also be the number (offset 1) of the player using
#		the sequence presented by the SlimServer. Note that this
#		sequence can change, so don't hard-code numbers.
#		To see the sequence numbers do:-
#			% player all noop
#
#	command => This is passed, as is, to each player, together with
#		the arguments. No sanity checking is performed.
#		To make quoting easier - Underscores (_) are replaced by
#		spaces.
#
# Usage Examples:
#
# Let's assume the following player names are configured:
#	Master bedroom (x205) (SB1)
#	Spare bedroom (x204) (SB1)
#	Recreation room (x203) (SB2)
#	Kitchen (x201) (SB3)
#	Living room (x202) (SB2)
#
# % player bedroom display 'Good Morning' 'Wake Up!!!' 30
#	will display message in both bedrooms
#
# % player all display 'Incoming call' '212-555-1212 - Unknown caller' 30
#	will display on all displays
#
# % player '(x201)' display 'Incoming call' '212-555-1212 - Unknown caller' 30
#	will display in Kitchen only
#
# % player -q -o0 kitchen play
#	will turn on the Kitchen player, and, press the menu "play" button.
#
# %  player all power 0
#	will power off all your players, and silence will reign.
#	(that's a zero)
#
# % player bedroom displaynow '?' '?'
#	will display the contents of 
#
################################################################################
#
# Use with Asterisk:-
# Add a line like the following to the appropriate place in your configuration.
#
# exten => _.,1,System(player -qf -s server all display "Incoming call from" "${CALLERIDNUM} - ${CALLERIDNAME}" 30)
#
# Note the use of the '-f' option, so the caller is not kept waiting while
# the message is displayed, and Asterisk will not lock up if the
# SlimServer host happens to be offline.
#
################################################################################
#
# When running under Cygwin, I suggest creating a player.bat file that contains
#  something like:-
#
# @ C:\cygwin\bin\perl.exe /bin/player -s slim.mydomain.com %1 %2 %3 %4 %5 %6 %7
#
# This can then be invoked relatively painlessly from the Windows command line.
#
############################################################################
# Original code derined from cid.pl
# Date: 2005-12-12 18:57:39 +0000 (Mon, 12 Dec 2005) $ $Rev: 48
# Copyright 2005 Max Spicer.
# Feel free to reuse and modify, but please consider passing modifications back
# to me so they can be included in future versions.
# If you use this script, please let me know!

use strict;
use Getopt::Std;

# Stuff used by getopts:
$main::VERSION                      = '$Id: player,v 1.5 2006/11/10 10:59:10 tim Exp $';
$Getopt::Std::STANDARD_HELP_VERSION = 1;

my %opts;
my $r = getopts( 'o:fqhdvs:u:', \%opts );

my ( $target, $cmd, @args ) = @ARGV;

# If the user is asking for help:
die "Usage: $0 "
  . " [-s server[:port]]"
  . " [-u user[:password]]"
  . " [-o secs]"
  . " [-fvq]"
  . " player_name(regex)"
  . " player_command"
  . " command_args ...\n"
  if ( defined( $opts{'h'} ) || !defined($cmd) );

my ( $serverAddress, $serverPort, $slimUser, $slimPass );

my $debug       = defined( $opts{'d'} ) ? 2                  : 0;
my $quiet       = defined( $opts{'q'} ) ? 1                  : 0;
my $powerOnTime = defined( $opts{'o'} ) ? ( 0 + $opts{'o'} ) : -1;

my @cmd;
$cmd[0] = $cmd;

if ( defined( $opts{'f'} ) ) {
    if ( !defined( my $child_pid = fork() ) ) {
        die "cannot fork: $!";
    }
    elsif ($child_pid) {

        # Parent - so exit
        exit(0);
    };
    $quiet = 1;
};

$slimUser = $opts{'u'};
$slimUser = $ENV{'SLIM_USER'} unless ( defined $slimUser );
$slimUser = 'nobody' unless ( defined $slimUser );
$slimPass = 'password';
( $slimUser, $slimPass ) = ( $1, $2 ) if ( $slimUser =~ /^([^:]*):(.*)$/ );

$serverAddress = $opts{'s'};
$serverAddress = $ENV{'SLIM_SERVER'} unless ( defined($serverAddress) );
unless ( defined $serverAddress ) {

    # This is being lazy
    $serverAddress = `hostname`;
    chomp $serverAddress;
};
$serverPort = 9090;
( $serverAddress, $serverPort ) = ( $1, $2 )
  if ( $serverAddress =~ /^([^:]*):(.*)$/ );

$target =~ s/([()<>])/\\$1/g;
$target =~ s/_/ /g;
$target = '.*' if ( lc($target) eq 'all' );

my $socket = &connect( $serverAddress, $serverPort );

die "Can't connect to server $serverAddress:$serverPort\n"
  unless ( defined $socket );

if ($debug) {
    eval 'use POSIX qw(strftime);';
    print strftime( "%Y-%m-%d %H:%M:%S:\n", localtime );

    $slimUser && print "User=$slimUser Passwd=$slimPass\n";
    print "Server=$serverAddress Port=$serverPort\n";
    print "Target squeezebox(es)=/$target/\n";
    print "Command $cmd '" . join( "' '", @args ) . "'\n";
};

for ( my $i = 0 ; $i < @args ; $i++ ) {
    $args[$i] =~ s/_/ /og;
};

my $targetId = 0;
$targetId = ( 0 + $target ) if ( $target =~ /^\d+$/ );

# Always login - to verify we're actually talking to a SlimServer

my @res = sendAndReceive( $socket, 'login', $slimUser, $slimPass );
die "login failed\n" unless ( $res[2] eq '******' );

# Get information about Squeezeboxes connected to this server
# Do this everytime, as we always need to find the playerid

my @players;
my @info = sendAndReceive( $socket, 'players', 0, 9999 );

# Parse response into an array

my $index = -1;
foreach my $info (@info) {

    # name:value pairs
    my ( $name, $value ) = split( /:/, $info, 2 );

    # which player
    if ( $name eq 'playerindex' ) {
        $index = ( $value + 0 );
        $players[$index]{'use'} =
          ( $targetId && $targetId == ( $index + 1 ) ) ? 1 : 0;
        next;
    }
    next unless ( $index >= 0 );

    $players[$index]{$name} = $value;

    # Is this a player we wish to use this time
    $players[$index]{'use'} = 1
      if ( $name eq 'name' && $value =~ /$target/i && !$targetId );

    # Ignore player if not connected
    $players[$index]{'use'} = 0 if ( $name eq 'connected' && !$value );
};

$debug && print @players . " players found\n";

die "No players found\n" unless (@players);

if ( $powerOnTime >= 0 ) {
    # First send a power on to all players that need it
    my $count = 0;
    for ( my $i = 0 ; $i < @players ; $i++ ) {
        next unless ( $players[$i]{'use'} );

        my $playerId = $players[$i]{'playerid'};
        $debug && print "Player $i has ID $playerId\n";

        my $power = sendAndReceive( $socket, $playerId, 'power', '?' );
        $debug && print "power: $power\n";
        $players[$i]{'power'} = $power;

        unless ($power) {
            sendAndReceive( $socket, $playerId, 'power', '1' );
            $players[$i]{'sleeptime'} = $powerOnTime;
            $players[$i]{'poweredon'} = 1;
            $count++;
        };
    };

    # Wait for the players to power on and change display.
    # Otherwise our output will be overwritten
    if ($count > 0) {
        eval 'use Time::HiRes qw(usleep);';
        while ( $count > 0 ) {

            # We need more time
            usleep(10000);
            for ( my $i = 0 ; $i < @players ; $i++ ) {
                next unless ( $players[$i]{'poweredon'} );
		my $playerId = $players[$i]{'playerid'};
                my @res =
                  sendAndReceive( $socket, $playerId, 'displaynow', '?', '?' );
                $debug && print "Display: " . join( ' : ', @res ) . "\n";
                if ( @res > 1 ) {
                    $players[$i]{'power'}     = 1;
                    $players[$i]{'poweredon'} = 0;
                    $count--;
                };
            };
        };
    };
};

# Run command on each player

for ( my $i = 0 ; $i < @players ; $i++ ) {
    next unless ( $players[$i]{'use'} );

    my $playerId = $players[$i]{'playerid'};
    $debug && print "Player $i has ID $playerId\n";

    my @res = sendAndReceive( $socket, $playerId, $cmd, @args );
    if (@res) {
        printf( "%d: $players[$i]{'name'}: ", $i + 1 ) unless ($quiet);
        print join( ' : ', @res ) . "\n" unless ( $quiet && $res[0] eq 'OK' );
    };
};

# If we powered on any players, send a sleep command to power off

if ( $powerOnTime > 0 ) {
for ( my $i = 0 ; $i < @players ; $i++ ) {
    next unless ( $players[$i]{'use'} );
    next
      unless ( defined $players[$i]{'sleeptime'} && $players[$i]{'sleeptime'} > 0 );
    my $playerId = $players[$i]{'playerid'};
    sendAndReceive( $socket, $playerId, 'sleep', $players[$i]{'sleeptime'} );
};
};
exit 0;

#
# Send given cmd to $socket and return answer with original command removed from
# front if present.  Routine nicked from code by Felix Mueller. :-)
#
# This implementation also handles the encoding of strings,
# and if multiple responses are received, the response is split into an
# array before decoding.
#
# This means the response from displaynow ? ? is now handled
# correctly with line 1 and line 2 of the display being in
# seperate display elements.
#
sub sendAndReceive {
    my $socket = shift;
    my $cmd    = '';

    foreach my $arg (@_) {
        $cmd .= URLEncode($arg) . ' ';
    };
    $cmd =~ s/ *$//o;

    return undef if ( $cmd eq '' );

    print $socket "$cmd\n";
    $debug > 1 && print "Sent $cmd to server\n";
    my $answer;
    while (1) {
	$answer = <$socket>;
	last if (defined($answer));
	die "Connection died: $!" if (eof($socket));
    }
    $answer =~ s/ *\n//;
    $debug > 1 && print "Server replied: $answer\n";

    # Strip any trailing question marks
    while ( $cmd =~ s/ *%3F$//oi ) { };

    $cmd =~ s/([!*()-.])/\\$1/g;
    $debug > 1 && print "Match: $cmd\n";

    if ( $answer =~ /$cmd *(.*)$/i ) {
        $answer = length($1) ? $1 : 'OK';
    };
    my @res = split( ' ', $answer );
    for ( my $i = 0 ; $i < @res ; $i++ ) {
        $res[$i] = URLDecode( $res[$i] );
    };

    return $res[0] if ( @res == 1 );
    return @res;
};

# Routines nicked from http://glennf.com/writing/hexadecimal.url.encoding.html

sub URLDecode {
    my $theURL = shift;
    $theURL =~ tr/+/ /;
    $theURL =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/oeg;
    return $theURL;
};

sub URLEncode {
    my $theURL = shift;
    $theURL =~ s/([^a-zA-Z0-9!*()'.~-])/"%" . uc(sprintf("%2.2x",ord($1)))/oeg;
    return $theURL;
};

# This is a lightweight replacement for IO::Socket->new with significantly
# less startup time.
# This is a big deal on a slow (500MHz) box

sub connect {
    my ( $server, $port ) = @_;

    use Socket;

    my $socket;

    # Again this forces the load post-fork
    eval 'use IO::Handle; $socket = new IO::Handle;';

    my $iaddr = inet_aton($server);
    my $paddr = sockaddr_in( $port, $iaddr );
    my $proto = getprotobyname('tcp');

    socket( $socket, PF_INET, SOCK_STREAM, $proto )
      or die "Can't open socket";
    connect( $socket, $paddr ) or die "Can't connect to server $server:$port\n";

    # This turns off buffering - very important
    my $oldfh = select $socket;
    $| = 1;
    select $oldfh;

    return $socket;
};

1;