Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Re: xluke_repwalker.pl

by mojotoad (Monsignor)
on May 18, 2002 at 01:08 UTC ( #167455=note: print w/ replies, xml ) Need Help??


in reply to xluke_repwalker.pl

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) ); - - -


Comment on Re: xluke_repwalker.pl
Download Code

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (8)
As of 2015-07-30 11:19 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 (271 votes), past polls