2007-03-01

[flipclip][plagger] FlipClipのフィードでPlaggerでWSSE認証

FlipClipでもWebAPIってことで、まずはクリップ検索用のフィードを公開しました。

http://www.flipclip.net/developer/

（...って、もう公開から１ヶ月経ってる話題なんですがw）

せっかくだから、とりあえず簡単になんかやってみようってことで、そうなるとやっぱりPlagger？。
実はずいぶん前に、とりあえずインストールだけはしたものの全然さわってなかったんで、まあちょうどいい機会かなということで試してみました。

とりあえず普通にクリップの一覧とか取ってくるだけなら、Subscription::Configでurlだけ書いとけばOKで、なんも考える必要もなくてアラ簡単！なんだけど、それだけじゃネタにもなりませんね。
FlipClipのクリップ検索フィードでは、誰でも見られる「一般公開」クリップの他、自分だけが見られる「非公開」、「友だちのみに公開」、「（指定した）グループに公開」などのように、それぞれ閲覧を制限されたクリップも、認証機能を利用して取得することができます。
まあ、自分の非公開クリップのフィードが取れてもあまりうれしくない気もしますが、自分の友だちが、友だちのみに公開しているクリップが見れるってのはちょっといいかもね。ということでこっちでいってみよう。

でもってさっそく、まずはPlaggerでWSSE認証ってどうすんの？
とりあえずUserAgent::AuthenRequestってのがあるので、これ使えばOKかな？楽勝楽勝！、とか思ってたら、どうもうまくいかないっぽい。
いろいろソースを見てみると、結局これ（というかLWP::UserAgent）は、Webサーバから401が返ってきたら認証ヘッダを投げるっていう実装なわけで、まあもちろんそれが正しいんだけども、今回のフィードAPIはというと、認証ヘッダがなかったら一般ユーザーとして扱い、認証ヘッダがあったら認証する、っていう仕様なもんだから、そもそも401は返ってこないわけですね。

じゃあもうしかたないから、もう頼まれなくてもこちらから一方的に認証ヘッダを送りつけてやらないとってことになりますね。すでになんかそういうのができる方法もあるのかもしんないけど見つからなかったので、ちょろっとプラグインを書いてみました。

ということでUserAgent::AuthenRequest::Constraint。
とりあえず名前もコードもかなりテキトーです。
こんな感じで使います。

    - module: Subscription::Config
      config:
        feed:
          - url: http://flipclip.net/clips/hi-rocks/friends/?_accept=rss
    - module: UserAgent::AuthenRequest::Constraint
      config:
        username: hi-rocks
        password: hogehoge

ソースはこんな。（WSSE認証文字列を生成するとこは、フィードのドキュメントにある例と同様、LWP::Authen::Wsseからほぼそのまんま拝借。）

package Plagger::Plugin::UserAgent::AuthenRequest::Constraint;
use strict;
use warnings;
use base qw(Plagger::Plugin);
use Digest::SHA1;
use MIME::Base64;

sub register {
    my ( $self, $context ) = @_;
    $context->register_hook( $self, 'useragent.request' => ?&add_wsse_header,
    );
}

sub add_wsse_header {
    my ( $self, $context, $args ) = @_;

    my $username = $self->conf->{username};
    my $password = $self->conf->{password};

    my $wsse_value = create_auth_header( $username, $password );
    $context->log( info => "Adding X-WSSE header: $wsse_value" );

    $args->{ua}->default_header( 'X-WSSE' => $wsse_value );
}

sub create_auth_header {
    my ( $username, $password ) = @_;

    my $pass_digest = Digest::SHA1::sha1_hex($password);
    my $now         = now_w3cdtf();
    my $nonce       = make_nonce();
    my $nonce_enc   = MIME::Base64::encode_base64( $nonce, q{} );
    my $digest      = MIME::Base64::encode_base64(
        Digest::SHA1::sha1( $nonce . $now . $pass_digest ), q{} );

    return 'UsernameToken '
        . join( ', ',
        qq(Username="$username"), qq(PasswordDigest="$digest"),
        qq(Nonce="$nonce_enc"),   qq(Created="$now"),
        );
}

sub make_nonce {
    Digest::SHA1::sha1( time() . {} . rand() . $$ );
}

sub now_w3cdtf {
    my ( $sec, $min, $hour, $mday, $mon, $year ) = gmtime();
    return sprintf(
        "%04s-%02s-%02sT%02s:%02s:%02sZ",
        $year + 1900,
        ++$mon, $mday, $hour, $min, $sec
    );
}

1;

わざわざこんなんしなくても「そんなのこうすればできるよ！」とかあったら教えてください。
あ、WSSE認証やめてクッキー使う、とかはとりあえず今回はナシで。

2007-02-27

[ffmpeg] ffmpegのconfigureオプション

昨日、久々にsvn最新をビルドしてみようとしたら、いつの間にか（r7967〜）configureオプションが変わってた。
てなわけで、とりあえずメモ。

外部ライブラリを有効にするオプションで、今までは

--enable-hoge

だったのが、

--enable-libhoge

になったみたい。
といっても全部ってわけじゃなくて、該当するのは↓だけね。

a52
a52bin
dts
faac
faad
faadbin
mp3lame
vorbis

2007-01-10

iPhone

Apple

というわけで出ましたiPhone。まああらかじめ各所で予想されてたので驚きもなかったし、それよりもLeopardの話は何もなし？とか、最初はけっこう冷めた印象だったんだけど。
とりあえずザッといくつか情報見てたら、ひょっとしてスゴイかもとか思い始めてきた。

ようするに、これって携帯電話って言っちゃうとまあそうなんだけど、実体はというと、新しいインターフェイスを持ったハンドヘルドMacじゃん！
OSがMacOSXでSafariが動くってことは、フルスペックのFlashPlayerとJavaScriptが使えることも期待しちゃうんだけど、そうなるとFlipClip（重要！w）やYouTubeの動画も見られるし、Ajax使ったWebアプリも普通に使えるんじゃね？とか。少なくともDashboard Widgetは動くっぽいからJavaScriptは問題なさそうだよね。これ用に新たなWidgetのアイデアなんかも出てくるかもしれないし。それからもちろん、これ自体OSXで動いてるということで、さらにいろいろなHackも期待できるかも。
単純なタッチパネルってだけじゃない感じのインターフェイスも含め、少なくともWindowsMobile機やなんかと同列に語られるものではないんではないかと。

日本で携帯電話として利用できるようになるまでにはけっこう遠そうな気もするけど、これ単体でも充分すぎるくらい魅力的で、かつ革新的なデバイスになりえるんではないかという予感に胸いっぱい！！なんですが。。。さてどんなもんでしょうかね。

2007-01-10

2007年

いまさらあけましておめでとうございますかよって感じですが、Macファンの新年はMacExpoが開けてから始まるものです。（てのは後付けで、ただ書きそびれてただけですがw）
というわけで、まずは初心に返ってというわけでもないですが、このblogタイトルもシンプルなものに戻してみました。
まあ、またすぐに変えるかもしんないけどね。

そんで、今年の抱負というか、オレ的テーマは、とにかくもっと積極的にアウトプットしていこう、ということで決定しました。

まずは、mixiにしても、ここにしても、今年はもうちょっとマメに書いていくようにがんばろうかと思います（って、これまでにも何回も宣言したような気もするが気にしない気にしない）。今までって、けっこうためこんじゃった後で、タイミング逃して書くのやめちゃったり、やっと書いても、ためこんだぶんダラダラ〜っと長くてまとまりがないものになっちゃったりってのが多かったので、今年はもうちょっとコンパクトかつタイトでいきます。

それから、自分プロジェクトを何か始めようと思ってます。いろいろと他社のエンジニアの人とかと会って話したりすると、自分の仕事以外にも、なにかそうやって個人的に取り組みをしてる人がけっこういたりして、そのたびに刺激を受けたりはするものの、これまではなかなか自分で行動に移すまでには至らずってとこだったんだけど。
とりあえずアイデアだけとかそんなのはいくつかあるから、どれかに絞ってちゃんとそれを実現したいなと思います。（それに伴って、1999年からやってきたけど今は完全に休止状態になってる自分の個人サイトも一回全部整理する。）
まあ、今から何か取り組んで、YAPC::Asia2007で発表したい、とかそこまでいけるとは考えちゃいませんがw。

というわけで、とにかく自分ももっとオープンソースコミュニティに、というか人の役に立てるようなことがしたいな、と考えてるわけです。あとは、なんだかんだと後回しにしちゃってたけど、いいかげんCPAN（PAUSE）のアカウントも取っとくか、とかですかね。（まずはそこからって話もあるw）

そんな感じでいきますんで、今年もどうぞよろしくお願いいたします。

2006-12-28

DBIC::Schema::Loader 使う時のリレーションとか

perl DBIC

いきおいついでにもういっちょ。
DBIC::Schema::Loader 任せってわけにいかないのは言うまでもないので、なんとかしてやらなきゃなりませんね。
んで、最初から「convention over configuration」な設計ができてれば MoFedge::Data::DBIC::Schema のように半自動化することもできると思いますが、すでにそうでもない感じwになってしまってる場合の対応を考えてみました。

まあ、結局のところ「規約じゃなくて設定」になるわけなんですが。
とりあえず、こんな設定ファイルをYAMLで書いて、

artist:
    relationship:
        cds:
            - has_many
            - cd
            - artist_id
    utf8_columns:
        - name
cd:
    relationship:
        artist_id:
            - belongs_to
            - artist
        tracks:
            - has_many
            - track
            - cd_id
        liner_notes:
            - might_have
            - liner_notes
            - 
            - proxy
                - notes
                - writer
    utf8_columns:
        - title

で、こいつをこんなふうに読ませる。（ついでに UTF8Columns なんかも面倒見てます）

my $config  = YAML::Syck::LoadFile( $config_yaml );
my $classes = $schema->loader->classes;

for my $table_name ( keys %$config ) {
    my $class = $classes->{$table_name};

    my $relationship = $config->{$table_name}->{relationship};

    if ( ref $relationship eq 'HASH' ) {
        for my $accessor ( keys %{$relationship} ) {
            my ( $relation_type, $related_class_name, @attr )
                = @{ $relationship->{$accessor} };
            my $related_class =
                ( $relation_type ne 'many_to_many' )
                ? $classes->{$related_class_name}
                : $related_class_name;
            $class->$relation_type( $accessor => $related_class, @attr );
        }
    }

    my $utf8_columns = $config->{$table_name}->{utf8_columns};

    if ( ref $utf8_columns eq 'ARRAY' ) {
        $class->load_components(qw/UTF8Columns/);
        $class->utf8_columns( @{$utf8_columns} );
    }
}

とりあえずこれだけできればOKかなあ。あとなんかあるかしら。
他にもなんかおかしかったりしたら、どなたかつっこんでくださいませ。

2006-12-28

DBICのRの件

perl DBIC

僕も最近ようやくDBICを触り始めました。まだ手探りな感じですが、とりあえずid:nekokakさんのとこはかなり参考にさせてもらいながら、いろいろ試し中です。（まだ新しいWeb+DBは見てませんすいません）

そんで、表題の件なんですが。
http://d.hatena.ne.jp/nekokak/20061227/1167210571

結局、ResultSetクラスにメソッド生やしちゃうと、全部のSchema（テーブル）でそのメソッドが共有されちゃうことになって、あんまりうれしくないケースもあったりすると思うんですが。。。そんなことないですか？そうですか。

てなわけで、ワタクシとしては

案２：自分でResultSetのクラスを作成する。

かなあ、という結論にいたりました。

んで、テーブルごとに MyApp::Schema::User に対して MyApp::Schema::User::ResultSet って作っておいて、Schemaをロードするクラス（ちなみに DBIC::Schema::Loader 利用）の中で、

my $resultset_class = "$class?::ResultSet";
if ( $resultset_class->use ) {
    $class->resultset_class($resultset_class);
}

こんなふうにするといい感じかなー、と。
まあ、ResultSetクラスの位置はここが適切なのか、やや疑問もないではありませんが。。。

2006-10-18

Sledge::Plugin::JSON 進化してます

perl sledge

id:nekokak さんがモバイルファクトリーのレポジトリで公開されている Sledge::Plugin::JSONに、ライブドアの金子さんがパッチを書いて公開されてました。

実は何を隠そう、僕もちょうど１年ほど前に、同名のプラグインをでっち上げwてみたりしてたんですが、ちゃんとここも見つけてくださって、ちょろっと触れていただいてました。

ちなみに、 d:id:hi-rocks さんが一年くらい前に同名のプラグインを公開されてたんですね。こちらも CPAN にはアップしていないようで。 AUTHOR: nekokak, originally-devised by hi-rocks で改めて CPAN にアップとか、どうですかね？

こちらとしましては、そんなところに名前を入れていただくのももったいないような気がしないでもないんですが、いずれにしろ「AUTHOR: nekokak」でアップしていただくことに異論はありませんです。

そんで、ちょっと話は逸れますが、Sledge といえばまずはライブドアかモバイルファクトリーってな状況で、われらがフリップクリップとしてはその次くらいの存在になりたいなーとか思ってます。まあ、僕は外向けにはほとんどなんもやってないんですけどねw。そのかわり？に相方の horiuchi がいろいろがんばってますので、どうぞよろしくお願いします。（人材も募集中です。興味のある方はhoriuchiのblogからどうぞ〜）

でもって、基本的に nekokak さんバージョン＋金子さんパッチな構成でいいんじゃないかと思うんですが、僕のほうでも、非公開ながらもコツコツと改良（ってほどでもないけど）してきた部分もありまして、このへんもうまいことマージして取り込んでもらえたらいいなーとか思ったりもします。まあこんな↓感じなんですが、どうでしょう、使えそうなとこはありますかねえ。。。

（いちおう）JSON::Syck だけじゃなく JSON.pm もサポート

フリップクリップでも JSON::Syck を使ってるので、ウチ的にはなくてもかまわないんですが。手元のやつはいちおう JSON.pm でも使えるようにしています。import 時にモジュールの有無をチェックしてクロージャを作って mk_json メソッドとしてます。
まあ、これはなくてもいいのかなあ？よくよく考えてみたら、Sledge は使えるのに JSON::Syck がインストールできない環境ってありえないよね。

$self->json で param()

$self->tmpl->param( foo => 'bar' );

とかのように

$self->json->param( foo => 'bar' );

ってできたらいいかなー、と。
あとは $self->output_json するだけ。

TT で整形して出力

普通にハッシュを dump して JSON にするだけならいいんだけど、例えばオブジェクトとかイテレータとかを渡してあとはよきにはからってくれたらなーとか考えると、やっぱりテンプレートに頼ってしまうってのもありかな、ということです。

$self->output_json_tt();

こうすると

$self->load_template($self->page.'.json');
$self->tmpl->param(%$obj);
my $content = $self->make_content;

こんな感じでテンプレートを読み替えてTTで普通に出力するってだけなんだけど。んで、テンプレート名とかは柔軟に変更できるほうがいいのかな。

てな感じで、以下コードの抜粋です。もうちょっと絞ったほうがよかったかな。
そんで、ところどころなんかおかしいような気もするんで、添削も歓迎しますです。

sub import {
    my $class = shift;
    my $pkg   = caller;

    no strict 'refs';
    *{"$pkg?::json"} = sub {
        my $self = shift;
        return $self->{_json};
    };
    *{"$pkg?::mk_json"}        = $class->_mk_json_closure();
    *{"$pkg?::output_json"}    = ?&_output_json;
    *{"$pkg?::output_json_tt"} = ?&_output_json_tt;

    $pkg->register_hook(
        AFTER_INIT => sub {
            my $self = shift;
            $self->{_json} = $class->new;
        },
    );
}

sub _mk_json_closure {
    my $pkg = shift;

    if ( "JSON::Syck"->require ) {
        return sub {
            my ( $self, $obj ) = @_;
            $obj ||= $self->{_json};
            return JSON::Syck::Dump($obj);
        };
    }
    elsif ( "JSON::Converter"->require ) {
        my $j = JSON::Converter->new;
        return sub {
            my ( $self, $obj ) = @_;
            $obj ||= { %{ $self->{_json} } };
            return $j->objToJson($obj);
        };
    }
    else {
        croak("$pkg requires either JSON::Syck or JSON");
    }
}

sub _output_json {
    my ( $self, $obj, $charset ) = @_;
    my $content = Encode::encode("UTF-8", $self->mk_json($obj));
    $self->json->output( $self, $content );
}

sub _output_json_tt {
    my ( $self, $obj ) = @_;
    $obj ||= $self->{_json};
    $self->load_template( $self->page . '.json' );
    $self->tmpl->param(%$obj);
    my $content = $self->make_content;
    $self->json->output( $self, $content );
}

sub output {
    my ( $self, $page, $content ) = @_;

    if ( my $callback = $self->callback ) {
        utf8::decode($callback);
        if ( $callback =? /^[a-zA-Z0-9?.?_?[?]]+$/ ) {
            $content = sprintf "%s(%s);", $callback, $content;
        }
    }

    $page->r->content_type('application/x-javascript; charset=utf-8');
    $page->set_content_length( length $content );
    $page->r->send_http_header;
    $page->r->print($content);
    $page->invoke_hook('AFTER_OUTPUT');
    $page->finished(1);
}

sub param {
    my $self = shift;
    if ( @_ == 0 ) {
        return keys %$self;
    }
    elsif ( @_ == 1 ) {
        return $self->{ $_[0] };
    }
    else {
        $self->{ $_[0] } = $_[1];
    }
}

1;