当サイトで生成している RSS（野良feed）：

M.C.P.C.:カテゴリー Perl バックナンバー

2010.03.06: PerlでTwitterの自画像アイコンを分に応じて回転させる
2010.03.05: PerlのWWW::Mechanizeを使って2010年3月現在のTwitterで自画像をアップロード
2010.03.03: Perlでパスワード文字列生成にString::Randomを使ってみる
2010.01.17: Proc::Daemon使った時のデバッグが大変だ
2009.12.28: mp3ファイルのファイル名をタグのタイトルに設定するPerlスクリプト
2009.12.23: PSP用天気予報画像を自動組版して作るPerlスクリプト
2009.11.26: CPANへのUpload失敗してた
2009.11.24: Adobe Creative Suite 出力対応店一覧をGoogle Mapsで表示させる(7)
2009.11.23: Adobe Creative Suite 出力対応店一覧をGoogle Mapsで表示させる(6)
2009.11.21: Adobe Creative Suite 出力対応店一覧をGoogle Mapsで表示させる(5)

2010.03.06

PerlでTwitterの自画像アイコンを分に応じて回転させる

飲み会用のネタ。cronに仕込んでね。あまりやりすぎると、TwitterからBANされるかも……

#!/usr/bin/perl
 
use strict;
use warnings;
use Config::Pit;
use Image::Magick;
use WWW::Mechanize;
 
my $p = pit_get( 'twitter.com@CLCLCL' );
die "not preset account data in Pit." if !%$p;
my $username = $p->{username};
my $password = $p->{password};
 
my $file = 'cl.png';
 
my $im = Image::Magick->new;
$im->Read($file);
my ( $x, $y ) = $im->Get( 'width', 'height' );
$im->Set(bordercolor=>'#FFFFFF');
my $deg = (localtime(time))[1] / 60 * 360;
$im->Rotate(degrees => $deg, crop => 0, sharpen => 1);
my ( $nx, $ny ) = $im->Get( 'width', 'height' );
$im->Crop(width => $x, height => $y,
          x => ($nx - $x) / 2, y => ($ny - $y) / 2, );
my $tmpfile = time.".png";
$im->write("png:$tmpfile");
 
my $mech = WWW::Mechanize->new();
$mech->agent_alias( 'Windows IE 6' );
 
my $res = $mech->get('https://twitter.com/settings/profile');
die if $mech->uri() ne 'https://twitter.com/login';
$mech->submit_form(
  form_number => 2,
  fields => {
    'session[username_or_email]' => $username,
    'session[password]'          => $password,
  },
  button => 'commit',
);
$mech->submit_form(
  form_number => 2,
  fields => {'profile_image[uploaded_data]' => $tmpfile, }
);
 
unlink $tmpfile;
 
exit;
 
__END__

Twitterクライアント側でアイコンキャッシュしていることも多いからあんまり意味ないかも。あと、cronに入れた場合はカレントディレクトリに注意。

2010.03.06 午前 09:01 [Perl] | 固定リンク | コメント (0) | トラックバック (0) |

2010.03.05

PerlのWWW::Mechanizeを使って2010年3月現在のTwitterで自画像をアップロード

Net::Twitterのメソッドだと出来んようだから。

エラー処理はほとんどナシな。くじら出てても知らん。あとTwitterのHTML構造変わったら動かなくなると思うよ。注意。

Filename: updateimage.pl

#!/usr/bin/perl
 
use strict;
use warnings;
use Config::Pit;
use WWW::Mechanize;
 
my $p = pit_get( 'twitter.com@CLCLCL' );
die "not preset account data in Pit." if !%$p;
my $username = $p->{username};
my $password = $p->{password};
 
#my $file = 'rinkoangry.png';
my $file = 'cl.jpg';
 
my $mech = WWW::Mechanize->new();
$mech->agent_alias( 'Windows IE 6' );
 
my $res = $mech->get('https://twitter.com/settings/profile');
die if $mech->uri() ne 'https://twitter.com/login';
$mech->submit_form(
  form_number => 2,
  fields => {
    'session[username_or_email]' => $username,
    'session[password]'          => $password,
  },
  button => 'commit',
);
$mech->submit_form(
  form_number => 2,
  fields => {'profile_image[uploaded_data]' => $file, },
);
 
exit;
 
__END__

これ使って美人時計でも作るがいいさ！しらんけど。

ものすごく参考にした。
nDiki: Twitter のアイコンを Perl スクリプトで更新する (改) (2009-03-20) [naney.org]

2010.03.05 午前 01:49 [Perl] | 固定リンク | コメント (0) | トラックバック (0) |

2010.03.03

Perlでパスワード文字列生成にString::Randomを使ってみる

パスワードの再発行ルーチンとか、作っているのですけれども、例えば'9'と'Q'は聞き間違えるからとかいう理由で、パスワードの文字列に使いたくないっていう用件があって、そうすると、パスワードの文字列を限定して生成するっていうことになるのだけれども、これをこんな感じで作っていましたが。

#!/usr/bin/perl
 
use strict;
use warnings;
use Digest::SHA1;
 
my $salt = '3gatsu6nichihatokyodeoffkaida';
 
my $new_password = _make_password();
my $ctx = Digest::SHA1->new;
 
$ctx->add( $salt.$new_password );
my $password_digest = $ctx->hexdigest;
 
print "NewPASSWORD: $new_password\n";
print "salted_SHA1: $password_digest\n";
 
exit;
 
# パスワード生成
sub _make_password {
  my @character
      = ( 'A','C','D','F','H','K','L',
          'P','R','T','U','X','Y','4','7', );
  my $str = q();
  my $length = @character;
  for (my $i = 0; $i < 8; $i++ ) {
    my $x = int(rand $length);
    $str .= $character[$x];
  }
  return $str;
}
 
 
__END__

モジュールでString::Random使えば簡単にできることに最近気づいた！

#!/usr/bin/perl
 
use strict;
use warnings;
use Digest::SHA1;
use String::Random;
 
my $salt = '3gatsu6nichihatokyodeoffkaida';
 
my $new_password = _make_password();
my $ctx = Digest::SHA1->new;
 
$ctx->add( $salt.$new_password );
my $password_digest = $ctx->hexdigest;
 
print "NewPASSWORD: $new_password\n";
print "salted_SHA1: $password_digest\n";
 
exit;
 
# パスワード生成
sub _make_password {
  my $sr = String::Random->new;
  $sr->{A}
   = [ 'A','C','D','F','H','K','L',
       'P','R','T','U','X','Y','4','7', ];
  return $sr->randpattern('AAAAAAAA');
}
 
__END__

String::RandomはCPANからインストール。

あんまりプログラムの長さは変わらんけれども、パスワードのバリエーションがいろいろできますよね。

2010.03.03 午後 02:40 [Perl] | 固定リンク | コメント (0) | トラックバック (0) |

2010.01.17

Proc::Daemon使った時のデバッグが大変だ

とある事情でLinuxでDaemonを作っていますが、相変わらずPerlで作っておりまして、

Perl Tips | Perl で、デーモン (Daemon) のプログラムを書くには？ [perltips.twinkle.cc]

のまま使ってやっていまして、TTYにつないだまま（Daemon化しない）だと、フツーにいつまでも動いているのですけれども、Daemon化すると、数分でプロセスがいつの間にか消えているという現象。

だから今はscreenで開いたコンソール1つ使いDaemon化させないで運用。あほすぎる

Daemon化した時の効率のよいデバッグの仕方が見いだせないなあ。

2010.01.17 午後 11:28 [Perl] | 固定リンク | コメント (2) | トラックバック (0) |

2009.12.28

mp3ファイルのファイル名をタグのタイトルに設定するPerlスクリプト

SONYのICレコーダ ICD-UX300FっていうUSBにざっくりさせるICレコーダがありまして、これでラジオをエアチェックしたMP3ファイルを再生しようと思ったのですが、僕はファイル名に曲名を入れていたのでこれでいいと思っていたんですが、MP3のTag的には曲名のところが空欄になっていまして、ICレコーダの液晶上では「Unknown」と表示される残念な事態になっていましたので、早速ファイル名と同じものをタイトルとして設定するPerlスクリプトを作りました。LinuxのUTF-8ボリュームですよ。でもなんだかCP932とかにしているからiTunes上で化けそうな気がします。あれ、化けるのってID3v1の日本語のやつでしたっけ。とりあえずWindows Vistaのファイルのプロパティだとこれでちゃんと表示される。

mp3ファイルを書き換えますので、mp3ファイルをコピーしてから使いましょう。僕の場合は、このスクリプトはport 445で接続できるLinuxで実行していますから、必要なmp3ファイルをLinuxボリュームにコピーして実行しています。

filename: f.pl

#!/usr/bin/perl
 
use strict;
use warnings;
use MP3::Tag;
use Encode;
use utf8;
 
while ( my $file = shift @ARGV ) {
  print "$file\n";
  my $mp3 = MP3::Tag->new($file);
  $mp3->get_tags();
  my $res = $mp3->parse("%t.mp3", $mp3->filename_nodir);
  $mp3->title_set(encode('cp932', decode_utf8( $res->{title} )));
  $mp3->{ID3v2}->write_tag;
  $mp3->close();
}
 
exit;
 
__END__

今日の30分プログラミングでした。

あと、冒頭で紹介したICレコーダ、スピーカ出力小さいのであまりお勧めできませぬ。ちょっと残念。

2009.12.28 午前 02:21 [Perl] | 固定リンク | コメント (0) | トラックバック (0) |

2009.12.23

PSP用天気予報画像を自動組版して作るPerlスクリプト

PSPのブラウザ全画面表示（480x272px）で見られる、天気予報画像を生成するPerlスクリプトです。作例ではフォントにIPAゴシックを指定していますが、用途によって適切なフォントを指定してみてください。

実行例：

HTMLソースは

<img src="http://labo.dtpwiki.jp/psptenki/weather.cgi?city=50&day=today" />

で

が表示、

<img src="http://labo.dtpwiki.jp/psptenki/weather.cgi?city=50&day=tomorrow" />

で

が表示されます。

バックエンドでlivedoor Weather Hacksを使っています。
お天気Webサービス仕様 - Weather Hacks - livedoor 天気情報 [weather.livedoor.com]

開発中のPSP実機での表示例はこちら。
M.C.P.C.: PSPでデジタルサイネージ風に天気予報表示させてみた

ソース：

Filename: weather.cgi

#!/usr/bin/perl
 
# filename: weather.cgi
# livedoor Weather Hacksを使い、指定された地域、指定日の
# 天気予報を取得し、PSPのディスプレイサイズ(480x272pixel）
# 内で組版し、JPEG画像として出力します。
# 使用例： <img src="weather.cgi?city=50&day=today" /> 
 
use strict;
use warnings;
use CGI;
use DateTime::Format::HTTP;
use Encode;
use Image::Magick;
use PDFJ 'SJIS';
use utf8;
use WebService::Livedoor::Weather;
 
# PDFJからエクスポートされるText()をCP932に固定する
sub Text_fixup {
  no warnings 'redefine';
  *main::Text = sub {
    return PDFJ::Text
           ->new(encode('cp932', shift ), @_);
  };
}
Text_fixup();
 
 
# メインルーチン
my $q = CGI->new();
( my $day  = $q->param('day' ) || 'today' ) =~ s/[^\w]//g;
( my $city = $q->param('city') || 50      ) =~ s/[^\d]//g;
my $w = WebService::Livedoor::Weather->new()
        ->get( $city, $day );
$w->{city} = $city;
 
#use CGI::Carp qw(fatalsToBrowser);use YAML::Syck;die Dump($w);
show_image($w);
 
exit;
 
 
# Weather Hacksの結果からPDFJで組版し、JPEGで表示
sub show_image {
  my $w= shift;
  
  ( my $description = $w->{description} ) =~ s/<br.*//;
  my $forecastdate = DateTime::Format::HTTP
                       ->parse_datetime($w->{forecastdate})
                       ->ymd('/');
  my $pdfversion  = 1.6;
  my $paperwidth  = 480; # PSP display width
  my $paperheight = 272; # PSP display height
  
  # make PDFJ object
  my $d = PDFJ::Doc->new($pdfversion, $paperwidth, $paperheight);
  
  # make font object
  my $p_font = $d->new_font('IPAfont00301/ipag.ttf', '90ms-RKSJ-H');
  
  # make page object 
  my $p_page = $d->new_page;
  
  # make paragraph/text object
  my $para_title
    = Paragraph( 
        Text( "$w->{title}($forecastdate)",
              TStyle( font => $p_font, fontsize => 24)
        ),
        PStyle( size => 456, align => 'b', linefeed => 35, )
      );
  my $para_telop
    = Paragraph(
        Text( $w->{telop},
              TStyle( font => $p_font, fontsize => 36, )
        ),
        PStyle( size => 456, align => 'm', linefeed => 60, )
      );
  my $para_description
    = Paragraph(
        Text( $description,
              TStyle( font => $p_font, fontsize => 24, )
        ),
        PStyle( size => 456, align => 'w', linefeed => 32, )
      );
  my $para_copyright
    = Paragraph(
        Text( $w->{version},
              TStyle( font => $p_font, fontsize => 12, )
        ),
        PStyle( size => 456, align => 'e', linefeed => 15, )
      );
  
  # make block object
  my $p_block = Block(
                  'V',
                  $para_title,
                  $para_telop,
                  $para_description,
                  BStyle(align => 'b')
                );
  my $x = 12;
  my $y = $paperheight - 8;
  $p_block->show($p_page, $x, $y);
  my $p_block2 = Block(
                  'V',
                  $para_copyright,
                  BStyle(align => 'b')
                );
  $x = 12;
  $y = 15;
  $p_block2->show($p_page, $x, $y);
  
  # write PDF
  #write_jpg($d);      # Image::Magick バージョン
  write_jpg2($d, $w); # Google Docs バージョン
  
  return;
}
 
# オンメモリでPDF->JPEG処理、標準出力へ（ImageMagick使用）
sub write_jpg {
  my $d = shift;
  my $pdf;
  # PDFJで組版したPDFを$pdfに代入
  {
    open my $fh, '>', \$pdf or die $!;
    $d->print($fh);
    close $fh;
  }
  # $pdfのPDFデータをImageMagickでJPEGに変換
  my $img = Image::Magick->new( magick => 'pdf' );
  $img->BlobToImage($pdf);
  print $q->header( -type => 'image/jpeg' );
  binmode STDOUT;
  #$img->Set( quality => 75 );
  $img->Write('jpg:-');
  undef $img;
  
  return;
}
 
# PDFを公開領域に書きだして、Google Docで
# PDF->画像変換処理へリダイレクト
sub write_jpg2 {
  my $d  = shift;
  my $w  = shift;
  my $dt = DateTime::Format::HTTP
           ->parse_datetime( $w->{publictime} );
  ( my $day  = $w->{forecastday} ) =~ s/[^\w]//g;
  ( my $city = $w->{city       } ) =~ s/[^\d]//g;
  my $ymdhms  = $dt->ymd('') . $dt->hms('');
  
  # PDF書きだし用ファイル名・パス準備
  my $pdffile = "${city}_${day}_$ymdhms.pdf";
  my $pdfdir  = '/var/www/html/psptenki/pdf';
    # PDFを書きだす公開ディレクトリ（作っておくこと）
  my $pdfdir_url = 'http://example.com/psptenki/pdf';
    # PDFを書きだす公開ディレクトリのURL
  my $file = "$pdfdir/$pdffile"; 
  my $url  = "$pdfdir_url/$pdffile";
  
  # PDFを公開ディレクトリに書き出し
  $d->print($file);
  chmod 0666, $file;
  
  # Google Docsにリダイレクト
  print $q->redirect( "http://docs.google.com/viewer?"
               ."a=bi&pagenumber=1&w=480&url=$url" );  
  return;
}
 
 
__END__

PSPで直接指定した場合、勝手にmarginつくので、HTMLに組み込んで読むようにしたほうがいいと思います。

また、PSPの画面を自動更新してほしいっていう場合には、HTMLに組み込み、こんな風にしてみたらどうでしょう。

filename: 50.html

<html>
  <head>
    <meta http-equiv="refresh"
      content="3600; url=50.html" />
    <style>
      * {
        margin: 0px;
        padding: 0px;
      }
      img {
        width: 480px;
      }
    </style>
  </head>
  <body>
    <img src="weather.cgi?city=50&day=today" />
  </body>
</html>

これの設置場所のURLをPSPのWebブラウザで読み込む。これで我が家ではPSPで常に最新の天気状況が表示されいます。多い日も安心です。雪が。

あと、画像とMETA REFRESHという古式ゆかりな技術を使っているだけあって、HT-03AのブラウザでもW-ZERO3[es]のブラウザでもみられます。ニンテンドーDSブラウザは微妙。少なくとも初代DSブラウザはだめだったなあ。

～～～

さて、今回のスクリプトですが、PDFJという組版エンジンでPSPの画面サイズ（480x272px）で組版して、できたPDFをImageMagick、またはGoogle DocsのViewerでJPEG変換する、というものです。印刷屋さんで言うとIDMLとかInDesign Serverとか使わなくてもできちゃうのがかっこいいところだと思います。

この程度のものになにも組版エンジン使わなくてもいいんじゃないかーて思った方もいるかもしれませんが、せっかく印刷屋さんにいるんだから一応ジャスティファイぐらいかけたいなーというのと、好きなフォント使いたいなーというので、PDFJを使ってみました。PDFJは、設置するにあたり制限が非常に少ないのも魅力。Apache FOPとか設置するだけで難儀だぞ。

なんだったら、液晶AQUOSの画面サイズ（1366x768ぐらい？）のやつも作れるわけですが、うちハイビジョンテレビないんです。困ったね。

2009.12.23 午後 06:25 [Perl] | 固定リンク | コメント (0) | トラックバック (0) |

2009.11.26

CPANへのUpload失敗してた

CPANに新しいバージョンのモジュールをアップロードしたがいつまでたっても反映されないので調べたら、CPANからメールが来ていて、

The distribution contains a blib/ directory and is therefore not being indexed. Hint: try 'make dist'.

とかいうてた。メールで来るのか。今夜もう一回トライします。

2009.11.26 午後 11:18 [Perl] | 固定リンク | コメント (0) | トラックバック (0) |

2009.11.24

Adobe Creative Suite 出力対応店一覧をGoogle Mapsで表示させる(7)

アドビのCS4対応プリントショップのリストのページから、Google Mapsに表示させるやつの7回目。

前回は、メインイベントのHTMLからのスクレイピングをWeb::Scraperを使って行いました。アドビのサイトの構造がtable要素で作られていましたので、table要素でデータが作られている場合のサンプルとして参考になると思います、というところまでやりました。

今回は、取得するデータを、後の利用に便利なように変形していくことの一つとして、特定の単語がでてきたら、1、それ以外だったらundef、というPerlにとって都合のよい形式にしてみようと思います。

さて、先回、取得したデータは、こんな感じでした。ちなみにこれはYAML::SyckのDumpになっています。

---
codes:
  -
    address: 北海道札幌市西区二十四軒2条6丁目1番8号 TEL:011-621-1000 FAX:011-621-1500
    company: 株式会社 須田製版
    illustratorcs4: 'Yes'
    indesigncs4: 'Yes'
    pdfx1a: 'Yes'
    pdfx4: 'Yes'
    pref: 北海道
  -
    address: 北海道札幌市北区北8条西8丁目TEL:011-747-8886 FAX:011-756-7971
    company: 北海道大学生活協同組合印刷 情報サービス部
    illustratorcs4: 'Yes'
    indesigncs4: 'Yes'
    pdfx1a: 'Yes'
    pdfx4:  
    pref: 北海道
  -
  ...
  -
    address: 大分県大分市碩田町2-2-13TEL:097-536-4111 FAX:097-538-1149
    company: 株式会社 双林社
    illustratorcs4: 'Yes'
    indesigncs4: 'Yes'
    pdfx1a: 'Yes'
    pdfx4: ''
    pref: 大分県

illustratorcs4、indesigncs4、pdfx1a、pdfx4というのが、それぞれの印刷会社が対応しているかどうかを表すのですけれども、入っている値が'Yes'、''、空白、とまちまちです。これを、1またはundefにするとわかりがいいと思います。

そもそも、これの'Yes'って何が入っているんでしょうか。それは、先回のWeb::Scraperのプログラムの

my $s = scraper {
  process '//div[@class="tabcontent"][1]//table[@class="data-bordered max"]/tbody/tr', 'codes[]' => scraper {
    process '//td[1]', pref    => 'TEXT';
    process '//td[2]', company => 'TEXT';
    process '//td[3]', address => 'TEXT';
    process '//td[4]', illustratorcs4 => 'TEXT';
    process '//td[5]', indesigncs4    => 'TEXT';
    process '//td[6]', pdfx1a  => 'TEXT';
    process '//td[7]', pdfx4   => 'TEXT';
  };
};

という箇所によります。process '//td[7]', pdfx4 => 'TEXT';と指定しているので、

HTMLの

<tbody>
  <tr>
    <td>北海道</td>
    <td><a href="http://www.suda.co.jp/" target="_blank"
      >株式会社 須田製版</a></td>
    <td>北海道札幌市西区二十四軒2条6丁目1番8号<br />
      TEL:011-621-1000 FAX:011-621-1500</td>
    <td class="yes">Yes</td>
    <td class="yes">Yes</td>
    <td class="yes">Yes</td>
    <td class="yes">Yes</td>
  </tr>

であれば7番目のtdの中身

Yes

が入るということになります。

この指定の仕方を変えると、ほしい値が入るようになります。

filename: test5.pl

#!/usr/bin/perl
 
use strict;
use warnings;
use utf8;
use Web::Scraper;
use YAML::Syck;
use Encode;
 
open my $fh, '<', 'printshop.html';
my $html = decode_utf8(do { local $/; <$fh> });
close $fh;
 
my $s = scraper {
  process '//div[@class="tabcontent"][1]//table[@class="data-bordered max"]/tbody/tr', 'codes[]' => scraper {
    process '//td[1]', pref    => 'TEXT';
    process '//td[2]', company => 'TEXT';
    process '//td[3]', address => 'TEXT';
    process '//td[4]', illustratorcs4 =>
      [ 'TEXT', sub { return $_ =~m/yes/i ? 1 : undef; } ];
    process '//td[5]', indesigncs4    =>
      [ 'TEXT', sub { return $_ =~m/yes/i ? 1 : undef; } ];
    process '//td[6]', pdfx1a         =>
      [ 'TEXT', sub { return $_ =~m/yes/i ? 1 : undef; } ];
    process '//td[7]', pdfx4          =>
      [ 'TEXT', sub { return $_ =~m/yes/i ? 1 : undef; } ];
  };
};
 
my $scraped = $s->scrape($html);
print Dump($scraped);
 
exit;
 
__END__

フィルタ機能というのを使って、取得してきた値を無名関数を使って変えてあげることができます。

実行結果はこんな感じ。

---
codes:
  -
    address: 北海道札幌市西区二十四軒2条6丁目1番8号 TEL:011-621-1000 FAX:011-621
-1500
    company: 株式会社 須田製版
    illustratorcs4: 1
    indesigncs4: 1
    pdfx1a: 1
    pdfx4: 1
    pref: 北海道
  -
    address: 北海道札幌市北区北8条西8丁目TEL:011-747-8886 FAX:011-756-7971
    company: 北海道大学生活協同組合印刷 情報サービス部
    illustratorcs4: 1
    indesigncs4: 1
    pdfx1a: 1
    pdfx4: ~
    pref: 北海道
  -
  ...
  -
    address: 大分県大分市碩田町2-2-13TEL:097-536-4111 FAX:097-538-1149
    company: 株式会社 双林社
    illustratorcs4: 1
    indesigncs4: 1
    pdfx1a: 1
    pdfx4: ~
    pref: 大分県

undefが入っているところはこのDumpでは~で表現されています。これで、'Yes'ばかりでうざかったのがすっきりしました！

おまけ。

さっきまでこんなコードになっていた。

filename: test6.pl

#!/usr/bin/perl
 
use strict;
use warnings;
use utf8;
use Web::Scraper;
use YAML::Syck;
use Encode;
 
open my $fh, '<', 'printshop.html';
my $html = decode_utf8(do { local $/; <$fh> });
close $fh;
 
my $s = scraper {
  process '//div[@class="tabcontent"][1]//table[@class="data-bordered max"]/tbody/tr', 'codes[]' => scraper {
    process '//td[1]', pref    => 'TEXT';
    process '//td[2]', company => 'TEXT';
    process '//td[3]', address => 'TEXT';
    process '//td[4]', illustratorcs4 =>
      sub { return $_->as_text =~ m/yes/i ? 1 : undef; };
    process '//td[5]', indesigncs4    =>
      sub { return $_->as_text =~ m/yes/i ? 1 : undef; };
    process '//td[6]', pdfx1a         =>
      sub { return $_->as_text =~ m/yes/i ? 1 : undef; };
    process '//td[7]', pdfx4          =>
      sub { return $_->as_text =~ m/yes/i ? 1 : undef; };
  };
};
 
my $scraped = $s->scrape($html);
print Dump($scraped);
 
exit;
 
__END__

この書き方をした場合、無名関数の中の$_に入っているのは、HTML::Elementのオブジェクトなんで、$_->as_textという書き方ができる。ふつうは、最初に出したコードのほうがわかりやすいですよね。

さて、次回は、この要領で、addressの中身に住所と電話番号とFAX番号が混ざっているのを何とかしたいと思います。これをちゃんと住所のみにしないと、ジオコーディングAPIに問い合わせできないので重要です。

2009.11.24 午前 12:14 [Perl] | 固定リンク | コメント (2) | トラックバック (0) |

2009.11.23

Adobe Creative Suite 出力対応店一覧をGoogle Mapsで表示させる(6)

アドビのCS4対応プリントショップのリストのページから、Google Mapsに表示させるやつの6回目。

前回は、いよいよHTMLからデータの取得（スクレイピング）を行おうと思ったわけですが、これから試行錯誤するわけですし、そのたびにアドビのサイトにアクセスしたら迷惑かかりそうなので、必要なHTMLをローカルに落としておこう、ということで、wgetコマンドを使ってローカルに落としておく、というところをやりました。

さて、今回はいよいよPerlのWeb::Scraperを使って、アドビのプリントショップのHTMLからスクレイピングするところをやります。

まず、データの構造を見ます。前回落としたprintshop.htmlをテキストエディタなどで見てみます。

抜き出したいデータは、tableタグを使って以下のような構造になっています。

<div class="dyn-tabsection" id="showMyTab">
  <h2 class="tabtitle" id="tabid1">CS4 の出力対応店</h2>
  <div class="tabcontent">
    <dl class="dyn-treelist">
      <dt><a>北海道地方</a></dt>
      <dd><table class="data-bordered max">
        <thead class="data-sectionHead">
          <tr>
            <th rowspan="2" style="width: 10%;">都道府県</th>
            <th rowspan="2" style="width: 25%;">社名／支店名／事業所名</th>
            <th rowspan="2" style="width: 33%;">住所/電話番号/ファックス番号</th>
            <th colspan="4" style="width: 8%;">入稿対応</th>
          </tr>
          <tr>
            <th style="width: 8%;">Illustrator<br />
              CS 4</th>
            <th style="width: 8%;">InDesign<br />
              CS 4</th>
            <th style="width: 8%;">PDF/X-1a</th>
            <th style="width: 8%;">PDF/X-4</th>
          </tr>
        </thead>
        <tbody>
          <tr>
            <td>北海道</td>
            <td><a href="http://www.suda.co.jp/" target="_blank">株式会社 須田製版</a></td>
            <td>北海道札幌市西区二十四軒2条6丁目1番8号<br />
              TEL:011-621-1000&nbsp;FAX:011-621-1500</td>
            <td class="yes">Yes</td>
            <td class="yes">Yes</td>
            <td class="yes">Yes</td>
            <td class="yes">Yes</td>
          </tr>
          <tr>
          ...
          <tr>
            <td>大分県</td>
            <td><a href="http://www.coara.or.jp/~sorinsha/" target="_blank">株式会社 双林社</a></td>
            <td>大分県大分市碩田町2-2-13<br />TEL:097-536-4111&nbsp;FAX:097-538-1149</td>
            <td class="yes">Yes</td>
            <td class="yes">Yes</td>
            <td class="yes">Yes</td>
            <td> </td>
          </tr>
        </tbody>
      </table>
    </dd>
    <!--<dt><a>沖縄地方</a></dt>
    <dd>***</dd>-->
  </dl>
</div>

つまりtable構造をそのまま引っ張ってくるような指示をすればいいということでこんな感じに書きます。

filename: test4.pl

#!/usr/bin/perl
 
use strict;
use warnings;
use utf8;
use Web::Scraper;
use YAML::Syck;
use Encode;
 
open my $fh, '<', 'printshop.html';
my $html = decode_utf8(do { local $/; <$fh> });
close $fh;
 
my $s = scraper {
    process '//div[@class="tabcontent"][1]//table[@class="data-bordered max"]/tbody/tr', 'codes[]' => scraper {
        process '//td[1]', pref    => 'TEXT';
        process '//td[2]', company => 'TEXT';
        process '//td[3]', address => 'TEXT';
        process '//td[4]', illustratorcs4 => 'TEXT';
        process '//td[5]', indesigncs4    => 'TEXT';
        process '//td[6]', pdfx1a  => 'TEXT';
        process '//td[7]', pdfx4   => 'TEXT';
    };
};
 
my $scraped = $s->scrape($html);
print Dump($scraped);
 
exit;
__END__

scraperの中の1行目の取得したいtableの指定が特殊な気がしますが何となくわかるかと思います。あと、scraperが多段になっているのが理解しにくいと思うんで、tableを処理したいときはこの構文になると思ってぱくっておくといいと思います。

実行結果：

---
codes:
  -
    address: 北海道札幌市西区二十四軒2条6丁目1番8号 TEL:011-621-1000 FAX:011-621-1500
    company: 株式会社 須田製版
    illustratorcs4: 'Yes'
    indesigncs4: 'Yes'
    pdfx1a: 'Yes'
    pdfx4: 'Yes'
    pref: 北海道
  -
    address: 北海道札幌市北区北8条西8丁目TEL:011-747-8886 FAX:011-756-7971
    company: 北海道大学生活協同組合印刷 情報サービス部
    illustratorcs4: 'Yes'
    indesigncs4: 'Yes'
    pdfx1a: 'Yes'
    pdfx4:  
    pref: 北海道
  -
  ...
  -
    address: 大分県大分市碩田町2-2-13TEL:097-536-4111 FAX:097-538-1149
    company: 株式会社 双林社
    illustratorcs4: 'Yes'
    indesigncs4: 'Yes'
    pdfx1a: 'Yes'
    pdfx4: ''
    pref: 大分県
$

こんな感じです。addressっつー所に住所と電話番号とFAX番号が混ざっているのと、pdfx1aとかいうところにいちいち'Yes'とか入っているのが気になりますが、なんとかデータが取り込めました。

次回は、いちいち'Yes'とウザいのを何とかしましょう。

2009.11.23 午前 12:00 [Perl] | 固定リンク | コメント (2) | トラックバック (0) |

2009.11.21

Adobe Creative Suite 出力対応店一覧をGoogle Mapsで表示させる(5)

アドビのCS4対応プリントショップのリストのページから、Google Mapsに表示させるやつの5回目。

前回は、アドビのサイトではHTTPレスポンスヘッダではHTMLコンテンツの変更がわからないので、しょうがないので毎回取得して取得できたデータの長さが前回と違っていたら更新とみなす、という乱暴な方法でコンテンツの更新を察知する、というところまでやりました。

さて、今回はちょっと別のことをやります。HTMLの構造を指定して、データを扱いやすいように抜き出すスクレイピングです。

まず、スクレイピングをやる前に、アドビのサイトに迷惑をかけないように、事前にローカルファイルとして取得しておきましょう。あー最初に言っておいたんですけれどもLinuxなんで、大抵wgetコマンド入っているという前提でやっとります。

$ wget http://www.adobe.com/jp/print/printshop/ -O printshop.html

としますと、コマンドラインで指定したURLで示されたデータを保存することができます。Mac OS Xで言うところのcurlコマンドですね。

さて、これをすることによって、カレントディレクトリにターゲットとするHTMLファイルが保存されたことになります。これで、アドビさんに迷惑かけずにいろいろ試すことができるようになったというわけです。

余談ですが、wgetコマンドは便利で、ホストにSSHでログインできるようにしてあれば、外出先からでも巨大ファイルのダウンロードをwgetにさせることができます。回線が切れてもwgetが動き続けるように、nohupやscreenを併用するのがいいと思います。よくISOイメージ（Linuxとかの）のダウンロードに使います。

次回は、ローカルファイルに落としたHTMLファイルをスクレイピングして、Perlで扱いやすいデータ構造に変換するところをやる予定です。今回手抜き気味なのはこれから飲み屋に行くからです。飲み屋遠いのでしこたま歩かなくてはならん……

2009.11.21 午後 05:32 [Perl] | 固定リンク | コメント (0) | トラックバック (0) |