Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

comment on

( [id://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":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others cooling their heels in the Monastery: (5)
As of 2024-03-19 05:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found