OPMLを食わせると、含まれているはてなIDを検出して、「はてなグループ」に問い合わせ、ウォッチしているIDのまだ購読していないグループ日記をOPMLにして出力するスクリプト書いた。

CGIで

<input type="file" name="opml">

からアップロードするか、端末から標準入力に食わせるかで動くと思う。流行りのWeb::Scraper使ってみた*1。

はてなグループには5秒ごとにループでデータを取りに行ってるけどみんなでインターバルを短くしてみんなBanされてみるのも一興。

デモサイトも作ってみましたが、怒られちゃったら止めます。
やる気が足りず、404に引っかかってしまうと途中で止まってしまいます。ごめんなさい。

#!/usr/bin/env perl

use strict;
use warnings;

use URI;
use XML::OPML;
use CGI;
use Web::Scraper;
use List::MoreUtils qw/uniq part/;
use HTTP::Date;


use vars qw/$i $url $scraper $opml_content $buffer $result
	    @urls @ids @first_result @final_result/;

my $fh = new CGI->upload('opml');
if(defined $fh){
  while(read($fh, $buffer, 1024)){
    $opml_content .= $buffer;
  }
  print "Content-Type: application/octet-stream\n\n";
}
else {
  $opml_content = join '', <ARGV>;
}

my $opml = new XML::OPML(version => "1.0");
$opml->parse($opml_content);
my $owner = $opml->{'head'}->{'ownerName'};

for(values %{$opml->{outline}->[0]}){
  if(ref $_ eq "HASH" and exists $_->{htmlUrl}){
    push @urls, $_->{htmlUrl};
  }
  elsif(ref $_ eq "HASH") {
    for(values %$_){
      if(ref $_ eq "HASH" and exists $_->{htmlUrl}){
	push @urls, $_->{htmlUrl};
      }
    }
  }
}

@ids = uniq map {
  m{http://[^/]+\.hatena\.ne\.jp/([^/]+)/};
  
} @urls;

#@first_result = map { qq{http://d.hatena.ne.jp/$_/}; } @ids;
# uncomment to detect d:id:username

for(@ids){
  $i = 0;
  $url = URI->new(qq{http://g.hatena.ne.jp/$_/});
  $result = scraper {
    process 'div.day div.body table tr td a', 'group[]'=>'@href';
    result qw/group/
  }->scrape($url);
  if(defined $result){
    @first_result = (@first_result, @{(part { $i++ % 2 } @$result)[1]});
  }
  sleep 5;
}

@final_result = grep {
  my $match = 1;
  for my $u (@urls){
    if ($_ eq $u){
      $match = 0;
    }
  }
  $match;
} @first_result;

my $opml_out = XML::OPML->new(version=>"1.1");

$opml_out->head(
		title => 'groupSubscription',
		dateCreated => time2str(time),
		dateModified => time2str(time),
		ownerName => $owner,
	       );

for(@final_result){
  $opml_out->add_outline(
			 type => 'rss',
			 title => $_,
			 htmlUrl => $_,
			 xmlUrl => $_ . 'rss',
			);
}
print $opml_out->as_string;

 %{$opml->{outline}->[0]}

の[0]あたりがいかにもバギーな匂いを発しているけど眠いから気にしない。

*1:XPathをろくに知らずに初めて書いて恥ずかしい部分があるけど気にしないで