Perl笔记

内核的幽默

2009-01-28T08:20:00.000-08:00

CONFIG_LGUEST:

If unsure, say N. If curious, say M. If masochistic, say Y.

如上。

BTW，一定保证DISKLABEL=yes或者genkernel时--disklabel，如果想用UUID指定根分区的话。

Larry Wall关于Perl6的演讲

2008-12-28T11:04:00.000-08:00

Youtube/Google Video上有长达1小时的视频。Larry提到很多已经公开讨论过的细节，比如：Perl6是许多语言的语言，操作符‘|’不再是从左到右依次求值了，而是满足并行求值的需求，操作符‘||’则进行Perl5中‘|’的串行；比如P6RE（没错，不再是PCRE了）里，一切都是默认x修饰过的扩展语法（所以没有x修饰符了），也没有s修饰了，一切都是多行的，\N用来匹配“非\n”，^^和^匹配字符串的开始和一行的开始，也没有/1，统统使用$1了；如，操作符的定义也可以极端灵活，现场展示了定义"+-"操作符的语法等等。一如既往，Larry希望别人能够继续“偷窃”perl对于Regex/正则的贡献。

Larry在解答现场提问时，提到自己不参与涉及语言实现的工作，一切实现都交予社区来进行，而他本人负责协调设计语言本身。还有人提问唐凤的近况，Larry提到唐凤似乎罹患Attention Deficit，不过目前已经停止用药了。祝她早日康复啊！

新的ProjectCartoon

2008-12-06T00:37:00.000-08:00

软件工程的讽刺漫画ProjectCartoon.com(beta)今年又有几幅更新：其中iSwing明显是在模仿苹果的iPod剪影广告。辛普森都要恶搞一下的产品……

听说Python 3发布后许多人在抨击兼容性，还有比如:


>>> (16**8**4+1)/2
Traceback (most recent call last):
  File "<pyshell#2>", line 1, in <module>
    (16**8**4+1)/2
OverflowError: int/int too large for a float
>>>

不知道perl6会咋样。

新的bioperl

2008-11-18T05:33:00.000-08:00

从邮件列表看，bioperl还在讨论是否保留针对perl-5.8的支持。Perl-5.8是Mac OS X 10.5 Leopard的标配版本，估计5.10要等到Snow Leopard了，所以5.8还是要支持的吧！Mac的平台跨度不小，估计想发布自己维护的二进制Perl也不是容易事。

根据计划，貌似bioperl-1.6要发布了，大概就在一个月以内吧。

不知道iPhoneOS2上的perl啥时候发布

2008-11-18T05:18:00.000-08:00

iPhone 2.x的python和pyobjc已经用了很久了，也有人用来写Cydia上的应用了。perl的编译倒是不大顺利，貌似还有些test没过。

希望能在Cydia上早日再见到perl。

/.上的回帖

2008-01-25T09:22:00.000-08:00

以下回帖节选自/.上又一篇关于perl有所为有所不为的争论：

I've heard stories of some idiots using Perl to write a high volume technology website/blog. I'm still trying to find out what site it is.

——说的就是/.嘛！

My favorite "You did WHAT in perl?" response is: On several projects, when there were portability problems, I've created a Makefile entry that runs a "man foo" command and pipes the data to a perl script, which generates C files for that system. It's typically just header files, but sometimes also a few .c files with data structures and/or simple functions to intercede with variant library routines.

It's fun to watch people's reaction when they realize that "You wrote a perl script that reads the manual and generates the code?" I just respond something like "Uh, yeah; you got a problem with that?"

Especially fun has been the couple of discussions in which I expressed a great deal of skepticism of various "AI" claims. Then someone brings up the fact that I write perl programs that read English-language docs and generate code from them. They're obviously puzzled by the fact that I do this while looking skeptically at "AI" proposals. It's like they expect me to just shrug and write other impossible things in perl.

A conceit of 2D operator in perl

2007-12-17T09:15:00.000-08:00

发信人: zhangchn (囧囧秋月朙), 信区: Perl
标题: Re: 如何确定一个元素是否存在于某个数组中？
发信站: 水木社区 (Mon Dec 17 21:10:19 2007), 转信


会不会弄个二维的？
    @a
     \
$x<<-#->>$y
     \
    %b;

【在 flw (梨花小蓓蕾) 的大作中提到: 】
: 看 Perl 6 的语法，沦陷的多了，
: <<==>> <<+>> <<->> 都是运算符了。

不是吧？perl在日本也搞サービス？

2007-12-03T08:33:00.000-08:00

详见http://www.slideshare.net/lapis25/perl-47997/，第53页。

可惜不太萌。

二进制的"tooold"

2007-06-19T04:50:00.000-07:00

printf("%08b "x6,map(ord,split //,"tooold"));

关于StandAloneBlast!!!

2007-05-21T11:39:00.000-07:00

使用Bio::Tools::Run::StandAloneBlast时，一定要保证输出临时文件的目录，一般是当前的工作目录，具有w权限！！！

正则表达式原来也可以计数的

2007-03-22T06:34:00.000-07:00

比如，比较等长（已对齐）字符串中不同的字符数。
$a="attggc";
$b="tttgac";
print (($a^$b)=~y/\0//c);

y///函数不但有tr那样的功能，还可以返回匹配的次数。/c匹配指定模式的补集。

Bio::Structure

2007-03-10T18:51:00.000-08:00

Bio::Structure里面的东西还真不多。pod里最常见的解释就是：

nothing useful until I get symbolic references to do what I want.

Orz!
到cpan翻了一下1.5，发现除了几个有关二级结构的包还略有些内容，其它基本上都是空架子。sigh!

perlvar的实用主义？

2007-03-05T04:28:00.000-08:00

Perl的预设变量里，居然有$a, $b!
无语了。纯实用主义啊！

转贴：Perl is Nothing

2007-02-21T00:23:00.000-08:00

发信人: Aldarion (Lord of the Ships and Havens of Numenor), 信区: Perl
标题: Re: 新年第一篇perl
发信站: 水木社区 (Wed Feb 21 12:18:27 2007), 转信

then, perl is Nothing...
【在 yaojii (人品积攒中大灰狼&土拨鼠=happy) 的大作中提到: 】
: 标题: Re: 新年第一篇perl
: 发信站: 水木社区 (Wed Feb 21 08:39:34 2007), 转信
:
: I have to say. Nothing is perfect.
: 【在 superisaac (反省中.....) 的大作中提到: 】
: : perl is perfect
:
:
: --
:
: ※ 来源:·水木社区 newsmth.net·[FROM: 66.77.81.*]

--

※ 来源:·水木社区 newsmth.net·[FROM: 59.151.45.*]

PPM的包管理真烂

2007-02-18T20:51:00.000-08:00

确切地说，不是ppm烂，而是bioperl.org不地道。http://bioperl.org/DIST/ 的包跟package.xml不同步(/DIST/下面只有bioperl-1.5.2_102，而package.xml里的bioperl-1.5.2_100在/DIST/old_releases里，而/DIST/RC则是空空如也)，而按照官方的Windows安装指南，根本就是缘木求鱼。

在维护者修订错误之前，也只能手动安装了。把/DIST/old_releases里的bioperl-1.5.2_100.ppm.tar.gz下载到一个目录，然后拷贝/DIST/package.xml里的这一段：


<softpkg name="bioperl" version="1.5.2_100" date="2006-12-6">
    <title>bioperl</title>
.
.
.
.
</softpkg>

然后，加上第一行：

<?xml version="1.0" encoding="UTF-8"?>

在同一个目录里另存为bioperl-1.5.2.ppd。
按照Windows的安装指南里配置bioperl的repo，然后安装Bundle-bioperl-core，这些依赖都满足后，则可以继续手动安装了。

打开cmd.exe，进入下载的目录，运行ppm-shell。

ppm> repo add ./ blablabla

这时会更新repo。

ppm> install bioperl-1.5.2.ppd
Unpacking bioperl-1.5.2_100...done
Generating HTML for bioperl-1.5.2_100...done
Updating files in site area...done
1706 files installed

这样就OK了。

参考：如何安装本地PPM(注意，其中某些PPM参数已过时。)

苹果的质量，永远的痛

2006-11-28T10:07:00.000-08:00

这两天一直在犹豫，是MB/MBP还是ThinkPad/Presario。Apple的硬件质量似乎一直不好，虽然外形超酷的口碑一直很好。

不过，根据专业拍苹果网站AppleDefects.com的消息，itnews.com.au说，你大可以放弃购买额外的质保，因为绝大多数硬件产品在长达3年的窗口期都不会出问题。可惜凡事皆有例外，对于这个结论，例外就是——你买了苹果！

上次买苹果不良MB/MBP的cnet.com.au的编辑该不会跳槽去了itnews.com.au了吧？

文章结尾还说，虽然AppleCare很糟糕，但是Dell的支持会更加糟糕！天哪！

继续赤果果

2006-11-28T09:29:00.000-08:00

#!/usr/bin/perl -w

use strict;
use POSIX;
use CGI::Fast qw(:standard);

use lib '/home/apache/fcgi_files';
use Util;
use MySes;
#use URI::Escape;
#use MIME::Base64;


my $title = "query";
#my $LOGDIR = "/home/coremail/logs";
my $LOGDIR = "/home/webedit/young/logs";
my $logname = "Grade_Act_3G";

my $PAGEDIR = '/home/apache/fcgi_files/html/163';

# read page
open(INDEX,"$PAGEDIR/index.htm") || die "Open index.htm: $!";
my @page_index = ;
close(INDEX);

=head
open(ERROR,"$PAGEDIR/error.htm") || die "Open error.htm: $!";
my @page_error = ;
close(ERROR);
=cut

while(my $req = new CGI::Fast)
{
 my %replace = ();
 my $today = POSIX::strftime("%F",localtime);
 my $logfile = "$LOGDIR/$logname\_$today.err";
 my $sid = $req->param('sid');
 unless($sid)
 {
 }
 else
 {
       my $session = MySes->new($sid);
       $session->Delete;
   }
 print $req->header(-charset=>'gb2312');
 PrintPage(\@page_index,\%replace);
}

网易赤果果

2006-11-28T09:28:00.000-08:00

#!/usr/bin/perl -w

use strict;
use POSIX;
use IO::Socket;
use CGI::Fast qw(:standard);
use CGI::Cookie;
use LWP::UserAgent;
use URI::Escape;

use lib '/home/apache/fcgi_files';
use Util;
#use CMAPI;
use MySes;
use Grade;
use UserInfo;
use MyLog;
#use URI::Escape;
#use MIME::Base64;

sub handle_term;

$SIG{'TERM'} = \&handle_term;
$SIG{'INT'} = \&handle_term;
$SIG{'ABRT'} = \&handle_term;
$SIG{'CHLD'} = 'IGNORE';

my $domain = '163.com';

#my $title = "query";
#my $LOGDIR = "/home/coremail/logs";
my $LOGDIR = "/home/webedit/young/logs";
my $logname = "Grade_Act_3G";

my $PAGEDIR = '/home/apache/fcgi_files/html/163';

# read page
open(INDEX,"$PAGEDIR/index.htm") || exit(0);#die 'EXIT' "Open login.htm: $!";
my @page_index = ;
close(INDEX);

open(LOGIN,"$PAGEDIR/login.htm") || exit(0);#die 'EXIT' "Open login.htm: $!";
my @page_login = ;
close(LOGIN);

=head
open(ERROR,"$PAGEDIR/error.htm") || die 'EXIT' "Open error.htm: $!";
my @page_error = ;
close(ERROR);
=cut

my $errmsg = "系统繁忙，暂时未能响应你的请求，请稍候。";
my $loginerrmsg = "验证失败，请先登录";
my $loginblockmsg = "失败尝试次数过多，请稍后再登录";
my $pre_url = "http://reg.163.com/servlet/netease.user.Login2Servlet?username=&password=&userip=";

my $ua = LWP::UserAgent->new(
   'keep_alive'    =>  30,
   'timeout'       =>  1,
);

#my $sesh = MySes->connect || die 'EXIT' "Connect mysql err: $!";

my $logdate = POSIX::strftime("%y%m%d",localtime);
my $statlog = "$LOGDIR/$logname\_$logdate.log";
&InitMyLog($statlog);

OUTER: while(my $req = new CGI::Fast)
{
   my $cmh;
eval{
 my %replace = ();
 my $today = POSIX::strftime("%y%m%d",localtime);
   unless($today eq $logdate)
   {
       $logdate = $today;
       $statlog = "$LOGDIR/$logname\_$logdate.log";
       &InitMyLog($statlog);
   }
 my $logfile = "$LOGDIR/$logname\_$today.err";
 my $sid = $req->param('sid');
 my $username = $req->param('username');
 $username && ($username = lc $username);
 my $password = $req->param('password');
 my $uid=$req->param('uid');
   my $userip = $ENV{'REMOTE_ADDR'};
 #$userip ||= '220.181.31.241';
   my $fullname;
   my $dispname;
 unless($uid || $username || $sid)
 {
  print $req->header(-charset=>'gb2312');
  PrintPage(\@page_index,\%replace);
  die 'EXIT';
 }
 if($uid)
   {
  $uid = uri_unescape($uid);
       unless(CheckUid($uid))
       {
           print $req->header(-charset=>'gb2312');
   #$replace{'errmsg'} = $loginerrmsg;
   #PrintPage(\@page_error,\%replace);
   #Error($loginerrmsg);
   PrintPage(\@page_index,\%replace);
           die 'EXIT';
       }
       $username = $uid;
       my $fullname = "$username\@$domain";
       #my $session = MySes->new($sesh);
       my $session = MySes->new();
       my $sess_ret = $session->WriteSes($fullname);
       unless($sess_ret)
       {
           print $req->header(-charset=>'gb2312');
   Error($errmsg);
           die 'EXIT';
       }
       $sid = $session->GetSid;
   }
 elsif($sid)
 {
       #my $session = MySes->new($sesh,$sid);
  my $session = MySes->new($sid);
       unless($fullname=$session->CheckSes())
       {
           print $req->header(-charset=>'gb2312');
   #$replace{'errmsg'} = $loginerrmsg;
   #PrintPage(\@page_error,\%replace);
   Error($loginerrmsg);
           die 'EXIT';
       }
       $username = (split(/@/,$fullname))[0];
   }
   elsif($username)
   {
       unless($password)
       {
           print $req->header(-charset=>'gb2312');
   #$replace{'title'} = $replace{'errmsg'} = "未输入密码";
   #PrintPage(\@page_error,\%replace);
   Error("请输入密码");
           PrintErr($logfile,"$username|password required");
           die 'EXIT';
       }
       $username = uri_unescape($username);
       $password = uri_unescape($password);
       if($username =~ /@/)
       {
           $fullname = $username;
           $username = (split(/@/,$fullname))[0];
       }
       my $ret = CheckURSPass($username,$password,$userip);
  print STDERR "$username($password):$ret\n";
       if($ret ne '200')
       {
   if($ret eq '412')
           {
               print $req->header(-charset=>'gb2312');
               PrintErr($logfile,"$username($userip)|CheckPass error too offen");
               Error($loginblockmsg);
               die 'EXIT';
           }
           print $req->header(-charset=>'gb2312');
   #$replace{'title'} = $replace{'errmsg'} = $loginerrmsg;
   #PrintPage(\@page_error,\%replace);
   Error($loginerrmsg);
           PrintErr($logfile,"$username|CheckPass error");
           die 'EXIT';
       }
       #my $session = MySes->new($sesh);
       my $session = MySes->new();
       $fullname = "$username\@$domain";
       $session->WriteSes($fullname);
       $sid = $session->GetSid;
   }
   #undef $session;

# 验证完成

##############################################################

   my ($jifen,$level,$rcode);

   $|=1;
   $fullname = "$username\@$domain";
   WriteLog("Login: $fullname($userip)");
   #my $grade = Grade->new('192.168.2.106',7788);
   my $grade = new Grade($ua);
   eval{
       unless($grade){
           print $req->header(-charset=>'gb2312');
           #$replace{'title'} = $replace{'errmsg'} = "积分对象创建失败";
           #$replace{'title'} = $replace{'errmsg'} = $errmsg;
           #PrintPage(\@page_error,\%replace);
           Error($errmsg);
           PrintErr($logfile,"Can't new Grade:$!");
           die 'EXIT';
       }
       my $ret = $grade->Query($fullname);
       unless($ret){
           print $req->header(-charset=>'gb2312');
           #$replace{'title'} = $replace{'errmsg'} = "服务器内部通信失败";
           #$replace{'title'} = $replace{'errmsg'} = $errmsg;
           #PrintPage(\@page_error,\%replace);
           Error($errmsg);
           PrintErr($logfile,"Can't connect to server:$!");
           die 'EXIT';
       }
       $rcode = $grade->rcode;
       if($rcode <= 0)
       {
           print $req->header(-charset=>'gb2312');
           #$replace{'title'} = $replace{'errmsg'} = "数据库出错";
           #$replace{'title'} = $replace{'errmsg'} = $errmsg;
           #PrintPage(\@page_error,\%replace);
           Error($errmsg);
           PrintErr($logfile,"$username|DB server error: $rcode");
           die 'EXIT';
       }
       $jifen = $grade->grade;
       $level = $grade->level;
   };
 if($@){
       $jifen = '系统繁忙';
       $level = 0;
   }

   my $uinfo = UserInfo->new($ua,$fullname);
   if($uinfo)
   {
       my %user_info = $uinfo->QueryBatch('nickname','realname');
       if( %user_info && $user_info{'rcode'}>=-1 )
       {
           $dispname ||= $user_info{'nickname'};
           $dispname ||= $user_info{'realname'};
       }
   }
   #print STDERR "here $username\n";
   $dispname ||= $username;

 # 页面输出
   $replace{'uname'} = $dispname;
   $replace{'sid'} = $sid;


   $replace{'jifen'} = $jifen;
   $replace{'level'} = $level;

=head_暂不提供用户查询
   $replace{'jifen'} = 0;
   $replace{'level'} = '';
=cut

   my $cookie_jifen = new CGI::Cookie(-name=>"jifen_$username",-value=>$jifen,-domain=>'mail.163.com');
   my $cookie_level = new CGI::Cookie(-name=>"level_$username",-value=>$level,-domain=>'mail.163.com');
 my $cookie_name = new CGI::Cookie(-name=>'name',-value=>$dispname,-domain=>'mail.163.com');
   #my $cookie_sid = new CGI::Cookie(-name=>'grade_sid',-value=>$sid);
  
 print $req->header(-charset=>'gb2312',-cookie=>[$cookie_jifen,$cookie_level,$cookie_name]);
   PrintPage(\@page_login,\%replace);
};
if($@){
   unless($@ =~ /EXIT/){
       my %replace = ();
       print $req->header(-charset=>'gb2312');
       PrintPage(\@page_index,\%replace);
   }
}
}


sub handle_term
{
 #next OUTER;
=head
 if($sesh)
   {
       $sesh->disconnect;
   }
=cut
   print CGI::header;
 exit(0);
}

BioPerl果然包罗万象

2006-11-23T08:22:00.000-08:00

检索了文档后，又仔细Google了一番，发现Bio::SeqIO居然可以支持ABI测序文件。当然，必须安装bioperl-ext扩展，里面的statden模块是必须的。而且代码是C语言内嵌于Perl中的，需要合适的编译器（对于Win32尤为重要）。效果未知。手头没有abi trace，遂作罢。

Regexp::Common::Profanity

2006-10-05T11:11:00.000-07:00

你在Google Code Search里可以搜到各种各样的牢骚、粗口或者脏话。

然后你会发现CPAN上居然也有。不过仔细一看，其中有一个模块名正言顺的收录了许多脏话。它就是Regexp::Common::Profanity。

这个包是专门用来检测文字、名字、邮箱地址中不雅的和冒犯的词句的。作者为过滤各种外国脏字煞费苦心，不但要考虑空格，还有模糊的读音、拼写以及类似ASCIIART的替换。不知道包括不包括“口禾言皆”之类的情况。

Pugs: Interview: Perl 6 on Perl 5

2006-09-13T00:16:00.001-07:00

登在Pugs官方blog的采访Pugs: Interview: Perl 6 on Perl 5中，负责开发v6模块的 Flávio Soibelmann Glock（fglock）透露了许多v6开发的情况：

总体上，最终目标——v6-Compiler模块（v6/v6-Compiler），用Perl6实现Perl6。

“v6.pm”是一个自举编译器（perl5/Pugs-Compiler-Perl6）。这意味着v6.pm在Perl 6能自己编译自己前，被用作编译Perl 6的编译器。

v6.pm使用了数个CPAN模块：Pugs::Compiler::Rule (regexes)， Data::Bind (signatures)， Moose (objects)，Parse::Yapp (precedence parser)。

这个模块目前通过了Perl 6测试套件的10%。它提供了语言的基础：语句，表达式，还有类。它还包括正则表达式和语法，这些也是编写编译器所需的。

编译器的若干部分用Perl 6编写，用v6.pm自身编译。CPAN上的Pugs::Compiler::Rule模块的语法用Perl 6编写，用v6.pm编译成Perl 5。

性能：

编译速度是100行每秒，代码有缓存——只编译一次。

生产的代码已经相当的优化，运行在perl5的速度上。

最终目标

v6.pm 的目标是能够编译“真正”的v6-Compiler(p6-on-p6)。但是，因为v6.pm必须“足够正确”和“足够快”，它也能用来编写一般用途的模块或程序。

所使用的“.pmc”文件的角色

".pmc"被用于perl5缓存文件。Perl5同时找到".pm"和".pmc"文件，它执行".pmc"文件。

当v6.pm编译一个".pm"时，它把perl 5代码dump下来作为".pmc"。下次执行，perl5会加载编译后的版本。这将变得很快。

v6项目是帮助继续用Perl5的人还是针对想要用Perl 6的人？

主要是为了perl5程序员，保证Perl5可以兼容Perl 6—双向兼容。

Perl5 程序员可以直接使用底层模块——Moose，和Pugs::Compiler::Rule——v6.pm就是“syntax layer”。

哪部分Perl 6不可能依此实现？

一些perl6功能可能在perl5中很缓慢——如协同进程，但并非不可能。

如何尽早尝试Perl 6?

从CPAN安装v6，依赖的模块可以自动补完。

一些模块，如PadWalker和Data::Bind需要C编译器。Windows用户可以用 vanilla-perl发行版，它带有C编译器。

如何参与和帮助

到freenode的#perl6频道来。

Devel::DProf - a Perl code profiler

2006-09-11T20:26:00.000-07:00

使用方法：
perl -d:DProf test.pl

UTF8下中文处理

2006-09-11T08:19:00.000-07:00

发信人: happierbee (吾生也有涯，而知也无涯), 信区: Perl
标题: UTF8下中文处理
发信站: 水木社区 (Mon Sep 11 21:22:53 2006), 站内

我来总结一下吧。先建一个文件，写上中文两个字。运行下面一个程序：

use strict;
use warnings;
use Encode;
my $str_code = "中文";
my $file = "test.txt";

open(my $fh, $file) || die "Can't open file $file: $!";
chomp(my $str_file = <$fh>);
close $fh;

open(my $fh_utf8, "<:utf8", $file) || die "Can't open file $file: $!";
chomp(my $str_fileu = <$fh_utf8>);
close $fh_utf8;

test_utf8($str_code, "code");
test_utf8($str_file, "file");
test_utf8($str_fileu, "file(utf8 layer)");
# print $str_code, "\n";
# print $str_file, "\n";
# print $str_fileu, "\n";

Encode::_utf8_on($str_code);
Encode::_utf8_on($str_file);
test_utf8($str_code, "code");
test_utf8($str_file, "file");

sub test_utf8 {
my ($str, $type) = @_;
if ( Encode::is_utf8($str) ) {
print "String from $type, utf8 flag is on."
} else {
print "String from $type, utf8 flag is off."
}
my @chars = split('', $str);
# print join("\t", @chars), "length: ", scalar(@chars);
if (scalar(@chars)==2) {
print " Can match chinese character.";
} else {
print " Can't match chinese character.";
}
print "\n";
}

结果如下：
String from code, utf8 flag is off. Can't match chinese character.
String from file, utf8 flag is off. Can't match chinese character.
String from file(utf8 layer), utf8 flag is on. Can match chinese character.
Turn on utf flag:
String from code, utf8 flag is on. Can match chinese character.
String from file, utf8 flag is on. Can match chinese character.

所以如果要想使用汉字作为一个字符的特性，就要在 open 里指明 io layer 为
utf8，同样，输出指明 utf8，然后在脚本里写 use utf8。
这样你就不用担心 utf8 下的乱码，又能享受汉字做为一个字符来写正则表达式的
的畅快。
如果不知道我上面说的意思，我就给一个例子：
use strict;
use warnings;
use Encode;
use utf8;

my $file = "test.txt";
my $outfile = "test-out.txt";
# open(my $fh, $file) || die "Can't open file $file: $!";
# open(my $out, '>:utf8', $outfile) || die "Can't open file $outfile: $!";
# select $out;
open(my $fh, '<:utf8', $file) || die "Can't open file $file: $!";
binmode STDOUT, ":utf8";
while (<$fh>) {
if (/[汉]/) {
unless (Encode::is_utf8($_)) {
Encode::_utf8_on($_);
}
print $_;
}
}

test.txt 中的内容是："求\n汉\n汁\n汗\n汕\n江\n"（每个汉字一行的意思）。
这个例子中，有好几个组合：
1. 不使用 utf8 指令，open 中也不使用 utf8。
这时所有行都匹配。因为正则表达式中是三个字节（我假定你也用 utf8 来编码
代码，如果不是，可以不匹配任何行），而所有输入的行中都含有这三个字节中
的一个，事实上 test.txt 是我精心挑选的，前两个字节都相同的汉字。
2. 不使用 utf8 指令, open 中使用 utf8.
不能匹配任何行。因为输入文件中是汉字，而正则表达式是三个字节。
3. 使用 utf8 指令，open 中不使用 utf8
也不能匹配任何行。因为正则表达式中是一个汉字，而输入文件是一个个的字节。
4. 使用 utf8 指令，open 中也使用 utf8
正确匹配一行。

至于输出的 warning，这确实这是一个小小的 warning，不会影响结果。如果不
想有这个 warning，最好的办法是用 binmode 或者在 open 中指定使用 utf8
layer。或者对于 warning 的字符串用 Encode 模块中 _utf8_on 函数，强制
加上 utf8 flag.

【在 happierbee (吾生也有涯，而知也无涯) 的大作中提到: 】
: 这个实在不好形容是什么错误呀。改成这个标题好点没？

vi,sed,perl的正则表达式替换

2006-08-29T00:25:00.000-07:00

VIM：
:1,5s/pattern/string/gi 1到5行
:%s/pattern/string/gi

sed:
sed -e s/pattern/string/gi originalfile > newfile #in FreeBSD: -E

perl:
#overwrite:
perl -pi -e ’s/bar/baz/’ fileA
perl -pi’*’ -e ’s/bar/baz/’ fileA
#backup to 'fileA.orig'
perl -pi’.orig’ -e ’s/bar/baz/’ fileA
perl -pi’*.orig’ -e ’s/bar/baz/’ fileA
#stdout
perl -pe ’s/bar/baz/’ fileA

url encode and url decode in Perl

2006-08-28T09:07:00.000-07:00

url-encode:
$str =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
url-decode:
$str =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg;

Onliner's:

Urlencode：对 \n 不转码
perl -p -e 's/([^\w\-\.\@])/$1 eq "\n" ? "\n":sprintf("%%%2.2x",ord($1))/eg' keywords.list
UrlDecode：
perl -p -e 's/%(..)/pack("c", hex($1))/eg' query.log

Really advanced perl RegEx reference

2006-08-28T07:57:00.000-07:00

* Samples
交换两项位置
s/(\S+)\s+(\S+)/$2 $1/

搜索C语言标识符
m/[_A-Za-z][_A-Za-z0-9]*/
m/[_[:alpha:]][_[:alnum:]]*/

空行
/^$/

单词
\b\w+\b

* Questions

* Reference
perlre (bytes and utf8)
regex.h (regcomp regexec regfree regerror) (single byte only)
java (unicode only)
python (bytes and unicode)

*基本结构

*语法
m/regex/ismx
s/regex/replacement/ismxg

*修饰符
i 大小写一视同仁
s 单行模式 (.能够匹配所有的东东)
m 多行模式 (只影响 ^ $，使其匹配一个字符串内的多个行首／行尾)
x 允许空格和注释 (针对perl 有效)
g 全部（替换）

*等价
m/ABC|XYZ/

*序列
m/ABC/

*重复
(agressive)
a? 0 or 1
a* 0 or more
a+ 1 or more
a{m} m
a{m,} m or more
a{m,n} m to n (inclusively)

(懒惰)
a??
a*?
a+?
a{m}?
a{m,}?
a{m,n}?

aa
(a?)(a*) $1 => a a
(a??)(a*) $1 => "" aa

*原子
Character = a b c
Character Class
Escape = \ + non-alpha, such as \\, \+, \(, except reference
Meta Escape= \ + alpha[a-zA-Z]
Groups = (...)

* Character Class
[abc] [a-b] [^abc] [^abc0-9]
[- and [] are considered literal
[-a] = - or a
[^\-]

[[]
[]]
[ ]

* Posix Character Class
[[.a.]] collation
[[=a=]] equivalence
[[:alpha:]]

* Meta
. anything except newlines (normal mode)
. anything (s mode, singleline, dotall)
^ start of string, or start of line (m mode)
$ end of string (including newline), or end of line (m mode)

* Meta Escape
\t \n \r \f \a \e
\0nn \xnn 分别是八进制和16进制
\cA (using algorithm ch ^ 0x40)
\cM
\N{name}
\l lowercase next char
\u uppercase next char
\L...\E lowercase until \E
\U...\E uppercase until \E
\Q...\E quote until \E
\w \W word char
\s \S space
\d \D digit
\b \B boundary
\p{property}
\P{property}
\X combining character sequence
\C single byte (perl)
\<> end of word (emacs)

* Groups
(abc) for capture group

* Special group
(?#comment)
(?imsx-imsx) embedded flags
(?:pattern) for non-capture
(?imsx-imsx:pattern) subpattern
(?=pattern) positive look ahead
(?!pattern) negative look ahead
(?<=pattern) positive look behind
(?<!pattern) negative look behind

* Reference for capture
m/(x)\1/
s/(x)/$1$1/

*传统 vs 扩展
\{m,n\} vs {m,n}
$xxx$ vs (xxx)
Emacs is still using traditional regular expression

* 特殊扩展
\<> end of word (emacs)

*换行

\n \v \r \r\n \f \x85 \x2028 \x2029 \x1A

Sed 与 Linux 等价命令代码鉴赏

2006-08-28T07:23:00.000-07:00


basename                        sed 's/\(.*\)\/\([^/]*\)/\2/'          or   sed 's,.*/,,'
cat                             sed '' or  sed -n '1,$p'           or   sed '1,$!d'
cat -s                          sed '/./,/^$/!d'
cat -n                          sed '=' | sed 'N;s/\n/\t/;s/^/    &/'   or  sed '=' | sed '$!N;s/\n/ /'
cat -E                          sed 's/$/\$/'
cat -t                           sed 's/\t/^I/g'
cut -c n                        sed 's/\(.\)\{n\}.*/\1/'              or   sed 's/^.\{(n-1)\}//g;s/\(.\)\(.*\)/\1/g'
cut -c x-y                      sed 's/\(^.\{y\}\)\(.*\)/\1/g;s/^.\{(x-1)\}//'
cut -d| -f6                      sed 's/\(\([^|]*\)\|\)\{6\}.*/\2/'
cp file1 file2                    sed 'w file2' file1
expand -t 1                     sed 's/\t/ /g'
dirname                         sed 's/\(.*\)\/\([^/]*\)/\1/'          or    sed 's,[^/]*$,,'
grep patten                      sed -n '/patten/p'                or    sed '/patten/!d'
grep -v patten                   sed -n '/patten/!p'                or    sed '/pateen/d'
grep -n patten                   sed -n '/patten/{=;p}'| sed 'N;s/\n/:/'
head                            sed -n '1,10p'
head -1                         sed -n '1p'                     or      sed 'q'
head -Number                    sed '1,Number!d'                or      sed 'Numberq'
paste -s file1 file2                sed ':a;N;s/\n/\t/;ba;' file1 file2 | sed 's/\t\t/\n/'
paste -sdstr                      sed ':a;N;s/\n/str/;ba'
rev                             sed '/\n/!G;s/\(.\)\(.*\n\)/&\2\1/;//D;s/.//'
tac                             sed -n '1! G;$p;h'                or      sed -n 'G;$p;h'
tail -1                          sed -n '$p'                      or      sed '$!d'
tail -Number                    sed ':t;$q;N;(Number+1),$D;bt'
tail -f                          sed -u '/./!d'
tr "\n" " "                      sed ':a;N;s/\n/ /;ba'
tr "A-Z" "a-z"                   sed 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'
tr "a-z" "A-Z"                   sed 'y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/'
tr -d "12"                    sed ':a;N;s/\n//;ba'       or      sed ':a;N;s/\(^.\)*\n\(.*\)/\2\1/;ba'
tr -s 'x'                        sed 's/\(x\)\(x\{1,\}\)/\1/'
tr -s ' '                        sed 's/ \+/ /g'
uniq -u                        sed '$b;N;/^\(.*\)\n\1$/ ! {P;D};:c;$d;s/.*\n//;N;/^\(.*\)\n\1$/{bc};D'
uniq                           sed 'N;/^\(.*\)\n\1$/!P;D'
wc -l                          sed -n '$='
wc -c                         sed ':a;s/./&\n/;P;D;/.\{2,\}\n/ba' t|sed -n '$='
wc -w                         sed 's/ /\n/g' | sed -n '$='
xargs                          sed ':a;N;s/\n/ /;ba'       or      sed -e ':a' -e '$!N;s/\n/ /;ta'

请别再用Perl 3了 - O'Reilly ONLamp Blog

2006-08-24T09:00:00.000-07:00

Please Stop Using Perl 3 - O'Reilly ONLamp Blog

这篇文章的作者Curtis Poe的立意十分明确：为Perl辩护。因为Perl批判者经常抱怨：1.Perl的scalability不好，2.Perl的代码写写可以，就是没法读。

Poe强调了开发中被新手和业余程序员忽略的“separation of concerns, loose coupling and cohesive functions”。并举例说明perl支撑的应用之强健。

当然，Python的死忠分子自然可以继续攻击perl的易读性，不过，Poe认为“随便拿一段PHP代码，程序员一眼看过，也分不清是PHP还是Perl。倒是没什么人抱怨PHP难读”。

PXPerl 5.8.7-6的cpan模块编译

2006-08-08T23:35:00.001-07:00

使用CPAN+MinGW编译模块，发现无法通过，后来发现，PXPerl 5.8.7-6在发布时少了个libperl58.a。重大失误啊！害得我干着急了两天！解决起来，唯一的办法还是把缺少的文件下载并保存到正确位置（PXPerl\lib\CORE\）。就这么简单！

让Encode::HanExtra起作用--chaoslawful的笔记

2006-08-08T23:35:00.000-07:00

让Encode::HanExtra起作用--chaoslawful的笔记: "为了支持GB18030编码需要从CPAN上安装Encode::HanExtra模块，但Perl发行版本默认的Encode模块设置没有打开对HanExtra的支持，装了该模块也暂时无法使用GB18030编码。让模块有效的修改方法是：
修改Perl发行版的lib/Encode/Config.pm文件，其中的%ExtModule散列表定义了不同的编码对应的模块名称，搜索后会发现包括gb18030在内的几个编码对应的行被注释了，装完Encode::HanExtra模块以后手工去掉这几个注释即可。"

blogspot的ip的确是66.102.15.101啊！

2006-08-08T22:22:00.000-07:00

也许你今天暂时又可以访问blogspot.com上的blog了。不过不要高兴的太早，也许这又是由于暂时更换ip导致gfw慢半拍造成的假象。

A photo test

2006-08-08T07:35:00.000-07:00

摘录

2006-08-07T15:09:00.000-07:00

Perl with UTF-8 mode
Parsing a Querystring With Perl - A Simple ISINDEX Query (Page 2 of 3 )
What’s in a User-Agent String?

Have fun with google: detect encoding of a meaningful string

2006-08-07T14:46:00.000-07:00

Mozilla有一套概率机制保证编码检测的准确,尤其是中日韩这样的大字符集. 其原理无非就是利用各个字符集的文字统计上出现频率的倒排表,比对目标文本中的频率,从而猜测文本的编码归属.

而google拥有全世界最大的可公开访问的网页数据库,从而形成了最为专业的文本检索排序的系统.如果利用google,检索某一个短字符串（比如由于各种原因常常混淆的中日韩MP3 id3标签）,则有可能根据匹配的记录数推断文本到底属于哪个字符集.

由于id3字符串通常较短, 如果出现大量生僻字,则可能给单独依靠个别文字的识别带来麻烦.而依靠文字组合的概率模型,在本地实现较复杂,需要更大的存储空间,且不能跟踪时代潮流,造成升级的困扰,而google的数据库实时更新,且结果具有实际意义.综上,这些因素给利用google检索条目总数的判别方法留出空间.

实现：

得到MP3 id3tag字符串
将字符串分别按utf8, cp936, big5, euc-jp, euc-kr解码（得到utf8的测试编码）
分别将不同的测试编码提交给google.com,进行搜索
得到条目总数,取最多者

Todo:

对得到正确的id3tag（ v1/v2）的能力进行测试
对正确地生成请求的url的测试
对不同编码的判断结果进行大规模验证

把utf8字符输出成url格式

2006-08-07T13:40:00.000-07:00

sub url_encode {
# default argument is $_
local $_ = @_ ? shift : $_;
defined or return;

# change unsafe characters (except for space) to encoded value
s/([^\w()'*~!.-])/sprintf '%%%02x', ord($1)/eg;

# change spaces to +
tr/ /+/;

return $_;
}

OSX下安装LWP

2006-08-07T08:04:00.000-07:00

找到Terminal

perl -MCPAN -e shell

然后

install HTTP::Tagset

最后:

install LWP

PXPerl:又一个win32的perl实现

2006-07-29T14:04:00.000-07:00

搜来搜去，找到这么一个好东西：PXPerl

PXPerl是一个针对win32平台的perl实现，目前版本是5.8.7-6。内容包括：perl-5.8.7*(intel的编译器编译的，应该更快吧？)，众多的CPAN模块（据称不比ActivePerl少），还前瞻性的加入了pugs、parrot（一切为了perl6），以及一个编辑器（SciTE）（，事实上还有nmake，微软白送的）。

可惜，似乎目前PXPerl还不支持ppm之类的二进制模块包，最好要有本地的编译器，比如MinGW，nmake，或者是Intel C++ compiler。不过想在Perl6里游泳的人可以先在这里练习一下水性。

如果说perl的源代码是随机字符的话

2006-07-29T08:53:00.000-07:00

Python's syntax succeeds in combining the mistakes of Lisp and Fortran.
I do not construe that as progress. -- Larry Wall, May 12 2004

Frankly, I'd rather not try to compete with Perl in the areas where Perl is
best -- it 's a battle that 's impossible to win, and I don't think it is a
good idea to strive for the number of obscure options and shortcuts that Perl
has acquired through the years. -- Guido van Rossum, 7 Jul 1992

Catch me if you can...

2006-07-29T07:13:00.000-07:00

发信人: crazycool (上), 信区: Python
标题: Re: 请问什么情况下用Python而不用C++?
发信站: 水木社区 (Sat Jul 29 19:32:47 2006), 转信

Python:
if you(can)^*:
catch (me)

C:
if (you(can)) catch (me);

Perl:
catch me if you can;

【在 cnsky (做人要厚道) 的大作中提到: 】
: 相比之下还是比较喜欢PYTHON,
: perl写的东东阅读困难.
: 可能是因为我用C用的不多
: ...................

*应该为if you.can():