はてなアンテナリーダー

こんなスクリプトを作ってみた。

これは何か?
はてなアンテナの設定をバックアップする。
詳細
はてなアンテナには、lirs形式、RSS形式などでアンテナデータをエクスポートする機能があるが、グループや更新チェック範囲などは保存されない。このスクリプトではアンテナの編集画面で編集できるものはすべて出力する。
#! /usr/bin/perl

use strict;

use URI::URL;
#use Net::SSLeay;
use HTTP::Request::Common qw(GET POST);
use HTTP::Cookies;
use LWP::UserAgent;
#use LWP::Debug qw(+);
use HTML::TokeParser;
use Jcode;

my $hatena_url='http://a.hatena.ne.jp';
my $hatena_regist_url='https://www.hatena.ne.jp/sslregister';
my $user='nozom'; # Your name
my $pass='';

sub login {
  my $ua=shift @_;

  if ($pass eq '') {
    print STDERR "Enter password: ";
    $pass=<STDIN>;
    chomp $pass;
  }

  my %post=(
    mode=>'login',
    key=>$user,
    password=>$pass,
  );

  my $req=POST($hatena_regist_url, [%post]);
  my $res=$ua->request($req);
  $res->is_success or
    die "Failed: " . $res->status_line;
}

sub extract_pages {
  my $content=shift @_;
  my $p=new HTML::TokeParser($content);

  my %pages=(0=>1);
  my $state=0;
  while (my $token=$p->get_token) {
    if ($state==0) {
      next if $token->[0] ne 'S' ||
              $token->[1] ne 'p' ||
              $token->[2]->{'class'} ne 'pager';
      $state++;
    } elsif ($state==1) {
      last if $token->[0] eq 'E' &&
              $token->[1] eq 'p';
      if ($token->[0] eq 'S' &&
          $token->[1] eq 'a') {
        my $url=new URI::URL($token->[2]->{'href'});
        my %form=$url->query_form;
        if ($form{'mode'} eq 'detail' &&
            $form{'of'}) {
          $pages{$form{'of'}}=1;
        }
      }
      next;
    }
  }

  return sort { $a <=> $b } keys %pages;
}

sub extract_forms {
  my $content=shift @_;
  my $p=new HTML::TokeParser($content);

  my @forms;
  my %form;
  my $state=0;
  while (my $token=$p->get_token) {
    if ($state==0) {
      next if $token->[0] ne 'S' ||
              $token->[1] ne 'form' ||
              $token->[2]->{'action'} !~ '^edit#(\d+)';
      $state=$1;
    } elsif ($state!=0) {
      if ($token->[0] eq 'E' &&
          $token->[1] eq 'form') {
        push(@forms,{%form});
        %form=();
        $state=0;
        next;
      }
      if ($token->[0] eq 'S' &&
          $token->[1] eq 'input') {
        my $attr=$token->[2];
        $form{$attr->{'name'}}=$attr->{'value'}
          unless $attr->{'type'} eq 'submit';
      }
      if ($token->[0] eq 'S' &&
          $token->[1] eq 'option' &&
          $token->[2]->{'selected'}) {
        $form{'group'}=$p->get_text;
      }
      next;
    }
  }

  return @forms;
}

sub get_content {
  my $ua=shift @_;
  my $url=shift @_;
  my $req=new HTTP::Request(GET=>$url);

  my $res=$ua->request($req);
  $res->is_success or
    die "Failed: " . $res->status_line;

#  print $res->content;

  return $res->content;
}

sub filter_text {
  my $str=shift @_;

#  Jcode::convert(\$str, "utf8");
  Jcode::convert(\$str, "euc");
  for ($str) {
    s/&/&amp;/g;
    s/</&lt;/g;
    s/>/&gt;/g;
    s/=/&quot;/g;
  }

  return $str;
}

sub print_header {
  print qq(<?xml version="1.0" encoding="EUC-JP"?>\n);
  print qq(<hatena_antenna user="$user">\n);
}

sub print_footer{
  print "</hatena_antenna>\n";
}

sub print_item {
  my $form=shift @_;
  print "<item>\n";
  foreach my $key (qw(linkurl linktitle author group startreg endreg ignorereg)$
    my $val=&filter_text($form->{$key});
    print "<$key>$val</$key>\n";
  }
  print "</item>\n\n";
}

sub main {
  my $cookie_jar=new HTTP::Cookies(
#    file=>'./cookies.txt',
#    autosave=>1,
#    ignore_discard=>1,
  );

  my $ua=new LWP::UserAgent;
  $ua->cookie_jar($cookie_jar);

  &login($ua);

  my @cookies;
  $cookie_jar->scan(sub { push(@cookies,[@_]); });
  foreach (@cookies) {
    # ignore "port" param
    $_->[5]=undef;
    $cookie_jar->set_cookie(@{$_});
  }
#  $cookie_jar->save();

  my $url=new URI::URL("$hatena_url/$user/edit");
  $url->query_form(of=>'0', mode=>'detail');

  my $content=&get_content($ua, $url);
#  print $content;

  my @pages=&extract_pages(\$content);
  my %content=(0=>$content);

  &print_header;

  foreach my $page (@pages) {
    if (!defined($content{$page})) {
      my $url=new URI::URL("$hatena_url/$user/edit");
      $url->query_form(of=>$page, mode=>'detail');
      $content{$page}=&get_content($ua, $url);
    }
    my $content=$content{$page};
    foreach my $form (&extract_forms(\$content)) {
      &print_item($form);
    }
  }

  &print_footer;
}
&main;

はてな住所登録に関するプライバシーポリシー変更に伴って、はてなアンテナから移行する人が増えると予想されるので、多少なりとも役に立てば。

個人的には、住所登録とは別にはてなアンテナは以前から使いにくくてしょうがないので、この機会に移行するつもり。どこかいいとこないかなあ。