#!/usr/bin/perl
#
# 任意のキーワード (複数可) を与えると、
# そのキーワードでそれぞれ Google 検索した結果の
# 上位10位のサイトと下位10位のサイトを自動巡回して
# 外部サイトへのリンクの A 要素に
# target 属性がついているか否か等の情報をカウントし報告する
#
# なお、Google API は使わず検索結果の HTML を勝手に解析しているので、
# 将来 Google が出力する HTML フォーマットが変わると
# 正常に使えなくなる可能性がある。
#
# 2005/12/28 作成 (http://pc8.2ch.net/test/read.cgi/hp/1135617734/13-18)
# 2006/01/08 改良 (http://pc8.2ch.net/test/read.cgi/hp/1135617734/671-686)

use strict;
use warnings;
use utf8;
use Encode;
use Encode::Guess qw/cp932 euc-jp 7bit-jis/;
use URI::Escape qw/uri_escape_utf8/;
use LWP::UserAgent;
use HTML::TokeParser;

# デバッグメッセージを表示するか否か
my $DEBUG = 0;

# デバッグメッセージ出力先ファイル
my $DEBUGLOG = 'debug.log';

# 以下の UA に見せかけてアクセスする
my $UA_STRING = 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; InfoPath.1; .NET CLR 2.0.50727)';

# 端末の文字コード
my $ENCODING = 'cp932';

binmode STDIN, ":encoding($ENCODING)";
binmode STDOUT, ":encoding($ENCODING)";
binmode STDERR, ":encoding($ENCODING)";
foreach (@ARGV) { $_ = decode($ENCODING, $_); }

if ($#ARGV < 0) {
	print "キーワードを指定汁 (複数可)\n";
	exit;
}

my @keywords = @ARGV;

my %counter_tmpl = (
	outerlink_num => 0,
	notarget_num => 0,
	blanktarget_num => 0,
	othertarget_num => 0,
	locallink_num => 0,
	plainlocallink_num => 0,
	absolutelocallink_num => 0,
	otherscheme_num => 0,
	blank0 => 0,
	blank1upper => 0,
	blank50upper => 0,
	blank50lower => 0,
);

my (%alltop10total, %alllast10total) = (%counter_tmpl, %counter_tmpl);

# 与えられたキーワード毎に繰り返す
foreach my $keyword (@keywords) {
	&debugout("$keyword の調査を開始");
	my ($top10total, $last10total) = &googlesearch($keyword);
	&report($keyword, $top10total, $last10total);
	foreach (keys %$top10total) { $alltop10total{$_} += $$top10total{$_}; }
	foreach (keys %$last10total) { $alllast10total{$_} += $$last10total{$_}; }
}

&report2("全ての検索結果 (上位10位) 総合統計", \%alltop10total);
&report2("全ての検索結果 (下位10位) 総合統計", \%alllast10total);

my %alltotal = %counter_tmpl;
foreach (keys %alltotal) { $alltotal{$_} = $alltop10total{$_} + $alllast10total{$_}; }
&report2("全ての検索結果 (上位下位混合) 総合統計", \%alltotal);

exit;

sub googlesearch
{
	my $keyword = shift;
	my $ua = LWP::UserAgent->new;
	$ua->agent($UA_STRING); # LWP な UserAgent のままリクエストすると拒否されちゃう
	my $request_url = 'http://www.google.co.jp/search?hl=ja&lr=lang_ja&ie=utf-8&oe=utf-8&q=' . uri_escape_utf8($keyword);
	my $req = HTTP::Request->new(GET => $request_url);
	my $res = $ua->request($req);
	my ($result, $totalnum, @top10url, @last10url);
	if ($res->is_success) {
		$result = decode('utf8', $res->content);
		while ($result =~ /<a class=l href="([^"]+)/g) {
			push(@top10url, $1);
		}
		$result =~ /約 <b>([\d,]+)<\/b> 件中/;
		my $totalnum = $1;
		$totalnum =~ s/,//g;
		if ($totalnum > 999) { $totalnum = 999 };
		$request_url = 'http://www.google.co.jp/search?hl=ja&lr=lang_ja&ie=utf-8&oe=utf-8&start=' . ($totalnum - 10) . '&q=' . uri_escape_utf8($keyword);
		my $req = HTTP::Request->new(GET => $request_url);
		$res = $ua->request($req);
		if ($res->is_success) {
			$result = decode('utf8', $res->content);
			$result =~ /&start=(\d+)/;
			$request_url = 'http://www.google.co.jp/search?hl=ja&lr=lang_ja&ie=utf-8&oe=utf-8&start=' . $1 . '&q=' . uri_escape_utf8($keyword);
			my $req = HTTP::Request->new(GET => $request_url);
			$res = $ua->request($req);
			if ($res->is_success) {
				$result = decode('utf8', $res->content);
				while ($result =~ /<a class=l href="([^"]+)/g) {
					push(@last10url, $1);
				}
			}
		}
	}
	else {
		die;
	}
	my (%top10total, %last10total) = (%counter_tmpl, %counter_tmpl);
	foreach (@top10url) {
		my %result = &investigative_page($_);
		foreach (keys %result) {
			$top10total{$_} += $result{$_};
		}
	}
	foreach (@last10url) {
		my %result = &investigative_page($_);
		foreach (keys %result) {
			$last10total{$_} += $result{$_};
		}
	}
	return (\%top10total, \%last10total);
}

# 第一引数に与えられた URL の調査を行う
sub investigative_page
{
	my $targeturl = shift;
	my %result = %counter_tmpl;

	&debugout("$targeturl の調査を開始");
	my $ua = LWP::UserAgent->new;
	$ua->agent($UA_STRING);
	$ua->timeout(5);

	my $req = HTTP::Request->new(HEAD => $targeturl);
	my $res = $ua->request($req);
	&debugout("ContentType: " . $res->content_type);
	if ($res->content_type =~ /^text\/html/ or $res->content_type =~ /^application\/xhtml\+xml/) {
		my $req = HTTP::Request->new(GET => $targeturl);
		my $res = $ua->request($req);
		if ($res->is_success) {
			my $guess = Encode::Guess->guess_encoding($res->content);
			$guess = 'utf8' unless defined($guess);
			my $content = encode('utf8', decode($guess, $res->content));
			my $tp = HTML::TokeParser->new(\$content);
			while (my $token = $tp->get_tag("a")) {
				if (length(encode('utf8', $token->[3])) != length(decode('utf8', $token->[3]))) { next; } # HREF に全角が含まれてると次の行が異常終了するため
				my $url = $token->[1]{href};
				$url = '' unless defined($url);
				&debugout("A要素を発見 - HREF属性: $url");
				if ($url && $url =~ /https?:\/\//) { # A の HREF 属性が http://… 又は https://… なら
					my $srchost = $targeturl;
					$srchost =~ s/https?:\/\/([^\/]+).*/$1/;
					my $dsthost = $url;
					$dsthost =~ s/https?:\/\/([^\/]+).*/$1/;
					if ($srchost ne $dsthost) { # さらにリンク元とリンク先のホストが異なるなら
						my $target = $token->[1]{target};
						if ($target) {
							&debugout("TARGET属性: $target");
							if ($target =~ /_blank/i) {
								$result{blanktarget_num}++;
							}
							else {
								$result{othertarget_num}++;
							}
						}
						else {
							$result{notarget_num}++;
						}
					}
					else { # このリンクは絶対 URL だけど内部リンク
						$result{absolutelocallink_num}++;
					}
				}
				elsif ($url =~ /^\w+:/) { # その他のスキームなら
					$result{otherscheme_num}++;
				} else { # それ以外、つまり内部リンク
					$result{plainlocallink_num}++;
				}
			}
			$result{locallink_num} = $result{plainlocallink_num} + $result{absolutelocallink_num};
			$result{outerlink_num} = $result{blanktarget_num} + $result{othertarget_num} + $result{notarget_num};
			if ($result{outerlink_num} > 0) {
				if ($result{blanktarget_num} == 0) { $result{blank0}++; }
				if ($result{blanktarget_num} > 0) { $result{blank1upper}++; }
				if ($result{blanktarget_num} > $result{outerlink_num} / 2) { $result{blank50upper}++; }
				else { $result{blank50lower}++; }
			}
		}
	}
	else {
		&debugout("HTTP GET 失敗");
	}
	return %result;
}

sub report
{
	my ($keyword, $top10total, $last10total) = @_;
	&report2("$keyword での検索結果 (上位10位) のサイトのA要素統計", $top10total);
	&report2("$keyword での検索結果 (下位10位) のサイトのA要素統計", $last10total);
}

sub report2
{
	my ($title, $total) = @_;
	print "■ $title\n";
	print "\n";
	print "外部リンク: $$total{outerlink_num} (" . sprintf('%3.1f', $$total{outerlink_num} ? $$total{outerlink_num} / ($$total{outerlink_num} + $$total{locallink_num} + $$total{otherscheme_num}) * 100 : 0) . "%)\n";
	print "　内訳\n";
	print "　　TARGET なし    : $$total{notarget_num} (" . sprintf('%3.1f', $$total{notarget_num} ? $$total{notarget_num} / $$total{outerlink_num} * 100 : 0) . "%)\n";
	print "　　TARGET=\"_blank\": $$total{blanktarget_num} (" . sprintf('%3.1f', $$total{blanktarget_num} ? $$total{blanktarget_num} / $$total{outerlink_num} * 100 : 0) . "%)\n";
	print "　　TARGET= その他 : $$total{othertarget_num} (" . sprintf('%3.1f', $$total{othertarget_num} ? $$total{othertarget_num} / $$total{outerlink_num} * 100 : 0) . "%)\n";
	print "内部リンク: $$total{locallink_num} (" . sprintf('%3.1f', $$total{locallink_num} ? $$total{locallink_num} / ($$total{outerlink_num} + $$total{locallink_num} + $$total{otherscheme_num}) * 100 : 0) . "%)\n";
	print "　内訳\n";
	print "　　素の内部リンク            : $$total{plainlocallink_num} (" . sprintf('%3.1f', $$total{plainlocallink_num} ? $$total{plainlocallink_num} / $$total{locallink_num} * 100 : 0) . "%)\n";
	print "　　絶対表記だけどホストが同一: $$total{absolutelocallink_num} (" . sprintf('%3.1f', sprintf('%3.1f', $$total{absolutelocallink_num} ? $$total{absolutelocallink_num} / $$total{locallink_num} * 100 : 0)) . "%)\n";
	print "その他のスキーム: $$total{otherscheme_num} (" . sprintf('%3.1f', $$total{otherscheme_num} ? $$total{otherscheme_num} / ($$total{outerlink_num} + $$total{locallink_num} + $$total{otherscheme_num}) * 100 : 0) . "%)\n";
	print "\n";
	print "外部リンクが1以上あるサイトの中で\n";
	print "　_blank 指定量が1以上:   $$total{blank1upper} (" . sprintf('%3.1f', $$total{blank1upper} ? $$total{blank1upper} / ($$total{blank1upper} + $$total{blank0}) * 100 : 0) . "%)\n";
	print "　_blank 指定量が0:       $$total{blank0} (" . sprintf('%3.1f', $$total{blank0} ? $$total{blank0} / ($$total{blank1upper} + $$total{blank0}) * 100 : 0) . "%)\n";
	print "　_blank 指定率が5割以上: $$total{blank50upper} (" . sprintf('%3.1f', $$total{blank50upper} ? $$total{blank50upper} / ($$total{blank50upper} + $$total{blank50lower}) * 100 : 0) . "%)\n";
	print "　_blank 指定率が5割以下: $$total{blank50lower} (" . sprintf('%3.1f', $$total{blank50lower} ? $$total{blank50lower} / ($$total{blank50upper} + $$total{blank50lower}) * 100 : 0) . "%)\n";
	print "\n";
}

sub debugout
{
	if ($DEBUG) {
		open(my $fd, ">>:encoding($ENCODING)", $DEBUGLOG);
		print $fd @_, "\n";
		close($fd);
	}
}