--- 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 multiple 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::StatsWhore # # 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 means use the 'to' parameter -$pmsite = 'http://www.perlmonks.net/index.pl'; # vroom's house of illrepute -$pmpagelen = 50; # articles 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, password => $password); + $stats_whore->mode('HTML') if $args{H}; + if ($args{I}) { - my $hreplist = initialize_rep_file ($username, $password, $filename); + 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}, $args{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, $args{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 ($holdreps->{$_})} + foreach (keys %$hnewreps) {push (@newnodes, $_) if !exists ($holdreps->{$_})} foreach (keys %$holdreps) {push (@deletednodes, $_) if !exists ($hnewreps->{$_})} foreach (keys %$holdreps) {push (@changednodes, $_) if exists ($hnewreps->{$_}) && $hnewreps->{$_}->{'rep'} != $holdreps->{$_}->{'rep'}} + # # For any article in the @changednodes array, move the 'rep' field from %holdreps into @@ -222,9 +224,7 @@ $outd .= sprintf ("\nChanged nodes: %d\n", scalar @changednodes) . 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 %$hrephash) - 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'})) foreach (@{$_->{'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 date) } ]) 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 "Node $nodeid is duplicated!"; - $nodehash {$nodeid} = {'nodeid' => $nodeid, - '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 what? Too much work, # too little return. # @@ -531,6 +464,8 @@ -f whom the mail should as be from (myname\@planetx.com) -s the subject (default is "Perlmonks.org Reputation Change 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 without -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) ); - - -