Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

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 '', [ 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.


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

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others contemplating the Monastery: (3)
    As of 2018-04-22 23:06 GMT
    Find Nodes?
      Voting Booth?