20190507のPerlに関する記事は2件です。

投稿日：2019-05-07T18:41:24+09:00

WWW::MechanizeでHTTPアクセスしてWeb::Scraper

Web::Scraperで生成済みのLWPオブジェクトを使いたい時がある。WWW::Mechanizeオブジェクトならなおいい。例えばログインが必要なサイトをスクレイピングするために、こうやってログインを済ませたWWW::Mechanizeインスタンスを用意した時、これをWeb::Scraperに使わせたい。
use WWW::Mechanize;
my $mech = WWW::Mechanize->new;
my $account = {
    'username' => 'myname',
    'password' => 'mypassword'
});
$mech->get('http://example.com/login'); # ログインページを取得
$mech->submit_form('fields' => $account); # ログイン
思いついた範囲で言えば、きれいな方法が2つとダーティーな方法が1つある。

scrapeメソッドの引数にHTTP::Responseオブジェクトを渡す

scrapeメソッドにはURIの代わりにHTTP::ResponseオブジェクトやHTMLデータなどを渡すことができる。ログイン済みのWWW::MechanizeオブジェクトでHTTPアクセスし、取得したHTTP::Responseオブジェクトを引数に渡してあげれば、要ログインページのコンテンツを解析できる。
use WWW::Mechanize;
use Web::Scraper;

# 前述のWWW::Mechanizeオブジェクト生成とログイン処理
my $mech = WWW::Mechanize->new;
my $account = {
    'username' => 'myname',
    'password' => 'mypassword'
});
$mech->get('http://example.com/login'); # ログインページを取得
$mech->submit_form('fields' => $account); # ログイン

# スクレイパーの生成、コンテンツの取得、解析
my $uri = URI->new('http://example.com/list');
my $scraper = scraper {
    process "a", uris[] => '@href';
};
my $res = $mech->get($uri);
my $list = $scraper->scrape($res);
print join("\n", @{ $list->{'uris'} };
ドキュメントに書かれている方法であり、一番きれいな感じ。またHTML::ResponseオブジェクトやHTML文字列を渡せることを知っておくと、例えば不調時にGETと解析は別個に行い調査したり、他のHTTPクライアントモジュールや外部コマンドでの取得結果を解析するといった応用も利く。

ただし、scrapeメソッドの呼び出し1つで取得と解析が済むスマートさは損なわれる。

scraperオブジェクトにWWW::Mechanizeオブジェクトを渡す

Web::Scraperのuser_agentメソッドを使うと、scraperメソッドで生成したWeb::Scraperオブジェクトで使用するLWP::UserAgent（またはその継承クラス）オブジェクトを設定できる。ログイン処理済みのWWW::Mechanizeオブジェクトを渡しておけば、以降このWeb::Scraperオブジェクトは渡されたWWW::MechanizeオブジェクトでHTTPアクセスする。
use WWW::Mechanize;
use Web::Scraper;

# 前述のWWW::Mechanizeオブジェクト生成とログイン処理
my $mech = WWW::Mechanize->new;
my $account = {
    'username' => 'myname',
    'password' => 'mypassword'
});
$mech->get('http://example.com/login'); # ログインページを取得
$mech->submit_form('fields' => $account); # ログイン

# スクレイパーの生成、UAの設定、スクレイプ
my $uri = URI->new('http://example.com/list');
my $scraper = scraper {
    process "a", uris[] => '@href';
};
$scraper->user_agent($mech);
my $list = $scraper->scrape($res);
print join("\n", @{ $list->{'uris'} };
user_agentメソッドはドキュメントに記述がないのだけど、オブジェクト変数を直接いじるわけでもなく、そこそこきれいな感じ。scrapeメソッドの呼び出し1つで取得と解析が済み、以降繰り返しscrapeしても自動的にこのWWW::Mechanizeオブジェクトが使われてスマートな感じ。

$Web::Scraper::UserAgent変数にWWW::Mechanizeオブジェクトを設定する

Web::Scraperオブジェクトは、user_agentメソッドで設定されたLWP::UserAgentオブジェクトがない場合、クラス変数$Web::Scraper::UserAgentを使用する。これもない場合、新規にLWP::UserAgentオブジェクトを生成して$Web::Scraper::UserAgentに格納し、以降はこれを使用する。ログイン処理済みのWWW::Mechanizeオブジェクトをこのクラス変数に設定しておけば、Web::ScraperはデフォルトでこのWWW::Mechanizeオブジェクトを使用する。
use WWW::Mechanize;
use Web::Scraper;

# 前述のWWW::Mechanizeオブジェクト生成とログイン処理
my $mech = WWW::Mechanize->new;
my $account = {
    'username' => 'myname',
    'password' => 'mypassword'
});
$mech->get('http://example.com/login'); # ログインページを取得
$mech->submit_form('fields' => $account); # ログイン

# デフォルトのUserAgentを設定しておく
$Web::Scraper::UserAgent = $mech;

# スクレイパーの生成、スクレイプ
my $uri = URI->new('http://example.com/list');
my $scraper = scraper {
    process "a", uris[] => '@href';
};
my $list = $scraper->scrape($res);
print join("\n", @{ $list->{'uris'} };
ドキュメント化されていないクラス変数$Web::Scraper::UserAgentを直接変更し、またuser_agentメソッドで設定されたLWP::UserAgentオブジェクトがある場合には無視されることを意識する必要があるなど、すこしダーティーというか力尽くな感じがある。しかし以降はなにも意識することなく、すべてのWeb::Scraperオブジェクトで自動的にこのWWW::Mechanizeオブジェクトが使われて、もっともスマートな感じ。

まとめ

要ログインサイトのスクレイピングなど、解析はWeb::Scraperで行いたいがHTTPアクセスはWWW::Mechanizeで行いたいといった時の方法として、以下の3つを挙げた。

scrapeメソッドの引数にHTTP::Responseオブジェクトを渡す

scraperオブジェクトにWWW::Mechanizeオブジェクトを渡す

$Web::Scraper::UserAgent変数にWWW::Mechanizeオブジェクトを設定する

一番上の方法がもっともきれいで（ドキュメント化されているので）長期間変更されることなく利用できそうな方法だが、一番下の方法がもっとも簡便だと思われる。実際、この調査のきっかけになったスクリプトでは一番下の方法を使った。丁寧さと利便性のバーターの中で使い分けるとよいと思う。

　 Tweet
Qiitaで続きを読む

投稿日：2019-05-07T15:53:00+09:00

Perlで「 `brew install coreutils` しろ」に抗う

Q: これMacで動かないんだけど？
A: brew install coreutilsしろ

みたいな身も蓋もないissueをよく見かける。

PerlならMacにもLinuxにも普段入っているので、これをPerlでなんとかしてみたい。

base64

https://github.com/DataDog/datadog-serverless-functions/pull/68

base64 の-wオプションで末尾の改行を無くしたい。
#!/bin/bash

if [ $(uname) == "Darwin" ]; then
    datecmd=gdate
    base64cmd=gbase64
else
    datecmd=date
    base64cmd=base64
fi
ts=$(($(${datecmd} +%s%N)/100000))

# [...]

tmp_CWLogB64=$(echo ${tmp_CWLogRaw/__timestamp__/$ts} | gzip | ${base64cmd} -w0)
Time::HiResで1秒未満の現在時刻を、base64にはMIME::Base64を使う。
ts=$(perl -MTime::HiRes=time -e 'printf "%.4f\n", time' | tr -d '.')
tmp_CWLogB64=$(echo ${tmp_CWLogRaw/__timestamp__/$ts} | gzip \
    | perl -MMIME::Base64 -0777 -ne 'print encode_base64($_, "");')
cut

https://github.com/bellecp/fast-p/issues/7

BSDの cut に-zオプションが無い。
p () {
    local open
    open=open   # on OSX, "open" opens a pdf in preview
    ag -U -g ".pdf$" \
    | fast-p \
    | fzf --read0 --reverse -e -d $'\t'  \
        --preview-window down:80% --preview '
            v=$(echo {q} | gtr " " "|"); 
            echo -e {1}"\n"{2} | ggrep -E "^|$v" -i --color=always;
        ' \
    | gcut -z -f 1 -d $'\t' | gtr -d '\n' | gxargs -r --null $open > /dev/null 2> /dev/null
}
gプレフィックスのついているものの置き換えをそれぞれ検討する:
p () {
    local open
    open=open   # on OSX, "open" opens a pdf in preview
    ag -U -g ".pdf$" \
    | fast-p \
    | fzf --read0 --reverse -e -d $'\t'  \
        --preview-window down:80% --preview '
            v=$(echo {q} | tr " " "|"); 
            printf "%s\n%s\n" "{1}" "{2}" | egrep "^|$v" -i --color=always;
        ' \
    | perl -0 -l0 -F'\t' -nae 'print $F[0]' | tr -d '\n' | xargs -0 $open > /dev/null 2> /dev/null
}
うーんこれはいまいち分かりづらいかな。

head

head -n -1ができない。
 command -v ghead > /dev/null && HEAD="ghead" || HEAD="head"
...
        SNAPSTOREMOVE="`listsnaps \"${TEMPLATE}\" \"${DATASET}\" | $HEAD -n -1`"
最後の行だけスキップ:
        SNAPSTOREMOVE="`listsnaps \"${TEMPLATE}\" \"${DATASET}\" | perl -nle 'print if !eof'`"
hostname

https://github.com/crr0004/deepracer/issues/11

hostnameの-iオプション。これはもとのコードにも問題ありそう。
export S3_ENDPOINT_URL=http://$(hostname -i):9000
hostname_i=$(perl -MSys::Hostname -MSocket -le '
    $ip = gethostbyname(hostname); print inet_ntoa($ip) if $ip;')
export S3_ENDPOINT_URL="http://${hostname_i}:9000"
readlink

https://github.com/area9innovation/flow9/pull/217

readlinkの-f/-eオプション
if [ `uname` == Darwin ]; then
    READLINK=greadlink
else
    READLINK=readlink
fi

SCRIPT_FN=`$READLINK -f "$0"`
Cwd::realpathを使ってcoreutilsに依存しない可搬性のあるコードにする:
SCRIPT_FN=$(perl -MCwd=realpath -le 'print realpath shift' "$0")
これはすっきり。

realpath

https://github.com/nvm-sh/nvm/pull/2045

realpathがPOSIXに無い。上と違って厄介なのは-m/--canonicalize-missingオプション。
node_path=$(realpath --canonicalize-missing "${2-}")
realpathが出てくるところまでトラバースして残りをディレクトリ扱いに:
node_path=$(perl -MFile::Spec::Functions=catdir,splitdir -MCwd=realpath -le '
    @p = splitdir shift;
    push @s, pop @p while !realpath catdir @p;
    print catdir realpath(catdir @p), @s;
' "${2-}")
sed

https://github.com/RobertsLab/resources/issues/694
  gsed "1iID\t${gene}" ${file}ID_CpG > ${file}ID_CpG_labelled
ファイルにヘッダをつけようとしたもの。BSDのsedにiコマンドがないので失敗してるパターン。
エスケープが甘いのでそれも考慮する。
  perl -plse 'print "ID\t$gene" if $. == 1;' -- -gene="$gene" "${file}ID_CpG" > "${file}ID_CpG_labelled"
でもこんなことをするぐらいなら普通にcatしたほうがいいと思うけど。
( printf "ID\t%s\n" "$gene"; cat "${file}ID_CpG"; ) > "${file}ID_CpG_labelled"
sha512sum

https://github.com/openzipkin-contrib/apache-release-verification/issues/5
@check("SHA512 checksum is correct")
    def check_sha512(state: State) -> R:
    return _check_sh(f"sha512sum -c {state.sha512_path}", workdir=state.release_dir)
COREモジュールの Digest::SHA が shasum コマンドを同梱しているので単純に置き換える:

https://perldoc.perl.org/shasum.html
@check("SHA512 checksum is correct")
    def check_sha512(state: State) -> R:
    return _check_sh(f"shasum -c {state.sha512_path}", workdir=state.release_dir)
shuf

https://github.com/ngerakines/commitment/issues/192

ファイルからランダムに1行だけピックしたい。
shuf -n 1 commit_messages.txt
これはperlfaq5にある通りですね。
perl -e 'srand; rand($.) < 1 && ($line = $_) while <>; print $line;' commit_messages.txt
1行だけじゃなくて複数行(N=5)とかになると若干面倒:
perl -e '
    $N = 5;
    srand;
    while (<>) {
        if ($. <= $N) { push @l, $_; next; }
        $r = rand $.; if ($r < $N) { $l[$r] = $_; }
    }
    print @l;
' commit_messages.txt
stat

https://github.com/trezor/trezor-firmware/issues/9

stat の-cオプションが無いとのこと。lsで代替するパッチが入ってるけど、lsも環境異存だし。
docker run -it -v $(pwd):/src:z --user="$(stat -c "%u:%g" .)" "$IMAGE" \
  /src/script/fullbuild "$BOOTLOADER_COMMIT" "$FIRMWARE_COMMIT"
これを直接perlでやるとこんな感じ
docker run -it -v "$(pwd):/src:z" \
  --user="$(perl -le 'print join ":", (stat(shift))[4..5]' .)" "$IMAGE" \
  /src/script/fullbuild "$BOOTLOADER_COMMIT" "$FIRMWARE_COMMIT"
もしくは File::stat:
UID_GID=$(perl -MFile::stat=:FIELDS -le \
  'stat shift; print join "$st_uid:$st_gid";' .)

docker run -it -v "$(pwd):/src:z" --user="$UID_GID" "$IMAGE" \
  /src/script/fullbuild "$BOOTLOADER_COMMIT" "$FIRMWARE_COMMIT"
timeout

https://github.com/OCamlPro/techelson/issues/9
timeout 2 $fmt_running_cmd &> /dev/null
ちょうどいいのがSOにあった
perl -e 'alarm shift; exec @ARGV' 2 $fmt_running_cmd &> /dev/null
他にもありそう。

　 Tweet
Qiitaで続きを読む

20190507のPerlに関する記事は2件です。

WWW::MechanizeでHTTPアクセスしてWeb::Scraper

scrapeメソッドの引数にHTTP::Responseオブジェクトを渡す

scraperオブジェクトにWWW::Mechanizeオブジェクトを渡す

$Web::Scraper::UserAgent変数にWWW::Mechanizeオブジェクトを設定する

まとめ

Perlで「 `brew install coreutils` しろ」に抗う

base64

cut

head

hostname

readlink

realpath

sed

sha512sum

shuf

stat

timeout

日付別

タグ一覧