吉沢明歩かわいい

吉沢明歩動画リンク集があったので、スクリプト書いて大量に動画を頂きました。それだけ。
http://fc23.blog63.fc2.com/blog-entry-813.html

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

use File::Basename;
use LWP::UserAgent;
use Perl6::Say;
use URI;
use Web::Scraper;

my $ua_pornhost = LWP::UserAgent->new( keepalive => 1 );
my $ua_sony = LWP::UserAgent->new( keepalive => 1 );

my $scraper_list = scraper {
    process '//a[contains(@href,"http://www.pornhost.com")]', 'urls[]' => sub {
        my $uri_pornhost_html = $_->{href};
        say $uri_pornhost_html;

        my $uri_sony = 'http://www.sonyyoutube.com/?v=' . $uri_pornhost_html;
        say '-> ' . $uri_sony;

        my $scraper_sony = scraper {
            process 'id("m")/a', url => '@href';
        };
        $scraper_sony->user_agent($ua_sony);
        my $result = $scraper_sony->scrape(URI->new($uri_sony));
        my $uri_pornhost_wmv = $result->{url};
        say '-> ' . $uri_pornhost_wmv;

        my $file = basename($uri_pornhost_wmv);
        $ua_pornhost->get($uri_pornhost_wmv, ':content_file' => $file);
        $file;
    };
};

my $uri_list = 'http://fc23.blog63.fc2.com/blog-entry-813.html';
$scraper_list->scrape(URI->new($uri_list));

バグ？

あとで調べる、きっと。Windows Vista + Strawberry Perl な環境。

D:\temp>cat zzz.pl
use ExtUtils::MakeMaker;
WriteMakefile(
    'NAME' => 'Foo::Bar'
);

D:\temp>perl zzz.pl
Writing Makefile for Foo::Bar

D:\temp>grep -n @ARGV Makefile
210:ECHO = $(ABSPERLRUN) -l -e "print qq{{@ARGV}" --
211:ECHO_N = $(ABSPERLRUN)  -e "print qq{{@ARGV}" --
214:MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e "install({{@ARGV}, '$(VERBINST)', 0, '$(UNINST)');" --
787:    $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e "pm_to_blib({{@ARGV}, '$(INST_LIB)\auto', '$(PM_FILTER)')" -- \

D:\temp>

とりあえず、{{@ARGV} を {@ARGV} にすれば動く。

Geography::JapaneseMunicipals

Geography::JapanesePrefecturesの市区町村版みたいなGeography::JapaneseMunicipalsを作った。
近々、CPANにうｐしようかと。

use strict;
use warnings;
use utf8;

use FindBin::libs;
use Geography::JapaneseMunicipals;
use YAML;

binmode STDOUT, ':encoding(sjis)';

my $name = '東京都渋谷区';
my $id = Geography::JapaneseMunicipals->municipal_id($name);
print "$name -> $id\n";
# 東京都渋谷区 -> 13113

$id = '01202';
$name = Geography::JapaneseMunicipals->municipal_name($id);
print "$id -> $name\n";
# 01202 -> 函館市

my $municipals = Geography::JapaneseMunicipals->municipal_infos('東京都');
print Dump $municipals;
# ---
# - id: 13101
#   name: 千代田区
#   prefecture:
#     id: 13
#     name: 東京都
#   region:
#     name: 関東
# 
# ...
# 
# - id: 13421
#   name: 小笠原村
#   prefecture:
#     id: 13
#     name: 東京都
#   region:
#     name: 関東

WWW::Mechanize::Plugin::Web::Scraper

文字ばっけー対策パッチ（数文字だけど…）送ったら速攻採用してくれてうれしかった。
中学生レベルの英語を間違えたのに気づいて恥ずかしかった。
WWW-Mechanize-Plugin-Web-Scraper-0.02 - Scrape the planet! - metacpan.org

WWW::PASMO

http://www.pasmo.co.jp/useful/mypage.htmlをスクレイピングするモジュールWWW::PASMOを作ってとりあえずコミッた。

use strict;
use warnings;

use WWW::PASMO;
use YAML;

my $pasmo = WWW::PASMO->new;
die "faild to login"
    unless $pasmo->login('your id', 'your pswd');

print Dump $pasmo->history();

[h@lily]% perl pasmo.pl     
---
histories:
  - balance: 330
    date: 02/01
    info1:
      kind: 入
      station: 旗の台
    info2:
      kind: 出
      station: 自由が丘
  - balance: 480
    date: 01/31
    info1:
      kind: 入
      station: 東急五反
    info2:
      kind: 出
      station: 旗の台
...
  - balance: 1230
    date: 01/27
    info1:
      kind: ｶｰﾄﾞ
      station: 富士見台
    info2:
      kind: ''
      station: ''
...
  - balance: 1070
    date: 01/25
    info1:
      kind: 現金
      station: 富士見台
    info2:
      kind: ''
      station: ''
[h@lily]% 

東急五反って…。駅名からジオコーディングしてあれこれしたかったのだけどな。

WWW::YourAVHost

ノーコメントで。

# yah.pl
use utf8;
use WWW::YourAVHost;

my $av = WWW::YourAVHost->new;
my $entries = $av->entries(actress => 'みひろ');
foreach my $entry (@{$entries}) {
    $av->get($entry);
}

% yah.pl 
% ls -R
(略)
./みひろ:
1600mihiro_part001.flv  620mihiro_01.flv  AD041_01.flv         mihiro_0719_001.flv
219410_25.flv           66289_1.flv       mihiro060217_01.flv  purin080709_51.flv
(略)

Net::Twitter::Scraper

http://coderepos.org/share/browser/lang/perl/Net-Twitter-Scraper
ぜんぜんできてないけどコミッた。他力なんとかってやつです。
Twitter API を使わずにスクレイピングだけで Net::Twitter とそれなりに互換の機能＋αを実装しようかと。
今ならみんな大好き Web::Scraper のコード書き放題だよ。

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

use YAML;
use Net::Twitter::Scraper;

my $tw = Net::Twitter::Scraper->new(
  username => 'xxxxxx',
  password => 'xxxxxx'
);

my $res = $tw->archive();
binmode STDOUT, ':utf8';
print Dump $res;

[hetappi@lily]% ./nts.pl 
---
- created_at: Sun Jun 22 12:11:26 +0000 2008
  id: 840881247
  source: "<a href=\"http://d.hatena.ne.jp/Kiri_Feather/20071121\">Tween</a>\n"
  text: きたー
- created_at: Sun Jun 22 11:53:09 +0000 2008
  id: 840873716
  source: "<a href=\"http://d.hatena.ne.jp/Kiri_Feather/20071121\">Tween</a>\n"
  text: みりんが切れているという信じたくない状況
...