Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
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
  • Outside of code tags, you may need to use entities for some characters:
            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 examining the Monastery: (14)
    As of 2014-10-21 20:02 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      For retirement, I am banking on:










      Results (109 votes), past polls