SPIDERING HACKS(#18)

#18は、スクリプトにプログレスバーを追加してみよう♪
ってお話ね。
原理は、LWP::UserAgentのオブジェクトを作ったのちに
getやらpostする時に、:content_cbヘッダに関数を指定することで
ある一定サイズのダウンロードが行われるたびに上記:content_cbに
指定した関数が呼び出されるを利用して、ダウンロードの進捗を表す
プログレスバーを作ろうってこった。

ちなみに、一定サイズのダウンロードごとに関数が呼び出されるわけだが
:content_cbヘッダと共に:read_size_hintというヘッダに、どのくらいの
ダウンロードサイズごとに関数を呼び出すか参考までに指定することが
できるそうな。
（指定したから、必ずそのサイズごとに呼ばれるわけではないらしい）


もっとも原始的な物はこんな感じになる。

#!/usr/bin/perl#!
use strict;
use warnings;
use LWP;
$|++;

die "[error]URLを指定して下さい。\n" unless @ARGV;
my $final_data; #受信データを格納する変数
for my $url (@ARGV){
$final_data = '';
print "URL", substr($url, 0, 40), "のダウンロード中...";
my $ua  = LWP::UserAgent->new();
my $res = $ua->get($url, ':content_cb'=>\&callback);
print "\n";
}

sub callback{
my ($data, $response, $protocol) = @_;
$final_data .= $data;
print ".";
}

ポイントは、
5行目で特殊変数$|に０以外の数値を指定してバッファリングしないようにしている点
13行目で:content_cbをセットしている点かな。

他の物については、後でおいおい追加してメモ書きしておくかな。。

SPIDERING HACKS(#14)

#14は、相対URLを絶対URLに直しちゃうってお話ですね。
どうやら、URIモジュールのnew_absってメソッドに
相対URLとBaseURLを渡すと絶対URLを返してくれますよん。
ってことなんだって。

じゃ、BaseURLをどうしてゲットすりゃいいのかって話になると
LWP::UserAgentオブジェクトでgetとかpostした後でbaseメソッドで
取り出せるんですね。

ここいらの話を使ってコードを書いてみるとこんな感じ。

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

#適当に階層の深そうなアドレスを用意してみる。                                             
my $uri = URI->new('http://search.cpan.org/~gaas/URI-1.38/URI.pm');
my $UA  = LWP::UserAgent->new();
my $response = $UA->get($uri);

#下記相対URLを絶対URLに直してみる。                                                     
my @list = qw(./1.html ./../2.html ./../../3.html ./hoge/0.html);

for my $list (@list){
 print URI->new_abs($list, $response->base), "\n";
}

実行してみるとこうなる。

http://search.cpan.org/~gaas/URI-1.38/1.html
http://search.cpan.org/~gaas/2.html
http://search.cpan.org/3.html
http://search.cpan.org/~gaas/URI-1.38/hoge/0.html

なるほろね。
おまけ。
URIモジュールといえば、アドレスを分解するのに
非常に便利いいのでここにのっけておく。。

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

my $u = URI->new('http://www.cpan.org/authors/00whois.html#hogehoge');

print "scheme:", $u->scheme,   "\n";
print "opaque:", $u->opaque,   "\n";
print "path:",   $u->path,     "\n";
print "frag:",   $u->fragment, "\n";
print "host:",   $u->host,     "\n";

実行結果は

scheme:http
opaque://www.cpan.org/authors/00whois.html
path:/authors/00whois.html
frag:hogehoge
host:www.cpan.org

SPIDERING HACKS(#12)

formのメソッドタイプがGetの場合はURIモジュールのquery_formメソッドを
使うと便利よいよって話なので、それを使ってなにか書いてみる。

例）知恵袋にクエリーを送ってヒットした件数を抜き出す。
文字コード:utf8

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use URI;
use LWP;
use Encode qw(decode_utf8 encode_utf8);

my $search_word = decode_utf8(shift);
my $browser = LWP::UserAgent->new();
my $uri = URI->new('http://search.chiebukuro.yahoo.co.jp/search/search.php');
$uri->query_form(
                flg => 3,
                fr  => 'chie-search-t',
                p   => encode_utf8($search_word),
);

my $res = $browser->get($uri);
if(decode_utf8($res->content) =~ m/([\d,]+件)/){
 print encode_utf8($1), "\n";
}else{
 print encode_utf8('Yahoo!知恵袋で、条件に一致する質問はみつかりませんでした。'), "\n";
}

utf8フラグ付きの鉄則は、スクリプトが受け取る時にdecode(もらうデータの文字コード, '文字列');
自分の書いたスクリプトを離れる時（printする場合や、モジュールに渡す場合などなど）に
encode('渡す先の文字コード', '文字列')
とすればよいっと。
あらかじめutf8に変換するってのがわかっている時は
use Encode qw(decode_utf8 encode_utf8);
のようにutf8用の関数を呼び出すとちょいとコードを書くのが楽になったりするわけね。

というわけで中身のメモ。
1行目　シェバン。(perlのありかを指定)
2行目〜7行目　モジュールの呼び出し
9行目　データの受け取りなのでさっそくdecode_utf8してフラグをつける。
　　　※スクリプト実行時の引数がutf8で渡されることを前提としている。
10行目 LWP::UserAgentオブジェクトの生成。
11行目 知恵袋のsearchアドレス
12行目 パラメの組み立て作業。
URIオブジェクトのquery_formメソッドにハッシュで渡せばOK
URIへのエンコードも行ってくれる。
15行目 URIオブジェクトに渡すんでフラグを取る。
知恵袋がUTF8なんでutf8でエンコードする。
18行目 getしてデータを受け取る。contentプロパティにリクエストが格納される。
19行目以下。
データを受け取ったんでdecodeしてフラグをつける。
ヒット件数の部位を正規表現でヒットしたらその件数をprintするか
しなければ、ヒットしなかった趣旨を表示して終了。

formのメソッドがpostの時は下記の感じになる。。
文字コード：utf8

#!/us/bin/perl                                                                                     
use strict;
use warnings;
use utf8;
use LWP;
use Encode qw(decode_utf8 encode_utf8);

my $pref    = decode_utf8(shift);
my $address = decode_utf8(shift);
my %pref = (
 '北海道'=>1,  '青森県'=>2,  '岩手県'=>3,  '宮城県'=>4,  '秋田県'=>5,
 '山形県'=>6,  '福島県'=>7,  '茨城県'=>8,  '栃木県'=>9,  '群馬県'=>10,
 '埼玉県'=>11, '千葉県'=>12, '東京都'=>13, '神奈川県'=>14,'新潟県'=>15,
 '富山県'=>16, '石川県'=>17, '福井県'=>18, '山梨県'=>19, '長野県'=>20,
 '岐阜県'=>21, '静岡県'=>22, '愛知県'=>23, '三重県'=>24, '滋賀県'=>25,
 '京都府'=>26, '大阪府'=>27, '兵庫県'=>28, '奈良県'=>29, '和歌山県'=>30,
 '鳥取県'=>31, '島根県'=>32, '岡山県'=>33, '広島県'=>34, '山口県'=>35,
 '徳島県'=>36, '香川県'=>37, '愛媛県'=>38, '高知県'=>39, '福岡県'=>40,
 '佐賀県'=>41, '長崎県'=>42, '熊本県'=>43, '大分県'=>44, '宮崎県'=>45,
 '鹿児島県'=>46, '沖縄県'=>47,
);

my @error;
push @error, encode_utf8("その都道府県は存在しません!\n") if(!exists $pref{$pref});
push @error, encode_utf8("引数が足りません。都道府県と市区町村名を渡して下さい\n") 
    if(!defined $address);
die print @error, "\n" if(@error);

my $browser = LWP::UserAgent->new();
my $uri = 'http://www.post.japanpost.jp/cgi-zip/zipcode.php';
my $response = $browser->post( $uri,
                               [
                                pref => $pref{$pref},
                                addr => encode_utf8($address),
                               ]
                             );
die "{$uri}エラー:", $response->status_line unless $response->is_success;
print $response->content, "\n";

スクリプト実行時に都道府県名と市区町村・町名を引数に渡せばOK

この項目での肝はgetの時が
LWP::UserAgentを作ったのち
getメソッドなら
$obj->get('URI', %header); #パラメータはURIモジュール等で先に組み立てておく。
postメソッドなら
$obj->post('URI', [key1=>value1, key2=>value2,...], %header);
で取得が可能というお話ですね。