http://qs1969.pair.com?node_id=785470
Category: Audio Related Programs
Author/Contact Info mikelieman@gmail.com
Description: In celebration of the birthday of Jerry Garcia ( b. 8/1/1942 d. 8/9/1995 ) I present a Perl script which allows a smartphone user (e.g.: Blackberry ) to control an instance of Amarok 1.4 running remotely on a media center PC by chatting with the daemon through Google Talk.

A few weekends ago, we were sitting on the porch wondering which of MANY Red Rocks shows we had queued up on the media center PC we were listening to at the moment when we started discussing ways to get the information about what we were listening to displayed conveniently.

A few hours later, after dismissing some ideas involving scrolling LED marquees over the cabin door, I got the idea that "Jeff's blackberry can run Google Talk. I can have the a script pull data from Amarok via its DCOP integration{1} and use XMPP to send 'Now Playing' messages" over Google Talk to the daemon's friends.

Once we had Song Change notices being sent, the natural extension was to have a two-way conversation. By the next morning we had transport and volume control integrated. A week later, I spent an hour or two adding *very basic* playlist construction support, and that was pretty much all you'd ever need.{2}

You'll need a Google Talk account, and the people who get control and notices need to be setup to chat with the Google Talk account ( I used the Gmail UI ).

Once the server has friends to chat with, fire up Amarok, fire up this script, and it'll connect to Google Talk and start notifying of song changes and accept volume, transport control, and playlist management commands.

Footnotes:

{1} Which in going to require an abstraction layer or something to accommodate Amarok 2.0's different yet still standards conforming desktop integration API.

{2} While testing, we ended up quickly adding 2 more features ( not shown). "X" will just stop what the server's doing, load a pre-set playlist and just start playing that -- for times when you just want music up, but don't have the time to construct a playlist. And a patch to return to $MUSIC_ROOT if you get confused where you are browsing for content. The playlist construction features need some work.

#!/usr/bin/perl

=head1 NAME amarok-im.pl

=head1 SYNOPSIS 

    ./amarok-im.pl [-d]

    The -d command line flag triggers XMPP level debugging.

=head1 DESCRIPTION
    
    amarok-im.pl provides an chat based UI for amarok over XMPP via  g
+oogle talk.

=head1 CHANGELOG

Patched trivial display bug pointed out in comments by jwkrahn on Aug 
+03, 2009 

=cut

use strict;
use warnings;
use Net::XMPP;
use File::Basename;
use Cwd;

######################################################################
+##########
#
#  Globals
#
######################################################################
+##########

my $debug_level = ( ( $ARGV[0] ) and ( $ARGV[0] eq '-d' ) ) ? 1 : 0;

my %im_status;

my $Connection;

my $lastPlaying = '';

my $body = '';    # message body

my %daemon;       # Variables for notifying daemon connection and oper
+ation

my $MUSIC_ROOT = "/storage/usb00/l-space/Music";

my $playlistCD = $MUSIC_ROOT;    # playlist browser Current Directory

my @dirEntries;

my %playlistSubdirs;

##  Google Talk login credentials ##
$daemon{'username'} = '';
$daemon{'password'} = '';

#  Mostly static values
$daemon{'hostname'}       = 'talk.google.com';
$daemon{'port'}           = 5222;
$daemon{'componentname'}  = 'gmail.com';
$daemon{'connectiontype'} = 'tcpip';
$daemon{'tls'}            = 1;
$daemon{'resource'}       = 'PerlBot';
$daemon{'delay'}          = 5;

######################################################################
+##########
#
#  Usage
#
######################################################################
+##########

my $usage =
    "Valid Commands\n"
  . "\th:Help\n"
  . "INFO:\n"
  . "\tl:playList\n"
  . "\ts:Status\n"
  . "TRNSPRT:\n"
  . "\tb:Back\n"
  . "\tn:Next\n"
  . "\tp:toggle Pause\n"
  . "\tt###:Track\n"
  . "VOLUME:\n"
  . "\tu:vol Up\n"
  . "\td:vol Down\n"
  . "\tm:Mute\n"
  . "\tv###:Vol set\n"
  . "\tf:Full vol\n"
  . "PLAYLIST:\n"
  . "\ta:Add selected dir to playlist\n"
  . "\tc:Change selected dir\n"
  . "\tz:Zap playlist\n";

######################################################################
+##########
#
#  Dispatch Table:  Given a single character, execute the correspondin
+g coderef
#  or anonymous subroutine.
#
######################################################################
+##########

my %dispatch_table = (

    "A" => \&addPlaylistItems,

    "B" => sub { player("prev"); $lastPlaying = ''; return "Previous t
+rack" },

    "C" => \&changePlaylistDir,

    "D" =>
      sub { player("volumeDown"); return "Volume: " . player("getVolum
+e") },

    "F" =>
      sub { player("setVolume 100"); return "Volume: " . player("getVo
+lume") },

    "H" => sub { return $usage },    #  Help message

    "L" => \&displayPlaylist,

    "M" => sub { player("mute"); return "Volume: " . player("getVolume
+") },

    "N" => sub { player("next"); $lastPlaying = ''; return "Next track
+" },

    "P" => sub { player("playPause"); return player("isPlaying") },

    "S" => \&displayStatus,

    "T" => \&setTrack,

    "U" => sub { player("volumeUp"); return "Volume: " . player("getVo
+lume") },

    "V" => \&setVol,

    "Z" => \&clearPlaylistItems,
);

######################################################################
+##########
#
# Signal handlers
#     These ensure that the connection is closed if the program is kil
+led
#
######################################################################
+##########

$SIG{HUP}  = \&shutdown;
$SIG{KILL} = \&shutdown;
$SIG{TERM} = \&shutdown;
$SIG{INT}  = \&shutdown;

sub shutdown {
    notifyUsers("Signal caught. Disconnecting and Shutting down.");
    $Connection->Disconnect();

    print "SIGNAL: Signal caught.  Disconnected and now Shutting down.
+\n";
    exit(0);

}    # sub shutdown

######################################################################
+##########
#
#
#
######################################################################
+##########
sub msgHeader {

    my $hostname = `hostname`;
    chomp $hostname;
    my $time = `uptime | cut -d' ' -f2,10-`;
    chomp $time;
    return "\n======  $hostname  ====  $time  =====\n"

};    # sub msgHeader

######################################################################
+##########
#
#
#
######################################################################
+##########
sub displaySong() {

    my $tmp_msg = player('isPlaying') . " " . player("nowPlaying");
    $tmp_msg .= " (vol:" . player("getVolume") . ")\n";

    return $tmp_msg;

};    # sub displaySong

######################################################################
+##########
#
#
#
######################################################################
+##########
sub displayPlaylist {

    my $playing = basename( player("path") );
    my @retval  = `dcop amarok playlist filenames`;

    my $tmp_string = "Playlist:\n";

    my $tmp_idx = 1;
    foreach my $tmp_name (`dcop amarok playlist filenames`) {

        $tmp_string .= "[$tmp_idx]\t";   

        # remove common suffixes
        chomp $tmp_name;
        # Patched as per jwkrahn 08/2009
        $tmp_name =~ s/\.(?:mp3|flac|shn|ogg)\z//;

        # and append the filename
        $tmp_string .= 
          ( $playing =~ /$tmp_name/ ) ? "*** $tmp_name ***\n" : "$tmp_
+name\n";

      $tmp_idx++;

    }

    return $tmp_string;

};    # sub displayPlaylist

######################################################################
+##########
#
#
#
######################################################################
+##########
sub displayStatus() {

    my $tmp_pct = sprintf( "%02d",
        player("trackCurrentTime") / player("trackTotalTime") * 100 );
    my $tmp_eta = player("trackTotalTime") - player("trackCurrentTime"
+);

    my $tmp_msg = displaySong;
    $tmp_msg .= " (%$tmp_pct eta:T-$tmp_eta)\n";
    $tmp_msg .= " (path:" . player("path") . ")\n";

    $tmp_msg .= "\nIM Status\n=========\n";

    foreach my $user ( sort keys %im_status ) {

        $tmp_msg .= "$user ";
        $tmp_msg .= $im_status{$user}->{'available'} ? '' : 'un';
        $tmp_msg .= 'available';

        if ( $im_status{$user}->{'show'} ) {
            $tmp_msg .= ' (' . $im_status{$user}->{'show'} . ')';
        }

        $tmp_msg .= "\n";
    }

    return $tmp_msg;

};    # sub displayStatus

######################################################################
+##########
#
#
#    Parameters: getVolume isPlaying nowPlaying path
#                playPause trackCurrentTime trackTotalTime
#
#
######################################################################
+##########
sub player {

    my $directive = shift;

    my ($retval) = `dcop amarok player $directive 2>&1`;

    if ( defined $retval ) {

        chomp $retval;

        # special output for isPlaying
        if ( $directive eq 'isPlaying' ) {
            if   ( $retval eq 'true' ) { return "Amarok is playing" }
            else                       { return "Amarok is stopped" }
        }

        # 'call failed' processing
        if ( $retval =~ /^call failed/ ) {
            return "Is Amarok running?";
        }

    }
    else { $retval = '' }

    return $retval;

};    # sub player

######################################################################
+##########
#
#
#
######################################################################
+##########
sub setVol {

    my $tmp_val = substr( $body, 1 ) or return "Bad Input";

    if ( $tmp_val =~ /^[+-]?\d+$/ ) {

        # this one goes to 11(0).
        if ( ( $tmp_val < 0 ) or ( $tmp_val > 110 ) ) {
            return "Usage: V### where 1 < ### < 110";
        }

        # change the volume, and return the resulting volume level.
        player("setVolume $tmp_val");
        return "Volume: " . player("getVolume");

    }
    else { return "Non-Integer Input" }

};    # sub setVol

######################################################################
+##########
#
#
#
######################################################################
+##########
sub changePlaylistDir {

    my $reply = "Current Dir: $playlistCD\n";

    opendir( my $DIR, $playlistCD ) || die "can't opendir $playlistCD:
+ $!";
    my @tmpEntries = readdir($DIR);
    closedir $DIR;

    my $tmp_entry_string = '';
    my $tmp_entry_idx    = 1;

    foreach my $entry ( sort @tmpEntries ) {

        next if ( $entry eq '.' );
        $tmp_entry_string .= "[$tmp_entry_idx]\t$entry\n";

        $playlistSubdirs{$tmp_entry_idx} = $entry;

        $tmp_entry_idx++;
    }

    my $tmp_val = substr( $body, 1 ) or return ( $reply . $tmp_entry_s
+tring );

    if ( $tmp_val =~ /^[+-]?\d+$/ ) {

        my $tmp_playlistCD .= $playlistCD . "/" . $playlistSubdirs{$tm
+p_val};

        my $curDir = cwd;
        if ( chdir $tmp_playlistCD ) { $playlistCD = cwd };
        chdir $curDir;
        
        $reply = "cd=$playlistCD";

    }

    return $reply;

}

######################################################################
+##########
#
#
#
######################################################################
+##########
sub addPlaylistItems {

    my @retval = `dcop amarok playlist addMedia \"$playlistCD\"`;
    return "Added $playlistCD to playlist";

};    # sub addPlaylistItems

######################################################################
+##########
#
#
#
######################################################################
+##########
sub clearPlaylistItems {

    my @retval = `dcop amarok playlist clearPlaylist`;
    $playlistCD = $MUSIC_ROOT;    # reset playlist browser Current Dir
+ectory
    return "Playlist cleared";

};    # sub addPlaylistItems
######################################################################
+##########
#
#
#
######################################################################
+##########
sub setTrack {

    my $tmp_val = substr( $body, 1 ) or return "Bad Input";

    # regex for integer
    if ( $tmp_val =~ /^[+-]?\d+$/ ) {

        #  These indexes are zero based, and you're gonna have to decr
+ement
        #  the value extracted from the command line to match ( as the
+ printed
        #  playlists are ONE based ).
        my $reindexed_val = $tmp_val - 1;

        # change the track
        my @retval = `dcop amarok playlist playByIndex $reindexed_val`
+;
        return "Track changed to $tmp_val";

    }
    else { return "Non-Integer Input" }

};    # sub setTrack

######################################################################
+##########
#
#
#
######################################################################
+##########
sub notifyUsers {

    my $msg = shift;

    foreach my $user ( sort keys %im_status ) {

        next if $user eq $daemon{'username'};

        if (    ( $im_status{$user}->{"available"} )
            and ( $im_status{$user}->{"show"} ne 'dnd' ) )
        {

            $Connection->MessageSend(
                to       => "$user\@" . $daemon{'componentname'},
                body     => msgHeader() . $msg,
                resource => $daemon{'resource'}
            );
            print "\t$user notified.\n";
        }
        ;    # if

    };    # foreach

};    # sub notifyUsers

######################################################################
+##########
#
#
#
######################################################################
+##########
sub messageChatCB {

    my ( $sid, $mess ) = @_;

    my $from = $mess->GetFrom();
    my ($user) = split( /\@/, $from );

    $body = uc( $mess->GetBody() );
    $body =~ s/^\s+//;    # trim leading blanks
    $body =~ s/\s+$//;    # trim trailing blanks

    my $tmp_cmd = substr $body, 0, 1;    # extract a single letter.
    my $to = $mess->GetTo();

    my $timestamp = $mess->GetTimeStamp();
    print
"MSG:$timestamp from:$from cmd:$tmp_cmd\n----body----\n$body\n--------
+----\n";

    #fetch the code ref from the table, and invoke it
    my $sub = $dispatch_table{$tmp_cmd};
    my $reply =
        $sub
      ? $sub->()
      : "'$tmp_cmd' not recognized as a valid command.\n$usage";

    $Connection->MessageSend(
        to       => $from,
        body     => msgHeader() . $reply,
        resource => $daemon{'resource'}
    );

    print "OUT:$reply\n\n";

};    # sub messageChatCB

######################################################################
+##########
#
#
#
######################################################################
+##########
sub messageErrorCB {

    my ( $sid, $mess ) = @_;

    my $error     = $mess->GetError();
    my $errCode   = $mess->GetErrorCode();
    my $from      = $mess->GetFrom();
    my $to        = $mess->GetTo();
    my $timestamp = $mess->GetTimeStamp();

    if ( $errCode == 503 ) {
        print "503:$timestamp f:$from t:$to\n\n";
        return;
    }

    print "\nERR:$errCode:$error\n\n";
    return;

};    # sub messageErrorCB

######################################################################
+##########
#
#
#
######################################################################
+##########
sub presenceAvailableCB {

    my ( $sid, $pres ) = @_;

    my ( $user, $federation ) = split( /\@/, my $from = $pres->GetFrom
+() );
    my $type     = $pres->GetType();
    my $status   = $pres->GetStatus();
    my $priority = $pres->GetPriority();
    my $show     = $pres->GetShow();

    # mark available
    $im_status{$user}->{"show"}      = $show;
    $im_status{$user}->{"available"} = 1;

    # display presence data
    print "PRESENCE: Available ";

    $from     ? print "from $from "         : 0;
    $type     ? print "type $type "         : 0;
    $status   ? print "status $status "     : 0;
    $priority ? print "priority $priority " : 0;
    $show     ? print "show $show "         : 0;

    print "\n";

    return;

};    # sub presenceAvailableCB

######################################################################
+##########
#
#
#
######################################################################
+##########
sub presenceUnavailableCB {

    my ( $sid, $pres ) = @_;

    my ( $user, $federation ) = split( /\@/, my $from = $pres->GetFrom
+() );
    my $type     = $pres->GetType();
    my $status   = $pres->GetStatus();
    my $priority = $pres->GetPriority();
    my $show     = $pres->GetShow();

    # mark unavailable
    $im_status{$user}->{"show"}      = $show;
    $im_status{$user}->{"available"} = 0;

    # display presence data
    print "PRESENCE: Unavailable ";

    $from     ? print "from $from "         : 0;
    $type     ? print "type $type "         : 0;
    $status   ? print "status $status "     : 0;
    $priority ? print "priority $priority " : 0;
    $show     ? print "show $show "         : 0;

    print "\n";

    return;

};    # sub presenceUnavailableCB

######################################################################
+#########
#
#
#
######################################################################
+#########
sub ConnectClient {

    $Connection = new Net::XMPP::Client( debuglevel => $debug_level );

    $Connection->SetMessageCallBacks(
        chat  => \&messageChatCB,
        error => \&messageErrorCB
    );

    $Connection->SetPresenceCallBacks(
        available   => \&presenceAvailableCB,
        unavailable => \&presenceUnavailableCB
    );

    $Connection->RosterDB();
    $Connection->PresenceDB();

    # Connect to talk.google.com
    my $status = $Connection->Connect(
        hostname       => $daemon{'hostname'},
        port           => $daemon{'port'},
        componentname  => $daemon{'componentname'},
        connectiontype => $daemon{'connectiontype'},
        tls            => $daemon{'tls'}
    );

    if ( not defined($status) ) {
        print "FATAL: Jabber server is down or connection was not allo
+wed.\n";
        exit(0);
    }

    # Change hostname
    my $sid = $Connection->{SESSION}->{id};
    $Connection->{STREAM}->{SIDS}->{$sid}->{hostname} =
      $daemon{'componentname'};

    # Authenticate
    my @result = $Connection->AuthSend(
        username => $daemon{'username'},
        password => $daemon{'password'},
        resource => $daemon{'resource'}
    );

    if ( ( not $result[0] ) or ( $result[0] ne "ok" ) ) {
        print "FATAL: Authorization failed.\n";
        exit(0);
    }

    $Connection->PresenceSend();
    $Connection->RosterRequest();

    print "SERVER: Connected.\n";

}    # sub ConnectClient

######################################################################
+##########################
##
##  BEGIN

while (1) {

    ConnectClient;

    while ( ( defined($Connection) )
        and ( defined( $Connection->Process( $daemon{'delay'} ) ) ) )
    {

        if ( $lastPlaying ne player("nowPlaying") ) {

            $lastPlaying = player("nowPlaying");

            print "SONGCHANGE: $lastPlaying\n";

            notifyUsers( displaySong() );

            print "\n";

        }

    };    # while defined connection....

    #  wait a bit before trying to reconnect
    sleep $daemon{'delay'};

};    # while (1)

__END__
Replies are listed 'Best First'.
Re: Smartphone/Media Center integration via XMPP over GoogleTalk
by jwkrahn (Abbot) on Aug 03, 2009 at 16:35 UTC
    foreach my $tmp_name (`dcop amarok playlist filenames`) { $tmp_string .= "[$tmp_idx]\t"; # remove common suffixes chomp $tmp_name; for my $suffix ( '.mp3', '.flac', '.shn', '.ogg' ) { $tmp_name =~ s/$suffix$//; } # and append the filename $tmp_string .= ( $playing =~ /$tmp_name/ ) ? "*** $tmp_name ***\n" : "$tmp_ +name\n"; $tmp_idx++; }

    Your algorithm is broken, see for example:

    $ perl -e' my @files = ( "egg_nogg.mp3\n", "egg_nogg\n", "stupid file.ogg.shn +.flac.mp3\n", "stupid fileloggashnoflacamp3\n" ); foreach my $tmp_name ( @files ) { print "\$tmp_name = $tmp_name\t=>"; # remove common suffixes chomp $tmp_name; for my $suffix ( ".mp3", ".flac", ".shn", ".ogg" ) { $tmp_name =~ s/$suffix$//; } print "\t$tmp_name\n"; } ' $tmp_name = egg_nogg.mp3 => egg_ $tmp_name = egg_nogg => egg_ $tmp_name = stupid file.ogg.shn.flac.mp3 => stupid file $tmp_name = stupid fileloggashnoflacamp3 => stupid file

    That would be better written as:

    foreach my $tmp_name (`dcop amarok playlist filenames`) { $tmp_string .= "[$tmp_idx]\t"; # remove common suffixes chomp $tmp_name; $tmp_name =~ s/\.(?:mp3|flac|shn|ogg)\z//; # and append the filename $tmp_string .= ( $playing =~ /$tmp_name/ ) ? "*** $tmp_name ***\n" : "$tmp_ +name\n"; $tmp_idx++; }
      Thanks for the tip. Luckily, that broken algorithm is just used to produce pretty printed output for displaying playlists. I'll make sure to include the changes into the next revision however.
        The one-line bug has been patched in the code.