Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

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


In reply to Re: Changes to the User Nodes ticker and introducing the NodeRep XML ticker (simple client) by demerphq
in thread Changes to the User Nodes ticker and introducing the NodeRep XML ticker by demerphq

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (8)
    As of 2014-07-11 03:07 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      When choosing user names for websites, I prefer to use:








      Results (217 votes), past polls