2003-10-12

ファイルから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番目のコードは考える必要なかった・・・。