Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
Patch incorporating PerlMonks::StatsWhore usage. Added -g (histogram) and -H (HTML fetch mode) options. This patch also includes my prior patch regarding the binary flag for CSV.

Matt

--- xluke_repwalker.old.pl Fri May 17 07:06:05 2002 +++ xluke_repwalker.pl Fri May 17 07:11:10 2002 @@ -7,6 +7,7 @@ # Version 1.00.30 - 2000/09/02 - Fix error if number of nodes is a m +ultiple of 50 # Version 1.10.00 - 2001/03/17 - Rip out HTML::TableExtract, convert + to XML::Twig # Version 1.10.01 - 2001/03/18 - Fixed mirods comments in node 65444 +# Version 1.??.?? - 2001/05/17 - Patched to use PerlMonks::StatsWhor +e # # Invoke with './luke_repwalker.pl -?' for help # @@ -33,9 +34,9 @@ # Requires: # LWP::Simple # Text::CSV_XS -# MIME::Lite; -# DBI; -# XML::Twig +# MIME::Lite +# DBI +# PerlMonks::StatsWhore # # Copyright 2000,2001(c) J.C.Wren jcwren@jcwren.com # No rights reserved, use as you see fit. I'd like to know about it +, though, just for kicks. @@ -43,18 +44,16 @@ use strict; use Carp; -use XML::Twig; -use LWP::Simple; use Text::CSV_XS; use MIME::Lite; use DBI; use IO::File; use Getopt::Std; +use PerlMonks::StatsWhore; use vars qw($def_username $def_password $def_filename); use vars qw($def_dbhost $def_dbdb $def_dbtable $def_dbuser $def_dbpw) +; use vars qw($def_mto $def_msubject $def_mserver $def_mfrom); -use vars qw($pmsite $pmpagelen); # # Set these accordingly, if you don't want command line parameters. @@ -66,8 +65,6 @@ $def_msubject = 'Perlmonks.org Reputation Change Report'; # default + title $def_mserver = 'localhost'; # default + mailserver $def_mfrom = '%s'; # %s mean +s use the 'to' parameter -$pmsite = 'http://www.perlmonks.net/index.pl'; # vroom's + house of illrepute -$pmpagelen = 50; # article +s returned per page $def_dbhost = 'localhost'; # Where our database is hosted $def_dbdb = 'Perlmonks'; # Name of our database @@ -82,7 +79,7 @@ my %args = (); my $out = ""; - getopts ('u:p:F:t:f:s:m:Inhe?cbzP123d', \%args); + getopts ('u:p:F:t:f:s:m:Inhe?cbzPgH123d', \%args); if ($args{'?'} || $args{h}) { @@ -110,18 +107,19 @@ # # # + + my $stats_whore = PerlMonks::StatsWhore->new(user => $username, pa +ssword => $password); + $stats_whore->mode('HTML') if $args{H}; + if ($args{I}) { - my $hreplist = initialize_rep_file ($username, $password, $file +name); + initialize_rep_file($stats_whore, $filename); if ($args{d}) { - my @nodelist = (); my %dbreplist = (); - push @nodelist, $_ foreach (keys %$hreplist); - - update_replist ('I', \%dbreplist, $hreplist, \@nodelist); + update_replist ('I', $stats_whore, \%dbreplist); db_update (\%dbreplist); } @@ -137,12 +135,15 @@ my $hmailopts = confirm_mailargs ($args{e}, $args{t}, $args{m}, $a +rgs{f}, $args{s}); - my ($outd, $outr, $dbreplist) = compare_reps ($username, $password +, $filename, $args{n}, $args{b}, $args{z}); + my ($outd, $dbreplist) = compare_reps ($stats_whore, $filename, $a +rgs{n}, $args{b}, $args{z}); - if (defined ($outd) && defined ($outr)) + if (defined ($outd)) { my $out; + my $outr; + $outr .= $stats_whore->histogram_as_string . "\n" if $args{g}; + $outr .= $stats_whore->summary_as_string . "\n"; $out = $outr . $outd . "\n"; $out = $outr . "\n" if ($args{1} && !$args{3}); $out = $outd . "\n" if ($args{2} && !$args{3}); @@ -169,9 +170,9 @@ sub compare_reps { - @_ == 6 or croak "Incorrect number of parameters"; + @_ == 5 or croak "Incorrect number of parameters"; - my ($username, $password, $filename, $noupdate, $brief, $zero) = @ +_; + my ($sw, $filename, $noupdate, $brief, $zero) = @_; my @newnodes = (); my @deletednodes = (); my @changednodes = (); @@ -180,16 +181,17 @@ my $outr = undef; my $holdreps = read_file ($filename); - my $hnewreps = get_article_list ($username, $password); + my $hnewreps = $sw->writeups_ref; scalar keys %$hnewreps != 0 or die "You have no articles, perhaps? +\n"; # # Find all the new, deleted and changed entries # - foreach (keys %$hnewreps) {push (@newnodes, $_) if !exists ($h +oldreps->{$_})} + foreach (keys %$hnewreps) {push (@newnodes, $_) if !exists ($h +oldreps->{$_})} foreach (keys %$holdreps) {push (@deletednodes, $_) if !exists ($h +newreps->{$_})} foreach (keys %$holdreps) {push (@changednodes, $_) if exists ($h +newreps->{$_}) && $hnewreps->{$_}->{'rep'} != $holdreps->{$_}->{'rep' +}} + # # For any article in the @changednodes array, move the 'rep' fiel +d from %holdreps into @@ -222,9 +224,7 @@ $outd .= sprintf ("\nChanged nodes: %d\n", scalar @changedno +des) . display_nodelist ($hnewreps, \@changednodes, $longest_title); } - $outr = reputation_report ($hnewreps); - - write_file ($filename, $hnewreps) unless $noupdate; + write_file ($filename, $sw) unless $noupdate; # # This builds the hash that might be written to the database @@ -234,7 +234,7 @@ update_replist ('C', \%replist, $hnewreps, \@changednodes); } - return ($outd, $outr, \%replist); + return ($outd, \%replist); } sub update_replist @@ -252,35 +252,6 @@ } } -sub reputation_report -{ - @_ == 1 or croak "Incorrect number of parameters"; - - my $hrephash = shift; - my $total = 0; - my $repmax = 0; - my $repmin = 999999999; - my $out = ""; - - scalar keys %$hrephash >= 0 or die "You have no articles, perhaps? +\n"; - - for (keys %$hrephash) - { - $total += $hrephash->{$_}->{rep}; - $repmax = max ($repmax, $hrephash->{$_}->{rep}); - $repmin = min ($repmin, $hrephash->{$_}->{rep}); - } - - $out = "\n"; - $out .= sprintf (" Total articles: %d\n", (scalar keys %$hre +phash) - 1); - $out .= sprintf (" Total reputation: %d\n", $total); - $out .= sprintf (" Min reputation: %d\n", $repmin); - $out .= sprintf (" Max reputation: %d\n", $repmax); - $out .= sprintf ("Average reputation: %3.2f\n", $total / ((scalar +keys %$hrephash) - 1)); - - return ($out); -} - sub display_nodelist { @_ == 3 or croak "Incorrect number of parameters"; @@ -314,7 +285,6 @@ foreach (@$hashlist) { my $nodes = $_->{'hash'}; - $linelen = max ($linelen, length ($nodes->{$_}->{'title'})) for +each (@{$_->{'array'}}); } @@ -337,17 +307,13 @@ sub initialize_rep_file { - @_ == 3 or croak "Incorrect number of parameters"; - - my ($username, $password, $filename) = @_; - - my $hnewreps = get_article_list ($username, $password); + @_ == 2 or croak "Incorrect number of parameters"; - scalar keys %$hnewreps >= 0 or die "You have no articles, perhaps? +\n"; + my ($sw, $filename) = @_; - write_file ($filename, $hnewreps); + write_file($filename, $sw); - return ($hnewreps); + return ($sw); } sub read_file @@ -362,7 +328,8 @@ defined ($fh) or croak "Can't open file \'$filename\": $!"; my $csv = Text::CSV_XS->new ({'always_quote' => 1, - 'eol' => "\n" + 'eol' => "\n", + 'binary' => 1, }); while (<$fh>) @@ -390,60 +357,26 @@ { @_ == 2 or croak "Incorrect number of parameters"; - my ($filename, $nodehash) = @_; + my ($filename, $sw) = @_; my $fh = IO::File->new (">$filename"); defined ($fh) or croak "Can't create file \"$filename\": $!"; my $csv = Text::CSV_XS->new ({'always_quote' => 1, - 'eol' => "\n" + 'eol' => "\n", + 'binary' => 1, }); - for (sort {$a <=> $b} keys %$nodehash) + for ($sw->writeups) { - $csv->print ($fh, [ @{ $nodehash->{$_} }{ qw(nodeid title rep d +ate) } ]) or croak "Text::CSV_XS->print failed"; + $csv->print ($fh, [ @{ $_ }{ qw(nodeid title rep date) } ]) or +croak "Text::CSV_XS->print failed"; } $fh->close; } # -# Don't display the URL when we die (which would be more informative +), because the users -# password might be e-mailed somewhere. And we sure don't want some + dweeb to be impersonating -# us on perlmonks.org, do we? -# -sub get_article_list -{ - @_ == 2 or croak "Incorrect number of parameters"; - - my ($username, $password) = @_; - my %nodehash = (); - - $LWP::Simple::FULL_LWP = 1; - - my $page = get ("$pmsite?user=$username&passwd=$password&op=login& +node=User+nodes+info+xml+generator") or croak "Get on $pmsite failed. +"; - - my $twig= new XML::Twig (TwigRoots => - { NODE => sub { + my ($t, $node) = @_; - my $nodeid = $node->att ('id'); - !exists ($nodehash {$nodeid}) or croak "N +ode $nodeid is duplicated!"; - $nodehash {$nodeid} = {'nodeid' => $nodei +d, - 'title' => $node- +>text, - 'rep' => $node- +>att ('reputation'), - 'last' => $node- +>att ('reputation'), - 'date' => $node- +>att ('createtime') - }; - $t->purge; - } - }); - - $twig->parse ($page); - - return (\%nodehash); -} - -# # OK, so if I was really smart, I'd have passed a hash in. Know wha +t? Too much work, # too little return. # @@ -531,6 +464,8 @@ -f whom the mail should as be from (myname\@planetx.co +m) -s the subject (default is "Perlmonks.org Reputation C +hange Report") -m SMTP mail server address ('mailserver.myserver.com' +) + -g histogram report + -H Fetch data via HTML rather than XML -1 quick reputation report -2 detailed reputation change report -3 both -1 and -2 (default) @@ -553,6 +488,8 @@ output to the console, in addition to mailing. -c specified witho +ut -e is meaningless, but not an error. + If you have problems using XML, use the -H option for HTML mode. + ENDOFHELP } @@ -578,6 +515,3 @@ Modified timestamp(14), PRIMARY KEY (ReputationID) ); - - -

In reply to Re: xluke_repwalker.pl by mojotoad
in thread xluke_repwalker.pl by jcwren

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
  • 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?
    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 chilling in the Monastery: (10)
    As of 2015-07-06 17:27 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (77 votes), past polls