新番組調査@2chアニメ板 その3

さて。色々調べてるのですが・・・。シャナとか継続スレッドはカウントしにくいんだよな。純粋なスレッド数で数えようとすると、その辺がどうにも・・・。スレッドの速度でやるかなあ。1から今までの速度を計算するとか?それでもCLANNADとかは1日に1スレ消費したりするし、放映日によって速度が変わったりするだろうしなあ・・・。

=====================重要項目===============================================
・【※実況厳禁】放送時間内に書き込む行為は実況とみなされます。
・【※ネタバレ禁止】原作・雑誌等での未放送内容は然るべき板へ。
youtubeニコニコ動画、ファイル共有やそれに類似する書き込みは専用板へ。
・煽り、荒らしは徹底放置しましょう。
・sage進行推奨(メール欄に半角小文字でsageと記入)。
・次スレは>>950が宣言してから立てる。無理なら代役を指名すること。
・スレ数は1期から継続しています。メロンパン115個目までが1期、2期は116個目からです。
============================================================================

灼眼のシャナ�U-Second- メロンパン129個目

そうなんや。じゃあ116を引き算して考えればいいのね。親切!

そんなわけで

前に書いたものをちょっと修正。どうせアンチスレは本スレよりレス数は少なくなるので、あえてフィルターをかけるよりは間違えてフィルターにかかってしまうリスクを回避する方向にしました。
一度全角英数→半角英数、漢数字→半角数字に変換してから、スレ番号っぽい数字とレス数っぽい番号を計算する感じ。最終的には手作業でチョコチョコと・・・。GIDはキーワード調査で使うグループID。はてなキーワードとの紐付けに使います。

use strict;
use warnings;
use utf8;
use Getopt::Std;
use File::Basename;
use Encode;

#parse argument
my $opt  = {};
my $conf = {};
getopts('i:p:h', $opt);
$conf->{infile}  = $opt->{i} || 'subback.html';
$conf->{pattern} = $opt->{p} || 'pattern.txt';
usage($conf) if($opt->{h});

# read keyword file
open(F, $conf->{pattern}) || die;
my @patterns = map{
  tr/\x0A\x0D//d;
  my($gid, $ptn) = split(/\t/);
  {gid=>$gid, filter=>lc($ptn)};
} <F>;
close(F);

# read logfile
my @list = parse_subback($conf->{infile});

# search keywords
foreach my $p (@patterns){
  print "x search $p->{filter}:\n";
  my @entries;
  foreach my $l (@list){
    my $l_org = $l;
    if($l =~ /$p->{filter}/i){
      print "x    => found! [$l]\n";
      $l =~ s/.+($p->{filter})(.+)/$2/i;
      if($l =~ /[^\d]+(\d+)[^\d]+\((\d+)\)/o){
        my $totalres = ($1 <= 1) ? $2 : ($1-1)*1000+$2;
        print "x       => total $totalres($1/$2)\n";
        push(@entries, {%$p, cnt=>$totalres, title=>$l_org});
      }
      elsif($l =~ /\((\d+)\)/o){
        my $totalres = $1;
        print "x       => total $totalres\n";
        push(@entries, {%$p, cnt=>$totalres, title=>$l_org});
      }
    }
  }
  next unless(@entries);
  @entries = sort {$b->{cnt} <=> $a->{cnt}} @entries;
  $_ = shift(@entries);
  print "xxx:$_->{gid}:$_->{cnt}:$_->{title}\n";
  foreach(@entries){
    print "xx:$_->{gid}:$_->{cnt}:$_->{title}\n";
  }
}

sub parse_subback{
  my $file = shift;

  open(F, $file) or die;
  my @list = <F>;
  close(F);
  # convert zenkaku to hankaku, lower case
  return map{
    tr/\x0A\x0D//d;
    s/.+?: //;
    s/<\/a>.*//;
    $_ = Encode::decode("sjis", $_);
    $_ = lc;
    tr/〇零一二三四五六七八九0-9a-z /00-90-9a-z /;
    $_ = Encode::encode("euc-jp", $_);
    $_;
  } grep(/a href=\"\d+\/l50/, @list);
}
sub usage{
  my $conf = shift;
  print "perl " . basename($0) . " [options]\n";
  print "    -i : input file (current:$conf->{infile})\n";
  print "    -p : pattern file (current:$conf->{pattern})\n";
  exit(0);
}