ファイルからURLを抽出し、そのURLからPing送信先を探してみる

自動TrackBackスクリプトのためのサブルーチンを2つ書いてみました。

引数に渡されたファイルから、URLを抽出するサブルーチン。HTML::LinkExtorってすごいな。

sub extract_urls {
	my $entry_path = $_[0];
	my @urls;

	my $p = HTML::LinkExtor->new(\&callback);
	sub callback {
		my($tag, %attr) = @_;
		if ($tag eq 'a' and ($attr{'href'} =~ m!^http://!)) {
			push(@urls, $attr{'href'});
		}
	}
	$p->parse_file($entry_path);

	return @urls;
}

引数に渡されたURLから、Ping送信先URLを探すサブルーチン。Ping送信先URLを見つけると、Ping送信先URLと1が返ってきます。

sub extract_ping_url {
	my $url = $_[0];
	my $flag = 0;

	my $ua = LWP::UserAgent->new(
		agent => "TrackBack/1.1",
		timeout => 15,
		parse_head => 0,
	);
	my $req = HTTP::Request->new(GET => $url);
	my $res = $ua->request($req);
	if ($res->is_success) {
		my $content = $res->content;
		$url =~ s/#.*$//;
		while ($content =~ m!(<rdf:RDF.*?</rdf:RDF>)!sg) {
			my $rdf = $1;
			my($perm_url) = $rdf =~ m!dc:identifier="([^"]+)"!;
			if ($perm_url eq $url) {
				if ($rdf =~ m!trackback:ping="([^"]+)"!) {
					$url = $1;
					$flag = 1;
				}
				elsif ($rdf =~ m!about="([^"]+)"!) {
					$url = $1;
					$flag = 1;
				}
			}
		}
	}

	return($url, $flag);
}

ネスト深すぎですよ。

とりあえず、自動的にTrackBack Pingを送るスクリプトはほとんど完成したので、実験をどうやってやろうかと考え中。自分のblogのエントリでやるべきだな(当たり前)。

うげ。Net::TrackBackモジュールにTrackBack ping URL auto discoveryの機能あったよ!2番目のコードは考える必要なかった・・・。