DBIx::Class::Schema

17 March 2006


* 为什么要选 DBIx::Class 而不是 Class::DBI ?
因为似乎 Class::DBI 只支持单个数据源的抽象层。而 DBIx::Class 是可以支持多个数据源。

* 为什么是 DBIx::Class::Schema ?
因为 DBIx::Class::Schema 可以先将数据库里的表抽象化而不管这个数据源是什么。你可以随便将不同的表抽象化,只要在后来的代码中指定数据源就可以。而对于不同的数据源可以构造不同的实例。

ok, 我得承认我说得可能很难理解。但是我们可以写一些代码加深我们的印象:
package Foorum::DBIC;

use strict;
use warnings;

use base qw/DBIx::Class::Schema/;

__PACKAGE__->load_classes(qw/User/);

package Foorum::DBIC::User;
use base qw/DBIx::Class/;

__PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('user');
__PACKAGE__->add_columns(qw/username password/);

上面这两段中我们没有指定这个数据库在哪个地方,而是假设有个数据库,里面会有个 user 表,表里有字段 username, password.
这种不指定数据源而是指定里面的模型结构的做法叫做 Schema, 这与以前的 Class::DBI 不同,Class::DBI 最基类中就要指定数据源。
做完了这个模型,我们就可以在实际代码中指定数据源而且使用了。
use Foorum::DBIC;

my $schema = Foorum::DBIC->connect(
'dbi:mysql:foorum1',
'root',
'pass',
{ AutoCommit => 1 },
);

my $result = $schema->resultset('User')->search( {username => 'fayland'} )->first;
print $result->password();

然后你可以在另外的数据源里使用这个 schema, 比如在上面接下来写:
my $schema2 = Foorum::DBIC->connect(
'dbi:mysql:foorum2',
'root',
'pass',
{ AutoCommit => 1 },
);

my $result2 = $schema->resultset('User')->search( {username => 'fayland'} )->first;
print $result2->password();

只要这个数据源 foorum2 里有个表是 user, 里面有字段 username, password 就可以。

这就是数据库抽象层的另一种做法,一种与 Class::DBI 不同的做法。
当然,我理解的可能有误,我得继续试下去,因为工作中是多个数据源的。非要用 DBIx::Class::Schema 不可。还得用到 Catalyst::Model::DBIC::Schema

* 参考
** perldoc DBIx::Class::Schema
** perldoc Catalyst::Model::DBIC::Schema

Shanghai Day 3

15 March 2006


ok, guys. At last, we decided to use DBIx::Class as our model. We planned to migrate to Catalyst within the coming month. I'll share my experience with you in the migration process. Of course, I'll not tell you anything related to the source code, which is not allowed. Yup, I'll be busy in the coming month, which is what I want. ;-)

cnhackTNT told me that he'll come to Perl Conf/BeiJing at 25th this month, yet I'm still not sure. I wish I could go. I bet I'll go if the work is going smoothly in the next week.

God bless me.

Shanghai Day 2

14 March 2006


It's not a busy day since I don't get into Zorpia's source code too much. My boss Jeffrey want to migrate the old Zorpia platform to Catalyst.
We talked something about Catalyst, especially the Model part. Since the old Zorpia source code have some SQL sentences much more complex than you thought(and we have a much much more complex database structure, which likes load balance on different servers), they doubted whether the DBIx::Class can handle them all and whether there is any speed efficiency problem. Maybe they'll use pure DBI instead, but that's not what I like. I prefer DBIx::Class, which is more cleaner, more expansive. Any way, that's not up to me. My right is to express my idea before all is nailed down.

God bless me.

Shanghai

13 March 2006


Hi, I'm at Shanghai now, in the East Asia Hotel at NanJing Eastern Road.
I'll be busy at day, but u guys can drop by after 7pm if u want a chat. :)

I met my fellow workers today, not my boss at this moment. We'll work together this week. to be honest, I'm a bit excited and upset. :)

The wireless of the hotel seems not to work, anyway, I'll query the information desk and try it tomorrow.

I'm just back from WaiTan, a bit tired. I'll update my blog tomorrow if I have free time. :)

数据迁移

11 March 2006


既然新买了笔记本,就将台式机退休掉。不过里面的数据可一个也丢不得。有时候仅仅用 copy+paste 是行不通的,有些软件还是有其内在的迁移方法。

Subversion
根据中文版 SVN 指南,首先将老电脑里的 svn 数据导出,比如说我自己的 svn repos 在 E:/repos
e:
svnadmin dump repos > dumpfile
然后将 e:/dumpfile 拷贝到新的电脑中。我还是想在 E:/repos 里放自己的 svn repos.
于是在新的电脑里执行:
e:
svnadmin create repos
svnadmin load repos < dumpfile
Firefox
因为 Firefox 保存了我好的网页密码,有些网页密码我自己都不太记得起了。还有呢,n 多插件如果重新安装那不得累死呀。还好在 Mozilla Firefox Support 里找到自己想要的东西。
首先在老的电脑里,找到 C:\Documents and Settings\Administrator\Application Data\Mozilla\Firefox\Profiles (找不到就搜索) 里找到一个 kg06lpn3.default 文件夹,将这文件夹里的所有资料都拷贝到新的电脑里,比如说我就把它拷贝到 E:\Profiles\Firefox\kg06lpn3.default
然后在新的电脑里,找到 C:\Documents and Settings\fayland lam\Application Data\Mozilla\Firefox (找不到就搜索)下面的 profiles.ini, 编辑将两行改为:
IsRelative=0
Path=E:\Profiles\Firefox\kg06lpn3.default
MySQL and Thunderbird
MySQL 类似于 Subversion 的做法,或者用 phpMyAdmin 来搞。
不过我老电脑里用的是 4.x 而新的用的是 5.x 似乎转过来 utf8 的中文显示部分是乱码部分是正常的,弄得我也搞不清了。
而 Thunderbird 则类似于 Firefox, 参见:http://www.mozilla.org/support/thunderbird/profile
这样能将 Thunderbird 的所有邮件和新闻组,还有 filters 都会拷贝过来,啥都不会丢。

还有一些还没弄完,只好等明天再弄了。今天太累了。病也还没好,得早点去睡了。

job day

25 February 2006


It's just another job day.

I'm still working at the "ticket" system. It's almost done expect the user authentication part.

And my previous work gets online now. Pierre(EuropeanServer) just uploaded this script to 1001forums.com. It's a comment system with "captcha"( Authen::Captcha ).

That's my two paid work.

The open-source "ShellWeb" finally switched from CVS to Subversion. But I'm not deeply involved since the code is not so clear to me. Get the lastest source from:

svn co https://svn.sourceforge.net/svnroot/shellweb/trunk shellweb
At last, I want to show your another TT tooltips I asked today.

TT 小提示


我向 [email protected] 邮件组发送了如下这样的问题:
hi, all.

in the front of the code ,I create TT instance like this:

[snip]
use vars qw/$tt/;
my $tt = Template->new({ PRE_PROCESS => 'header', POST_PROCESS => 'footer', [snip] };
my $q = $query->param('q');
[snip]
require "$q.pl";
[snip]

but in one of $q.pl(such as mail.pl, others need the PRE_PROCESS), I don't want the PRE_PROCESS when I call $tt->process
is there a way to change *Config Options* after $tt is created? just like $tt->{PRE_PROCESS} = ''; or something else.
I don't want to create a new TT instance in this $q.pl(mail.pl) since it's ugly.

Thanks for your help.

我的 TT 模版中启用了 PRE_PROCESS 和 POST_PROCESS 参数用于头文件和尾文件。但是程序需要发送一个邮件,而邮件的模版也是一个 tt 文件。但是这个模版不需要头尾文件(因为头文件中包含 HTML 代码,而邮件是纯文本的)。所以就需要暂时性的把 PRE_PROCESS 关闭掉。后来 Sergey Martynoff 在邮件组里回了一个:
For PRE_PROCESS option you can try altering
$tt->service->{PRE_PROCESS} (this should work, although I don't
think it is a good idea).
总算学到了一招。最后在邮件的发送代码中大致是这样的:
my $body; # email Body
               
######################################3
## trick, we don't need the PRE_PROCESS and POST_PROCESS in the mail.tt
$tt->service->{PRE_PROCESS} = [];
$tt->service->{POST_PROCESS} = [];
               
$tt->process('mail.tt', $tt_vars, \$body) || die $tt->error();
               
# call the sub to send mail
require 'sendmail.pl';
$mail_sent = mailer(
   To => $email_to,
   From => $from,
   Subject => $subject,
   Body => $body,
);
用 $tt->service->{PRE_PROCESS} = []; 来改变 config 中的 PRE_PROCESS.
have fun!

another part-time job day

24 February 2006


今天接了另一份 Perl 兼职在干,也是做 Web Programming. 做的是一个客户支持系统。
很常见的功能。客户有问题通过网页 open a ticket, 然后网站的客服人员通过回复将这个 ticket close 掉,并通过 email 通知客户。当然另外还有一些附加的功能。
这个系统类似 bug tracing 又类似 forum, 总体来说不算太难。所有的 Web Programming 看起来都是很类似的,无非将资料插入数据库又将资料从数据库取出来显示,或者更新或者删除。大部分工作就是这些所谓的 CRUD ( select, insert, update, delete ), 比较复杂的只是数据库的构造和资料的结构需要考虑。
没有使用 Catalyst 来做。但是用类似的概念,在 index.pl 进行了 action dispatch, 用 DBI 做 model, 用 TT 做 view.
YAML 来做 config 以避免 hard code. 其间将 $config 和 $query 作为 TT 的一个变量来处理。这样方便在 TT 模块中使用这些功能。大致的代码类似:
use vars qw/$query $dbh $tt $tt_vars $config/;
use FindBin;
my $DIR = $FindBin::Bin;
# config
$config = YAML::LoadFile("$DIR/config.yml");
# cgi
$query = new CGI;
# dbi
$dbh = DBI->connect(..
# template
$tt = Template->new({ ..
$tt_vars = {
   cgi => $query,
   config => $config,
};
增加 $tt_vars 的变量就用 $tt_vars->{message} 之类的,最后传到 $tt->process('message.tt', $tt_vars) || die $tt->error(); 就差不多了。
不过这样做的效果似乎不是非常理想但还可以,毕竟 YAML 和 TT 都比较庞大。Any way, 这样写起来很顺畅。

TT tip


今天还碰到 TT 的变量连接。比如说 Perl 中可以这么写 $re = 'Re: ' . $title; 但是 TT 中因为 . 是用来作为 -> 使用的。所以变量连接可以这么写:
<input type='text' name='subject' value='[% cgi.param('subject') || "Re: ${ticket.ticket_subject}" %]' lenght='12' />
"Re: ${ticket.ticket_subject}",用 ${} 来内插 TT 变量。

DBIx::Class 的 inflate_column

23 February 2006


DBIx::Class is great, 所以我在最近写的论坛代码 Foorum 中就使用了 DBIx::Class 作为我的 Model. (use base 'Catalyst::Model::DBIC';)
但我挺喜欢 Class::DBI 的 Trigger,而 DBIx::Class 要使用这个东西似乎比较麻烦。按它 wiki 上的说法似乎要载入 use base qw/ DBIx::Class::CDBICompat::Triggers DBIx::Class::Core/; 没有其他的办法。

我在写 Foorum 的注册程序,表 user 里有一个字段是 register_date 类型为 DATETIME。如果用 Trigger 的话似乎简单一些, register_date = NOW() 就可以(用 mysql 的函数)。

还好 DBIx::Class 也提供了 inflate. 所以我就用这个来完成我的任务。 inflate 在这里只是一个暗喻,它主要用于在表的某一字段的数据存入或取出之前做一些变动。 deflate 用于做存入前的变动,而 inflate 做取出后的变动。

在无法用 register_date = NOW() 之后,要将 localtime 或 gmtime 转为 DATATIME 类型似乎比较麻烦。还好 CPAN 上有一模块为 DateTime::Format::MySQL 用于将 DateTime 对象转为 MySQL 所需要的类型。所以代码很简单:

package Foorum::Model::DBIC::User;

use strict;
use base 'Foorum::Model::DBIC';

use DateTime::Format::MySQL;

__PACKAGE__->inflate_column( 'register_date',
{ inflate => sub { return shift; },
deflate => sub { DateTime::Format::MySQL->format_datetime( shift ); } }
);

而当我们存入数据时就可以使用:
use DateTime;
$c->model('DBIC')->table('user')->create({
username => $username,
password => $computed,
email => $email,
register_date => DateTime->now,
register_ip => $c->req->address,
});
当 create 创建新的 record 时,将传入的 register_date(这里是 DateTime->now;)先用 deflate 做一些变动,这里将它(shift 指的是 DateTime->now)处理(format_datetime)后再存入。
而 inflate 反一下,指取出后立即处理的匿名函数。我这里只是直接返回,因为我不需要再处理。如果你想它取出来也是一个 DateTime 对象好方便你进一步处理的话,可以将 inflate 的函数改为:
inflate => sub { DateTime::Format::MySQL->parse_datetime( shift ); },
:) have fun. 如有疑问,发 mail 跟我探讨。 thanks.

Catalyst 的用户鉴定登陆

23 February 2006


因为最近开始有点闲下来(当然,虽说闲下来也有很多事情要做,比如毕业论文,实习,part-time job 等),于是在刚过去的一个多小时里开始了一直想写的基于 Catalyst 的论坛程序。坦白说,Catalyst 我也有很多地方都不懂,都没试验过。因为要写论坛程序,类似 Session, Authentication 这样的东西是必不可少,于是就试了下 Catalyst 的 Authentication 插件。

写个详细的流程,方便诸位再次试验。

  1. 首先当然是创建整个项目的结构:(过程部分略)
    catalsyt Foorum
    cd Foorum
    perl script/foorum_create.pl controller User
    perl script/foorum_create.pl view TT TT
    perl script/foorum_create.pl model DBIC DBIC
    ..
  2. 创建数据库 foorum, 创建表 user, 表的结构其他不管,两个字段是必须的,username 和 password
  3. 修改文件:
    • Foorum.pm
      package Foorum;

      use strict;
      use warnings;

      use Catalyst qw/
         -Debug
         ConfigLoader
         Authentication
         Authentication::Store::DBIC
         Authentication::Credential::Password
         Session
         Session::Store::File
         Session::State::Cookie
         Static::Simple/;

      our $VERSION = '0.01';

      __PACKAGE__->setup;

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

      # Hello World
      $c->response->body( $c->welcome_message );
      }

      因为在 Win32 下跑,所以 Catalyst::Plugin::Session::Store::FastMmap 是安装不起来的,而我试了下 Catalyst::Plugin::Session::Store::DBI 发现报错,最后只好转为 Catalyst::Plugin::Session::Store::File .
      用 File 模块,于是在与 lib script 同级目录下创建了个文件夹 sessions
    • foorum.yml
      ---
      name: Foorum
      dsn: dbi:mysql:foorum
      dsn_user: root
      dsn_pwd: ''

      authentication:
      dbic:
      user_class: "Foorum::Model::DBIC::User"
      user_field: "username"
      password_field: "password"
      password_type: "hashed"
      password_hash_type: "SHA-1"
      session:
      expires: 3600
      storage: __HOME__/sessions

      大致看看并会明白。密码用 SHA-1 加密。
    • 修改 Model/DBIC.pm
      package Foorum::Model::DBIC;

      use strict;
      use base 'Catalyst::Model::DBIC';

      __PACKAGE__->config(
      dsn => Foorum->config->{dsn},
      password => Foorum->config->{dsn_pwd},
      user => Foorum->config->{dsn_user},
      options => { AutoCommit => 1, RaiseError => 1, PrintError => 1 },
      relationships => 1,
      );

      1;

    • 创建 Model/DBIC/User.pm
      package Foorum::Model::DBIC::User;

      use strict;
      use base 'Foorum::Model::DBIC';

      1;

  4. 上面大致就是所有的准备工作了。接下来就是对 Foorum::Controller::User 做一些动作了。
    因为是测试,所以我们先增加了一条纪录。
    package Foorum::Controller::User;

    use strict;
    use warnings;
    use base 'Catalyst::Controller';

    sub insert : Local {
       my ( $self, $c ) = @_;
       
       use Digest ();
       my $password = '123456';

       my $d = Digest->new( 'SHA-1' );
       $d->add($password);
       my $computed = $d->digest;
       
       $c->model('DBIC')->table('user')->create({
       username => 'fayland',
       password => $computed
       });
       
       $c->res->body('hi, add test user name to table.');
    }

    而 Authentication 的验证过程就开始变得简单了。因为仅仅是试验,所以就用了最简单的代码。
    sub login : Local {
       my ( $self, $c ) = @_;
       
       if ( $c->login('fayland', '123456') ) {
           $c->res->body("hello, " . $c->user->username);
       } else {
           $c->res->body('failed');
       }
    }
    大致并是如是,运行后先访问 http://fayland:3000/user/insert 来插入数据,然后运行 http://fayland:3000/user/login 来做测试。如果是 123456 屏幕就会输出 hello, fayland,不是的话就会输出 failed.

上面并是所有的大致过程。详细的查阅 Catalyst::Plugin::Authentication 或者等我继续。我还要继续写 Foorum 代码,或许过几天就会再次讲到详细的应用。have fun!


在文本中寻找 URI 地址

20 February 2006


我们经常碰到这样的任务,在一段文本中找到 URL/URI 地址,然后让这个地址变为可以点击。
最寻常的方法就是用正则表达式来做。不过有时候这不是很理想。

CPAN 中有一个 URI::Find 模块专门来做这事。实例代码如下:

#!/usr/bin/perl
use strict;
use warnings;

use URI::Find;

my $text = <<HTML;
hi, it's from http://www.fayland.org/ then 1313s.com?
HTML

my $finder = URI::Find->new(
   sub {
       my($uri, $orig_uri) = @_;
       return qq|<a href="$uri">$orig_uri</a>|;
   });
$finder->find(\$text);

print $text;

这样 $text 的输出会变为:
hi, it's from <a href="http://www.fayland.org/">http://www.fayland.org/</a> then
1313s.com?
如果想让 1313s.com 也变为可点击,则可以使用 URI::Find::Schemeless

#!/usr/bin/perl
use strict;
use warnings;

use URI::Find::Schemeless;

my $text = <<HTML;
hi, it's from http://www.fayland.org/ then 1313s.com?
HTML

my $finder = URI::Find::Schemeless->new(
   sub {
       my($uri, $orig_uri) = @_;
       return qq|<a href="$uri">$orig_uri</a>|;
   });
$finder->find(\$text);

print $text;

Schemeless 的意思就是没有协议头(如 http )也匹配。
$text 变为:
hi, it's from <a href="http://www.fayland.org/">http://www.fayland.org/</a> the
<a href="http://1313s.com/">1313s.com</a>?
大致如是。详细的查阅 URI::Find , have fun!