Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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__

In reply to Smartphone/Media Center integration via XMPP over GoogleTalk by mikelieman

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others making s'mores by the fire in the courtyard of the Monastery: (10)
    As of 2015-07-07 09:00 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (88 votes), past polls