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