Kendama Revolutionsも順調にページ数が増え200を超えるまでになりました。
管理するWikiのページ数が増えてくるとたとえば以下のようなことを手で行なうのは困難になってきます。
- ページに付けられたタグを一覧にする
- 特定のキーワードを含むページに共通の書式を埋め込む
- そのほか複数のページに対して同じような処理を行ないたいとき
今時のWikiにはXML-RPCのようなAPIが付いていたりしてプログラムから操作できるものもあります。(MediaWikiとか)
残念ながら@wikiにはないので作ってみることにしました。とはいえ、サーバサイドに何かを実装することもできないので、PerlのWWW::Mechanizeを使ってブラウザをシミュレートする方法で実装することにしました。
昔モジュールを作ったときはh2xsを使って雛形を生成していましたが、最近はModule::Starterというものがあるようなのでそちらを使いました。PBP(Perlベストプラクティス)でも推奨されています。
実装した機能は、ページの取得・新規作成・編集・名前変更、ページの一覧取得です。とりあえずWWW::Mechanizeの練習に作ってみたというレベルなのでエラーチェックなどは甘いです。ドキュメントもとりあえず自分用というレベルです。あまりニーズはないと思いますがニーズがあれば何とかする方向で。
いくつか、こんなことができますという使用例を挙げてみます。
・ページに付けられたタグを一覧にして出力する。
#!/usr/bin/perl # get_page_tag.pl # ページのタグを取得するサンプル use warnings; use strict; use utf8; use Encode; use WWW::Atwiki; # オブジェクトを生成する my $wiki = WWW::Atwiki->new( url => 'http://www19.atwiki.jp/shakemid', username => 'shakemid', password => 'xxxxxxxx', ); # ログインする $wiki->login(); # ページ一覧を取得する my %page_list = $wiki->get_page_list(); for my $p ( sort { $a <=> $b } keys %page_list ) { # ページを取得する my $page = $wiki->get_page( $p ); # ページ番号、ページ名、タグを出力する print "$p\t"; print encode( 'utf8', $page_list{ $p } ) . "\t"; print encode( 'utf8', $page->tag() ) . "\n"; }
・ビデオが貼り付けられていているページすべてにコメント欄を付ける。
#!/usr/bin/perl # add_pcomment.pl # ビデオが貼り付けられているページにコメント欄を付ける use warnings; use strict; use utf8; use Encode; use WWW::Atwiki; # オブジェクトを生成する my $wiki = WWW::Atwiki->new( url => 'http://www19.atwiki.jp/shakemid', username => 'shakemid', password => 'xxxxxxxx', ); # ログインする $wiki->login(); # ページ一覧を取得する my %page_list = $wiki->get_page_list(); for my $p ( sort { $a <=> $b } keys %page_list ) { # ページを取得する my $page = $wiki->get_page( $p ); # ページの内容を取得する my $c = $page->content(); # ビデオが貼り付けられていてコメント欄がまだないページを処理する if ( $c =~ /&video\(/ && $c !~ /#pcomment/ ) { print "$p\t" . encode( 'utf8', $page_list{ $p } ) . "\n"; # ページの最後にコメント欄を付ける $c =~ s/\n*\z/\n\n*コメント\n#pcomment(reply)\n/; $page->content( $c ); # ページを編集する $wiki->edit_page( $page, notimestamp => 1 ); } }
上の例は実際に使用しました。すべてのページを手動で編集していくのはもはや拷問に近いので重宝しました。
今後いろいろなことに使えると思います。
たとえば、
- 新着コメントを抽出する
- 英訳ページを半自動で作成する
- 将来他のWikiにバッチ一発で移転する
などなど。
ダウンロードはこちらからどうぞ → WWW-Atwiki-0.01.tar.gz
CPANizeはまだ怖い...
WWW::Mechanizeを使ってヒューリスティックに画面遷移を行なっていますので、@wiki側の仕様が変われば動作しなくなる可能性があります。また、使い方によって、あるいは予期せぬバグによって取り返しの付かない結果を招く可能性があります。
もし使ってくださる場合は、無保証、自己責任でお願いします。まとめてページを書き換えるような場合は事前に十分なテストとバックアップを行なってください。
インストールはModule::Buildを使って行ないます。
インストール手順 依存するモジュールをインストールしてください。 cpan WWW::Mechanize cpan Jcode cpan Module::Build 以下のコマンドでモジュールをインストールしてください。 perl Build.PL ./Build . env.sh (ATWIKI_URL, ATWIKI_USERNAME, などの環境変数をセットしてください) ./Build test ./Build install testのときに実際に@wikiにページを作成しますのでご注意ください。
コードを載せておきます。
package WWW::Atwiki; # $Id: Atwiki.pm 2 2009-01-03 10:02:45Z shima $ use warnings; use strict; use utf8; use WWW::Atwiki::Page; use Carp; use Encode; use Data::Dumper; use base 'WWW::Mechanize'; =head1 NAME WWW::Atwiki - @wiki(http://atwiki.jp)のためのPerlモジュール =head1 VERSION Version 0.01 =cut our $VERSION = '0.01'; =head1 SYNOPSIS オブジェクト生成 use WWW::Atwiki; my $wiki = WWW::Atwiki->new( url => 'http://wwwXX.atwiki.jp/xxxx' ); ログイン my $wiki->login( username => 'user', password => 'pass' ); ページの取得 my $page_number = $wiki->get_page_number( 'PageName' ); my $page = $wiki->get_page( $page_number ); ... ページの新規作成 my $page = WWW::Atwiki::Page->new( name => 'PageName', content => 'hogehoge', tag => 'tag1,tag2', ); my $wiki->new_page( $page ); ... ページの編集 my $page = WWW::Atwiki::Page->new( name => 'PageName', content => 'hogehoge', tag => 'tag1,tag2', ); my $wiki->edit_page( $page ); ... =head1 EXPORT なし =head1 FUNCTIONS =head2 new() オブジェクトを生成するコンストラクタです。 my $wiki = WWW::Atwiki->new( url => 'http://wwwXX.atwiki.jp/xxxx' ); 引数 =over 4 =item * url WikiのURL。必須。 =item * username ユーザ名。任意。login() で指定することもできます。 =item * password パスワード。任意。login() で指定することもできます。 =back =cut sub new { my $class = shift; my %arg = @_; my $self = $class->SUPER::new(); return $self->_init( %arg ); } sub _init { my $self = shift; my %arg = @_; %$self = %arg; return $self; } =head2 login() ログインを行ないます。成功すれば1を返します。失敗した場合は例外を送出します。 引数としてユーザ名とパスワードを取ります。オブジェクト生成時に指定していれば省略できます。 $wiki->login( username => 'user', password => 'pass' ); 引数 =over 4 =item * username ユーザ名 =item * password パスワード =back =cut sub login { my $self = shift; my %arg = @_; # 引数でユーザ名とパスワードが指定されたらそちらを使う $self->{username} = $arg{username} if defined $arg{username}; $self->{password} = $arg{password} if defined $arg{password}; # ログインページに移動する my $r = $self->get( $self->{url} . '/login' ); if ( ! $self->success() ) { croak Dumper [ $r ]; } # ログインフォームを探す my $forms = $self->forms(); my $form_number = 1; for my $f ( @$forms ) { if ( $f->{action} =~ m{/loginx/$} ) { last; } $form_number++; } if ( $form_number > @$forms ) { croak "Login form was not found!"; } # ログインする $r = $self->submit_form( form_number => $form_number, fields => { username => $self->{username}, password => $self->{password}, action => 'login', } ); if ( $r->is_error() ) { croak Dumper [ $r ]; } my $c = $self->content(); if ( $c =~ m{ユーザ名もしくはパスワードが間違っています。} ) { croak "Login failed! Wrong username or password."; } # セッションIDをCookieにセットする $self->add_header( cookie => $r->header('set-cookie') ); #warn Dumper [ $r ]; return 1; } =head2 get_page_number() ページ名からページ番号を検索します。 $page_number = $wiki->get_page_number( 'PageName' ); 引数 =over 4 =item * ページ名 =back =cut sub get_page_number { my $self = shift; my $name = shift; # ページ一覧に移動する my $r = $self->get( $self->{url} . '/list' ); if ( ! $self->success() ) { croak Dumper [ $r ]; } # ページ一覧のリンクを抽出する my @listpages = ( $self->{url} . '/list' ); my @links = $self->links(); #warn Dumper [ @links ]; for my $l ( @links ) { if ( $l->url() =~ m{/list\?sort=update&pp=\d+} ) { #warn Dumper [ $l ]; push @listpages, $l->url(); } } # ページ一覧の中からページ名と一致するリンクを探す for my $p ( @listpages ) { $r = $self->get( $p ); if ( ! $self->success() ) { croak Dumper [ $r ]; } @links = $self->links(); #warn Dumper [ @links ]; my $result = $self->_search_page_name( \@links, $name ); return $result if defined $result; } # 見つからなければundefを返す return undef } # リンクのリストからページ名を検索しページ番号を返す sub _search_page_name { my $self = shift; my $links = shift; my $name = shift; for my $l ( @$links ) { my $text = ""; if ( defined $l->text() ) { $text = $l->text(); # textがdecodeされたりされなかったりする気がするので # decodeされてなければdecodeする。 if ( ! utf8::is_utf8( $text ) ) { $text = decode( 'utf8', $text ); } else { #warn 'text is already decoded!' } } if ( $text eq $name ) { #warn Dumper [ $l ]; $l->url() =~ m{/(\d+).html$}; return $1; } } return undef } =head2 get_page_list() ページ一覧を取得します。ページ番号がキーでページ名が値のハッシュを返します。 %page_list = $wiki->get_page_list(); =cut sub get_page_list { my $self = shift; my $name = shift; my %page_list; # ページ一覧に移動する my $r = $self->get( $self->{url} . '/list' ); if ( ! $self->success() ) { croak Dumper [ $r ]; } # ページ一覧のリンクを抽出する my @listpages = ( $self->{url} . '/list' ); my @links = $self->links(); #warn Dumper [ @links ]; for my $l ( @links ) { if ( $l->url() =~ m{/list\?sort=update&pp=\d+} ) { #warn Dumper [ $l ]; push @listpages, $l->url(); } } # ページ一覧の中からリンクを抽出する for my $p ( @listpages ) { $r = $self->get( $p ); if ( ! $self->success() ) { croak Dumper [ $r ]; } my @links = $self->links(); #warn Dumper [ @links ]; for my $l ( @links ) { my $text = ""; if ( defined $l->text() ) { $text = $l->text(); # textがdecodeされたりされなかったりする気がするので # decodeされてなければdecodeする。 if ( ! utf8::is_utf8( $text ) ) { $text = decode( 'utf8', $text ); } else { #warn 'text is already decoded!' } } if ( $l->url() =~ m{/pages/(\d+).html} ) { #warn Dumper [ $l ]; $page_list{ $1 } = $text; } } } return %page_list } =head2 get_page() ページを取得します。 引数としてページ番号を取り、WWW::Atwiki::Pageオブジェクトを返します。 $page = $wiki->get_page( 111 ); $page = $wiki->get_page( $wiki->get_page_number( 'PageName' ) ) 引数 =over 4 =item * ページ番号 =back =cut sub get_page { my $self = shift; my $number = shift; if ( ! $number ) { croak "Page number is required!"; } # 編集ページに移動する my $r = $self->get( $self->{url} . "/editx/$number.html" ); if ( ! $self->success() ) { croak Dumper [ $r ]; } my $c = $self->content(); if ( $c =~ m{<p class="error">編集できません</p>} ) { croak "Authentication required!"; } elsif ( $c =~ m{指定されたページ番号は存在しません。} ) { croak "Page not found!"; } my $form = $self->form_name( 'edit_form' ); if ( ! $form->value('source') ) { croak "Page not created!"; } #warn Dumper [ $r ]; #warn Dumper [ $form ]; #warn $c; # WWW::Atwiki::Page オブジェクトを生成する my $page = WWW::Atwiki::Page->new(); $page->number( $number || $self->get_page_number( $form->value('pagename') ) ); $page->name( $form->value('pagename') ); $page->tag( $form->value('tags') ); $page->edit_mode(0); $page->content( $form->value('source') ); return $page; } =head2 edit_page() ページを編集します。 $page = WWW::Atwiki::Page->new( name => 'PageName', content => 'hogehoge', tag => 'tag1,tag2', ); $wiki->edit_page( $page ); 引数 =over 4 =item * WWW::Atwiki::Page オブジェクト オブジェクトにはページ番号かページ名の少なくともどちらかが指定されていなければいけません。 両方指定された場合はページ番号が優先されます。 =item * notimestamp => [0|1] タイムスタンプを更新しないオプションです。(default:0) =item * ping => [0|1] 更新情報を宣伝するオプションです。(default:1) =back =cut sub edit_page { my $self = shift; my $page = shift; my %arg = ( notimestamp => 0, ping => 1, @_ ); # 編集ページに移動する my $r; if ( $page->number() ) { $r = $self->get( $self->{url} . "/editx/" . $page->number() . ".html" ); } elsif ( $page->name() ) { $r = $self->get( $self->{url} . "/?cmd=edit&wysiwyg=0&page=" . $page->name() ); } else { croak "Page number or page name is required!"; } if ( ! $self->success() ) { croak Dumper [ $r ]; } my $c = $self->content(); if ( $c =~ m{<p class="error">編集できません</p>} ) { croak "Authentication required!"; } elsif ( $c =~ m{指定されたページ番号は存在しません。} ) { croak "Page not found!"; } my $form = $self->form_name( 'edit_form' ); if ( ! $form->value('source') ) { croak "Page not created!"; } #warn Dumper [ $self->forms() ]; # ページを編集する $r = $self->submit_form( form_name => 'edit_form', fields => { 'source' => $page->content(), 'tags' => $page->tag(), 'notimestamp' => $arg{notimestamp} ? 'on' : 'off', 'xmlrpcping' => $arg{ping} ? 'on' : 'off', } ); if ( $r->is_error() ) { croak Dumper [ $r ]; } return 1; } =head2 new_page() 新しいページを作成します。 $page = WWW::Atwiki::Page->new( name => 'PageName', content => 'hogehoge', tag => 'tag1,tag2', ); $wiki->new_page( $page ); 引数 =over 4 =item * WWW::Atwiki::Page オブジェクト =back =cut sub new_page { my $self = shift; my $page = shift; # 新規ページ作成に移動する my $r = $self->get( $self->{url} . "/new" ); if ( ! $self->success() ) { croak Dumper [ $r ]; } my $c = $self->content(); if ( $c =~ m{このwikiでは新規ページの作成をログインユーザに限定} ) { croak "Authentication required!"; } # 新規作成フォームを探す my $forms = $self->forms(); my $form_number = 1; for my $f ( @$forms ) { if ( defined $f->{attr}{class} && $f->{attr}{class} eq 'new' ) { last; } $form_number++; } if ( $form_number > @$forms ) { croak "Form not found!"; } # 新規ページのページ名がすでにあるか調べる $r = $self->submit_form( form_number => $form_number, fields => { newpage => $page->name(), } ); if ( $r->is_error() ) { croak Dumper [ $r ]; } $c = $self->content(); if ( $c =~ m{そのページ名はすでに存在します。他のページ名を指定} ) { croak "Page name already exists!"; } #warn Dumper [ $r ]; # ページを作成する $r = $self->get( $self->{url} . "/?cmd=edit&wysiwyg=0&page=" . $page->name() ); if ( ! $self->success() ) { croak Dumper [ $r ]; } $c = $self->content(); $r = $self->submit_form( form_name => 'edit_form', fields => { 'source' => $page->content(), 'tags' => $page->tag(), } ); if ( $r->is_error() ) { croak Dumper [ $r ]; } return $self->get_page_number( $page->name() ); } =head2 rename_page() ページ名を変更する。 $wiki->rename_page( $page_number, 'NewName' ); 引数 =over 4 =item * ページ番号 =item * 新しいページ名 =back =cut sub rename_page { my $self = shift; my $number = shift; my $newname = shift; # 名前変更ページに移動する if ( ! $number ) { croak 'Page number is required!' } elsif ( ! $newname ) { croak 'New name is required!' } my $r = $self->get( $self->{url} . "/renamex/" . $number . ".html" ); if ( ! $self->success() ) { croak "Request failed!"; } my $c = $self->content(); if ( $c =~ m{ログインするにはこのウィキのユーザ名とパスワードを入力} ) { croak "Authentication required!"; } # 名前変更フォームを探す my $forms = $self->forms(); my $form_number = 1; for my $f ( @$forms ) { if ( defined $f->{attr}{class} && $f->{attr}{class} eq 'rename' ) { last; } $form_number++; } if ( $form_number > @$forms ) { croak "Form not found!"; } # 新しいページ名を指定する $r = $self->submit_form( form_number => $form_number, fields => { newname => $newname, } ); if ( $r->is_error() ) { croak Dumper [ $r ]; } $c = $self->content(); if ( $c =~ m{そのページ名はすでに存在します。他のページ名を入力} ) { croak "Page name already exists!"; } return 1; } =head1 AUTHOR K.CIMA, C<< <k-cima at shakemid.com> >> =head1 BUGS Please report any bugs or feature requests. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc WWW::Atwiki =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2009 K.CIMA, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of WWW::Atwiki
package WWW::Atwiki::Page; # $Id: Page.pm 2 2009-01-03 10:02:45Z shima $ use warnings; use strict; use utf8; use Encode; use Jcode; =head1 NAME WWW::Atwiki::Page - @wiki のページを表すクラスです。 =head1 VERSION Version 0.01 =cut our $VERSION = '0.01'; =head1 SYNOPSIS Quick summary of what the module does. Perhaps a little code snippet. use WWW::Atwiki::Page; my $foo = WWW::Atwiki::Page->new(); ... =head1 FUNCTIONS =head2 new =cut sub new { my $class = shift; my %arg = @_; my $self = bless \%arg, $class; # UTF-8フラグを付ける while ( my( $k, $v ) = each %$self ) { $self->{ $k } = $self->_to_utf8( $v ); } return $self; } =head2 dump =cut sub dump { my $self = shift; my $out; $out = "ページ番号:" . $self->number() . "\n"; $out .= "ページ名:" . $self->name() . "\n"; $out .= "タグ:" . $self->tag() . "\n"; $out .= "編集モード番号:" . $self->edit_mode() . "\n"; $out .= '-' x 31 . "\n"; $out .= $self->content(); return $out } =head2 number =cut sub number { my $self = shift; my $arg = shift; $self->{number} = $arg if defined $arg; return $self->{number}; } =head2 name =cut sub name { my $self = shift; my $arg = shift; $self->{name} = $self->_to_utf8($arg) if defined $arg; return $self->{name}; } =head2 tag =cut sub tag { my $self = shift; my $arg = shift; $self->{tag} = $arg if defined $arg; return $self->{tag}; } =head2 edit_mode =cut sub edit_mode { my $self = shift; my $arg = shift; $self->{edit_mode} = $arg if defined $arg; return $self->{edit_mode}; } =head2 content =cut sub content { my $self = shift; my $arg = shift; $self->{content} = $self->_to_utf8($arg) if defined $arg; return $self->{content}; } sub _to_utf8 { my $self = shift; my $str = shift; $str =~ s/\r\n/\n/g; $str =~ s/\r/\n/g; if ( ! Encode::is_utf8( $str ) ) { $str = decode( 'utf8', Jcode->new($str)->utf8 ); } return $str; } =head1 AUTHOR K.CIMA, C<< <k-cima at shakemid.com> >> =head1 BUGS Please report any bugs or feature requests. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc WWW::Atwiki::Page =head1 ACKNOWLEDGEMENTS =head1 COPYRIGHT & LICENSE Copyright 2009 K.CIMA, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of WWW::Atwiki::Page
ついでにPODも
NAME WWW::Atwiki - @wiki(http://atwiki.jp)のためのPerlモジュール VERSION Version 0.01 SYNOPSIS オブジェクト生成 use WWW::Atwiki; my $wiki = WWW::Atwiki->new( url => 'http://wwwXX.atwiki.jp/xxxx' ); ログイン my $wiki->login( username => 'user', password => 'pass' ); ページの取得 my $page_number = $wiki->get_page_number( 'PageName' ); my $page = $wiki->get_page( $page_number ); ... ページの新規作成 my $page = WWW::Atwiki::Page->new( name => 'PageName', content => 'hogehoge', tag => 'tag1,tag2', ); my $wiki->new_page( $page ); ... ページの編集 my $page = WWW::Atwiki::Page->new( name => 'PageName', content => 'hogehoge', tag => 'tag1,tag2', ); my $wiki->edit_page( $page ); ... EXPORT なし FUNCTIONS new() オブジェクトを生成するコンストラクタです。 my $wiki = WWW::Atwiki->new( url => 'http://wwwXX.atwiki.jp/xxxx' ); 引数 * url WikiのURL。必須。 * username ユーザ名。任意。login()で指定することもできます。 * password パスワード。任意。login()で指定することもできます。 login() ログインを行ないます。成功すれば1を返します。 失敗した場合は例外を送出します。 引数としてユーザ名とパスワードを取ります。 オブジェクト生成時に指定していれば省略できます。 $wiki->login( username => 'user', password => 'pass' ); 引数 * username ユーザ名 * password パスワード get_page_number() ページ名からページ番号を検索します。 $page_number = $wiki->get_page_number( 'PageName' ); 引数 * ページ名 get_page_list() ページ一覧を取得します。ページ番号がキーでページ名が値のハッシュを 返します。 %page_list = $wiki->get_page_list(); get_page() ページを取得します。 引数としてページ番号を取り、WWW::Atwiki::Pageオブジェクトを返します。 $page = $wiki->get_page( 111 ); $page = $wiki->get_page( $wiki->get_page_number( 'PageName' ) ) 引数 * ページ番号 edit_page() ページを編集します。 $page = WWW::Atwiki::Page->new( name => 'PageName', content => 'hogehoge', tag => 'tag1,tag2', ); $wiki->edit_page( $page ); 引数 * WWW::Atwiki::Page オブジェクト オブジェクトにはページ番号かページ名の少なくともどちらかが 指定されていなければいけません。 両方指定された場合はページ番号が優先されます。 * notimestamp => [0|1] タイムスタンプを更新しないオプションです。(default:0) * ping => [0|1] 更新情報を宣伝するオプションです。(default:1) new_page() 新しいページを作成します。 $page = WWW::Atwiki::Page->new( name => 'PageName', content => 'hogehoge', tag => 'tag1,tag2', ); $wiki->new_page( $page ); 引数 * WWW::Atwiki::Page オブジェクト rename_page() ページ名を変更する。 $wiki->rename_page( $page_number, 'NewName' ); 引数 * ページ番号 * 新しいページ名 AUTHOR K.CIMA, "<k-cima at shakemid.com>" BUGS Please report any bugs or feature requests. SUPPORT You can find documentation for this module with the perldoc command. perldoc WWW::Atwiki ACKNOWLEDGEMENTS COPYRIGHT & LICENSE Copyright 2009 K.CIMA, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.