comment on

Warning:The following code is HEAVILY based on OeufMayos XML::Parser tutorial and lhowards LWP/HTTP/PM node...Most credit goes to them.

I shamelessly abused the code so I could get both XPs and messages from the inbox and get them in XChat, which allows perl scripting...
I split it up in 2 bits, because the actual grabbing and parsing takes a few moments, that will stall XChat for a short period.
Edit: Tweak Monestary related stuff... thanks epoptai !

#!/usr/bin/perl -w
# XP Grabber...
use strict;
use XML::Parser;
use LWP::UserAgent;
use URI::URL;
use HTTP::Cookies;

my $parser = new XML::Parser ( Handlers => { Start => \&hdl_start, End
+ => \&hdl_end, Char => \&hdl_char, Default => \&hdl_def });

my $pm_user=''; #ofcourse fill you alias in here
my $pm_password=''; #and your password in here

my $WWWAgent = new LWP::UserAgent();
my $co=new HTTP::Cookies(file=>'./cookies.dat',autosave=>1,ignore_disc
+ard=>1);
$WWWAgent->cookie_jar($co);

my $url=new URI::URL 'http://www.perlmonks.org/index.pl';
$url->query_form(op => "login",node_id => "16046",user => $pm_user,pas
+swd => $pm_password, expires=> "+10y");
my $WWWRequest = new HTTP::Request 'GET', $url->as_string() ;
my $WWWResult = $WWWAgent->request($WWWRequest);
die "Error logging in $WWWResult->code $WWWResult->message" if(!$WWWRe
+sult->is_success);

my $cb_ticker = $WWWResult->content;
$parser->parse($cb_ticker);
   
sub hdl_start{
    my ($p, $elt, %atts) = @_;
    if ($elt eq "XP") { 
    open (XP,">/tmp/XP.db") || die $!;
    flock(XP,2); 
    print XP "XP: ",$atts{xp},"\nXPs to next level: ",$atts{xp2nextlev
+el}; 
    close(XP);
    }
}
   
sub hdl_end{ my ($p, $elt) = @_; }
  
sub hdl_char { my ($p, $str) = @_; }
  
sub hdl_def { }
[download]

Similar chunk of code for Inbox grabber, but with the following differences...

my $url=new URI::URL 'http://www.perlmonks.org/index.pl';
$url->query_form(op => "login",node_id => "15848",user => $pm_user,pas
+swd => $pm_password,expires=> "+10y");
my $WWWRequest = new HTTP::Request 'GET', $url->as_string() ;
my $WWWResult = $WWWAgent->request($WWWRequest);
die "Error logging in $WWWResult->code $WWWResult->message" if(!$WWWRe
+sult->is_success);

$parser->parse($cb_ticker);
my $key = undef;
sub hdl_start{
    my ($p, $elt, %atts) = @_;
    if ($elt eq "message") {
    open(INBOX,">>/tmp/inbox.db") || die $!;
    my $time = $atts{time}; $time =~ s/(\d{4})(\d{2})(\d{2})(\d{2})(\d
+{2})(\d{2})/$4\:$5\:$6 $3\/$2\/$1/;
    $key++;
    print INBOX "Time: ",$time," Message from: ",$atts{author}," Statu
+s: ",$atts{status},"\n"; 
    close(INBOX);
    }
}

#Edit: Oops, pasted an older snippet   
sub hdl_end{ my ($p, $elt) = @_; }
  
sub hdl_char { 
 my ($p, $str) = @_; $str =~ s/^\n+//g; if ($key && $str) { 
 $str =~ s/\[id\:\/\/(\d*?)\]/http\:\/\/www\.perlmonks\.com\/index\.pl
+\?node_id\=$1/g;
 print $str,"\n"; 
 open(INBOX,">>/tmp/inbox.db") || die $!;
 print INBOX $str,"\n"; 
 close(INBOX); } 
}
  
sub hdl_def { }
[download]

The 2 grabbers run as cronjob, while the XChat script just reads the XP and Inbox file...

#!/usr/bin/perl

IRC::print "\0035:: Loading X-Chat Perlmonks XML Ticker ::\003 \n";
IRC::register ("PM XML Ticker", "0.1", "", ""); 

IRC::add_timeout_handler(300000, getXP);
#Add a timeout handler that checks every 5 mins
IRC::add_timeout_handler(300000, getInbox);
#again :) but diff sub handler

sub getXP { 
open(XP,"</tmp/XP.db") || die $!;
$xp = <XP>; close(XP);
chomp $xp;
IRC::print $xp,"\n";
IRC::add_timeout_handler(300000, getXP); }

sub getInbox { 
open(INBOX,"</tmp/inbox.db") || die $!;
(@Inbox) = <INBOX>; close(INBOX);
if (@Inbox) { IRC::print @Inbox; }
IRC::add_timeout_handler(300000, getInbox); }
[download]

For some reason, this stuff sometimes crashes XChat.... I'll get an update here ASAP.
Greetz
Beatnik
... Quidquid perl dictum sit, altum viditur.

In reply to XP & Inbox XChat Perl script by Beatnik

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.


Welcome to the Monastery
	PerlMonks