古い記事
ランダムジャンプ
新しい記事
今回の YahooHacks は「アンカーテキストの収集」です。

とはいえ、文字コードにはまったー!
「./hack_anchor.pl http://www.yahoo.co.jp/」を実行すると、「UTF-16LE:Malformed LO surrogate dab3 at /usr/lib/perl/...」などと怒られて落ちるのですが(環境によって異なるみたい…)、これを skip するにはどうしたら良いのでしょうか?
とりあえず、decode のところを eval してみました…。

使用している Web API の提供が終了となったため、現在動作しません。ご了承ください。



■■■あるページへのリンクのアンカーテキストを収集する

同じページを指すハイパーリンクのアンカーテキストにはいろいろと
バリエーションがあります。
例えば、 http://www.yahoo.co.jp/ に対するアンカーテキストは
「ヤフー」「Yahoo!」「Yahoo! JAPAN」「18歳未満」(!)など多種多様です。

ということで、指定した URL へのリンクのアンカーテキストを収集する
ハックです。

クエリー構文「link:」を使います。「link:http://example.com/」で
検索すると、http://example.com/ へのハイパーリンクを持つページが
検索結果として表示されます。

■コード

Yahoo! API 経由で、
指定した URL へのリンクがあるページの URL を取得します。
そして、それぞれのページをクロールし、アンカーテキストを
簡単なパターンマッチングで収集します。

#!/usr/bin/perl
use strict;
use warnings;
use Encode;
use Encode::Guess qw/ euc-jp shiftjis 7bit-jis /;
binmode STDOUT, ":utf8";
use LWP::Simple;
use XML::Simple;

my $t = shift @ARGV;
(my $ec = $t) =~ s/([^0-9A-Za-z_])/'%'.unpack('H2',$1)/ge;

my $url = "http://search.yahooapis.jp/WebSearchService/V1/"
    ."webSearch?appid=YahooDemo&query=link:$ec";
my $results = get_results($url);

my %anchor;
foreach my $page (@$results) {
    my $str = get($page->{Url});
    eval {$str = decode('Guess', $str)};
    next if ($@);
    while ($str =~ m!<\s*a\s[^>]*?href=["']$t['"][^>]*?>
           (.+?)
           <\s*/\s*a\s*>!gsmix) {
        $anchor{$1}++;
    }
}

foreach my $anchor_text (sort {$anchor{$b} <=> $anchor{$a}} keys %anchor) {
    print "$anchor_text:$anchor{$anchor_text}\n";
}

sub get_results {
    my ($url) = @_;
    my $yahoo_response = get($url);
    my $xmlsimple = XML::Simple->new(ForceArray => [ 'Result' ]);
    my $yahoo_xml = $xmlsimple->XMLin($yahoo_response);
    return $yahoo_xml->{Result};
}

■Hack の実行

% ./hack_anchor.pl http://nais.to/~yto/
たつをのホームページ:4
たつを:3
たつをさん:2
山下 達雄:2
山下達雄:2
山下達雄さん:1
とある先輩:1

■Hack をさらに Hack する

同じサイト内のページからのリンクのアンカーテキストは、
「トップ」「前」「ホーム」など面白みがないので、
始めからサイト外のページのみを対象にするのも良いでしょう。
例えば、 yahoo からのリンクを除外するときには「-inurl:yahoo」等、
クエリー構文「inurl:」の否定(-)を使うと便利です。



参考ページ:
- Yahoo!デベロッパーネットワーク (YDN)
  http://developer.yahoo.co.jp/

関連書籍:
Yahoo! Hacks
まるごとPerl! Vol.1

追記070908: 「UTF-16LE:Malformed...」問題の解決策!なるほど感謝。
- UTF-16LE:Malformed LO surrogate を避ける - 徒書
  http://www.akatsukinishisu.net/itazuragaki/perl/malformed_lo_surrogate.html
$Encode::Guess::NoUTFAutoGuess = 1;
Encode::Guess->set_suspects( qw(euc-jp shiftjis 7bit-jis utf8) );