Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/usr/local/bin/perl -w # # Invoke with './xstatswhore.pl [-u username] [-p password] [-b histo +gram_binsize | -1]' # # Alternatively, username and/or password can be embedded into the sc +ript, if you don't want # command line arguments. Use a -b option of -1 to suppress the hist +ogram. # # Displays a users total writeups, total reputation, along with min, +max, and average, and # a histogram. Only works for your own account, since reps are 'prop +rietary'. # # Thanks to larryl for the histogram patch. Be sure to give him ++ c +redit if you like # the histogram portion (node id 65199) # # Requires: # XML::Twig # LWP::Simple # # 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. # # This module has more code than is actually necessary for the functi +onality provided. # I was originally writing a module for another function, and this ca +me out of it. The # @articles array that is returned from get_article_list() contains a +n array reference # that has the articles name, prefixed by the string 'node_id=xxx:', +where 'xxx' is the # number the article title refers to, the reputation of the article, +and the date the # article was written. I'm sure you can imagine some uses for this.. +. # # 2000/08/03 - 1.00.00 - Initial release # 2001/03/17 - 1.10.00 - Changed XML::TableExtract to using XML::Twig +, added larryl's # histogram code # 2001/03/18 - 1.10.01 - Applied mirods change from node 65444 # use strict; use Carp; use LWP::Simple; use Getopt::Std; use XML::Twig; use POSIX qw(ceil floor); my $def_username = ""; # Set this to your user name if you don't want + to use the -u option my $def_password = ""; # Set this to your pass word if you don't want + to use the -p option my $def_binsize = 5; # Bin size for reputations. Set to -1 to disa +ble histograms. my $pmsite = "http://www.perlmonks.org/index.pl"; { my %args = (); getopts ('u:p:b:', \%args); my $username = $args{u} || $def_username; my $password = $args{p} || $def_password; my $binsize = $args{b} || $def_binsize; die "No password and/or username. Program terminated.\n" if (!$use +rname || !$password); my $hrephash = get_article_list ($username, $password) or croak "Ge +t on $pmsite failed."; my $hsummary = summarize ($username, $hrephash) or croak "You have +no articles, perhaps?\n";; show_reps ($hsummary); show_histogram ($binsize, $hrephash, $hsummary) unless $binsize < 0 +; } # # Display the user that's the whole point of the program # sub show_reps { @_ == 1 or croak "Incorrect number of parameters"; my $hsummary = shift; print "\n"; printf (" User: %s\n", $hsummary->{username}); printf (" Total articles: %d\n", $hsummary->{articles}); printf (" Total reputation: %d\n", $hsummary->{reputation}); printf (" Min reputation: %d\n", $hsummary->{repmin}); printf (" Max reputation: %d\n", $hsummary->{repmax}); printf ("Average reputation: %3.2f\n", $hsummary->{average}); print "\n"; } # # We subtract one from the total hash count because the site XML retu +rns # the users homenode as a article (Dog knows why... Ask Vroom) # sub summarize { @_ == 2 or croak "Incorrect number of parameters"; my ($username, $hrephash) = @_; my $total = 0; my $repmax = 0; my $repmin = 999999999; my %hsummary = (); ((scalar keys %$hrephash) - 1) >= 0 or return undef; for (keys %$hrephash) { $total += $hrephash->{$_}->{rep}; $repmax = max ($repmax, $hrephash->{$_}->{rep}); $repmin = min ($repmin, $hrephash->{$_}->{rep}); } $hsummary {articles} = (scalar keys %$hrephash) - 1; $hsummary {repmax} = $repmax; $hsummary {repmin} = $repmin; $hsummary {reputation} = $total; $hsummary {average} = $total / ((scalar keys %$hrephash) - 1); $hsummary {username} = $username; return (\%hsummary); } # # Gets the XML from the site. Much more reliable that the old 'get e +ach # page of articles' method. And for those verbose people (tilly...), + it # should result in a 26x reduction of server hits. # 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&n +ode=User+nodes+info+xml+generator") or return undef; my $twig= new XML::Twig (TwigRoots => { NODE => sub { my ($t, $node) = @_; my $nodeid = $node->att ('id'); !exists ($nodehash {$nodeid}) or croak "No +de $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); } # # This code was contributed by larryl. I mucked with it a little bit +, passing in the # summary hash, and a little reformatting. This is a great idea, and + I'm glad it was # contributed. I'da never thought of it... # sub show_histogram { @_ == 3 or croak "Incorrect number of parameters"; my ($binsize, $hrephash, $hsummary) = @_; # # Divide articles into bins based on reputation: # my %bins = (); $bins {floor (($hrephash->{$_}->{rep} + 0.5) / $binsize)}++ foreach + (keys %$hrephash); my @bins = sort {$a <=> $b} keys %bins; my $minbin = $bins [0]; # lowest reputation bin my $maxbin = $bins [-1]; # highest reputation bin # # Try to keep histogram on one page: # my $width = 50; my $scale = 1; my $maxrep = $hsummary->{repmax}; if ($maxrep > $width && $maxrep <= ($width * 5)) { $scale = 5; } elsif ($maxrep > ($width*5)) { while (($maxrep / $scale) > $width) { $scale *= 10; } } my $start = $minbin * $binsize; my $end = $start + $binsize - 1; print " Reputation Article Count\n"; print "------------- -------", "-" x 50, "\n"; do { my $count = $bins {$minbin} || 0; my $extra = ($count % $scale) ? '.' : ''; printf "%4d .. %4d \[%4d\] %s$extra\n", $start, $end, $count, ' +#' x ceil ($count / $scale); $start += $binsize; $end += $binsize; } while ($minbin++ < $maxbin); print "\n Scale: #=$scale\n\n" if $scale > 1; } # # Gotta wonder why these aren't core functions... # sub max { my ($a, $b) = @_; return ($a > $b ? $a : $b); } sub min { my ($a, $b) = @_; return ($a < $b ? $a : $b); }

In reply to xstatswhore.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
  • Outside of code tags, you may need to use entities for some characters:
            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 wandering the Monastery: (6)
    As of 2014-12-18 00:18 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (41 votes), past polls