Google Custom Search EngineをCustomしてみたよ:後編

昨日に引き続き。ソースも交えながら、何をやったのかの解説をします。

なお、設定項目はYAML形式で以下のように。これをYAML::Syckで読み込みます。

livedoor:
  login_url: https://member.livedoor.com/login/ 
  opml_url:  http://reader.livedoor.com/export/opml
  id:livedoorのID」
  passwd:livedoorのパスワード」

google:
  login_url: https://www.google.com/accounts/ServiceLogin
  cse_url  :Google CSE > control panel > Advanced のURL」
             (http://www.google.com/coop/manage/cse/advanced/?cx=****)
  email:GoogleのID」
  passwd:Googleのパスワード」


最初に、livedoor ReaderからOPMLを取得。livedoorにログインしておかないと取得できないので、先にログイン。

ここで「no warnings」を入れているのは、WWW::Mechanize中で警告*1が出るため。ぐぐってみたところ特に問題なさそうだったので、ここだけ警告を外しています。

### OPML取得(LDR)ルーチン ###
sub get_ompl_from_ldr {
  my ($conf) = @_;

  my $mech = WWW::Mechanize->new();

  # livedoor ログイン
  $mech->get($conf->{livedoor}->{login_url});
  $mech->field('livedoor_id', $conf->{livedoor}->{id});
  $mech->field('password',    $conf->{livedoor}->{passwd});
  {
    no warnings;
    $mech->click();
  }

  # OPML取得
  $mech->get($conf->{livedoor}->{opml_url});
  return $mech->content();
}


で、取得したOPMLをちょこっと編集。というのは、livedoor Readerに登録しているFeedには他の人には公開したくないものまで登録されているんですよね。例えばmixipressが吐き出すRSSだったり、サイドフィード株式会社が提供しているサービスで通知がRSSを使用するものだったり。これらのサイトを除外するように、LDRで「private」フォルダに登録されているFeedは削除するようにしました。

ここで、昨日もちょっと触れましたが、XML::Simpleは単純にimport・outportしただけでもOPMLの形式が変わってしまうために使用不可。代わりに、XML::LibXMLを用いることに。4年ほど前にやった、XML DOMについての断片的な知識を引っ張り出してくるのに苦労しましたよ…

### private feed削除ルーチン ###
sub remove_private_element {
  my ($xml, $private_name) = @_;
  return $xml unless defined $private_name;

  my $parser = XML::LibXML->new();
  my $doc    = $parser->parse_string($xml);
  my $root   = $doc->documentElement();

  my @elements = $root->getElementsByTagName('outline');
  for (@elements) {
    $_->parentNode()->removeChild($_)
      if $_->getAttribute('title') eq $private_name;
  }

  return $doc->toString();
}


あとは、↑で編集されたOPMLを一時ファイルに保存してやると。


続いては、作成されたOPMLファイルをGoogle CSEにアップロードします。流れとしては、

  1. Googleにログイン
  2. Google CSEに登録されている検索対象サイトを全削除
  3. 検索対象サイトの再登録(OPMLアップロード)

です。

### OPMLファイル送信ルーチン ###
sub submit_opml {
  my ($conf, $file) = @_;
  $file = 'export.xml' unless $file;

  my $mech = WWW::Mechanize->new();

  # Googleログイン
  $mech->get($conf->{google}->{login_url});
  $mech->field('Email',  $conf->{google}->{email});
  $mech->field('Passwd', $conf->{google}->{passwd});
  $mech->click();

  # 登録済検索サイト削除
  $mech->get($conf->{google}->{cse_url});
  $mech->follow_link(text => 'delete');

  # OPMLアップロード
  $mech->field('file', &get_tmp_file_path($file), 1);
  $mech->submit_form(form_number => 1);
}

ここで、アップロードするOPMLファイルを、Windows上の絶対パスで指定してやる必要があります。ただ、私はCygwin上でPerlを動かしているので、Cwdモジュールを使うとCygwinのパス、つまり「/cygdrive/c/****」になってしまいます。

さぁ、どうしようと思ってたら、↓のような天の声が頭の中に聞こえてきましたw

CygwinからWindowsへのパス変換には、「cygpath」コマンドが使えるよ。

さっそく、オプションを調べて検証。うまくいきそうです。

### 一時ファイルパス取得ルーチン ###
sub get_tmp_file_path {
  my ($file) = @_;
  $file = 'export.xml' unless $file;

  my $cyg_dir = cwd;
  chomp(my $win_dir = `cygpath -w $cyg_dir`);
  return $win_dir . '\\' . $file;
}


Google CSEに反映されることを確認して完成。一時ファイルも削除するのを忘れずに。

おあとは、このスクリプトをタスクスケジューラで一週間ごとにぶん回してやればおっけかな。


思いのほか時間かかりました。手間取ったところは、

  • XML::LibXMLの使用方法調査
    • 無理やりXML::Simpleでいこうとして結局断念。その辺のタイムロスが痛かったかな。
  • Test::Moreを使ったユニットテストの記述
    • 上記では説明はしていませんが、ユニットテストも並行してやりました。ただ、テストドリブンとまではいかず。レグレッションテストには有効に使えましたが、いまいちテストドリブンのやり方がピンとこず。
    • あと、ユニットテストの本質ではないのですが、Google CSEの検索ってユーザエージェントではじいているみたい。テスト内で検索できなかったので、HTTPのレスポンスを見てみたら「libwww-perl-****」では「403 Forbidden」が。ここでも、小一時間ほど詰まりました…orz

あと、今回初めてYAMLを使ったのですが、これいいですね。ものすごく見やすい!可読性とか保守性とかが上がりそうです。レンタルサーバにも最近YAML::Syckがインストールされたので、今度からガシガシYAML使っていこう!


最後に、全ソースコードをのっけて終了とさせていただきます。

#!/usr/bin/perl
use warnings;
use strict;

use Cwd;
use Switch;
use WWW::Mechanize;
use XML::LibXML;
use YAML::Syck;



### メインルーチン ###
# 初期設定
my ($yaml, $src, $file) = @ARGV;
$yaml = 'opml4cse.yml' unless defined $yaml;
my $conf = YAML::Syck::LoadFile($yaml)
  or die '$yaml : $!';

# OPMLファイル出力
&export_opml($conf, $src, $file);

# OPMLファイル送信
&submit_opml($conf, $file);

# 一次ファイル削除
&delete_tmp_file($file);



### OPMLファイル出力ルーチン ###
sub export_opml {
  my ($conf, $src, $file) = @_;
  my $factory = defined $src ? $src : 'livedoor';

  # OPML取得
  my $opml;
  switch ($factory) {
    case /(livedoor|ldr)/i { $opml = &get_ompl_from_ldr($conf); }
    else                   { die "Can't factory method with argv!"; }
  }

  # private feed削除
  $opml = &remove_private_element($opml, 'private');

  # 一時ファイル出力
  &export_tmp_file($opml, $file);
}

### OPML取得(LDR)ルーチン ###
sub get_ompl_from_ldr {
  my ($conf) = @_;

  my $mech = WWW::Mechanize->new();

  # livedoor ログイン
  $mech->get($conf->{livedoor}->{login_url});
  $mech->field('livedoor_id', $conf->{livedoor}->{id});
  $mech->field('password',    $conf->{livedoor}->{passwd});
  {
    no warnings;
    $mech->click();
  }

  # OPML取得
  $mech->get($conf->{livedoor}->{opml_url});
  return $mech->content();
}

### private feed削除ルーチン ###
sub remove_private_element {
  my ($xml, $private_name) = @_;
  return $xml unless defined $private_name;

  my $parser = XML::LibXML->new();
  my $doc    = $parser->parse_string($xml);
  my $root   = $doc->documentElement();

  my @elements = $root->getElementsByTagName('outline');
  for (@elements) {
    $_->parentNode()->removeChild($_)
      if $_->getAttribute('title') eq $private_name;
  }

  return $doc->toString();
}

### 一時ファイル出力ルーチン ###
sub export_tmp_file {
  my ($opml, $file) = @_;
  $file = 'export.xml' unless $file;

  open OUT, "> $file" or die "$file : $!";
  print OUT $opml;
  close OUT;
}

### OPMLファイル送信ルーチン ###
sub submit_opml {
  my ($conf, $file) = @_;
  $file = 'export.xml' unless $file;

  my $mech = WWW::Mechanize->new();

  # Googleログイン
  $mech->get($conf->{google}->{login_url});
  $mech->field('Email',  $conf->{google}->{email});
  $mech->field('Passwd', $conf->{google}->{passwd});
  $mech->click();

  # 登録済検索サイト削除
  $mech->get($conf->{google}->{cse_url});
  $mech->follow_link(text => 'delete');

  # OPMLアップロード
  $mech->field('file', &get_tmp_file_path($file), 1);
  $mech->submit_form(form_number => 1);
}

### 一時ファイルパス取得ルーチン ###
sub get_tmp_file_path {
  my ($file) = @_;
  $file = 'export.xml' unless $file;

  my $cyg_dir = cwd;
  chomp(my $win_dir = `cygpath -w $cyg_dir`);
  return $win_dir . '\\' . $file;
}

### 一時ファイル削除ルーチン ###
sub delete_tmp_file {
  my ($file) = @_;
  $file = 'export.xml' unless $file;

  unlink $file or die "$file : $!";
}


1;

*1:警告内容は、「Parsing of undecoded UTF-8 will give garbage when decoding entities at /usr/local/lib/perl5/site_perl/5.8.8/cygwin/HTML/PullParser.pm line 83.」というやつ