Text::Textile

14 April 2005


Textile 是种 wiki 常用的格式,写起来比较方便。 perlchina wiki 用的就是这个格式。

CPAN 上有个模块为 Text::Textile 可以实现这个功能。于是想着给 Eplanet 增加这功能。

代码还是很简单:

use Text::Textile;
my $textile = Text::Textile->new();
$textile->charset('utf-8');

$c->stash->{cms_text} = $textile->process( $c->stash->{cms_text} );

唯一值得一写的是如果是 utf-8 格式数据的话就得多一句

$textile->charset('utf-8');

Have fun. Enjoy!

Refer


Kwiki Formatter

14 April 2005


数几个小时前写了个 textile, 现在想写个 Kwiki 格式。

CPAN 中没有现成的 Kwiki 直接格式模块,但是有个实现了所有功能的模块 CGI::Kwiki::Formatter ,于是我就写了个继承这模块的子模块。

模块代码如下:

package Text::KwikiFormatter;

use strict;

use vars qw( $VERSION );
$VERSION = '0.01';

use base qw(CGI::Kwiki::Formatter);

sub new {
   my $class = shift;
   my $self = { @_ };
   bless $self, $class;
   return $self;
}

sub wiki_link_format {
   my ($self, $text) = @_;
   my $wiki_link = qq{<a href='$text.html'>$text</a>};
   return $wiki_link;
}

1;

代码很简单,除了要置换 wiki_link_format 这个格式是针对 wiki 内部词汇转换,我把它改为我自己所需要的 Eplanet 内部转换。

运用代码如下:

use Text::KwikiFormatter;
my $formatter = Text::KwikiFormatter->new();

print $formatter->process($text);

Have fun! Enjoy!

Refer

http://www.kwiki.org/index.cgi?KwikiFormattingRules


WWW::Mechanize && Google Group

13 April 2005


觉得 Google 的 new 新闻组挺不错的,就申请了一个。http://groups-beta.google.com/group/fayland
拿来做什么还不知道,呵呵。暂时就打算去发表自己的 journal.

如果每次都登陆然后发表就太麻烦了。于是就想着用 WWW::Mechanize 来解决,然后做个 Eplanet 的功能,一键就发表了。简单写了下,挺简单的。5分种就搞定了。(终于发现自己 Perl 水平上去了,不容易呀。)

简单的代码如下,具体的 Eplanet 功能还要考虑将 HTML 转换为文本形式,迟点再搞:

use strict;
use warnings;
use WWW::Mechanize;

my $mech = WWW::Mechanize->new( autocheck => 1 );

# first, we should login
$mech->get('https://www.google.com/accounts/Login?hl=en&cd=US&service=groups2&continue=http:%2F%2Fgroups-beta.google.com%2Fgroup%2Ffayland%2Fpost');

$mech->submit_form(
    fields   => {
        Email => '[email protected]', # your email, google account
        Passwd => 'yyy', # your password, please not be 'yyy'
    }
);

$mech->get('http://groups-beta.google.com/group/fayland/post');

$mech->submit_form(
    fields   => {
        subject => 'Test from WWW::Mechanize',
        body => 'Yap, WWW::Mechanize it',
    },
    button => 'Action.Post'
);

用 Ajax 技术添加预览功能

10 April 2005


简单介绍

Preview/预览功能在BBS, CMS中是个常用的功能,如果没有 Ajax, 一般就得弹出窗口或提交页面,挺麻烦的。
而有 Ajax 后自然不同,写完了直接在本页显示结果。

我给自己的 Eplanet 添加了用 Ajax 写就的预览功能。代码如下,仅供参考。

Update

2005/4/21 将 GET 改为 POST 方法,这样能支持大于 512K 的参数。

代码分析

  • js 分析
    loadXMLDoc 为创建一个 XMLHttpRequest 对象,可以提交 URL
    PreviewMe 为预览函数,没有回复时提交,提交后得到的回复显示出来
    form 区块为填写预览内容区块,而且有一按钮用以交互
    
    <script language="javascript" type="text/javascript">
    var req;
    
    function loadXMLDoc(url, parameters) 
    {
        // branch for native XMLHttpRequest object
        if (window.XMLHttpRequest) {
            req = new XMLHttpRequest();
            req.onreadystatechange = processReqChange;
            req.open("POST", url, true);
            req.setRequestHeader('Connection', 'close');
            req.setRequestHeader('Content-type', 'application/x-www-form-urlencoded');
            req.send(parameters);
        // branch for IE/Windows ActiveX version
        } else if (window.ActiveXObject) {
            req = new ActiveXObject("Microsoft.XMLHTTP");
            if (req) {
                req.onreadystatechange = processReqChange;
                req.open("POST", url, true);
                req.setRequestHeader('Connection', 'close');
                req.setRequestHeader('Content-type', 'application/x-www-form-urlencoded');
                req.send(parameters);
            }
        }
    }
    
    function PreviewMe(input, response)
    {
      if (response != ''){ 
        // Response mode
        message = document.getElementById('preview');
        message.innerHTML = response;
      }else{
        // Input mode
        url  = 
          '[% base %]/preview/';
        loadXMLDoc(url,'body=' + encodeURIComponent(input));
      }
    }
    
    function processReqChange() 
    {
        // only if req shows "complete"
        if (req.readyState == 4) {
            // only if "OK"
            if (req.status == 200) {
    
          response  = req.responseText;
         
          PreviewMe('', response);
    
            } else {
                alert("There was a problem retrieving the XML data:\n" + req.statusText);
            }
        }
    }
    </script>
    
    <form><textarea name="editor" name="cms_text" rows="15" cols="100" wrap="virtual"></textarea>
    <input type='button' onclick="PreviewMe(this.form.editor.value,'');" value='Preview Me'>
    </form>
    
    <div style='margin:2em; border: 1px solid #888888;background: #000; color:#FFF;'>Preview:<br>
    <div id="preview" style='background: #FFF; color:#000;padding: 1em'></div>
    </div>
    
  • [% base %]/preview/?body= 文件
    此代码块主要是用一个 CGI 接收 body 参数,经过变换打印出来。如下是我的 Eplanet 代码(片断):
    
    package Eplanet::C::Preview;
    
    use base 'Catalyst::Base';
    
    sub preview : Global {
        my ( $self, $c, $submit ) = @_;
        
        my $text = $c->req->params->{'body'};
        
        #damn it, why i should add this
        $c->res->headers->header( 'Content-Type' => 'text/html;charset=utf-8' );
        
        $c->res->output("$text");
    
    }
    
    1;
    

特殊说明

这是个不完整也不完美的代码。
Catalyst 有个 Plugin::Ajax. 但是不太完美,不符合我的要求。
已经把它加到自己的 BBS 中,如果有时间给 LeoBBSx 等写个修改。
如下为一截图:

如何用 minicpan 映像自己的 CPAN

07 April 2005


简单介绍

minicpan 最简单的说法是把伟大的CPAN搬到自己的电脑里。它的最初想法来自Randal L. SchwartzMirroring your own mini-CPAN
完整的 CPAN 有 1G 多,minicpan 只是把这一模块的最新版本 down 下来,所以只有500M左右,可以放到一张光盘里。
一般用于需要时不必上网就能安装所需模块,这对某时上不了网非常有用。

安装和使用

minicpan 是模块 CPAN::Mini 的一个运行程序。介绍下我自己安装和使用过程:
  • cpan CPAN::Mini 安装此模块,安装完毕后 bin 目录下会有minicpan可执行文件(win32下为bat文件)
  • 执行命令,将 CPAN 拷贝到 E:\CPAN 目录下:
    minicpan -l E:/CPAN/ -r http://cpan.linuxforum.net/
    推荐使用 joe 的镜像 http://cpan.3322.org
  • 我大约弄了三个小时(用 rsync 可能会快很多)才拷贝到已 D 字开头的模块,受不了先断一下。而后要重新续传的话可以用如下命令,加一 -f 参数:
    minicpan -l E:/CPAN/ -r http://cpan.linuxforum.net/ -f
  • 完毕后加自己的CPAN路径加到 Config.pm 里。这里有好几种办法,一种是手工打开 CPAN/Config.pm 修改,另一种是
    C:>cpan
    cpan>o conf urllist unshift file:///E:/CPAN/
    cpan>o conf commit
  • 以后安装的话可以直接install, 不用联网。
    cpan>install DBD::Mock
    如果不想每次都输入 -l -r 这长地址可以建一文件 .minicpanrc
    local:  E:/CPAN/
    remote: http://cpan.linuxforum.net/
    然后修改 minicpan 可执行文件:
    %config = config_read( 'C:\usr\bin\.minicpanrc' );
    写入文件的地址。

    后记 于2005/04/08

    早上又花了两个小时总算把 CPAN download 完了。共11533个文件,大小418 MB (438,329,000 字节)。赞一声。

    参考


  • Win32 下 Apache 和 #!/usr/bin/perl

    01 April 2005


    我一向喜欢写
    #!/usr/bin/perl
    这么写的很大部分原因是为了兼容 Linux(Unix).

    但是假设你的 Perl 目录为 C:\usr\bin, 而 Apache 目录为 D:\Apache2. 那你所有的程序头一行必须是

    1. #!C:/usr/bin/perl.exe
    2. #!usr/bin/perl
    3. #!perl
    这三种中的一种。其中第 3 种还必须得把 C:\usr\bin 加个 Path 中。
    如果你不这么做,当你访问类如 http://localhost/cgi-bin/printenv.pl(此程序以#!/usr/bin/perl开头时) 时就会报错:
    No such file or directory: couldn't spawn child process: D:/Apache2/cgi-bin/printenv.pl

    解决这个问题的方法不是修改 httpd.conf 或者注册表什么的。你要么都用 #!C:/usr/bin/perl.exe 开头,要么将 Apache 和 Perl 安装到一个目录中(都在 C: 或者都在 D:)

    今天重装 Apache 时发现此问题。按照搜索来的修改 httpd.conf 和注册表或文件对应都没用,后来火大再重装回 C:\Apache2 时无意中解决。希望能有所帮助。我的配置为:

    Perl 5.8.6 and Apache 2.0.52, together with mod_perl-1.99_20, mod_ssl / OpenSSL (0.9.7e), and php-4.3.10

    Class::DBI 改 Primary 项

    30 March 2005


    问题

    今天碰到的是在数据库里更改一项 primary auto_increment field.
    Class::DBI 中的 move 好像失效了。在 DBI.pm 中是这么写的。
    sub move {
        my ($class, $old_obj, @data) = @_;
        $class->_carp("move() is deprecated. If you really need it, "
                . "you should tell me quickly so I can abandon my plan to remove it.");
        return $old_obj->_croak("Can't move to an unrelated class")
            unless $class->isa(ref $old_obj)
            or $old_obj->isa($class);
        return $class->create($old_obj->_data_hash(@data));
    }
    而我试了下 set( 'cms_id' => $new_id); update 也不成。在 POD 文档中是这么说的。
    The update() method returns the number of rows updated, which should
    always be 1, or else -1 if no update was needed. If the record in the
    database has been deleted, or its primary key value changed, then the
    update will not affect any records and so the update() method will
    return 0.
    方法 update() 返回更新的行数,应该经常是 1, 或者没有必要的更新时返回 -1. 
    如果数据库中的纪录被删除,或者说它的主键被更改,那此后的更新不会再影响任何纪录,所以 update() 将返回 0.
    最后到 CDBI wiki 上找了个 DirectlyExecuteSql.
    最后写了代码如下:
    
    my $new_id = Eplanet::M::CDBI::Cms->maximum_value_of('cms_id');
    $new_id++;
    
    my $dbh = Eplanet::M::CDBI::Cms->db_Main();
        $dbh->do(qq|
        UPDATE cms SET cms_id = $new_id WHERE cms_id = $id
    |);
    

    如何创建 Atom

    29 March 2005


    简介

    Atom 的作用请自行搜索。
    RSS 的创建请参阅给网页增加RSS.

    描述

    这里我使用 XML::Atom::SimpleFeed 来创建 Atom

    XML::Atom::SimpleFeed 有些许瑕疵,如不能设置编码和多了个默认的 xml:lang="en"

    我略微修改了下使之符合我的要求。

    1. 删除两处 xml:lang="en"
    2. 改 encoding="iso-8859-1" 为 encoding="UTF-8"

    代码

    如下代码来自我基于 Catalyst 的 Eplanet

    
    use lib "E:/t/Eplanet/hackedlib"; # add the hack file's address
    use XML::Atom::SimpleFeed;
    
    my $Atom_file = $c->config->{build_root} . "/atom.xml";
    my $title = 'Fayland\'s';
    my $link = 'http://www.fayland.org/';
    my $description = 'What Fayland says';
    	
    my $atom = XML::Atom::SimpleFeed->new(
    	title    => $title,
    	link     => $link,
    	tagline  => $description,
    	author => { name => 'Fayland Lam' },
    )
    or die;
    
    my @cats = Eplanet::M::CDBI::Cms->retrieve_from_sql(qq{
    	1=1 ORDER BY cms_id DESC LIMIT 0, 20
    });
    
    foreach my $cat (@cats) {
    	my $_title = $cat->get('cms_title');
    	my $_link = "http://www.fayland.org/journal/$cat->{'cms_file'}.html";
    	my $_description = $cat->{'cms_describe'};
    	my $_create_data = $cat->{'cms_cre_data'};
    	# convert to the standard w3cdtf
    	$_create_data = date2w3cdtf($_create_data);
    	# got the modified data
    	my $_modified_data = $cat->{'cms_mod_data'};
    	# if not exists, use create data instead
    	if ($_modified_data) {
    		$_modified_data = date2w3cdtf($_modified_data);
    	} else {
    		$_modified_data = $_create_data;
    	}
    		
    	$atom->add_entry(
    		title    => $_title,
    		link     => $_link,
    		author   => { name => "Fayland Lam" },
    		issued   => $_create_data,
    		created  => $_create_data,
    		modified => $_modified_data,
    		content  => $_description,
    	)
    	or die;
    }
    
    $atom->save_file($Atom_file);
    
    sub date2w3cdtf {
    	my $data = shift;
    	# the original data foramt like 2005-03-29 23:02:14 & it's a localtime
    	# so we convert localtime to $time and got the gmtime
    
    	my ($year, $mon, $mday, $hour, $min, $sec) = ($data =~ /^(\d+)-(\d+)-(\d+)\s(\d+):(\d+):(\d+)$/);
    	$mon--;
    	use Time::Local;
    	my $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
    	( $sec, $min, $hour, $mday, $mon, $year) = gmtime($time);
    	$year += 1900; $mon++;
    
    	# at last we return the w3c dtf
    	my $timestring = sprintf( "%4d-%02d-%02dT%02d:%02d:%02dZ",
            $year, $mon, $mday, $hour, $min, $sec );
     	return ($timestring);
    }
    

    Yap, I recieved a book

    28 March 2005


    When I'm dealing with the math/calculous painfully today, my mailwoman(classmate) give me a package. Thanks for this disruption, I left the math far away. :)

    It's a book from hoowa, one of the PerlChina leaders. It's a prize for my translation work on Perl localization. u can find them here: http://wiki.perlchina.org/main/.

    The book is < Network Programming with Perl >, by the CGI.pm author -- Lincoin D.Stein.
    I read it once years ago and it's still worth reading again. Thanks for hoowa & PerlChina.


    发送邮件附件

    23 March 2005


    简单描述

    如果仅仅只是发送不带附件的邮件,请参考如何用Net::SMTP发送邮件

    这里使用 MIME::Lite 模块来发送附件。分为两种情况,一种是 SMTP 服务器不需要验证的,另一种是需要验证/auth 的。

    情况一:SMTP 服务器不需要验证

    这种情况下可以参考 perldoc MIME::Lite. 还有个更详细的例子在 Cooking with perl.
    一个简单的 Example:
    
    use MIME::Lite;
     
    my $msg = MIME::Lite->new(From    => '[email protected]',
                 To      => '[email protected]',
                 Subject => 'My photo for the brochure',
                 Type    => 'multipart/mixed');
    $msg->attach(Type        => 'image/jpeg',
                 Path        => '/Users/gnat/Photoshopped/nat.jpg',
                 Filename    => 'gnat-face.jpg');
    $msg->attach(Type        => 'TEXT',
                 Data        => 'I hope you can use this!');
    #$msg->send(  );            # default is to use sendmail(1)
    # now we use smtp.
    $msg->send('smtp', 'mailserver.example.com');
    

    情况二:SMTP 服务器需要验证/auth

    现在的 SMTP 服务器大部分都需要验证,我猜测可能的原因是为了防止垃圾邮件。
    MIME::Lite 中是不支持 SMTP 验证/auth 的。所以我们一般将 MIME::Lite 转为 string, 然后通过验证后的 Net::SMTP 来发送。详细的代码如下(已测试成功):
    
    use Net::SMTP;
    use MIME::Lite;
    
    # setting
    my $mailhost = 'smtp.163.com';
    my $username = 'usr';
    my $password = 'pwd';
    my $from = '[email protected]'; # your email on that smtp host
    my $to = '[email protected]'; # the recipient
    my $subject = 'It\'s a test mail with attachment'; # the email title
    my $content = 'emailed from fayland.'; # the content of email
    my $attachment = 'E:/test.gif';
    
    $smtp = Net::SMTP->new($mailhost, Timeout => 120, Debug => 1);
    
    # anth login
    $smtp->auth($username, $password);
    
    # attachment
    my $msg = MIME::Lite->new(
        From    => $from,
        To      => $to,
        Subject => $subject,
        Type    => 'TEXT',
        Data    => $content,
    );
    
    # Attach 
    $msg->attach(
        Type     => 'image/gif', # the attachment mime type
        Path     => $attachment, # local address of the attachment
        Filename => 'asuwish.gif', # the name of attachment in email
    );
    
    my $str = $msg->as_string() or die "Convert the message as a string: $!\n";
    
    $smtp->mail($from);
    $smtp->to($to);
    $smtp->data();
    $smtp->datasend($str);
    $smtp->dataend();
    $smtp->quit;
    

    参考