joy in Perl

13 December 2005


有时候写 Perl 代码写得很累的时候,可以玩一下。
CPAN 中以 Acme 开头的模块很多都是用来 play 的。
一起来玩一下吧。

Acme::Pony

当然,你得先安装它。cpan Acme::Pony
安装完毕后,写一个简单的 Perl 文件(t.pl)
use Acme::Pony;
print "Hello world";
然后 perl t.pl
Woo, 再看看你的 t.pl, 看看它变成了什么:
use Acme::Pony;
buf
fYBUff
YbuFFYbU
ffYbUFfyBU
FfYBuffYbUF
FybuffyBu
ffYbufFybuf fYbu
Ff YbUffYBuffYBuFFybuFFyBU
fFYBUfFYbuffybUffYBUfFYBuFFYB
uFF ybUffYBUffyBUfFYbufFybUFf
yBu ffYbuFFyBUFfybUfFybufFY
BUFf YbUFFYBuFfYb
Uffy BufFYBufFy
buF fybUfFYBU
Ff Yb UFFYBuF
fX XX XXX
XXX XX
XX XX
更惊奇的在后头,它可以被运行。 perl t.pl 输出了 Hello world
很不可思议吧。

Acme::Bleach

在 David Cantrell 写完 Acme::Pony 后很多人都开始搞怪。比如 Damian Conway, 他就写了 Acme::Bleach , Acme::DWIMAcme::Morse
安装完它们后一个个试试吧。
use Acme::Bleach;
print "Hello world";
perl t.pl 后,这文件变成了:
use Acme::Bleach;
                                           
                   
                   
               
           
           
       
               
               
                       
               
               
                           
                   
                   
           
           
               
是不是什么都看不见。其实其中都是空格,你用鼠标反白它就看见了。
再运行它 perl t.pl 就会输出 Hello world
都是空白的东西输出了 Hello world, 玩得还可以吧。

Acme::Morse

use Acme::Morse;
print "S-O-S\n";
Morse 的意思为“摩尔斯式电码”。所以运行它后该文件会变为:
use Acme::Morse;
.--.-..--..---.-.--..--.-..--..---.-.--.
....---..-..---.-..-.--..---.--...-.---.
.....-...-...-..--..-.-.-.--.-..----..-.
-.--.-..--..-.-...---.-..---.--..-...-..
--.---..
还是一样,再运行它会输出 S-O-S

Acme::EyeDrops

Acme::EyeDrops 这是最最好玩的一个模块。想把 Perl 代码变为我们最爱的骆驼吗?跟我来吧:

  1. 创立一个 helloworld.pl 文件。内容为:
    print "hello world\n";
    当然也可以为你喜欢输出的内容。
  2. 创立一个 t.pl 文件。内容为:
    use Acme::EyeDrops qw(sightly);
    print sightly( { Shape => 'camel',
    SourceFile => 'helloworld.pl',
    Regex => 1 } );
  3. 运行 perl t.pl >camel.pl
    将运行的结果输入 camel.pl
  4. 打开 camel.pl, Woo000ooo0o0oooooooo00oooooooooooooo! 骆驼:
                                          ''=~('('.'?'
    .'{'.( '`'|'%').("\["^
    '-').('`'| '!').('`'|',').'"'
    .('['^'+') .('['^ ')').('`'|')').('`'|
    '.').('['^'/').('{'^ '[').'\\'.'"'.('`'|'('
    ).('`'|'%').('`'|',') .('`'|',').('`'|"\/").(
    '{'^'[').('['^','). ('`'|'/').('['^')').("\`"|
    ',').('`'|'$') .'\\'.'\\'.('`'|'.').'\\'.'"'
    .';'.'"'."\}". ')');$:='.'^'~';$~='@'|('(');$^=
    ')'^'[';$/='`'| '.';$,='('^'}';$\='`'|'!';$:=(')')^
    '}';$~='*'|'`'; $^='+'^'_';$/='&'|'@';$,='['&('~');$\=
    ','^'|';$:='.'^ '~';$~='@'|'(';$^=')'^'[';$/='`'|'.';$,=
    '('^'}';$\='`' |'!';$:=')'^'}';$~='*'|'`';$^='+'^'_';$/=
    '&'|'@';$,='[' &'~';$\=','^'|';$:='.'^'~';$~='@'|"\(";$^=
    ')'^'[';$/='`'|'.';$,='('^'}';$\='`'|'!';$:=')'^'}';$~='*'
    |'`';$^='+'^'_';$/='&'|'@';$,='['&'~';$\=','^'|';$:='.'^'~'
    ;$~='@'|'(';$^=')'^'[';$/='`'|'.';$,='('^'}';$\='`'|'!';$:
    =')'^'}';$~='*'|'`';$^='+'^'_';$/='&'|'@';$,='['&'~';$\=','
    ^'|';$:='.'^'~';$~='@'|'(';$^=')'^'[';$/='`'|'.';$,='('^'}'
    ;$\='`'|'!';$:=')'^'}';$~='*'|'`';$^='+'^'_';$/='&'|'@';$,
    ='['&'~';$\=','^'|';$:='.'^'~';$~='@'|'(';$^=')'^'['; $/=
    '`'|'.';$,='('^'}';$\='`'|'!';$:=')'^'}';$~='*'|'`' ;$^
    ='+'^'_';$/='&'|'@';$,='['&'~';$\=','^'|' ;$:='.'^ '~'
    ;$~='@'|'(';$^=')'^'[';$/='`'|"\.";$,= '('^'}' ;$\
    ='`'| '!';$:=')'^'}';$~='*'|"\`";$^= '+'^'_' ;$/
    ='&'|'@';$,='['&'~';$\=(',')^ '|';$:= '.'
    ^'~';$~= '@'|'(';$^ ="\)"^ '[';$/ =(
    ('`'))| "\.";$,= ('(')^ '}';$\ =(
    ('`'))| "\!";$:= "\)"^ "\}"; (
    ($~))= '*'|'`'; ($^) ='+'
    ^"\_"; $/=('&')| '@'; ($,)
    ='['& "\~";$\= ','^ '|';
    ($:)= '.'^'~' ;$~= '@'|
    '('; $^=')' ^'[' ;$/=
    '`'| '.' ;$,= '('^
    '}'; $\= '`' |((
    '!' )); $:= ')'
    ^(( '}' )); $~=
    '*' |(( '`' ))
    ;( ($^))= ((
    (( '+')) ))
    ^+ "\_";$/= ((
    '&' ))|+ "\@"; $,
    =(( '['))& '~'; $\=
    ','^ "\|";$:= '.' ^'~'
    ;($~)= ('@')|
    "\(";$^= ')'^'['
    这就是我们心爱的骆驼。
  5. perl camel.pl 它还能运行。而且输出原来的东西。

除了骆驼还有很多好玩的形状。试试这个:
use Acme::EyeDrops qw(sightly);
print sightly( { Shape => 'larry',
SourceFile => 'helloworld.pl',
Regex => 1 } );
运行 perl t.pl >larry.pl
打开 larry.pl 看看会变成什么:
                         ''=~('('.'?'.'{'
.('`'|'%').('['^"\-").(
'`'|'!').('`'|',').'"'.(('[')^
'+'). ('['
^')' ).(
'`'| ')'
).+( ( '`'
)|(( ( '.'
)))) .( ( '['
)^(( ( ( '/'
))) )) .( '{'
^(( (( ( '['
))) ))). ( (((
((( '\\' ) )))
))) .'"' . (((
'`' ))|'(').( ( '`'
)|+ (( ( ((
'%' )) ) ))
).( ( ( ((
'`' ) )))|+
',' ) .(
'`' | ',').('`'|'/').('{'^'[').('['^(',')).(
'`' |'/').("\["^ "\)").( ( ( "\`"))| (
',' ) ) .+( '`' |+ ( ( (( '$' ))) )
).+ ( ( '\\')).'\\'. ( ( '`')|('.')). (
((( ( ( ( ( (
(( ((( ( ( ( (( (
(( ( '\\') ) ) )) )
)) ) ) ) ) ) )
)) ) ))) ))).'"'.';'.'"' . '}'.')');$:=
(( ( ( ( (
( ( ( ( (
( ( ( '.' ) )
) ))) )) )
) ) )))^'~';$~='@'|'(';$^ =
( ( ')'))^'[';$/='`'|'.';$,= (
( ( '(')))^'}';$\='`'|"\!";$:= (
( ( ')')) )^'}';$~="\*"| '`'; (
( ( $^)) ) = '+' ^
(( '_' ));$/='&'|'@';#; #;#
; #
; #
; #
; # ;
# ; #
; # ;
# ; #
; # ; #
; # ; #
; #;# ;# ;
# ;#;#;#;#;#; #
还有很多很多形状。看看 Acme::EyeDrops 的文档。这是我见过的最棒的模块。

Filter::Simple

这样的 Perl code 看起来像不像密码?
perl 中还有个模块 Filter::Simple 专门用来将 perl code 变为谁也看不懂的密码。
有空诸位可以试试。

Enjoy!

Have fun. :->>

Reference

http://www.perladvent.org/2001/6th/

Template customized Filters

10 December 2005


昨日写了点 TT 内置过滤器(Template builtin Filters),现在有兴趣讲讲自己怎么写一个 filter.

昨日说了 filter 分为两种:一种为静态,一种为动态。二者的区别是静态不接受任何参数,如 html, collapse, trim, ucfirst, lower 等,而动态接受参数,如 format('%0.3f'), indent("> ")
而放置 filter 的地方也分为两种,一种是直接放在代码里,另一种是写为 Template::Plugin::Filter 的子类模块。
我打算先讲直接放在代码里的。

Static Filters

静态过滤器是最简单的。我们用个最简单的 filter 来写个 lower/ucfirst 过滤器。
sub ucf {
   my $text = shift;
   $text = ucfirst lc $text;
   return $text;
}
my $tt = Template->new({
FILTERS => {
'ucf' => \&ucf,
'lcf' => sub { lcfirst uc shift; },
},
});
上面就是静态过滤器的两种形式。一种是 subroutine 子程序的引用,一种是匿名子程序。
无论是哪种子程序都接受一个 shift 过来的字符串,然后返回一个 $string.
注册 filters 使用 FILTERS 参数。而 Catalyst 可以这么写:
package Eplanet::V::TT;

use strict;
use base 'Catalyst::View::TT';

__PACKAGE__->config->{FILTERS} = {
   'ucf' => \&ucf,
   'lcf' => sub { lcfirst uc shift; },
};

而 filter 的应用与内置的是一样的。
[% FILTER ucf %]template is great[% END %]
输出 Template is great
[% | lcf %]template is great[% END %]
输出 tEMPLATE IS GREAT

Dynamic Filters

动态的是可以接受参数的。它的注册方法与静态的略微有点不同:
my $tt = Template->new({
FILTERS => {
'ucf' => \&ucf, # our trusty static filter
'cut' => [ \&cut, 1 ], # our dynamic filter
},
});
第一种是我们所熟悉的静态过滤器,而第二种就是动态过滤器。它传递的一个数组引用且第二个参数为 1.
我们所熟悉的静态过滤器还有种写法:
'ucf' => [ \&ucf, 0 ],
这与 'ucf' => \&ucf, 是一样的。

动态过滤器所定义的子程序大致为这样子的:

sub cut {
my ($context, $len) = @_;
return sub {
my $text = shift;
$text = substr($text, 0, $len);
return $text;
}
}
[% | cut(5) %]template is great[% END %]
输出为 templ
动态过滤器里第一个参数 $context 是 Template::Context 的一个对象,这个涉及到 Template 的内核我也不太懂。
第二个参数 $len 这里就是 5.
它返回的必须是一个程序的引用。跟静态的差不多。不过这个返回的子程序引用是个闭包。

这样我们差不多说清楚了 filter 怎么写了,下面说说怎么写一个模块。

Template::Plugin::Filter

package MyTemplate::Plugin::Filter::Textile;

use strict;
use Template::Plugin::Filter;
use base qw(Template::Plugin::Filter);
use Text::Textile;

sub filter {
   my ($self, $text) = @_;
   $text = Text::Textile::textile($text);
   return $text;
}

1;

这是一个标准的写法:use base qw(Template::Plugin::Filter); see Template::Plugin::Filter
然后覆盖它的 filter 子程序。参数为 my ($self, $text) = @_; 返回字符串。一个静态过滤器。
而注册的写法为:
my $tt2 = Template->new({
PLUGIN_BASE => 'MyTemplate::Plugin::Filter'
PLUGINS => {
Textile => 'MyTemplate::Plugin::Filter::Textile',
},
});
因为 Filter 是 Plugin 的一种,所以我们这里设置的是 PLUGINS.
Catalyst 的 ::V::TT 写法类似:
__PACKAGE__->config->{PLUGIN_BASE} = 'MyTemplate::Plugin::Filter';
__PACKAGE__->config->{PLUGINS} = {
   Textile => 'MyTemplate::Plugin::Filter::Textile',
};
而实际用则这么写:
[% USE Textile %]
[% FILTER $Textile %]this is _like_ *so* *cool*[% END %]
效果为:

this is like so cool

Conclusion

这就是大致上一般的 template toolkit filter 的知识。如有错误请指正。Enjoy!

Catalyst config YAML

10 December 2005


我们一般写代码都应当避免一种称为 hardcode 硬代码。
所谓的 hard code 是指将代码拷贝到另外的地方你必须更改其中的某些代码。
比如你写了一个 Controller, 里面使用了类如 '/home/fayland/eplanet' 这样的字符串。当你将这个代码迁移到其他目录或其他机子的时候,人们必须要改变这个字符串才能正常运行该程序。我们管这些字符串为 hard code.
一种避免 hard code 的方法就是将所有的这些字符串用一个配置文件包括,这样人们就只需要修改下配置文件就能运行程序而不是修改程序的源代码。
这种避免 hard code 的方法尤其在源码协作/ Subversion 时最为有用。每人拥有相同的源码不同的配置文件,这样不会对源码造成冲突。

最近的 CatalystAdvent 就介绍了怎么在 Catalyst 中使用 Day 9 - YAML, YAML, YAML!.
原来在 MyApp.pm 中这么写的代码:

 __PACKAGE__->config( name => 'MyApp', 'View::TT' => { EVAL_PERL => 1 } );
将修改为:
use YAML ();    
__PACKAGE__->config( YAML::LoadFile( __PACKAGE__->path_to('myapp.yml') ) );
而 myapp.yml 文件的结构为:
---
name: MyApp
View::TT:
EVAL_PERL: 1
不过该 Advent 里没有介绍怎么写 yml 文件。对于复杂的希哈里套数组再套希哈什么的结构很容易让人写错。
我一般的习惯都是写一个 pl 文件来创立该 yml 文件。比如在 Person 项目中我在 tools 里是这么写的:
#!/usr/bin/perl
use strict;
use warnings;
use FindBin;
use YAML();

# CHANGE THIS LINE, THEN RUN IT!
my $DIR = $FindBin::Bin;
$DIR =~ s!/tools/?!!; # /usr/local/apache/www/Person
print $DIR;

my %a = (
   name => 'Person',
   root => "$DIR/root",
   templates => "$DIR/templates",
   member_images => "$DIR/root/member",
   email => {
       enable => 1, # local machine can be 0
       charset => 'utf8',
       smtp_host => '61.152.95.132',
       prefix => '[PerlChina]',
   },
   dsn => 'dbi:mysql:person',
dsn_user => 'root',
dsn_password => '',
images_folder => "$DIR/captcha/images",
   data_folder => "$DIR/captcha/data",
   output_folder => "$DIR/root/captcha",
   # if u run this in your local machine, CHANGE IT
   base_site => 'http://localhost:3000/',
);

YAML::DumpFile("$DIR/Person.yaml", \%a);
print ', DONE!';

1;

这样我们用 YAML::DumpFile 出一个 yml 文件,然后用 LoadFile 导进一个。非常的绝配。 :-)
详细的查看 http://dev.perlchina.org/cgi-bin/trac.cgi/browser/trunk/Person/tools/YAML_Create.plhttp://dev.perlchina.org/cgi-bin/trac.cgi/browser/trunk/Person/lib/Person.pm

导入 Template Toolkit 文件

10 December 2005


因为 TT 是个很庞大的系统,我们经常将 template 拆分为好几部分,然后在某一 .tt 文件中导入外部的文件。
很明显,这么做最大的目的是代码复用/ code reuse. 带来的好处还有清晰的结构。
我上回在Template Toolkit 入门提过 INCLUDE 和 INSERT 的区别。
不过导入的指示符中我忘了讲另一个很重要的 PROCESS

我们先用一个简单的例子解释下三者的区别。一个外部文件 ex.tt 如:

[% foo = 'bar' %]
foo = [% foo %] in External File.
然后一个主文件:
[% foo = 'main' %]
foo = [% foo %] in Main
[% INSERT ex.tt %]
foo = [% foo %] in Main after insert/include/process
    三种情况:
  • 如代码所显示的是 [% INSERT 时,显示的结果为:
    foo = main in Main
    [% foo = 'bar' %]
    foo = [% foo %] in External File.
    foo = main in Main after insert/include/process
    INSERT 的作用就是将文件原封不动的显示出来。
  • 将 [% INSERT 改为 [% INCLUDE 后将显示:
    foo = main in Main
    foo = bar in External File.
    foo = main in Main after insert/include/process
    INCLUDE 将外部文件执行,然后将结果返回到主文件中。
  • 将 [% INSERT 改为 [% PROCESS 后将显示:
    foo = main in Main
    foo = bar in External File.
    foo = bar in Main after insert/include/process
    注意与 INCLUDE 的不同。PROCESS 后 foo 在 main 中的值将变为 bar. PROCESS ex.tt 将 foo 改后会影响 main 里的值。
    INCLUDE 是将结果返回,而 PROCESS 更类似与将这段代码返回然后在 main 中执行。

other tips

    下面是一些你可能碰到的东西:
  • 不管是哪个指示符, INCLUDE 也好 PROCESS 也好。注意下面的区别:
    [% myheader = 'my/misc/header' %]
    [% INCLUDE myheader %] # 'myheader'
    [% INCLUDE "myheader" %] # 'myheader'
    [% INCLUDE $myheader %] # 'my/misc/header'
    [% INCLUDE "$myheader" %] # 'my/misc/header'
  • 如果在 main 中定义了 foo 而在 ex.tt 中没有定义 foo 的话, ex.tt 里的 foo 将采用 main 里的 foo 值。
  • 参数传递。我们可以在 INCLUDE/PROCESS 后传递参数进去。比如:
    foo = [% foo %] in External File.
    [% INCLUDE ex.tt foo = '77' %]
    这样 ex.tt 里的 foo 值将是 77.
  • 注意如果你在 main 里定义了一个 BLOCK 与 INCLUDE/PROCESS 里的文件名一样时,将调用 main 里的该 BLOCK 而不是外部文件。比如我们有一个外部文件叫 bar(没有后缀),而在 main.tt 里这么写的话:
    [% INCLUDE bar %]
    [% BLOCK bar %]
    foo was [% foo %]
    [% END %]
    它调用的是这个 BLOCK 而不是外部文件。这就是优先级问题。
  • 需要多个文件的话可以使用加号:
    [% PROCESS foo + bar %]
  • 关于 INCLUDE_PATH 等配置选项设置可以参考:Template Toolkit 的配置选项
Send me mail if u have any problem. Thanks.

Template builtin Filters

09 December 2005


所谓 filter, 过滤器。想像一下咖啡的过滤器,想像下香烟的过滤嘴。Template 的过滤器也差不多。
我打算先介绍下 TT 内置的一些 filters, 然后明天介绍下如何写自己的 filter.

builtin filters

恐怕最最常用的一个 filter 就是 html, filter 的用法有以下几种:
[% FILTER html %]
<script language="JavaScript" type="text/javascript">
<!--
document.writeln("Hello, world");
//-->
</script>
[% END %]
TT 给懒人们弄了个简单的符号 | 用以代替 FILTER 这六个英文字母。所以你也可以这么写:
[% | html %]
另一种是外来的一个变量或者在其他地方定义的一个变量。比如我们在其他的模版里定义了:
[% output = '<script language="JavaScript" type="text/javascript">
<!--
document.writeln("Hello, world");
//-->
</script>' %]
到时候我们输出的话可以这么写:
[% output | html %]
# or [% output FILTER html %]
我们还可以使用多个 filters.
[% output | html | truncate(30) %]
以上差不多就是所有 filter 的用法。

    另外的一些内置 filter 有
  • format format 与 html 不同,它是一个动态 filter, 可以接受参数。比如:(用途类似 sprintf)
    [% pi = 3.1415926536 %]
    [% pi | format('%0.3f') %]
    这样输出的结果为 3.142
  • collapse 这个内置的 filter 将所有的所有多于一个空格的大空白过滤为一个空格。如:
    [% FILTER collapse %]
    You'll love

    it, it's a way

    of life.
    [% END %]

    输出的结果为:You'll love it, it's a way of life.
  • eval / evaltt 将变量作为 TT 模版来运行。这个变量一般是从外面传进来的。比如:
    my $vars  = {
    fragment => "The cat sat on the [% place %]",
    };
    $tt->process($file, $vars);
    || die $tt->error( );
    [% fragment | eval %]
    能将 [% place %] 用变量 place 代替掉。evaltt 跟 eval 是等同的。
  • indent(pad) 用于缩进。比如我们回复信件的时候一般在原来的信件内容前加“> ”,在 TT 中就可以这么写:
    [% FILTER indent("> ") -%]
    Dear Fayland,

    Would u help me to ..

    Best Regards,
    [% END %]

    输出的结果为:
    > Dear Fayland,
    >
    > Would u help me to ..
    >
    > Best Regards,
  • lcfirst/ucfirst/lower/upper 如字面意思所写的,首字小写/大写/全部小写/大写
  • remove(string) 用正则表达式移除一些字符。如:
    [% string = "Hello, I must be going.";
    string | remove("e") %]
    输出:Hllo, I must b going. 我们还有更复杂的正则表达式:
    [% string = "Hello, I must be going.";
    string | remove("(?x) # whitespace is not important
    (?<=H) # an 'H'
    e # strip the 'e'!
    (?=ll) # followed by 'll'
    ") %]
    这个表达式用于匹配以 H 开头后接 e 再接 ll 但不移除 H 和 ll 的表达式。
  • replace(search, replace) 以 remove 不同的是代替。remove 查不多是将 replace(string, '')
    [% string = "Hello, I must be going.";
    string | replace("e", "u") %]
    输出:Hullo, I must bu going.
  • repeat(iterations) 重复几次。
    [% FILTER repeat(5) %]
    I love Perl only less than my girl.
    [% END %]
    将这句重复输出 5 次。
  • trim 将前后空格去掉。
  • truncate(length) 截取前 length 个字符。我们常见的一个描述然后 Read More.. 就可以这样子:
    [% FOREACH result = results %]
    * [% result.description | truncate(24) %]
    <a href="[% result.link %]">Read more</a>
    [% END %]
  • uri 将 uri 变为浏览器所喜欢的形式。类似 URI::Escape 的功能。
  • 还有其他一些,查看 TT 的 documents
文章有点长,怎么自定义 filter 明天在另一篇中写。

be a CPANPLUS Tester

09 December 2005


summary:
# Console 为控制台,Win2000 下运行 cmd
Console >perl -MCPAN -e shell
# 或者直接 cpan

cpan> install CPANPLUS
cpan> install Test::Reporter
cpan> q

Console >perl -MCPANPLUS -e shell
# 或者直接 cpanp
CPAN Terminal> s edit
# 修改你的配置如 hosts, base 等。测试的话最重要的将 'cpantest' => 1, 这个设置为 1
CPAN Terminal> s save
CPAN Terminal> i CPAN
# 安装模块
CPAN Terminal> q

将 'cpantest' => 1 后
如果安装模块出错(成功也会问)后会问你是否将错误报告给 CPAN
Would you like to send the test report? [y/N]:
到时候选 y 就可以了。


Graph::Easy

07 December 2005


最初认识这模块是 joe jiang 用的时候。他用这个模块做了一些很有用的图。
后来在 use.perl 上也看到几个人用这个做 DBIx::Class 的关系图。觉得挺不错的。
今天拿来做做 svk 的关系图。发现做一个简单的图很简单。复杂的图应该也比较简单,不过还没试验过。
因为在 Win32 下跑,所以也没安装 'gpg'.

因为很简单,所以代码也很简单:

#!/usr/bin/perl
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use CGI qw/:cgi/;

my $query = new CGI;
print $query->header(-type=>'text/html');

use Graph::Easy;

my $graph = Graph::Easy->new();

my $remote = $graph->add_node("Remote\n(SVN server)");
my $mirror = $graph->add_node("Mirror\n(Local Machine)");
my $local = $graph->add_node('Local Machine');

# sync
my $edge = Graph::Easy::Edge->new( label => 'sync' );
$graph->add_edge ($remote, $mirror, $edge);
# checkout, up, ci
$edge = Graph::Easy::Edge->new( label => 'co' );
$graph->add_edge ($mirror, $local, $edge);
$edge = Graph::Easy::Edge->new( label => 'up' );
$graph->add_edge ($mirror, $local, $edge);
$edge = Graph::Easy::Edge->new( label => 'ci' );
$graph->add_edge ($mirror, $local, $edge);
# log, diff
$edge = Graph::Easy::Edge->new( label => 'log' );
$graph->add_edge ($mirror, $local, $edge);
$edge = Graph::Easy::Edge->new( label => 'diff' );
$graph->add_edge ($mirror, $local, $edge);

# raw HTML section
#print $graph->as_html_file( );
#my $graphviz = $graph->as_graphviz();

用 Graphviz 弄出来的结果大致是这样子的:
graph easy

Update

Win32 下的 Graphviz 在 http://www.graphviz.org/Download_windows.php 可以下。

Template Toolkit 入门

03 December 2005


PRE/POST_CHOMP

我在 Template Toolkit 的配置选项 写过可以设置 POST_CHOMP 和 PRE_CHOMP 为 1 来去掉 TT 代码所带来的前后空行。不过如果你不想设置这个的话也是可以去掉前后空行的。比如这样:
Hello [% a = 3 %]
World [% a %]
这个输出的话为“Hello \nWorld 3\n”。而这么写可以把里面的 \n 去掉:
Hello [% a = 3 -%]
World [% a -%]
输出为“Hello World 3”。这个在 http://www.stonehenge.com/merlyn/LinuxMag/col60.html 里提到过。

合并两个 TT 代码

[% user.name %][% END %]
可以写成
[% user.name; END %]

INSERT 和 INCLUDE 的区别

INSERT 只是插入文件的内容而不管你是不是另一个 .tt 文件。而 INCLUDE 的话如果是另一个 .tt 文件的话会执行它。
比如你有一个文件叫 footer.tt, 内容为:
Copyright 2004-2005 All Rights Reserved. Powered by <a href="Eplanet.html">Eplanet</a> && <a href='http://catalyst.perl.org'>Catalyst</a> [% CatalystVersion %].
当在另一个文件中调用 [% INSERT footer.tt %] 时输出的结果跟上面的会一样。里面的 [% CatalystVersion %] 是原封不动。而如果是用 [% INCLUDE footer.tt %] 的话里面的 [% CatalystVersion %] 会被执行为这个变量的值。

BLOCK

比如你有段代码要执行两次。比如我有一个导航栏,需要上面放一个下面放一个。那我可以这么写:
[% show_guidebar = BLOCK %]
<p>
[% IF prev_topic %]<<Previous: <a href="[% prev_topic.cms_file %].html">[% prev_topic.cms_title %]</a>[% END %]
[% IF prev_topic and next_topic %] [% END %]
[% IF next_topic %]>>Next: <a href="[% next_topic.cms_file %].html">[% next_topic.cms_title %]</a>[% END %]
</p>
[% END %]

[% show_guidebar %]

...

[% show_guidebar %]

注释

注释很简单,在 [% 后加上 # 那这一行就被注释掉了。唯一值得注意的是下面这两种是不一样的:
[%# a = 77
b = 88
%]
a: [% a %] b: [% b %]
输出 a: b:
而[% 和 # 中间空了一格后就只有注释一行而不是整个 [% %], 如:
[% # a = 77
b = 88
%]
a: [% a %] b: [% b %]
输出 a: b: 88

参考


attributes 用法介绍

01 December 2005


用过 Catalyst 的人都知道 Catalyst 的 action 都要用 : Global, : Local, : Path(), : Regex 等等来 register.
这种 sub subroutine : attributes 虽然在 perldoc attributes 里说还是试验性的,但是看起来不会再有大的改变。
不过代码写起来却不是很舒服。我不打算翻译 attributes, 而是写几个简单的例子来试验试验其在 sub 上的功能。

一个最最简单的例子是:

use strict;

test();

sub MODIFY_CODE_ATTRIBUTES {
my ($pkg, $ref, @attrs) = @_;

print "$pkg\n";
print "attrs: $_\n" foreach @attrs;

return;
}

sub test : attribute {
print "test";
}

1;

输出的结果:
main
attrs: attribute
test
    简单的解释一下:
  • MODIFY_CODE_ATTRIBUTES 根据 perldoc attributes 的介绍,将对每一个拥有 attributes 属性后缀的子程序都执行一次。而且对于子程序的执行时间是在 complie 编译时执行。所以 main attrs: attribute 会出现在 test 前面。
  • my ($pkg, $ref, @attrs) = @_; 这三个参数分别对应 包名(这里是 main),$ref 为拥有后缀的子程序的引用(这里的 $ref 差不多是 \&test),而 @attrs 就是那属性后缀名。为什么这里是用 @attrs 是因为属性后缀可以是多个。比如 sub test : attribute kisssherry { 的话我们的输出就会变为
    main
    attrs: attribute
    attrs: kisssherry
    test
    @attrs 接收了 attribute 和 kisssherry
  • 另外得注意的是返回。return 1 是绝对不允许的,return 返回的必须是一个属性列表,作用是配合类继承。
这个返回值怎么配合类继承我也不太明白。一般的做法就是类似 Catalyst 的做法。弄一个 Package 专门用于解析 attributes, 然后将它们保存下来:
package Catalyst::AttrContainer;

use strict;
use base qw/Class::Data::Inheritable Class::Accessor::Fast/;

use Catalyst::Exception;
use NEXT;

__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache/;
__PACKAGE__->_attr_cache( {} );
__PACKAGE__->_action_cache( [] );

# note - see attributes(3pm)
sub MODIFY_CODE_ATTRIBUTES {
my ( $class, $code, @attrs ) = @_;
$class->_attr_cache( { %{ $class->_attr_cache }, $code => [@attrs] } );
$class->_action_cache(
[ @{ $class->_action_cache }, [ $code, [@attrs] ] ] );
return ();
}

sub FETCH_CODE_ATTRIBUTES { $_[0]->_attr_cache->{ $_[1] } || () }

唯一使用了这个类的 Catalyst 模块是 Catalyst::Base;
package Catalyst::Base;

use strict;
use base qw/Catalyst::Component Catalyst::AttrContainer Class::Accessor::Fast/;

...

这样诸位应当知道为什么我们每在一个 Controller 里都要写上 use base 'Catalyst::Base'; 了吧。它的目的就是解析类如 Global/Path/Local 等 attributes. 没写 use base 'Catalyst::Base'; 的话,action 里根本就不会出现你写的 Controller.
而即使现在的 Catalyst 将 Catalyst::Base 拆分为 Catalyst::Controller Catalyst::Model Catalyst::View 后, Catalyst::Controller 目前的代码也只是:
package Catalyst::Controller;

use strict;
use base qw/Catalyst::Base/;

1;

另外有个 Attribute::Handlers 用于专门处理 attributes, 其实也差不多,看看 perldoc 就 OK 了。

modperl 的用户验证

26 November 2005


    如果不用 modperl 的话,我们也可以这么做:
  • 修改 httpd.conf
    Alias /t/ "E:/Fayland/t/"
    <Directory "E:/Fayland/t">
    AllowOverride AuthConfig
    Options Indexes MultiViews
    Order allow,deny
    Allow from all
    </Directory>
  • 在 E:/Fayland/t 目录下创建 .htaccess 文件
    AuthName "Fayland's Test WebSite"
    AuthType Basic
    AuthUserFile E:/Fayland/t/.htpasswd
    require valid-user
  • 用 Apache 的 htpasswd 命令创建用户名和密码(第一次需要 -c 开关)
    $> htpasswd -c E:/Fayland/t/.htpasswd fayland
    $> htpasswd E:/Fayland/t/.htpasswd hi
    这样就可以了,访问 http://localhost/t 时会弹出这样的窗口:

这种形式创建的用户名和密码必须要用 htpasswd
而一般我们都把用户名和密码存在数据库里,这样比较方便增加和修改用户密码等。
在 modperl 中这一块是使用 PerlAuthenHandler 来处理的。

一个事例代码如下:

package MyApache2::MyAuth;

use strict;
use warnings;

use Apache2::Access ();
use Apache2::RequestRec ();
use Apache2::Const -compile => qw(OK DECLINED HTTP_UNAUTHORIZED);

use DBI;
my $dbh = DBI->connect("DBI:mysql:auth:localhost",
       'root', undef, { RaiseError => 1, PrintError => 1 }) or die "cann't connect";

sub handler {
   my $r = shift;

   my ($status, $password) = $r->get_basic_auth_pw;
   return $status unless $status == Apache2::Const::OK;

   my $sth = $dbh->prepare("SELECT password FROM users WHERE username = ?");
   $sth->execute($r->user);
   my @turepwd = $sth->fetchrow_array();

   if ($password eq $turepwd[0]) {
       return Apache2::Const::OK;
   }

   $r->note_basic_auth_failure;
   return Apache2::Const::HTTP_UNAUTHORIZED;
}

1;

然后在 perl.conf 里面添加
Alias /auth/ "E:/Fayland/auth/"
<Location /auth/>
SetHandler perl-script
PerlResponseHandler ModPerl::Registry
PerlAuthenHandler MyApache2::MyAuth
Options +ExecCGI

AuthType Basic
AuthName "Fayland's Test WebSite"
Require valid-user
</Location>
上面就是一个简单的例子。这里没有使用 Apache::DBI 而是直接使用了 DBI 是为了简便。

    简单的解释下代码:
  • my ($status, $password) = $r->get_basic_auth_pw;
    第一个 $status 是状态,只有在弹出窗口的用户名和密码都被填写时,$status 为 Apache2::Const::OK
    否则的话,return $status unless $status == Apache2::Const::OK; 返回它原来的状态。一般就是浏览器直接显示 401 Authorization Required
  • 必须注意是 AuthType Basic 这样才能用 $r->get_basic_auth_pw
  • 用户名用 $r->user 获取,密码用 $r->get_basic_auth_pw 的第二字段
  • 然后我们比较的密码,如果密码正确的话返回 Apache2::Const::OK 否则返回 Apache2::Const::HTTP_UNAUTHORIZED 让它继续验证。
这中间你还可以更复杂点,针对不同的 $status 返回不同的东西。用户名不存在返回什么,密码错误返回什么的。
不过大致的代码就是这个样子了。更详细的查看 Apache/modperl 文档:
http://perl.apache.org/docs/2.0/user/handlers/http.html#PerlAuthenHandler