再帰処理練習（Perl） - くじょーさんの寝言

先日のニコニコ動画ゲーム実況者さんのTwitterアカウント調査に使用したコードを晒してみます。

これは純粋に、実況者さんのTwitter利用状況を知りたい、という欲求がメインではありましたが、ついでに再帰処理モノを書いてみたい、という裏目標があったりしました。

まー、これで良いんかどうかよくわからんのですが（ダメな気ガス）、運が良ければ誰かからアドバイスが貰えるかもしれないのでｗ残念コードを晒しておきますよ〜。

nico_tw.pl

#!perl
use strict;
use warnings;
use Encode;
use Encode::Guess qw(euc-jp shiftjis 7bit-jis);
use LWP::UserAgent;
use DateTime;

  my $uri_find_twitter_file = 'list'.DateTime->now(time_zone => 'Asia/Tokyo')->strftime("%Y%m%d%H%M%S").'.txt';

  my $start_uri = 'http://dic.nicovideo.jp/a/%E3%82%B2%E3%83%BC%E3%83%A0%E5%AE%9F%E6%B3%81%E3%83%97%E3%83%AC%E3%82%A4%E5%8B%95%E7%94%BB%E3%81%AE%E3%83%97%E3%83%AC%E3%82%A4%E3%83%A4%E3%83%BC%E3%81%AE%E4%B8%80%E8%A6%A7';

  my $regex_uri_lack = '/[-_.!~*()a-zA-Z0-9;/?:@&=+$,%#]+';  # \'
  my $regex_uri = "s?https?:/$regex_uri_lack";
  my $regex_anchor_nicoroot = "href=\"($regex_uri_lack)\"";
  my $regex_anchor_domain = "($regex_uri)";
  my $regex_twitter = '(http://twitter\.com/\w+)';

  my @exception_tw = (
    'http://twitter.com/home',
    'http://twitter.com/flash',
    'http://twitter.com/javascripts',
    'http://twitter.com/statuses',
  );

  my $TW_COUNT = 0;
  my @TW_LISTS;
  my @LOOKED_LINKS;

  &check(0, $start_uri);

  print "\n\nTwitter Link:\n";
  foreach my $uri_twitter (@TW_LISTS) {
    print "\t", $uri_twitter, "\n";
  }

  exit;

####

sub check {
  my($linklevel, $uri) = @_;

  foreach my $uri_lookedlink (@LOOKED_LINKS) {
    if($uri_lookedlink eq $uri) { return; }
  }
  push(@LOOKED_LINKS, $uri);
  my $contents = &get_linkpage_contents($uri);
  if(length($contents) < 1) { return; }

  print $TW_COUNT,"\t", $linklevel,"\t", length($contents),"\t", $uri,"\n";
  sleep(1);  #

  foreach my $uri_link_tw ($contents =~ m/$regex_twitter/g) {
    my $pass;
    foreach my $uri_except (@exception_tw) {
      if($uri_link_tw eq $uri_except) { $pass = $uri_link_tw; last; }
    }
    foreach my $uri_stored_tw (@TW_LISTS) {
      if($uri_link_tw eq $uri_stored_tw) { $pass = $uri_link_tw; last; }
    }
    unless($pass) {
      &savefile($uri_link_tw, $uri);
      return;
    }
  }

  $linklevel++;  #
  if($linklevel < 4 && ($uri =~ /(www|dic|ch)\.nicovideo\.jp/g)) {
    foreach my $uri_link_anc ($contents =~ m/$regex_anchor_nicoroot/g) {
      $uri_link_anc = 'http://dic.nicovideo.jp'.$uri_link_anc;
      if($uri_link_anc ne $uri) { &check($linklevel, $uri_link_anc); }
    }
    foreach my $uri_link_anc ($contents =~ m/$regex_anchor_domain/g) {
      if($uri_link_anc ne $uri) { &check($linklevel, $uri_link_anc); }
    }
  }
}

sub savefile {
  my($uri_link_tw, $uri_before) = @_;
  my $body = Encode::decode('Guess', &get_page($uri_before));
  unless(Encode::encode('utf8', $body) =~ /実況/g) { return; }
  $TW_COUNT++;
  push(@TW_LISTS, $uri_link_tw);
  open my $outputfile, '>>', $uri_find_twitter_file || return;
  print $outputfile "$uri_link_tw\t$uri_before\n";
  close $outputfile;
  return;
}

sub get_linkpage_contents {
  my $uri = shift;
  my $content = &get_page($uri);
  if($content =~ m/<body([\s\S]+<\/body>)/s) {
    $content = $1;
    # $content =~ s/(ul class\=\"word\-blog\"([\s\S]+)<\/body>)//g;
    return $content;
  }
  return "";
}

sub get_page {
  my $uri = shift;
  my $ua = LWP::UserAgent->new();
  $ua->timeout(10);  # timeout setting
  $ua->agent('Mozilla');  # useragent setting
  my $req = HTTP::Request->new(GET => $uri);
  # $req->referer('http://dic.nicovideo.jp/');
  my $res = $ua->request($req);
  if($res->is_success) { return $res->content; }
  return "";
}

こんな感じなんですけど、いかがでしょうか。

再帰・・・処理・・・ってこんな感じでしたっけ？

もう一段浅くしても良いのかもしれませんね。リンクを辿る上限は。このままだと広がりすぎかもしれません。

それと、処理の結果には問題があって、実況と関係ない記事ページやニコニコ大百科の各記事ページの下の方の『「〜」を含むブログ』なんかのリンクを除外していないので、実況者とは関係ないTwitterアカウントに辿り着くことがままあります。直前のページ内に『実況』ってワードが含まれているかどうかチェックするだけでもうちょい精度が上がりそうですが・・・どうだろう・・・。

ダラダラといじってみました。そもそも、探索方法が拙いんですけどね！

つーか、このままだと画像だろうがjsファイルだろうがなんでも読みに行くというすげーウザい仕様なんですけどね・・・。迷惑・・・？

そーいや、Perl 5.8以降って、use utf8; しなくてもしてるのと同じだぜってのを見かけたんだけど、アレって本当なのかな？　てか、use してる時としてない時で挙動が違うんだが・・・？