CUFP
jaldhar
<p>[jcwren]'s node [XPFixation -- The Essential Windows XP Whoring Tool] presented an interesting tool which has two problems. It doesn't run on Linux and it doesn't use perl. We can't have that can we?</p>
<p>I set out to write something similiar. On my Linux box, I run a desktop environment called [http://www.kde.org/|KDE]. Rather than a tray icon, I decided to use a KDE program called AMOR (Amusing Misuse Of Resources) to display my XP status. AMOR makes a little animated character dance on top of whichever window has focus but more importantly it can also display some text in a bubble. KDE has an automation system called DCOP similiar to OLE (or whatever they're calling it this week) on Windows. While I believe there was a perl binding for DCOP at some point, I couldn't find it now. Luckily KDE also has a gateway to DCOP via XML-RPC (which can be accessed from perl with [cpan://Frontier::RPC].) so I used that to control AMOR instead. I could also have used DCOP/XML-RPC to pop up a message box or play an MP3 via noatun (the KDE media player) if I wanted to.</p>
<p>How to get your XP? I could have scraped the HTML from the XP nodelet but that would have been tedious and prone to breakage. A better way is through the [XP XML ticker]. [cpan://XML::Simple] made short work of parsing it for the info I needed.</p>
<p>Anyway, without further ado, here is XPAddiction. I hope you like it and please send me any suggestions to enhance it.</p>
<p>-- <br>જલધર</p>
<readmore>
<code>
!/usr/bin/perl -w
use strict;
#################
# CONFIGURATION #
#################
my $user = 'Your name';
my $passwd = 'Your password';
my $configdir = "$ENV{HOME}/.xpaddiction";
my $interval = 300;
#### NO NEED TO EDIT ANYTHING BELOW THIS LINE ####
use Frontier::Client;
use HTTP::Cookies;
use HTTP::Request::Common;
use LWP::UserAgent;
use XML::Simple;
while (1)
{
unless ( -d $configdir )
{
mkdir $configdir or die "Cannot create configuration directory\n";
}
my $oldxp = 0;
if ( -f "$configdir/xp" )
{
open (XP, '+<', "$configdir/xp") or die "Cannot open xp file\n";
$oldxp = <XP>;
chomp $oldxp;
close XP;
}
my $xp = getxp($user, $passwd, $configdir);
my $delta = $xp - $oldxp;
if ($delta > 0)
{
talktoamor("Hooray $user! Your Perl Monks XP increased by $delta to $xp.");
}
elsif ($delta < 0)
{
talktoamor("Sorry $user! Your Perl Monks XP decreased by " . abs($delta) .
" to $xp.");
}
else
{
talktoamor("Hey $user! Your Perl Monks XP is $xp.");
}
open (XP, '>', "$configdir/xp") or die "Cannot open xp file\n";
print XP $xp;
close XP;
sleep $interval;
}
sub getxp
{
my ($user, $passwd, $configdir) = @_ or die;
my $ua = LWP::UserAgent->new(
cookie_jar => HTTP::Cookies->new(file => "$configdir/cookies.txt",
autosave => 1),
);
# simulate a login and get a cookie
my $req = POST ('http://perlmonks.org/index.pl',
{ op => 'login',
user => $user,
passwd => $passwd,
expires => '+10y',
});
my $res = $ua->request($req);
if ($res->is_success)
{
# get the ticker.
$req = GET ('http://perlmonks.org/index.pl?node=XP%20xml%20ticker');
my $res = $ua->request($req);
if ($res->is_success)
{
my $ticker = XMLin($res->content);
return $ticker->{XP}->{xp};
}
}
# something must have gone wrong. Display LWPs' error message
warn 'Uh-oh!: ' . $res->status_line . "\n";
}
sub talktoamor
{
my ($message) = @_ or die;
open(KXMLRPCD, '<', "$ENV{HOME}/.kxmlrpcd") or
die "Can't open configuration file. Is kxmlrpcd running?\n";
my ($port, $auth) = split(/,/, <KXMLRPCD>);
chomp $auth;
close KXMLRPCD;
my $rpc = Frontier::Client->new(url => "http://localhost:$port/amor")
or die "Cannot make RPC connection. Is amor running?\n";
$rpc->call('showTip', $auth, $message);
}
__END__
=pod
=head1 NAME
xpaddiction -- XP whoring for the rest of us
=head1 SYNOPSIS
B<./xpaddiction &>
=head1 DESCRIPTION
This script will log you into the Perl Monks website, access the XP XML ticker
at regular intervals and tell you if your XP has changed via XML-RPC to the
B<amor> program.
=head1 INSTALLATION
Make the script executable. You may have to change the first line if
B<Perl> is not in F</usr/bin> on your system. You will also need the
B<Frontier::RPC>, B<LWP>, and B<XML::Simple> packages from CPAN plus
version 2 or above of the KDE desktop environment. This script has so far
only been tested on Linux and KDE 3.0.2 but should work elsewhere as long
as the prerequisites are met.
In order for this script to do its' thing, the B<kxmlrpcd> and B<amor>
programs from KDE must be running. In B<amor>'s options, "Allow
application tips" must be selected.
=head1 CONFIGURATION
There are four values you can change in the configuration section at the
top of the script:
=over 4
=item I<$user>
Your Perl Monks user ID.
=item I<$passwd>
Your Perl Monks password.
=item I<$configdir>
Where you want B<xpaddiction> to store its' stuff.
=item I<$interval>
The period in seconds the script should wait before checking your XP
again. The default is 300 (5 minutes.)
=back
=head1 AUTHOR
Jaldhar H. Vyas E<lt>jaldhar@braincells.comE<gt>
=head1 LICENSE
This code is free software under the Crowley Public License ("Do what
thou wilt shall be the whole of the license")
=head1 VERSION
1.0 -- Jul 2, 2002
=cut
</code>
<p><b>edited:</b> Mon Jul 8 02:09:23 2002 by [jeffa] - added readmore tag</p>