ふるふる日記

WWW::Mechanizeを利用して、ちょっとしたものを作成していたんですが、なぜが文字が化けてしまって、おかしいなぁ。この化け方って、どう考えても、utf-8に変換するときの問題だよな……。と思って探したら、WWW::Mechanize中に、こんなコードが……

# Try to decode the content. Undef will be returned if there's nothing to decompress.
# See docs in HTTP::Message for details. Do we need to expose the options there?
my $content = $res->decoded_content;
   $content = $res->content if (not defined $content);

decoded_contentは、HTTP::Messageにあって、

if ($ct && $ct =~ m,^text/,,) {
    my $charset = $opt{charset} || $ct_param{charset} || $opt{default_charset} || "ISO-8859-1";
    $charset = lc($charset);
    if ($charset ne "none") {
	require Encode;
	if (do{my $v = $Encode::VERSION; $v =~ s/_//g; $v} < 2.0901 &&
	    !$content_ref_iscopy)
	{
	    # LEAVE_SRC did not work before Encode-2.0901
	    my $copy = $$content_ref;
	    $content_ref = \$copy;
	    $content_ref_iscopy++;
	}
	$content_ref = \Encode::decode($charset, $$content_ref, Encode::FB_CROAK() | Encode::LEAVE_SRC());
    }
}

となっているので、Content-Typeが、text/....だったら、デフォルトはISO-8859-1としてEncode::decode、つまりUTF-8に変換しUTF-8フラグを立てることになるわけですな。そりゃ、文字化けもするよ……。

てか、オプションいるかい？じゃなくて、大至急何とかしろよ。と、思いつつも、ラッパークラスを作って対応。

そういえば、WWW::Mechanizeの1.22(現在のNetBSD pkgsrcの最新)より新しいバージョンはあるのかな？とcpanを探してみたら、最新の1.24では該当コードが削除されていて、開発版の1.29_01では

# Try to decode the content. Undef will be returned if there's nothing to decompress.
# See docs in HTTP::Message for details. Do we need to expose the options there? 
# use charset => 'none' because while we want LWP to handle Content-Encoding for 
# the auto-gzipping with Compress::Zlib we don't want it messing with charset
my $content = $res->decoded_content( charset => 'none' );
   $content = $res->content if (not defined $content);

と、なっていた。たしかに、そうよね……。さて、default_charsetをutf-8として指定するようにラッパークラスを書いてしまった私は、どうすればいいんだろう……。ま、得られた結果をutf-8としてencodeしてやればいいだけ……なの？かな？

あと、Class::DBI::Pagerを使っていて、1ページから最終ページまでじゃなくて、gooooogleみたいに、カレントページの周辺１０ページにリンクを張るみたいなコトできないだろうか？と、調べてみたんだけど、よくわからない。

ただ、Changesに書いてある、Data::Page::Navigationってのが、それっぽくて、しかも、supportと書いてあるけれど、イマイチ使い方がよくわからないな。

Class::DBI::Pagerを継承する俺クラスでuse Data::Page::Navigationするってこと？なの？かな？でも、それって、supportなの？わからないね

なんにしても、プログラムを書くということは、たのしいものですな。それにしても、今さらながら、Class::DBIすげー。とか、ほんと、思う。

Class::DBIは、いろんな意味で最高なのですが、many_to_manyのリレーションを作るどうやればいいんだろうなぁ。と、いろいろ検索して、見つけたのが、ξ；゜ー゜)ξ { 遅レス。 - Class::DBI(CDBI)で多対多(many_to_many)。

そういえば、大昔、というか、前の(？)会社の時に、先輩が、そういう風にテーブルを作っていたなぁ、と懐かしくなったりしつつ、いろいろ利用。ところが、なんかうまくいかないです。

結論から言うと、Complex many to many - ClassDBIのように、中間テーブルには、idカラムというか、「複合ではないプライマリキー」が必要でした。

リンク先の例にならうと、

CREATE TABLE Users (
    code    varchar(8)   primary key,
    passwd  varchar(255) not null
);


CREATE TABLE CourseUsers (
    id    varchar(8)   primary key,
    user_code     varchar(8)   not null,
    course_code   varchar(255) not null,
    unique (user_code, course_code)
);


CREATE TABLE Courses (
    code varchar(5)    primary key,
    name varchar(255)  not null
);


package MyApp::Model::CDBI;
use strict;
use base 'Class::DBI::SQLite';
__PACKAGE__->set_db('Main', 'dbi:SQLite:dbname=/path/to/dbfile');


package MyApp::Model::CDBI::Users;
use strict;
use base 'MyApp::Model::CDBI';


__PACKAGE__->set_up_table('Users');
__PACKAGE__->has_many(courses => ["MyApp::Model::CDBI::CourseUsers" => 'course_code'], 'user_code');


package MyApp::Model::CDBI::CourseUsers;
use strict;
use base 'MyApp::Model::CDBI';


__PACKAGE__->set_up_table('CourseUsers');
__PACKAGE__->has_a(course_code => "MyApp::Model::CDBI::Courses");
__PACKAGE__->has_a(user_code => "MyApp::Model::CDBI::Users");
sub courses { shift->user->courses }
sub users { shift->course->users }


package MyApp::Model::CDBI::Courses;
use strict;
use base 'MyApp::Model::CDBI';


__PACKAGE__->set_up_table('Courses');
__PACKAGE__->has_many(users => ["MyApp::Model::CDBI::CourseUsers" => 'user_code'], 'course_code');

たぶん、こんな感じ。

なんというか、結局のところ、本家の情報を英語だからといって避けたりしないでちゃんと読め。ってことなんだろうなぁ……

いや、perlが5.8になってから、utf-8フラグがらみで、面倒なことばっかりだな。と、正直思ってたんです。

でも、考えを改めてもいい。正直そう思った。

たとえば、「スペースで区切って、複数のワードを入力する」というインターフェースがあった場合、「スペース」がすべていわゆる半角スペースであると仮定すれば、splitでわけるだけですよね。インターフェースの都合上、いわゆる全角スペースが混じってしまう可能性があるとすると、その全角のスペースを一旦半角スペースに変換してからsplitしないとだめになるわけですよ。

ところが、split( /[\x{0020}\x{3000}]/, $input )ってやるだけで、$inputがUTF8フラグ付なら、一発でわけることができるわけですね。ちゃんと「バイト列」ではなくて「文字列」として扱ってつわけですな。

でも、逆に、面倒なのが、バイト列として扱うときの操作。たとえば、urlで許されない文字をaタグなんかにつかうときにつかう、%xx%xxというあれですね。

sub my_encode{
  my $tmp = shift;
  $tmp = Encode::encode('utf8',$tmp);
  $tmp =~ s/([^\w])/'%'.unpack("H2", $1)/ego;
  $tmp =~ tr/ /+/;
  $tmp = Encode::decode('utf8',$tmp);
  return $tmp;
}

ってな感じに、文字列ではなくバイト列として扱うように、UTF8フラグを外してから変換してUTF8フラグを立てるという処理にしなくてはいけません。文字列のままだと[^\w]が１バイトとは限らないので、unpackのH2の2がダメになってしまうからですね。

これもはまりました。それにしても、「はまる」ということすら、楽しくなってくるというのが、プログラムを書く楽しみと言えるのでしょうか。山登りみたいなもんですかね……

すごい悩んだことに限って、実際、たいしたことじゃなくて、後から考えてみると、なんであのときわからなかったんだろう。などということは、よくあるわけですが……

あと、Class::DBI::Pagerを使っていて、1ページから最終ページまでじゃなくて、gooooogleみたいに、カレントページの周辺１０ページにリンクを張るみたいなコトできないだろうか？と、調べてみたんだけど、よくわからない。

ただ、Changesに書いてある、Data::Page::Navigationってのが、それっぽくて、しかも、supportと書いてあるけれど、イマイチ使い方がよくわからないな。

はまりました (ふるふる日記)

ようするに、

使い方は、

use Data::Page::Navigation;

とuseするだけです。

Data::Page::Navigationリリースしました : blog.nomadscafe.jp

らしい。なんてことだ……。ソースを見て、使い方がわかるくらいにならないとダメ。ってことかも。

テーブルのupdateトリガーに、そのテーブルのupdateをするルーチンを書くと、ひどいことになるくらい、気づきましょう＞俺

まぁ、実際には、perlのClass::DBIの話ですが……。

今さらですが……

[% hoge | uri %]

って書くと、hogeの内容をuriエンコードして出力するのね……。

知らなかった……プログラム側で変更するルーチンをわざわざ用意してたよ……orz

そういえば、いいかげん、AmazonのECS 3.0からECS 4.0へ移行しないとだめなんじゃないか？と、その昔作ったmt-amazon.plをいろいろいじり始める。

とはいえ、Net::Amazonというモジュールを使っているのだから、簡単に対応できるだろう。と、いうわけで、最新版をインストール

NetBSDの場合、pkgsrc-wipから、wip/p5-Net-Amazonをインストールすると、必要なものも全部インストールしてくれるので楽ちん。NetBSDじゃないひとは、CPANモジュールを使うと楽ちんですね。

で、いろいろやってみたんだけど、昔と違って、affiliateのリンクが作成されない。というか、そもそも、affiliate_idを指定しても、なにもやってないじゃん……。ってな感じで、あるバージョン以降、そういう風になったみたいだ。

--- /usr/pkg/lib/perl5/vendor_perl/5.8.0/Net/Amazon.pm    2008-01-14　10:03:02.000000000 +0900
+++ extlib/Net/Amazon.pm        2008-03-25 01:13:13.000000000 +0900
@@ -152,6 +152,7 @@
         $url->query_form(
             'Service'        => 'AWSECommerceService',
             'AWSAccessKeyId' => $self->{token},
+            'AssociateTag'   => $self->{affiliate_id},
             'Version'        => $WSDL_DATE,
             map { $_, $params{$_} } sort keys %params,
         );

ってな、パッチを当ててやればいいわけですが、これだと、affiliate_idを指定しなかったときにちゃんと動かなくなるので、もうすこし、マトモに対応してあげる必要がありそうｗｗ。

でも、もう、めんどうだから、これでいいや的。

ただ、mt-amazon自身は、mt-という接頭語をつけるのは、よろしくない。と、sixapartが言っていることと、設定を画面上から行うようにした方がいいんじゃないか？という理由で、もう少し、いじるとするかな。

今の状態が、欲しいという人は、送ることは出来ますが、おそらく、必要なモジュールを大量にインストールするのが面倒になるような気がします。

【追記】

あー、うそだうそだ。

    use Net::Amazon;
    use Net::Amazon::Request::Artist;
    use Data::Dumper;


    die "usage: $0 artist\n(use Zwan as an example)\n"
        unless defined $ARGV[0];


    my $ua = Net::Amazon->new(
        token       => 'YOUR_AMZN_TOKEN',
    );


    my $req = Net::Amazon::Request::Artist->new(
        artist  => $ARGV[0],
        AssociateTag => [your associate id],
    );


       # Response is of type Net::Amazon::Artist::Response
    my $resp = $ua->request($req);


    if($resp->is_success()) {
        print $resp->as_string, "\n";
    } else {
        print $resp->message(), "\n";
    }

ってな感じで使えばいいだけじゃないか……。すまぬ。単純に以前と同じようには使えない。というだけだったのね……