MongoDB practice: My Perl GridFS Wrapper
简单写了一个Perl版本的GriFS的wrapper：
package CZone::GridFS;
use strict;
use MongoDB::GridFS;
use Path::Class;
use Digest::file qw(digest_file_hex);
use Digest::MD5 qw(md5_hex);
use IO::File;
use Data::Dumper;
use Any::Moose;
has database => (
isa => ‘MongoDB::Database’,
is => ‘ro’,
required => 1
);
has _gridfs => (
isa => ‘MongoDB::GridFS’,
is => ‘ro’,
lazy => 1,
builder => ‘_build__gridfs’,
);
has _file_collection => (
isa => ‘MongoDB::Collection’,
is => ‘ro’,
lazy => 1,
builder => ‘_build__file_collection’
);
sub _build__gridfs {
my $self = shift;
return $self->database->get_gridfs;
}
sub _build__file_collection {
my $self = shift;
return $self->database->get_collection(’fs.files’);
}
sub get_bytes {
my ($self, $id ) = @_;
my $file = $self->_gridfs->find_one({_id => $id });
my $bytes;
my $fh = new IO::File \$bytes,’>';
$file->print($fh);
return $bytes;
}
sub store_file {
my ($self, $file_path) = @_;
my $file = file($file_path)->absolute;
return undef unless -e $file;
my $md5 = digest_file_hex($file,’MD5′);
my $fh = $file->open(’r') or return undef;
return $self->_store_fh($fh,$md5);
}
sub _store_fh {
my ($self,$fh,$md5) = @_;
# $grid_file isa MongoDB::GridFS::File
my $grid_file = $self->_gridfs->find_one({ ‘md5′ => $md5});
if ($grid_file) {
$self->_inc_refs($grid_file->info->{_id});
return $grid_file->info->{_id};
}
else {
my $oid = $self->_gridfs->insert($fh,{
refs => 1,
md5 => $md5,
});
return $oid;
}
}
sub store_bytes {
my ($self, $bytes) = @_;
my $md5 = md5_hex($bytes);
my $fh = new IO::File \$bytes,’<';
# my $fh = FileHandle->new;
# $fh->open(\$bytes,’<');
return $self->_store_fh($fh,$md5);
}
sub unlink {
my ($self, $id ) = @_;
$self->_dec_refs(MongoDB::OID->new(value =>”$id”));
}
sub _inc_refs {
my ($self,$id) = @_;
$self->_file_collection->update({_id => $id },{ ‘$inc’ => { refs => 1}});
}
sub _dec_refs {
my ($self,$id) = @_;
$self->_file_collection->update({_id => $id },{ ‘$inc’ => { refs => -1}});
}
sub gc {
my $self = shift;
$self->_gridfs->remove({refs => 0});
}
no Any::Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
这是从czone项目中的PHP代码移植过来的。
方便将gridfs中的文件读写到scalar中。同时，通过检查存储文件的md5值，并记录相同文件的引用计数，相同文件只存储一个copy，节省空间。（BSON格式对于空间的需求是非常大的）
Notes: CentOS5.4编译Perl IO::Tty的处理
直接编译IO::Tty,会导致:
Can’t load ‘/root/.cpan/build/IO-Tty-1.08-PWZkbn/blib/arch/auto/IO/Tty/Tty.so’ for module IO::Tty:
undefined symbol: strlcpy at …..
快速修正, 打开Makefile
DEFINE = -DHAVE_DEV_PTMX -DHAVE_GETPT -DHAVE_GRANTPT -DHAVE_OPENPTY -DHAVE_POSIX_OPENPT -DHAVE_PTSNAME -DHAVE_PTSNAME_R -DHAVE_PTY_H -DHAV
E_SIGACTION -DHAVE_STRLCPY -DHAVE_SYS_STROPTS_H -DHAVE_TERMIOS_H -DHAVE_TERMIO_H -DHAVE_TTYNAME -DHAVE_UNLOCKPT -DHAVE__GETPTY
去掉 中间的-DHAVE_STRLCPY和最后的-DHAVE__GETPTY
重新编译, make test.
ok!
Mouse,Moose和MooseX::Declare
如果你是一个Perl的开发者, 现在还不知道Moose那么你对Perl的了解基本上还停留在10年前了.
虽然国内Perl的开发者寥寥无几, 但Perl的强大远远超越一般人的想象空间.
我使用Perl是让自己更愉快,因为很多事情变得很简单.
Perl的OO一般人很难理解, 但是却用了最简单和巧妙的方式实现了,想想, 一个bless搞定, 再看看
PHP之类的,多么臃肿.
有了Moose,你会发现, 不仅仅OO,AOP这些东西实现起来是多么的轻松.
当看到MooseX::Declare, 你更会惊叹, “这还是Perl么?”.
use MooseX::Declare;
class BankAccount {
has ‘balance’ => ( isa => ‘Num’, is => ‘rw’, default => 0 );
method deposit (Num $amount) {
$self->balance( $self->balance + $amount );
}
method withdraw (Num $amount) {
my $current_balance = $self->balance();
( $current_balance >= $amount )
|| confess “Account overdrawn”;
$self->balance( $current_balance - $amount );
}
}
和教条的Python相比我喜欢Perl的哲学, 同样的结果可以有不同的选择, 如何做,取决你自己.
MongoDB的Perl driver的中文乱码问题
Perl下面向mongodb插入中文字符串会出现乱码.
根据MongoDB的文档, MongoDB支持UTF-8的编码. 但在Perl中,
如果直接使用utf8的字符串,也会出现问题.
测试代码:
my $mongo_dbh = $mongo_connection->get_database( $mongo_db );
my $t = $mongo_dbh->get_collection(’test’);
my $word = ‘测试’;
$t->insert({ title => $word });
my $row = $t->find_one();
say “title:”,$row->{title};
$t->remove();
输出结果是乱码. 在mongo shell和PHP中得到的也是乱码.
我初步判断是perl driver没有能够识别utf8编码而是强制encode成utf8编码后存储.
修改如下:
my $mongo_dbh = $mongo_connection->get_database( $mongo_db );
my $t = $mongo_dbh->get_collection(’test’);
my $word = ‘测试’;
$t->insert({ title => decode_utf8($word) });
my $row = $t->find_one();
say “title:”,$row->{title};
$t->remove();
输出正常. 判断正确, 问题解决. 希望Kristina能够修改就无须多此一举(当然,如果是非utf8编码还是需要转换的),
也许并不是bug而是个feature? 
UPDATE: Kristina的回复很迅速, 一觉醒来, master里已经加入判断是否为utf8的代码. CPAN .27(下周2发布)以上不会存在这个问题.
但是, 其他格式的编码仍然需要转换为utf8编码,因为BSON只支持UTF8编码.
Apple最新的Leopard更新导致Perl无法正常使用
Apple这次做了一个很不专业的事情，在最新的Mac OS X Security Update 2009-001中，竟然使用了老的Perl IO XS bundle。安装更新后，运行cpan或者perl -MIO会得到以下错误信息：
IO object version 1.22 does not match bootstrap parameter 1.23 at /System/Library/Perl/5.8.8/darwin-thread-multi-2level/XSLoader.pm line 94.
Compilation failed in require at /System/Library/Perl/5.8.8/darwin-thread-multi-2level/IO/Handle.pm line 263.
看来,apple竟然将IO xs bundle回滚到1.22, 但是相应的IO.pm则仍然是1.23, 无语。
由于IO无法启用，cpan也break了。 只能手动下载 CPAN IO 1.2301，重新make install后才解决。
看来perl还是要自己编译才好,要想不出这种问题，可以考虑使用local::lib了。
PS:
彻底歇菜，看看这次更新了哪些bundle:
lsbom -f -s /Library/Receipts/boms/com.apple.pkg.update.security.2009.001.bom | grep -i perl
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/CORE/config.h
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/CORE/embed.h
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/CORE/libperl.dylib
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/CORE/patchlevel.h
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/CORE/proto.h
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/Config_heavy.pl
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/B/B.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/B/C/C.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/ByteLoader/ByteLoader.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Cwd/Cwd.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/DB_File/DB_File.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Data/Dumper/Dumper.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Devel/DProf/DProf.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Devel/PPPort/PPPort.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Devel/Peek/Peek.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Digest/MD5/MD5.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/DynaLoader/DynaLoader.a
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Encode/Byte/Byte.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Encode/CN/CN.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Encode/EBCDIC/EBCDIC.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Encode/Encode.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Encode/JP/JP.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Encode/KR/KR.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Encode/Symbol/Symbol.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Encode/TW/TW.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Encode/Unicode/Unicode.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Fcntl/Fcntl.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/File/Glob/Glob.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Filter/Util/Call/Call.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/I18N/Langinfo/Langinfo.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/IO/IO.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/IPC/SysV/SysV.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/List/Util/Util.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/MIME/Base64/Base64.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/NDBM_File/NDBM_File.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Opcode/Opcode.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/POSIX/POSIX.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/PerlIO/encoding/encoding.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/PerlIO/scalar/scalar.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/PerlIO/via/via.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/SDBM_File/SDBM_File.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Socket/Socket.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Storable/Storable.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Sys/Hostname/Hostname.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Sys/Syslog/Syslog.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Time/HiRes/HiRes.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/Unicode/Normalize/Normalize.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/XS/APItest/APItest.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/XS/Typemap/Typemap.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/attrs/attrs.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/re/re.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/threads/shared/shared.bundle
./System/Library/Perl/5.8.8/darwin-thread-multi-2level/auto/threads/threads.bundle
./System/Library/Perl/5.8.8/pods/perldiag.pod
./usr/bin/perl
./usr/bin/perl5.8.8
./usr/bin/perlbug
./usr/share/man/man1/find2perl.1.gz
./usr/share/man/man1/perlbug.1.gz
./usr/share/man/man1/perlcc.1.gz
./usr/share/man/man1/perldiag.1.gz
./usr/share/man/man1/perlivp.1.gz
修复：
1.重新下载IO安装
2.重新编译CPAN
3.Config::Auto
4.其他不正常的module
累人。
Mojo小试
Mojo framework 是一个新的Perl web framework。
其作者是原Catalyst的开发者之一。 最近在作一个救火的小case中试用了一下，试用中的体会：
1. 如作者所写，这是一个Full stack HTTP 1.1 client/server implementation. 因此安装和部署非常清爽，
所依赖的CPAN module很少。
2. 代码很精简，看起来不费劲
3. Mojolicious 这个类似RoR的MVC framework 用起来也比较容易。
4. 缺点： 文档很贫乏，实例很少，不把源码都看一遍很难下手。
5. Mojo几个主要Package：
Mojo是底层支持库，封装实现了Base,HTTP Server,Request,Repsonse等底层类，实际上Mojo本身是用于二次开发framework，比如其Mojo::Base就实现了一个更快速的OO系统, 可以实现accessor，风格类似Ruby的语法.
MojoX
Mojo的扩展包，主要是针对类似Mojolicious这种MVC的场景封装了一些常用类，比如Context容器,Dispatcher机制基础实现,Routes,Render系统等。
Mojolicious
在MojoX基础上构建的RubyOnRails，当然肯定是精简版了(没有Model实现）。
目前功能还比较简单，不过已经有一个app生成器，生成application模版。
6. 开发提示：
－ 在lib/App_name.pm (App_name.pm是生成的application类) startup方法用于启动server的时候进行初始化，因此对于一次性的工作可以在这里执行，比如routes设定，config的读取，database handler的创建等。
－ 通过扩展Mojolicious::Context 可以在你的context中加入其他的属性
－ Controller的每个method都可以self,context, 不过，在0.9以后,context可以从self->ctx来获得，因此，每个method只需要一个获得invocant就可以了。
－ 前端页面传递的参数通过$self->req->param,params来获得，upload(name),uploads则返回文件上传对象信息（Mojo::Upload)
－ 可以从CPAN下载JSON和TT的render
－ 如果希望Mojo以独立服务器运行,可以尝试AnyEvent::Mojo,如果和Nginx配合，则使用内置的FastCGI Server即可。
总体来说，Mojo和CGI::Application 和Catalyst不是一个起跑线， 但是其前途似乎不错，值得跟踪。