dseg (14237) の日記

2003 年 06 月 30 日
午後 11:34

タレコミ者リスト作成スクリプト v0.24

#!/usr/bin/perl -w

###
# $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;
  @_;
}
この議論は賞味期限が切れたので、アーカイブ化されています。 新たにコメントを付けることはできません。

犯人は巨人ファンでA型で眼鏡をかけている -- あるハッカー

処理中...