Vox には Windows XP 対応アップロード用ツール というのがある。

XP 対応フォトアップローダーを使うと、アイテムとご近所さん へ簡単に大量の画像ファイルをアップロードする事ができます。

「フォトアップローダー」といっても実際はただの .reg ファイルだ。どうなっているのかというと、Windows XP の「Web 発行 ウィザード」という仕組みを使っている。

MSDN の Publishing Wizards を読むと、特別な API がついたミニブラウザを JavaScript からたたくかたちになっていて、Dashboard なんかによく似ている。

というか HTML や JavaScript を OS まわりにとりこんだのは Microsoft が明らかに早かったと思うので、Vista が Dashboard をパクってるとか信じているひとはもうね、いや、それはいまはいいか。パクリとかはどうでもいいです。

で、早速 WebKit を使ってまねしてみようと思ったんだけど、selectNodes という XPath 系の API を使っているあたりであきらめ。JavaScript を人力 eval しながら WWW::Mechanize で地味にやってみた。zonageek: articulos: Programming Microsoft's Publishing Wizards に Transfer Manifest って結局 HTML でいうとどんな感じ？というのが載っていてとても参考になる。

package Vox::PhotoUploader;

use strict;
use WWW::Mechanize;
use HTTP::Request::Common;
use URI::Escape;
use UNIVERSAL;

sub new {
  my ($class) = @_;

  return bless({ mech => WWW::Mechanize->new(), token => undef }, $class);
}

sub login {
  my ($self, $username, $password) = @_;
  $self->{mech}->get('http://www.vox.com/services/xpwizard/welcome/fd');
  $self->{mech}->submit_form(form_number => 0,
                             fields => { username => $username,
                                         password => $password });

  if ($self->{mech}->content() =~ /add_param\(xml, postTag, "token", "(.*)"\);/) {
    $self->{token} = $1;
  }
}

sub upload {
  my ($self, $path, %args) = @_;

  if ($self->{token} == undef) {
    return;
  }

  my $tags = '';
  if (UNIVERSAL::isa($args{tags}, 'ARRAY')) {
    $tags = join(',', $args{tags});
  } else {
    $tags = $args{tags};
  }

  $self->{mech}->request(POST 'http://www.vox.com/services/xpwizard/upload',
                         Content_Type => 'multipart/form-data',
                         Content => [
                                     xpwizard => 1,
                                     ugroup_id => $args{privacy} || 1,
                                     tags => uri_escape($tags),
                                     allow_comments => $args{allow_comments} || 1,
                                     token => $self->{token},
                                     file => [$path],
                                    ]);
}

1;

つかいかたはこんな感じ。

use strict;
use Vox::PhotoUploader;

my $uploader = Vox::PhotoUploader->new();
$uploader->login('you@example.com', 'password');
foreach (@ARGV) {
  $uploader->upload($_);
}

undocumented なものに密結合なのがかっこわるいな。