dseg (14237) の日記
2003 年 06 月 30 日
午後 11:34
タレコミ者リスト作成スクリプト v0.24
###
# $Id: hof.pl,v 0.24 2003/06/30 11:58:54 dseg Exp dseg $
#
# Written by dseg: <ds26 at mail.goo.ne.jp>
# Just a quick hack, don't blame me about this...
#
# Note: Script charset must be EUC-JP
require 5;
use strict;
use LWP::Simple;
my $url = 'http://srad.jp/users.pl?uid=';
my $max_uid = 29999;
my ($html, $name, $subs, $is_author);
my (@name, @subs, @uid);
my $re_nick = qr<[ a-zA-Z0-9_\$.+!*\'(),-\\]+>; # see http://srad.jp/users.pl?uid=6182 (!!!)
my %authors = getListOfAuthors('http://srad.jp/authors.shtml', $re_nick)
or die "Something wrong happened\n";
# uid 8796 & 8797 doesn't exist. seems strange, don't know why
for my $uid (3..8795, 8798..$max_uid) {
$html = get($url . $uid);
print "Failed fetching information [user id = $uid]\n" and exit
unless defined $html;
print STDERR "Now processing [user id = $uid] ...\n";
# no more users...?
$max_uid = $uid-1 and last
unless ($name) = $html =~ /($re_nick) \([1-9]\d*\) のユーザ情報/o;
#fetch information
$subs = 0;
$subs = $1 while $html =~ /([1-9]\d*) 個の記事を投稿しました。.+?は \d+ 個のコメントを投稿しました。/gs;
print STDERR "name: $name, submissions: $subs\n";
$is_author = grep $_ == $uid, values %authors;
if(!$is_author && $subs > 0) {
push @subs, $subs;
push @name, $name;
push @uid, $uid;
}
# sleep(1);
}
print STDERR "max uid => $max_uid\n";
# save all information to .csv
open F_CSV, '>hof.csv' or die $!;
print F_CSV (join ',', $uid[$_], $name[$_], $subs[$_]), "\n"
for 0..$#subs;
close F_CSV;
# output html
open F_HTML,'>hof.html' or die $!;
print F_HTML '<html><head><meta http-equiv="Content-Type" content="text/html; charset=euc-jp">',
'<title>Stats of Slashdot.jp submitters</title></head>',
'<body>もっとも採用されたタレコミニスト ',
(sprintf('(<b>Generated on %04d/%02d/%02d %02d:%02d</b>)<p>',
sub {($_[5]+1900, $_[4]+1, $_[3], $_[2], $_[1])}->(localtime))), '<tt>';
my @index = sort {
$subs[$b] <=> $subs[$a] or
$name[$a] cmp $name[$b]
} 0..$#subs;
my ($old_subs, $rank, $inner_cnt) = (0, 0, 0);
for(@index) {
if($old_subs != $subs[$_]) {
$rank += ($inner_cnt+1);
$inner_cnt = 0;
} else {
++$inner_cnt;
}
$html = sprintf '%3d. %3d ', $rank, $subs[$_];
$old_subs = $subs[$_];
print F_HTML $html, "<a href='$url$uid[$_]'>$name[$_]</a><br>\n";
}
# -4 : uid=1(A.C.), uid=2(root), uid=8796, 8797(non-existent id)
my $users = $max_uid - 4;
my $submitters = @subs - int values %authors;
my $submitters_perc = sprintf '%.2f', $submitters / $users * 100;
print F_HTML "<p>総タレコミニスト数: $submitters<br>",
"/.-J 住人数: $users<br>",
"/.-J 住人総数に対する(採用経験のある)タレコミニストの割合: ${submitters_perc}%",
'</tt></body></html>';
### Subroutine
#
sub getListOfAuthors {
return () unless $_ = get(shift);
my $re_nick = shift;
@_ = ();
push @_, ($2, $1) while m!<H2>.*?&author=(\d+).*?>($re_nick)</A></H2>!gos;
@_;
}