Value-domain.comで契約しているドメインのDNS設定をバックアップしてドメインごとYAMLファイルに保存します。

valuedomain.pl

#!/usr/bin/perl

# Value-Domain.comで契約済みのドメインリストを取得します。
#

use strict;
use warnings;
use utf8;
use Data::Dumper;
use File::Spec;
use FindBin;
use HTTP::Cookies;
use WWW::Mechanize;
use YAML;

# ドメイン情報YAMLの保存先
my $save_dir = File::Spec->catdir( $FindBin::Bin, 'domain_list');

# Value-domain.comログインユーザ名・パスワード
my $username = 'username';
my $password = 'password';

# Cookie Jar初期化（Cookieをファイルに保存して次回自動ログインできるようにする）
my $cookie_jar = HTTP::Cookies->new(
  file     => File::Spec->catfile( $FindBin::Bin, 'cookies.dat'),
  autosave => 1,
);

# Mech初期化（Cookie JarとUser Agentの設定）
my $mech = WWW::Mechanize->new();
$mech->cookie_jar( $cookie_jar );
$mech->agent_alias('Mac Safari');

# 保存ディレクトリ用意
mkdir $save_dir unless -d $save_dir;

# 取得ループ1：ドメインごとの有効期限取得
print "Phase 1: Get expires.\n";
my $expires = {};
sleep 3;
$mech->get('http://www.value-domain.com/modall.php?action=list');
foreach my $line ( split '\n', $mech->content() ) {
  (my $domain, my $expire ) = split "\t", $line;
  print "[DOMAIN] $domain\n";
  print "$domain\t$expire\n";
  print "\n";
  $expires->{$domain} = $expire;
}
# 取得ループ2：ドメインごとのDNSレコード取得
print "Phase 2: Get DNS records.\n";
sleep 3;
$mech->get('http://www.value-domain.com/moddns.php');
while (1) {
  check_login();
  print "now uri: ". $mech->uri() ."\n";
  my @links = $mech->find_all_links( url_regex => qr/moddns.php\?action=moddns/i );
  last if $#links < 0; # ページ内にドメインリストが0個ならループ終了
  foreach my $link ( @links ) {
    ( my $domain ) = $link->url() =~ m/domainname=([\da-z\.-]+)/;
    print "[DOMAIN] $domain\n";
    #next if -e File::Spec->catfile( $save_dir, "$domain.yaml");
    sleep 3 + int( rand( 5 ) );
    $mech->get( $link );
    my $data = get_dns();
    $data->{expire} = $expires->{$domain};
    print YAML::Dump $data;
    print "\n";
    YAML::DumpFile( File::Spec->catfile( $save_dir, "$data->{domain}.yaml"), $data );
    $mech->back();
  }
  last unless $mech->find_link( text => '次のページ' );
  $mech->follow_link( text => '次のページ' );
}

exit;


# get_dns:
sub get_dns {
  my $data;
  my $html = $mech->content();
  if ( $html =~ m/当ネームサーバーを使用していませんので、編集できません。/ ) {
    ( my $domain ) = $html =~ m/<!-- DOMAINNAME=(.+?) -->/;
    return {
      domain => $domain,
      error  => '当ネームサーバーを使用していませんので、編集できません。',
    };
  }
  if ( $mech->find_link( text => '編集ページはこちらをクリックして下さい。' ) ) {
    $mech->follow_link( text => '編集ページはこちらをクリックして下さい。' );
    $data = get_dns();
    $mech->back();
  }
  elsif ( $html =~ m/FORM NAME="formMAIN" METHOD="post" ACTION="\/moddnsfree.php/ ) {
    $data = form_type1();
  }
  elsif ( $html =~ m/FORM NAME="formMAIN" METHOD="post" ACTION="\/moddns.php/ ) {
    $data = form_type2();
  } 
  return $data;
}

# check_login:
# ログインチェック。ログインが必要なページであれば必ずチェックすること
# 一度ログインすれば、Cookieで次回からはログイン不要になるが、Cookie
# ファイルを削除した場合はログインが必要となります。
sub check_login {
  # 同じURLでも表示しているものが違う
  sleep 4 + int( rand( 5 ) );
  if ( $mech->title() =~ m/ユーザー名:/ ) { # ログイン済み
    unless ( $mech->title() =~ m/ユーザー名:$username/i ) { # ログインユーザが違う
      my $url = $mech->uri();
      logout();
      sleep 3;
      $mech->get($url);
      sleep 3;
      login();
    }
  }
  else { # ログインしていない
    login();
  }
}

sub login {
  $mech->submit_form (
    form_name => 'formMAIN',
    fields => {
      username => $username,
      password => $password,
    },
  );
  my $html = $mech->content();
  die 'ログインできませんでした' if $html =~ m/ユーザーログイン/;
}

sub logout {
  $mech->get('http://www.value-domain.com/logout.php');
}

# DNS設定がtextareaになっているタイプ
sub form_type1 {
  my $html = $mech->content();
  (my $domain, my $last_modified) = $html =~ m/DNS設定 \( <B>(.+)<\/B> 最終更新:([\d\s:-]+)\)/;
  $domain = 'null' . time() unless $domain;
  $domain = 'null' . time() if $domain eq '';
  return {
    records => $mech->value('records'),
    domain  => $domain,
    ttl     => $mech->value('ttl'),
    last_modified => $last_modified,
  };
}

# DNS設定がinputの組み合わせになっているタイプ
sub form_type2 {
  my @res;
  my $domain = $mech->value('domainname');
  for my $i (1..$mech->value('HostCount') ) {
    if ( ( my $hostname = $mech->value("HostName$i") ) ne '' ) {
      if ( ( my $recordtype = $mech->value("RecordType$i") ) eq 'MX' ) {
        push @res, sprintf "%s %s %s %s",
          $recordtype,
          $hostname,
          $mech->value("Address$i"),
          $mech->value("MXPref$i"),
        ;
      }
      else {
        push @res, sprintf "%s %s %s",
          $recordtype,
          $hostname,
          $mech->value("Address$i"),
        ;
      }
    }
  }
  return {
    records => join("\n", @res),
    domain  => $domain,
  };
}

__END__

CentOS 5標準のperl-libwww-perl 5.805-1.11.noarch.rpmから置き換えたくない場合は、WWW::Mechanizeとして、たとえばRPMForgeのperl-WWW-Mechanize-1.34あたりの古いパッケージを使うことになるのだけれども、

yum install --enablerepo=rpmforge perl-WWW-Mechanize-1.34

そうするとEUC-JPコンテンツをUTF-8に自動変換するところが動かないので、このスクリプトのところどころでdecodeやencodeをする必要があります。