Magical Diary, beta version

ニコニコ動画の情報を取得する WWW::NicoVideo を作成した。RSSを作成するために最低限必要な部分しか作っておらず、非公開APIについても未対応。

CPAN

http://search.cpan.org/dist/WWW-NicoVideo/

いじり中Subversionリポジトリ

http://svn.coderepos.org/share/lang/perl/WWW-NicoVideo/

いじり中ソースコードブラウザ

http://coderepos.org/share/browser/lang/perl/WWW-NicoVideo/

使い方は 添付のサンプル を参照… では不親切なので、Feed に変換するプログラム:

use utf8;
use strict;
use warnings;
 
use Getopt::Std;
use Encode;
use Encode::Guess "euc-jp";
use XML::Feed;
use WWW::NicoVideo;
 
MAIN: {
  my %opts;
  getopts('m:p:t:k:f:o:', \%opts);
  my $mail = $opts{m} || die "mail required";
  my $passwd = $opts{p} || die "passwd required";
  my $outfile = $opts{o};
  my $format = $opts{f} || "Atom";
  my $key = defined $opts{k}? decode("Guess", $opts{k}): "律子ソロ";
  my $type = $opts{t} || "tag";
  my $method = {tag => "getEntriesByTagNames",
		"search" => "getEntriesByKeywords"}->{$type} or
		die "invalid type: $type";
 
  my $outfh;
  if(defined $outfile) {
    open $outfh, ">:utf8", $outfile;
  } else {
    $outfh = \*STDOUT;
    binmode STDOUT, ":utf8";
  }
 
  my $nv = new WWW::NicoVideo();
  $nv->mail($mail);
  $nv->passwd($passwd);
  $nv->login or die "login failed";
 
  my $feed = new XML::Feed($format);
  $feed->title("@{[ucfirst $type]}: $key - ニコニコ動画");
  $feed->link("http://www.nicovideo.jp/");
  foreach my $e ($nv->$method(key => $key, sort => "f", order => "d")) {
    my $ent = new XML::Feed::Entry($format);
    $ent->title($e->title);
    $ent->link($e->url);
    $ent->content($e->desc);
    $feed->add_entry($ent);
  }
 
  print $outfh $feed->as_xml;
}

使用例: perl ritsuko-feed.pl -m your-mail@example.org -p your-passwd -k "最東みんくP" -o minkhouse.atom

ritsuko.org始めました

Defined-or 演算子 ("//") は perl 5.10 以降で利用可能 (とりあえず、開発者向けの5.9は考えない) であるが、FreeBSD port の lang/perl5.8 では利用できる。 これは、FreeBSD portのPerlは /usr/ports/lang/perl5.8/Makefile で defined-or-5.8.8.bz2 というパッチが指定されているためだ:

PATCHFILES=	defined-or-5.8.8.bz2

perl -V を実行することでもわかる:

Characteristics of this binary (from libperl):
  Compile-time options: MYMALLOC PERL_MALLOC_WRAP USE_64_BIT_INT
                        USE_LARGE_FILES USE_PERLIO
  Locally applied patches:
        defined-or

現状で 5.9 / 5.10 が導入されて環境は少ないため、可搬性を考慮する場合は "//" の利用は見合わせたほうがよさそうだ。

ニコニコ動画のタグごとにRSSを作るため、最初は以下のように正規表現でゴリゴリと処理していたが、イマイチ綺麗じゃない。

while($html =~ m{<p><a\s+href="watch/(\w+)">\s*
                 <img\s+.*?src="(.*?)".*?>.*?
                 <strong>((?:\d+分)?\s*\d+秒)</strong>.*?
                 再生：<strong>([\d,]+)</strong>.*?
                 コメント：<strong>([\d,]+)</strong>.*?
                 <a\s+class="video".*?>([^<>]*)</a></p>.*?
                 <p.*?>([^<>]*?)</p>.*?
                 <p.*?><strong>([^<>]*?)</strong></p>
                 }gsx) {
    ...
}

今回は Web::Scraper というモジュールを使ってみた。これは、CSSセレクタやXpathで対象を指定すると、解析した結果を返してくれる。HTMLをパースして情報を取得するときに便利だ。

どのブロックからデータを取得するのかを大まかに指定してしまって、その中で細かい情報を取得するという段階を踏むと、スクレーピングしやすいとあったので、

1. "thumb_frm" を class 属性として持つ div 一式を取得
2. これらの div について、細かく Xpath 指定で要素を抽出

という手順で処理することにした:

my $scraper = scraper {
  process('//div[@class="thumb_frm"]',
          'videos[]' => scraper {
            process('/div/div/div/p/a/img',
                    img_url => '@src',
                    img_width => '@width',
                    img_height =>  '@height');
            process('/div/div/p[2]/strong',
                    length_str => 'TEXT');
            process('/div/div/p[2]/strong[2]',
                    num_played_str => 'TEXT');
            process('/div/div/p[2]/strong[3]',
                    num_comments_str => 'TEXT');
            process('/div/div[2]/p/a[@class="video"]',
                    title => 'TEXT',
                    url => '@href');
            process('/div/div[2]/p[2]',
                    desc => 'TEXT');
            process('/div/div[2]/div/p/strong',
                    comment => 'TEXT');
          });
};

作った結果: ニコニコ動画 俺様用RSS

ニコニコ動画アクセス関係は WWW::NicoVideo として分離させているけど、需要あるかな?

メールアドレスが正しい形式であるか確認する

入力されたメールアドレスの形式を確認するため、

if(not $mail =~ /^[a-z0-9]+@[a-z0-9-]+(?:\.[a-z0-9-]+)+$/) {
  die "invalid address";
}

のようなコードを書くべきではない。メールアドレスというものはあなたが考えている以上に複雑で、このような単純なコードでチェックし切ることはできない。車輪の再発明をせず、次のように Email::Valid を利用しよう。これはDNSのMXレコードのチェックなども可能である。

use Email::Valid;
if(not Email::Valid->address(-address => $mail,
                             -mxcheck => 1,
                             -fqdn => 1) {
  die "invalid address";
}

RFC 822 (2822) 形式のアドレスをパースする

メールのヘッダ中に含まれるアドレスはさまざまな形式を取るため、これを自力で解析するのは骨が折れる。これもモジュールを利用することで車輪の再発明を避けることができる。以下は Email::Address を利用した例である。(同様のモジュールとしては Mail::Address があり、若干インターフェイスが異なる。)

use Email::Address;
my @addrs = Email::Address->parse(
  'HIRATA Yasuyuki <yasu@example.com>, ' .
  'yasu@example.net (HIRATA Yasuyuki), ' .
  '"sakura tan haahaa"@example.org' # *VALID* RFC 2822 address
);
foreach (@addrs) {
  print $_->address, "\n";
}

Javaのようにバックトレース付きで死ぬ方法。

# confess.pl
use Carp qw[confess];
require "confess2.pl";
foo();
sub foo { bar() }

# confess2.pl
sub bar { baz() }
sub baz { zot() }
sub zot { confess "moe" }
1;

実行結果:

% perl confess.pl
moe at confess2.pl line 3
        main::zot() called at confess2.pl line 2
        main::baz() called at confess2.pl line 1
        main::bar() called at confess.pl line 4
        main::foo() called at confess.pl line 3