unknownplace.org

ps の出力をパースしたかったんだけど、日付部分めんどいなと思いきや Date::Manip 使ったら一発だった。覚えててよかった！

30boxes.pl とかで使われてるやつ。

Catalystは Authentication::Credential::* プラグインを複数使うことにより、複数の認証方式に対応できる。

IP認証などのような、Credプラグインが提供されていないものも即席でCredインタフェースにそったモジュールを作ることで簡単に認証方法を追加することができる。

MyApp.pm はこんな感じ

package MyApp;

use strict;
use warnings;

use Catalyst::Runtime '5.70';
use Catalyst qw/
    ConfigLoader

    Authentication
    Authentication::Credential::HTTP
    +MyApp::Credential::IP
    Authentication::Store::DBIC
    /;

our $VERSION = '0.01';

__PACKAGE__->setup;

Cred::HTTP が Basic 認証用のモジュール。+MyApp::Credential::IP がIP認証用のオリジナルモジュール。

この MyApp::Credential::IP のコードはこんな感じ。

package MyApp::Credential::IP;
use strict;
use warnings;
use base qw/Catalyst::Plugin::Authentication::Credential::Password/;

sub authenticate_from_address {
    my $c = shift;

    my $ip = $c->model('DBIC::UserIp')->find({ ip => $c->req->address }, { prefetch => 'user' })
        or return;
    my $user = $c->get_user( $ip->user->username )
        or return;

    $c->set_authenticated($user);

    1;
}

1;

こんな短いコードで認証増やせるの。なかなか便利。

で、実際に利用するのは以下のように、Root Controller の auto アクションに

sub auto :Private {
    my ($self, $c) = @_;

    # basic auth
    $c->authenticate_http and return 1;

    # ip auth
    $c->authenticate_from_address and return 1;

    # return basic auth response when no auth success
    $c->authorization_required_response( realm => 'Require Authentication' );
    return;
}

などとする。

全体に認証かけたいときはルートコントローラの auto に、コントローラ個別に指定したいときは、上記コードを埋め込んだ認証用の親コントローラクラスつくって認証必要なコントローラはそれを継承する。

パスごとにやりたいときは Authentication::ACL ってのがあるけど僕は使っていない。

すげーよく使うわりに使い方を覚えられないので、毎回docみてる。

APIがわるいんだろうなぁ。ラッパるのがいいんかなぁ。

use base qw/Class::Accessor::Fast/;

sub new { shift->SUPER::new( @_ > 1 ? {@_} : $_[0] ); }

っていうだけのモジュールがほしい件。

書き忘れたけどさっきの update_schema.pl は

./script/myapp_update_schema.pl dbi:mysql:tablename username password

見たいな感じで DSN を渡す必要がある。めんどう。

ここら辺があれでまだヘルパーにはなってない。

mizzy.org : Re: DBICとDBIx::Class::Schema::Loader 僕のいろいろな勘違い

僕の中で流行ってる使い方があるのでかぶせて書いておいてみる。mizzy さんの二個目の例を自分ルール化させた感じ？

作業は一般的なCatalystアプリのディレクトリ構造上であるとして、そこに新しく schema というディレクトリを作成。

そんで、

• schema/lib/Schema/{TableName}.pm

に各テーブルのリレーション定義とかメソッドとかを自分で書く。実際にこのライブラリは Catalyst にロードされない。

上記ファイルを元に Schema::Loader の make_schema_at を使い

• lib/MyApp/Schema.pm
• lib/MyApp/Schema/*.pm

にコードを自動生成して、そちらをロードするという感じ。こちらのコードは自分では書き換えない。

コード自動生成は script/myapp_update_schema.pl にこんなのを書いてそれを実行している。

#!/usr/bin/env perl

use strict;
use warnings;

use FindBin;
use File::Spec;
use lib File::Spec->catfile( $FindBin::Bin, qw/.. schema lib/ );

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

die unless @ARGV;

make_schema_at(
    'MyApp::Schema',
    {   components     => ['ResultSetManager', 'UTF8Columns'],
        dump_directory => File::Spec->catfile( $FindBin::Bin, '..', 'lib' ),
        dump_overwrite => 1,
        debug => 1,
    },
    \@ARGV,
);

@INC に schema/lib をくっつけてから make_schema_at してるだけ。ワンライナーでもできるけど見通しが悪いので。

これで普通の make_schema_at でつくられる Schema ファイルに自分で schema/lib/Schema/ 以下に書いた定義がくっついて出力されるという寸法。

Schema::Loader でダイナミックロードを使っていると各テーブルクラスにはリレーション定義やメソッド拡張のコードだけをかけばいいのでシンプルになって好きなんだけど、そうすると起動時のオーバーヘッドがあるし、ResultSetManagerがつかえなくていやんというときに、これだとまぁイイとこどりのような感じにできる。

実際にいじるファイルは schema/lib 以下のファイルで、それらのファイルを更新するたびに update.pl を実行するというのがあれだけどまぁ自動化できる。してないけど。

難点は、schema/lib 以下のファイルでsyntax errorがあっても何も言われないこと。

何も言われないというか、syntax error があるファイルは

# Loaded external class definition for 'MyApp::Schema::TableName'

ってのが出ないだけという。どこがエラってるのかとかがわからないので、がーーって書いてどこか typo してたりするとはまるかも。

ファイルアップロードしたときに、サーバーが自動でどっかファイルに保存しつつ受信して、fastcgi にはファイルを渡さずファイル名を渡す。

結構でかいファイルだと Webサーバー <-> FastCGI 間のファイルデータのやり取りに時間かかってすげー無駄だ。

lighty が実装しねーかなぁ。

perlbal でできたりするのかな。

んー

for my $date_column (qw/created_date modified_date/) {
    __PACKAGE__->inflate_column(
        $date_column => {
            inflate => sub { DateTime::Format::MySQL->parse_datetime(shift)->set_time_zone('UTC') },
            deflate => sub { DateTime::Format::MySQL->format_datetime(shift->set_time_zone('UTC')) },
        }
    );

    {
        no strict 'refs';
        *{"$date_column\_for"} = sub {
            my ($self, $user) = @_;

            ($user && $user->info && $user->info->time_zone)
                ? $self->$date_column->set_time_zone( $user->info->time_zone )
                : $self->$date_column;
        }
    }
}

こんな感じ。普通にIRCっぽくなる。

安定してるから nick に @ つけるのはオプションにしてほかのクライアントでもつかえるようにしようかなぁ。

作った！

空前の Twitter - IRC ゲートウェイ作成ブーム。

ソースこの辺です。ライセンスは GPLv2。(たぶん。PoCo::Jabberのせいです。)

http://svn.unknownplace.org/public/scratch/Twirc/

これの特徴は

• Jabber 使ってるのでリアルタイム性が高い
• nick に @ つけているのでクライアントによってはバグる

などです。

二個目は LimeChat でおかしくなることを確認。

まー僕の使ってる irssi で動けばいいのです。

irssi は nick の補完ができるので、@ をつけておけばいい感じで twitter 形式のレスができるってわけです。

使い方

1. svn co
2. yaml いじる (jabberアカウントと、IRCのポートとIRCクライアントの文字コード)
3. ./script/twirc.pl
4. IRCクライアントでつないで #twitter に join

あと、2で設定するjabber(or gtalk)アカウントはあらかじめtwitterで使えるように設定しておく必要があります。