Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

Re^5: Our Saints

by ww (Archbishop)
on Sep 28, 2005 at 17:22 UTC ( #495842=note: print w/replies, xml ) Need Help??

in reply to Re^4: Our Saints
in thread Our Saints

As modified below, works for me on w2k, (AS) perl v 5.8.6 with output to a local dir (see "MODIFY" comment, below)
#!C:/Perl/bin use strict; use warnings; use Date::Calc qw /Today Delta_Days/; use LWP::Simple; use POSIX qw /strftime/; # umask 022 or die "Failed to set umask: 022\n"; #umask? Not on 'doze sub output; my $url = ' +print'; $_ = get $url or die "Failed to fetch '$url'\n"; my $target_dir = "c:/__wo_ww/"; # MODIFY TO SUIT YOUR NEEDS. w +as /tmp in Abigail-II's node, cited above my $xp_file = "$target_dir/xp.html"; my $arts_file = "$target_dir/arts.html"; my $days_file = "$target_dir/days.html"; my $xp_day_file = "$target_dir/xp_day.html"; my $xp_art_file = "$target_dir/xp_art.html"; my $art_day_file = "$target_dir/art_day.html"; my %data; while (m!<tr[^>]*> <td \s+ align="[^"]+">(\d+)</td> <td><a \s+ HREF="[^"]+">([^<]+)</a></td> <td \s+ align="[^"]+">(\d+)</td> <td \s+ align="[^"]+"><a \s+ HREF="[^"]+">(\w+)</a></td> <td \s+ align="[^"]+">(\d+)-(\d+)-(\d+)</td>!gx) { my ($pos, $name, $xp, $arts, $yr, $mon, $day) = ($1, $2, $3, $4, $5, $6, $7); $xp -= 1000000 if $name =~ /^vroom/; my $days = Delta_Days $yr, $mon, $day, Today; $data {$name} {xp} = $xp; $data {$name} {arts} = $arts =~ /None/ ? 0 : $arts; $data {$name} {days} = $days; $data {$name} {xp_day} = sprintf "%.2f" => $xp / $days; $data {$name} {xp_art} = $arts =~ /None/ ? "999999" : sprintf "%.2f" => $xp + / $arts; $data {$name} {art_day} = $arts =~ /None/ ? 0 : sprintf "%.2f" => $art +s / $days; } # Rank them. for my $field (qw /xp arts days xp_day xp_art art_day/) { my $new_field = "${field}_rank"; my $count = 0; foreach my $name (sort {$data {$b} {$field} <=> $data {$a} {$field}} keys %data) { $data {$name} {$new_field} = ++ $count; } } output "xp", $xp_file; output "arts", $arts_file; output "days", $days_file; output "xp_day", $xp_day_file; output "xp_art", $xp_art_file; output "art_day", $art_day_file; sub output { my ($key, $file) = @_; my @names = sort {$data {$b} {$key} <=> $data {$a} {$key}} keys %d +ata; my $now = strftime "%e %B %Y", localtime; open my $fh => ">", $file or die "Failed to open $file: $!\n"; print $fh <<"--"; <html> <head><title>Pointless Perlmonks Saints Statistics</title></head> <body> <a href = "/">Home</a> <a href = "./">Pointless stats</a> <hr> <h1>Pointless Perlmonks Saints Statistics</h1> <table border = 1> <tr><th>Name</td> <th colspan = 2><a href = 'arts.html'>Articles</a></td> <th colspan = 2><a href = 'xp.html'>XP</a></td> <th colspan = 2><a href = 'days.html'>Days</a></td> <th colspan = 2><a href = 'xp_day.html'>XP per day</a></td> <th colspan = 2><a href = 'xp_art.html'>XP per article</a></td> <th colspan = 2><a href = 'art_day.html'>Articles per day</a></td> +</tr> -- foreach my $name (@names) { print $fh "<tr><td>$name</td>"; foreach my $key (qw /arts xp days xp_day xp_art art_day/) { my $rank = "${key}_rank"; print $fh "<td align = 'right'>$data{$name}{$key}</td>" . "<td align = 'right'>($data{$name}{$rank})</td>" +; } print $fh "</tr>\n"; } print $fh <<"--"; </table> <hr> <div align = "center"> <table><tr><td> Copyright 2003 by Abigail.<br> Page last modified: $now</br> Comments to: \$web\$\ </td></tr></table> </div> </body></html> -- close $fh or die "Failed to close $file: $!\n"; }

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (4)
As of 2020-12-01 06:32 GMT
Find Nodes?
    Voting Booth?

    No recent polls found