Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re: Changes to the User Nodes ticker and introducing the NodeRep XML ticker (simple client)

by demerphq (Chancellor)
on Nov 11, 2005 at 13:20 UTC ( #507708=note: print w/ replies, xml ) Need Help??


in reply to Changes to the User Nodes ticker and introducing the NodeRep XML ticker

Here is a simple client that maintains a Node DB from the user nodes ticker and updates it from the Noderep ticker. It populates the node db _first_ so if you have made a lot of posts, it could take a while before it picks them all up and starts polling the noderep ticker.

use XML::Simple; use HTTP::Request::Common qw(POST); use LWP::UserAgent; use HTTP::Cookies; use Storable; use DB_File; use MLDBM qw(DB_File Storable); use strict; use warnings; my $CLEAR_ON_FIRST_FETCH = 0; # enable for debugging sub get_pm_xml { my $ua = shift; my $node_id = shift; my $req = POST 'http://www.perlmonks.org', [ node_id => $node_id, @_, xmlstyle => 'stream,flat', ]; my $resp=XMLin($ua->request($req)->content); # cleanup older tickers that dont return # result sets consistant with the newer ones. my @keys=keys %$resp; foreach my $key (@keys) { if (lc($key) ne $key and !$resp->{lc($key)}) { $resp->{lc($key)}=delete $resp->{$key}; } } return $resp; } sub login { my ($user,$pass,$cookie_jar)=@_; die "Must have User and Pass arguments" if !$user or !$pass; $cookie_jar||="$0.cookie"; my $ua = LWP::UserAgent->new; $ua->cookie_jar( HTTP::Cookies->new( file => "$0.cookie", autosave => 1 ) ); my $resp = get_pm_xml($ua,109, op => 'login', user => $user, passwd => $pass, expires => '+10y', sexisgood => 'submit', ticker => 'yes', displaytype => 'xml', ); return $resp && $resp->{loggedin} ? $ua : undef; } sub fetch_nodes { my ($ua,$db,$file)=@_; $file ||= "$0.dbf"; if (!$db) { my %db; tie %db, 'MLDBM', $file, O_CREAT|O_RDWR, 0640 or die $!; # Ask for portable binary (tied %db)->DumpMeth('portable'); $db=\%db; } my $lastid=$db->{lastid}; $lastid||=0; my $count=0; my $sleep=0; do { if ($sleep) { print "(sleeping for $sleep seconds)\n"; sleep $sleep; } print "Fetching records since '$lastid'\n"; my $resp=get_pm_xml($ua,32704, fromid => $lastid, ); $resp->{node} ||= {}; # simulate an empty list. $resp->{node} = { $resp->{node}{node_id} => $resp->{node} } if ref $resp->{node} ne "HASH"; $sleep = $resp->{info}{min_poll_seconds}; foreach my $id (keys %{ $resp->{node} }) { $db->{$id} = $resp->{node}{$id}; $lastid=$id if $lastid<$id; } $count=keys %{$resp->{node}}; $db->{lastid}= $lastid; (tied %$db)->UseDB()->sync(); # flush our data so far. print "Got $count records\n"; } until $count<100; $db->{lastid}=$lastid; return $db; } sub poll_rep { my ($ua,$db)=@_; my $sleep=0; do { if ($sleep) { print "(sleeping for $sleep seconds)\n"; sleep $sleep; } print "Checking for noderep changes\n"; my $resp=get_pm_xml($ua , 507310, $CLEAR_ON_FIRST_FETCH && !$sleep ? (clear=>1) : () ); $sleep=$resp->{info}{min_poll_seconds}; $resp->{node}||=[]; # simulate an empty list. $resp->{node}=[$resp->{node}] if ref $resp->{node} ne "ARRAY"; my $count=@{ $resp->{node} }; print "Got $count records\n"; foreach my $msg ( @{ $resp->{node} } ) { if (!exists $db->{$msg->{node_id}}) { print "Looks like you made a new post. Updating DB.\n" +; fetch_nodes($ua,$db); last; # } } foreach my $msg ( @{ $resp->{node} } ) { printf "%3d #%-8s %s\n", $msg->{delta}, $msg->{node_id}, $msg->{content}; my $dbrec=$db->{$msg->{node_id}}; $dbrec->{$_}=$msg->{$_} for qw(content reputation node_id); $db->{$msg->{node_id}}=$dbrec; } (tied %$db)->UseDB()->sync(); # flush our data so far. } while 1; } $|++; my ($user,$pass,$reset)=@ARGV; if ($reset) { unlink "$0.cookie","$0.dbf","$0.db"; } my $ua= login( $user, $pass ) or die "Failed login\n"; my $db= fetch_nodes($ua) or die "Weird!"; poll_rep($ua,$db);

Note the client is compliant in that it determines its polling period automatically based on the information in the 'info' tag from the previous fetch.

Apologies to davido and bobf to not using their code for this, I wanted to see how long it would take to write from scratch (not too long :-)

Update: I modified the code slightly as it blew up when only one node was returned by either ticker.

---
$world=~s/war/peace/g


Comment on Re: Changes to the User Nodes ticker and introducing the NodeRep XML ticker (simple client)
Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://507708]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (5)
As of 2014-09-02 10:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite cookbook is:










    Results (21 votes), past polls