perl problem-domain , but I stopped that, because that, at best, sent me to a module page on CPAN, which, unfortunately, doesn't always tell you how to use the module. I have started to use
perl problem-domain site:blogspot.com instead, as it is likely that someone hit the same problem and found a solution. When I started looking into the problem of changing the status for Google Talk, I did this, and found this page, ending with the line "Worked? Or Crap?" I could not help responding "Worked AND Crap." "Worked" is nothing to sneeze at. The IETF motto is "rough consensus and running code", and when you have code that does what you ask it to, what more do you want? But when you use the same variable name three times for three different things, you have to wonder if you could do a better job with it.
#!/usr/bin/perl
# http://digitalpbk.blogspot.com/2009/02/perl-change-google-talk-status.html
#usage : perl stat.pl
use Modern::Perl ;
use Net::XMPP ;
use subs qw{ get_status set_status } ;
my $status = get_status ;
if ( defined $status && length $status > 1 ) {
set_status $status ;
}
exit ;
sub get_credentials {
#this is the point where my setup sucks
my %creds ;
$creds{ username } = 'NO' ;
$creds{ password } = 'A Thousand Times NO' ;
return %creds ;
}
sub get_status {
return join ' ', @ARGV ;
}
sub set_status {
my $status = shift ;
my %cred = get_credentials ;
my $username = $cred{ username } ;
my $password = $cred{ password } ;
my $hostname = 'talk.google.com' ;
my $port = 5222 ;
my $componentname = 'gmail.com' ;
my $connectiontype = 'tcpip' ;
my $tls = 1 ;
my $Con = new Net::XMPP::Client( debuglevel => 0 ) ;
my $con_status = $Con->Connect( hostname => $hostname,
port => $port,
componentname => $componentname,
connectiontype => $connectiontype,
tls => $tls,
timeout => 10 ) ;
if ( !( defined( $con_status ) ) ) {
exit( 0 ) ;
}
my $sid = $Con->{ SESSION }->{ id } ;
$Con->{ STREAM }->{ SIDS }->{ $sid }->{ hostname } = $componentname ;
my @result = $Con->AuthSend( username => $username,
password => $password,
resource => "neuron" ) ;
$Con->Send(
"<iq type='get' to='gmail.com'>"
) ;
$Con->Process() ;
my $iq = $Con->SendAndReceiveWithID(
"<iq type='get' to='$username\@gmail.com'>"
) ;
my ( $cur_status, $statuslist, $show ) = ( "", "", "" ) ;
$cur_status = $1 if ( $iq->GetXML() =~ m/(.*?)<\/status>/ ) ;
$statuslist = $1
if ( $iq->GetXML() =~ m/(<status-list(.*)<\/status-list>)/ ) ;
$show = $1 if ( $iq->GetXML() =~ m/<show>(.*?)<\/show>/ ) ;
##Change status
$Con->Send(
"<iq type='set' to='$username\@gmail.com'>
<query xmlns='google:shared-status'>
<status>$status
<show>$show
</query></iq>" ) ;
$Con->Process() ;
$Con->Disconnect() ;
return $status ;
}
I'll admit that
set_status is fairly cargo-cult. But I think it is a little less crap that it was before. Thanks to digitalpbk for the code.
