日向夏特殊応援部隊

俺様向けメモ

Net::OpenID::Consumerでsregを試す

ふと思い立ってOpenIDが使えるちょっとしたサービスを作ってみようかなと思っています。
で、その中でsreg*1を使いたかったのでNet::OpenID::Consumerのopenid2 branchで出来るかどうか調べてみました。

その前にsregについて具体的に説明

The request parameters detailed here SHOULD be sent with OpenID Authentication checkid_immediate or checkid_setup requests. This extension works with both versions 1.1 (Recordon, D. and B. Fitzpatrick, “OpenID Authentication 1.1,” .) [OpenIDAuthentication1.1] and 2.0 (Recordon, D., Hoyt, J., Hardt, D., and B. Fitzpatrick, “OpenID Authentication 2.0 - Draft 10,” 2006.) [OpenIDAuthentication2.0] of the OpenID Authentication protocol.

まぁ簡単に要約するとですね。

  • checkid_immediateまたはcheckid_setupのリクエストと一緒に送ります
  • OpenID Authentication 1.1, 2.0のどちらでも動きますよ

って事ですね。

で、送るパラメータは、

name detail
openid.ns.sreg http://openid.net/extensions/sreg/1.1
openid.sreg.required カンマ区切りで欲しいプロフィールの名前

とかですね。openid.sreg.optional, openid.sreg.policy_urlもありますが、今回は簡単の為考慮しません。カンマ区切りの値は4. Response Formatに列挙してある値でopenid.sreg.をprefixにしてある値で、このprefixの値は省略することになります。つまり、

openid.sreg.required=nickname,email

とかとか、そういう事になりますね。
そうするとOpenID Providerがsregに対応してて、ユーザーがそのprofileを公開する事に同意した場合は、これらの値がレスポンスと一緒に返って来ます。

つまるところ会員登録とかでの入力補助、補完と言う場面で使うような機能ですね。
説明おしまい。

Net::OpenID::Consumerで試す

まずはコードから。

#!/usr/bin/perl

use strict;
use warnings;

use Cache::File;
use LWP::UserAgent;
use Net::OpenID::Consumer;

### ここは固定になってるけど実際はユーザーのclaimed_id
my $claimed_id = "zigorou.myopenid.com";
my $csr = Net::OpenID::Consumer->new(
    ua => LWP::UserAgent->new,
    cache => Cache::File->new(
        cache_root => '/tmp/openid',
        default_expires => '6000 sec'
    ),
    consumer_secret => 'zigorou',
    args => {},
    required_root => 'http://localhost:3000/',
    debug => 1,
);

if (my $cident = $csr->claimed_identity($claimed_id)) {
    ### ここがポイント
    $cident->set_extension_args("http://openid.net/extensions/sreg/1.1", {
        required => join(",", qw/email nickname/)
    });

    my $check_url = $cident->check_url(
        return_to => "http://localhost:3000/login/handler",
        trust_root => "http://localhost:3000/",
        delayed_return => "checkid_setup",
    );

    ### 実際にはUserAgentに対してこのcheck_urlにリダイレクトさせる
    print "[check_url]\n";
    print $check_url;
}

適宜コメント振りました。

ポイントはNet::OpenID::ClaimedIdentifierオブジェクトのset_extension_argsに対して、ソースのような値を入れて行くのがポイントです。

こうする事によってcheck_url、即ちcheckid_setupの時のリクエストURLのパラメータに先ほど説明したようなopenid.ns.sregとか、openid.sreg.requiredがセットされます。実行結果を見てみると、

http://www.myopenid.com/server?
openid.ns=http://specs.openid.net/auth/2.0&
openid.return_to=http://localhost:3000/login/handler%3Foic.time%3D1206197561-a06a907ab7899fbd2e83&openid.claimed_id=http://zigorou.myopenid.com/&
openid.identity=http://zigorou.myopenid.com/&
openid.mode=checkid_setup&
openid.realm=http://localhost:3000/&
openid.assoc_handle=%7BHMAC-SHA1%7D%7B47e51527%7D%7BwyS0XA%3D%3D%7D&
openid.ns.e1=http://openid.net/extensions/sreg/1.1&
openid.e1.required=email,nickname

となりsregではなくs1みたいになってますね。
ちなみに実行結果は見易さの為に適宜改行しています。

これはNet::OpenID::Consumer側でのcheck_urlメソッドの実装にて、168行目付近から、

# Finally we add in the extension arguments, if any
my %ext_url_args = ();
my $ext_idx = 1;
foreach my $ext_uri (keys %{$self->{extension_args}}) {
    my $ext_alias;

    if ($self->protocol_version >= 2) {
        $ext_alias = 'e'.($ext_idx++);
        $ext_url_args{'openid.ns.'.$ext_alias} = $ext_uri;
    }
    else {
        # For OpenID 1.1 only the "SREG" extension is allowed,
        # and it must use the "openid.sreg." prefix.
        next unless $ext_uri eq "http://openid.net/extensions/sreg/1.1";
        $ext_alias = "sreg";
    }

    foreach my $k (keys %{$self->{extension_args}{$ext_uri}}) {
        $ext_url_args{'openid.'.$ext_alias.'.'.$k} = $self->{extension_args}{$ext_uri}{$k};
    }
}

となってますが、OpenID Authentication 2.0プロトコルの場合は、aliasを使ってprefixを指定出来るんですね。ちょうどxmlnsみたいですね。

もちろんきちんと何の拡張なのかnamespaceを表すURIをaliasに対して明記する必要がありますが。

まとめ

  • check_url()の前にset_extension_argsでsregに必要な値を突っ込んでおく

でした。

*1:OpenID Simple Registration Extension 1.1のこと

DBIx::Class::Schema::Loaderの手動スキーマ生成、初心者向けチュートリアル

と言う訳で自分なりに色々調べてみた。

テスト用データベース定義

CREATE TABLE `User` (
  `user_id` bigint(20) NOT NULL auto_increment,
  `name` varchar(255) character set latin1 default NULL,
  `created_on` datetime default NULL,
  `updated_on` datetime default NULL,
  PRIMARY KEY  (`user_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;

CREATE TABLE `Book` (
  `book_id` bigint(20) NOT NULL auto_increment,
  `name` varchar(255) character set latin1 default NULL,
  `created_on` datetime default NULL,
  `updated_on` datetime default NULL,
  PRIMARY KEY  (`book_id`)
) ENGINE=InnoDB DEFAULT CHARSET=utf8;

CREATE TABLE `BookShelf` (
  `bookshelf_id` bigint(20) NOT NULL auto_increment,
  `user_id` bigint(20) default NULL,
  `book_id` bigint(20) default NULL,
  `created_on` datetime default NULL,
  `updated_on` datetime default NULL,
  PRIMARY KEY  (`bookshelf_id`),
  UNIQUE KEY `user_book_uidx` (`user_id`,`book_id`),
  KEY `book_id` (`book_id`),
  CONSTRAINT `bookshelf_ibfk_1` FOREIGN KEY (`user_id`) REFERENCES `user` (`user_id`) ON DELETE CASCADE ON UPDATE CASCADE,
  CONSTRAINT `bookshelf_ibfk_2` FOREIGN KEY (`book_id`) REFERENCES `book` (`book_id`) ON DELETE CASCADE ON UPDATE CASCADE
) ENGINE=InnoDB DEFAULT CHARSET=utf8;

ER図にするとこんな感じ。


DBIx::Class::Schema::Loaderを使ってSchemaクラスを生成する

とりあえずはCatalystとかとの連携を考えないで、ネイティブなDBICの事だけで考えます。

適当なディレクトリに行って、

$ module-starter --module DBICTest::DBIC::Schema --distro DBICTest-DBIC

みたいな感じでモジュールのスケルトンを作ります。

$ cd DBICTest-DBIC
$ mkdir -p bin
$ touch bin/update_schema.pl
$ chmod +x bin/update_schema.pl

とかやっておいて、このupdate_schema.plの内容をほとんどtypesterさんの奴のパクりで、

#!/usr/bin/perl

use strict;
use warnings;

use FindBin;
use File::Spec;

# ここは敢えてコメントアウトしておく
# use lib File::Spec->catfile( $FindBin::Bin, qw/.. schema/ );

use DBIx::Class::Schema::Loader qw/make_schema_at/;

die unless @ARGV;

make_schema_at(
    'DBICTest::DBIC::Schema',
    {   components => [ 'ResultSetManager', 'UTF8Columns' ]
        ,    # デフォでloadするcomponents
        dump_directory => File::Spec->catfile( $FindBin::Bin, '..', 'lib' )
        ,    # 出力先のディレクトリ
        really_erase_my_files => 1
        ,    # 元にあったファイルを再生成時に消すかどうか
        debug => 1,
    },
    \@ARGV,
);

んでもって、これを実行する。

$ ./bin/update_schema.pl dbi:mysql:database=dbictest root

みたいな感じで。

こうするとlibディレクトリ以下に、

$ find ./lib -name "*.pm"
./lib/DBICTest/DBIC/Schema/Book.pm
./lib/DBICTest/DBIC/Schema/Bookshelf.pm
./lib/DBICTest/DBIC/Schema/User.pm
./lib/DBICTest/DBIC/Schema.pm

みたいなのが出来ますよって話ですね。ここまでは非常に簡単なおさらいでした。

自動生成 + 手動生成

やはり色々と自動生成だけだとかゆい所まで手が届かなかったりします。
例えばMyISAM使ってるならリレーション設定は自動でやってくれないし、DBIC::Schemaの派生クラスなどにメソッド生やしたいとかそういう需要がある場合には、
自動生成で毎回作ってると色々と困る訳です。

ここでソリューションが二通りあって、

  • 別のINCパスに生やしたい差分を定義したモジュールを置いて、update_schema.plを実行する時のみ@INCにパスを通して実行 (typester版)
  • 生成されたモジュールのmd5sum以下に差分を定義する

と言う2パターンがあります。

別のINCにテンプレ

例えばこんな感じです。

$ mkdir -p schema/DBICTest/DBIC/Schema
$ touch schema/DBICTest/DBIC/Schema/User.pm

とかして、User.pmにて

package DBICTest::DBIC::Schema::User;

sub hoge {}

1;

などと書いておきます。
さらに、update_schema.plのuse lib部分のコメントアウトを外します。で再度実行する。

すると ./lib/DBICTest/DBIC/Schema/User.pm のファイル末尾付近に、

# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:WFbbTfTFDFr/kewSj3QwAw
# These lines were loaded from '/private/tmp/DBICTest-DBIC/schema/DBICTest/DBIC/Schema/User.pm' found in @INC.# They are now part of the custom portion of this file# for you to hand-edit.  If you do not either delete# this section or remove that file from @INC, this section# will be repeated redundantly when you re-create this# file again via Loader!
package DBICTest::DBIC::Schema::User;

sub hoge {}

1;
# End of lines loaded from '/private/tmp/DBICTest-DBIC/schema/DBICTest/DBIC/Schema/User.pm'

として、自前で定義した物が挿入されます。
なんでカスタムであれこれしたければこの辺りをゴニョゴニョすれば良い訳です。

差分を直に書く方法

実は「別のINCにテンプレ」方式だと一点問題があって、Schemaクラスの拡張定義を書けないと言う点。
と言うのもDBIx::Class::Schema::Loaderのmake_schema_atは最終的にモジュールをファイルに書き出す際に、DBIx::Class::Schema::Loader::Base内で、

  • _load_tables()
    • _load_external()
  • _dump_to_dir()
  • _write_classfile()

みたいな流れになっています。

この_load_externalこそ他のINCにあるテンプレを読み込む処理に他ならないのですが、_load_tables()の中で抽出したDBテーブルに対応したモジュールに限定しているのでSchemaに対するテンプレを記述しても追記されません。

そこで差分を直接書く方法を取ってみます。

update_schema.plで二点変更します。

  • use libを再びコメントアウト
  • make_schema_atのreally_erase_my_filesを0にする (つまり再生成時に消さない)

として、./lib/DBICTest/DBIC/Schema.pm のファイル末尾付近で、

# Created by DBIx::Class::Schema::Loader v0.04004 @ 2008-03-18 16:56:43
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:WFbbTfTFDFr/kewSj3QwAw

sub fuga {}

# You can replace this text with custom content, and it will be preserved on regeneration

こんな風にしておきます。そして再生成すると、きちんとコメントで囲われた部分の領域は保持されています。
意地悪して、データベースで、

ALTER TABLE User ADD COLUMN nickname VARCHAR(255);

として新しいカラムをわざと増やします。再びupdate_schema.plを実行してみると、
きちんとnicknameカラムの定義が増えてて、さらに自前で定義したfugaメソッドも残っている事が分かります。

まとめ

と言う訳でちょこまかDB定義を弄りながらやる場合は今回の手法のいずれかでやるのが良さそう。
Schemaに自動生成以上の何かをしたい場合は後者の手法しかないです。

あるいはSchema::Loader自体に手を加えるかですかね。
ふー、疲れたぜ。

DBICx::DeployでSchema->Database

DBICx::Deployが便利す。
これは既にある既存のSchemaクラスからデータベースを構築(deploy)する物です。

元々MySQLでテーブル作ってからDBIx::Class::Schema::LoaderとかでSchema生成してあったとして、
それをSQLiteで手元でちょっとテストとかそういうのに使えそう。

PODにあるまんまですけど。

$ dbicdeploy -Ilib My::Schema DBI:SQLite:root/database

こんなんで出来た。ウマー。

Class::C3::Componentised Source Code Reading

DBIC関連の基底クラスとも言えるモジュールがClass::C3::Componentisedです。

C3ベースのコンポーネント化されたクラスモジュールを作る際のベースですね。
1.0003をテキストとします。

load_components()

sub load_components {
  my $class = shift;
  my $base = $class->component_base_class;
  my @comp = map { /^\+(.*)$/ ? $1 : "${base}::$_" } grep { $_ !~ /^#/ } @_;
  $class->_load_components(@comp);
}

component_base_classってのはSynopsisにもありますが、基本的には決めうちの何か。例えばDBIx::Classとかって言う文字列を返す。

load_componentsに渡したリストの各要素で、

  • #をprefixに持つものはスキップ
  • +をprefixに持つならそのまま
  • そうでないならcomponent_base_classのsuffixとして

モジュール名として@compに格納して、_load_components()に渡してる。

_load_components()
sub _load_components {
  my ($class, @comp) = @_;
  foreach my $comp (@comp) {
    $class->ensure_class_loaded($comp);
  }
  $class->inject_base($class => @comp);
  Class::C3::reinitialize();
}

まぁここはそうして抽出したcomponentのリストに対して、

  • ensure_class_loadedして
  • inject_baseをコールして
  • Class::C3::reinitialize()

なんだけど、それぞれ簡単に。
ちなみにClass::C3::reinitialize()はもっかい継承ツリーを総なめする処理だと思うし、読むのがしんどそうなのでそれはパスする。

ensure_class_loaded()
sub ensure_class_loaded {
  my ($class, $f_class) = @_;

  croak "Invalid class name $f_class"
      if ($f_class=~m/(?:\b:\b|\:{3,})/);
  return if Class::Inspector->loaded($f_class);
  my $file = $f_class . '.pm';
  $file =~ s{::}{/}g;
  eval { CORE::require($file) }; # require needs a bareword or filename
  if ($@) {
    if ($class->can('throw_exception')) {
      $class->throw_exception($@);
    } else {
      croak $@;
    }
  }
}

そのモジュールがロードされてれば何もしなくて、そうでなければrequireしてみてコケたらthrow_exceptionメソッドが実装されてればそれを叩いて、そうじゃなきゃcroakするだけですね。

inject_base()
sub inject_base {
  my ($class, $target, @to_inject) = @_;
  {
    no strict 'refs';
    foreach my $to (reverse @to_inject) {
      unshift ( @{"${target}::ISA"}, $to )
        unless ($target eq $to || $target->isa($to));
    }
  }

  # Yes, this is hack. But it *does* work. Please don't submit tickets about
  # it on the basis of the comments in Class::C3, the author was on #dbix-class
  # while I was implementing this.

  eval "package $target; import Class::C3;" unless exists $Class::C3::MRO{$target};
}

特定のクラスに対して複数のコンポーネントをinjectする。

一回reverseしてからその特定のクラスがコンポーネントを継承していないならば、継承順位で先頭にどんどん突っ込んで行く。

つまり、

package Hoge;

use base qw(Class::C3::Componentised);

sub component_base_class { __PACKAGE__ };

__PACKAGE__->load_component(/Foo Bar Baz/);

ならば@ISAは、

@ISA = qw(Hoge::Foo Hoge::Bar Hoge::Baz Class::C3::Componentised);

ってなる。
最後の%Class::C3::MROに特定のクラスが無い場合のevalもパス。

load_own_components()

後はバリエーションですね。

sub load_own_components {
  my $class = shift;
  my @comp = map { "${class}::$_" } grep { $_ !~ /^#/ } @_;
  $class->_load_components(@comp);
}

なんで、

package Jitensya;

use base qw(Hoge); # Hogeはさっきの奴

__PACKAGE__->load_own_components(qw/Foo Bar Baz/);

は、

@ISA = qw(Jitensya::Foo Jitensya::Bar Jitensya::Baz);

になる。

load_optional_components()

sub load_optional_components {
  my $class = shift;
  my $base = $class->component_base_class;
  my @comp = grep { $class->load_optional_class( $_ ) }
             map { /^\+(.*)$/ ? $1 : "${base}::$_" } 
             grep { $_ !~ /^#/ } @_;

  $class->_load_components( @comp ) if scalar @comp;
}

#と+の取り扱いは今までと同じだけど、読み込み方が違う。load_optional_class()を使う。
これって実装が見当たらないのでサブクラスが実装してるかどうかなんでしょうな。多分。

これまったく持ってundocumentだなー。

まとめ

原則としてClass::C3::Componentisedの子孫クラスでは、load_*を読んだ場合は、指定したコンポーネントを自分の親クラスとして持つようになり、さらにClass::C3が使えるようになるんだけども、コンポーネントの略す際のベースが異なる。

  • load_components(@comp)は指定したコンポーネントをcomponent_base_classのsuffixとしたモジュールと見なしてload
  • load_own_components(@comp)は指定したコンポーネントを呼び出したpackage名のsuffixとしたモジュールと見なしてload

一方でload_optional_componentsはほとんどload_componentsと同じ仕組みなんだけど、最後にload_optional_class()でフィルタリング出来るよって代物だと思って良さそう。

DBICのTransactionとAutoCommit

追記(2008-03-16T02:21:32+09:00)


ごめんなさい、要約が超間違えてました><

要約

transactionしたい場合はAutoCommit => 1としてtxn_doすると幸せになれます。

解説

しようかと思ったけど、同様の現象で既にきちんと解説してる人が居るのでそちらにリンクする。

まだ感覚戻せない><

Catalyst::Controller::Atompubのdispatch、Slugヘッダとか

Atompubの勉強始めました。

Catalyst::Controller::Atompubについて

こちらはid:teahut*1さん自身がPerl(Catalyst)でAtompubサーバーを作る解説記事を書かれていますので、そちらを見ると大体分かると思います。

で今の所、分かった事とか困ってる事とか書いてみる事にします。

URLが基本的にpackage名で固定されてしまう。

例えば、コレクションFeedを取得したい場合はコレクションリソースURIに対してGETするんですけど、そのCatalystアクションの書き方は、

sub get_feed :Atompub(list) {
  # implements
}

みたいに書くんですが、これが仮にpackage MyApp::Foo::Collectionだとすると/foo/collectionに固定されてしまいます。

と言うのもCatalyst::Controller::Atompub::Collectionにて、

  • create_action()にてAtompub(xxx)みたいなattributeがある場合はxxxに応じたhandlerとしてCODEREFを保持
  • do_xxx(list, read, create, update, delete)を生成。この際、実行される実体は先ほど保持したCODEREF
  • dispatchは基本的にdefault, edit_uriで行い、ここがURIが決めうちになる原因となっている。それぞれHTTP Methodに応じて適切な実体(do_xxx)を呼び出すようになっている

なので、自前のURIとして例えば、/foo//collection みたいな物を提供したいなと思った場合はかなり力技に頼らねばならない。

力技とは、大体こんな感じ。

まず前提としてコレクションリソースURIにアクセスしたのかエントリリソースURIにアクセスしたかで、起動するメソッドが違う

  1. コレクションURI - default()
    1. GET, HEAD - _list()
    2. POST - _create()
  2. リソースURI - edit_uri()
    1. GET, HEAD - read()
    2. POST - _create()
    3. PUT - _update()
    4. DELETE - _delete()

で、default, edit_uriのdispatchが固定されてるんだから上書きしちゃえば良い。

sub default :Regex('^foo/(\w+)/collection') {
  my ($self, $c) = @_;
  $self->NEXT::default($c);
}

sub edit_uri: Regex('^foo/(\w[\w_-]+\w)/collection/([^-?&#][^?&#]*)') {
  my ($self, $c) = @_;
  $self->NEXT::edit_uri($c);
}

そして、その後はdo_xxxを直接実装しちゃうのがいいのかなーと思います。
多分この辺りはたけまるさんやid:ikasam_aが適切な補足をしてくれると思います。

たけまるさんの指摘を元に$c->NEXT::xxxを$self->NEXT::xxxに修正しました。(2008-03-11T23:11:41+09:00)

ところで、

なお,ZIGOROu さんの例では,default メソッドを先に定義していますが, 探索順の関係から edit_uri を先にしてください

これってどういう事でしょう。ちょっと僕には分からなかったです。

追記 (2008-03-11T20:05:55+09:00)

id:ikasam_a反応してくれたです。なるほどChainedアクションですか。
先の例だと、

sub user: Chained PathPart('foo') CaptureArgs(1) {
  my ($self, $c) = @_;
}

sub default: Chained('user') PathPart('collection') {
  my ($self, $c) = @_;
}

sub edit_uri: Chained('user') PathPart('collection') Args(1) {
  my ($self, $c) = @_;

}

みたいな感じかな。

Catalyst::Controller::Resourcesも期待ageですね。

割り当てられるエントリリソースURIについて

この辺りはCatalyst::Controller::Atompub::Collectionのmake_edit_uri()にて実装されています。ソース見た方が早いので拝借。コメントは僕が勝手につけました。

sub make_edit_uri {
    my ( $self, $c, @args ) = @_;

    # XML::Atom::Feedオブジェクト
    my $collection_uri = $self->info->get( $c, $self )->href;

    my $basename;
    if ( my $slug = $c->req->slug ) { # Slugヘッダがある場合
        my $slug = uri_unescape $slug;
        $slug =~ s/^\s+//;
        $slug =~ s/\s+$//;
        $slug =~ s/[.\s]+/_/;
        $basename = uri_escape lc $slug;
    }
    else { # Slugヘッダが無い場合
        my ( $sec, $usec ) = gettimeofday;
        $basename = join '-', strftime( '%Y%m%d-%H%M%S', localtime($sec) ),
            sprintf( '%06d', $usec );
    }

    my @media_types = map { media_type($_) } ( 'entry', @args );

    my @uris;
    for my $media_type (@media_types) {
        my $ext = $media_type->extension || 'bin';
        my $name = join '.', $basename, $ext;
        push @uris, join '/', $collection_uri, $name;
    }

    return wantarray ? @uris : $uris[0];
}

って訳でSlugヘッダがあるか無いかで命名規則が違う実装みたいです。
この辺りはRFC 5023 Atom Publishing Protocol 日本語訳 - Slugヘッダを見ると良く分かります。

Slug は HTTP エンティティヘッダであり、コレクションに POST が行われるときのこのヘッダの存在は、これから作成されるエントリないしメディアリソースを参照するために通常使用される URI の一部としてそのヘッダの値を使ってほしい、というクライアントの要求を示す。 新しく作成されたリソースのメンバ URI を作るとき、サーバは Slug ヘッダの値を使ってもよい(MAY)。たとえば、最後の URI セグメントにその値の中の単語の一部、あるいはすべてを使う。また、atom:id を作成するとき、あるいはメディアリンクエントリのタイトルとしてその値を使ってもよい(MAY)(9.6 節参照)。 サーバは Slug エンティティヘッダを無視することを選択してもよい(MAY)。サーバはそれを使う前に、ヘッダの値を変えるかもしれない(MAY)。たとえば、サーバはある文字を取り除くか、あるいは強調されていない文字を強調された文字に置き換えるか、あるいは下線をスペースで置き換えるかもしれない。

なので、Slugヘッダがあった場合は新しいエントリないしはメディアリソースのURIの一部として使用しても構わないと。

Atompub::Clientを使ってcreateEntryする場合は、

#!/usr/bin/perl

use strict;
use warnings;

use XML::Atom::Entry;
use Atompub::Client;

sub create_entry {
    my ($title, $content) = @_;
    my $entry = XML::Atom::Entry->new;
    $entry->title($title);
    $entry->content($content);
    return $entry;
}

sub create {
    my ($collection_uri, $title, $content) = @_;
    my $client = Atompub::Client->new;
    return $client->createEntry(
        $collection_uri, 
        create_entry($title, $content), 
        $title ### ここがSlugヘッダの値になる
    );
}

print create(@ARGV);

みたいなソースになる。

*1:たけまるさん

XML::LibXML::XPathContextで良くやるミス

自戒の為にメモっとく。

<?xml version="1.0" encoding="utf-8"?>
<doc xmlns:foo="http://foo.com/" xmlns="http://bar.com/">
  <x/>
  <foo:x/>
</doc>

なんてxmlがあるとして、

#!/usr/bin/perl

use strict;
use warnings;

use XML::LibXML;
use XML::LibXML::XPathContext;

my $doc = XML::LibXML->new->parse_file("test.xml");
my $xpc = XML::LibXML::XPathContext->new($doc);

print $xpc->findnodes('//x')->size . "\n";

これは期待に反して「0」と返って来る。
正解はこちら。

#!/usr/bin/perl

use strict;
use warnings;

use XML::LibXML;
use XML::LibXML::XPathContext;

my $doc = XML::LibXML->new->parse_file("test.xml");
my $xpc = XML::LibXML::XPathContext->new($doc);

$xpc->registerNs("bar", "http://bar.com/");

print $xpc->findnodes('//bar:x')->size . "\n";

xmlnsのprefixが空でもXPathContextで空文字で無いprefixを指定しないと動きません。