Archive for the “perl” Category

虽然zip诞生之初只支持cp437,但对UTF-8的支持早已加入zip格式的标准之中,原本这样就该天下太平了。但这个世界爱自作主张和固守陈规的软件太多了,尤其是悲剧只发生在Linux用户的头上的时候(当然Win用户从JP下回的zip乱码的可能性也有,不过Win下JP的东西什么都是乱码,所以无所谓了)。于是常常会解压一个zip得到一大堆乱码的文件,如果运气好的话,可以convmv解决;但是遇到解压完的文件名里有一堆的“(invalid encoding)”,那convmv也回天乏术;更不幸的是直接解压不能,说什么

checkdir error:  cannot create ?R?X?v???-?^?Wblabla
                 Invalid or incomplete multibyte or wide character
                 unable to process ?R?X?v???-?^?Wbalbla/gao.

早先的unzip,比如UnZip 5.52,有个在usage, help和manpage等各种文档中都没提到的神秘参数-O可以指定文件名的编码,从而解决GBK/BIG5/shift_JIS等编码的乱码问题。比如:

unzip -O CP936 怎样打飞机.zip

可是到了新版本的unzip,比如UnZip 6.00,这个-O参数便名花有主了,而原来的-O功能似乎神隐了。用力搞了很久没搞定,最后求助perl。利用Archive::Zip和Encode,写了个简短的脚本,这个问题瞬间解决。

#!/usr/bin/perl

use Archive::Zip;
use Encode qw(decode encode);

sub usage {
	print <<USAGE;
USAGE: unzip.pl ZIPFILE [FROMCODE=utf-8 [TOCODE=utf-8]]
USAGE
	exit;
}

usage unless -e $ARGV[0];
$zip = Archive::Zip->new($ARGV[0]);
$from = $ARGV[1] || 'utf-8';
$to = $ARGV[2] || 'utf-8';

for ($zip->memberNames()) {
	$member = $zip->memberNamed($_);
	$_ = encode($to, decode($from, $_));
	$zip->extractMember($member, $_);
}

现在只要

perl unzip.pl 怎样打飞机.zip GBK

就能顺利解压了。至于开头提到的原因不明的乱码造成的解压不能的情况,可以直接将$_ = encode($to, decode($from, $_))这句修改文件名的代码替换为s#.*?/#gao/#等能解决问题的代码。

Comments 5 Comments »

昨天的HDOJ第三场月赛中hhanger出了一道非主流的Guess the number。援引官方解题报告:

本题属于非正常题,纯属娱乐。因为本题最多只有16个字符,所以可以用X分提交法来套取输入数据,可以利用的返回结果至少有6种,把字符先统一转化成小写后,基本上两次提交可以确定一个字符,因此可以在期望时间内得到解。

相信很多acmer对利用返回结果来套取输入数据并不陌生,我们经常用这招来获得case数或检验输入数据是否与题目描述不符。下面这段程序可以判断第off个字符在哪个范围内,利用了HDOJ中G++的TLE, MLE, OLE, RE(ACCESS_VIOLATION, STACK_OVERFLOW, DIVIDE_BY_ZERO)和WA七种不同返回结果。但平时编译器对包括尾递归、空循环和常量的优化此时却成了绊脚石,为了生成我们预期的返回结果,只好让代码复杂一点或产生一些副作用。

// author: watashi
#include <cctype>
#include <cstdio>
#include <cstring>

void gao(int ch) {
	if (ch < $_[1]) {	// Time Limit Exceeded
		while (true);
	} else if (ch < $_[2]) { // Memory Limit Exceeded
		char* p = new char[128 << 20];
		memset(p, 0xff, 128 << 20);
	} else if (ch < $_[3]) { // Output Limit Exceeded
		while (true) {
			fputs("[Output Limit Exceeded] (http://watashi.ws/wabots) quick brown fox jumps over the lazy dog", stdout);
		}
	} else if (ch < $_[4]) { // Runtime Error (ACCESS_VIOLATION)
		int p[1 << 10] = {-1};
		putchar(p[1 << 20]);
	} else if (ch < $_[5]) { // Runtime Error (STACK_OVERFLOW)
		gao(ch);
	} else if (ch < $_[6]) { // Runtime Error (INTEGER_DIVIDE_BY_ZERO)
		int p = sizeof(char);
		printf("%d", sizeof(int) / --p);
	} else { // Wrong Answer
		return;
	}
}

int main() {
    int off = $_[0];
    for (int i = 0; i < off; ++i) {
        getchar();
    }
    gao(tolower(getchar()));
	return 0;
}

有了这段程序,理论上就可以在32次内得到输入数据了。但由于人肉提交难免手抖,判断易出差错,而且需要很多的肉,实际次数远在这之上,不少人都提交上百次后才AC。对于又缺少肉,又容易手抖的我,连尝试的勇气都没有。不过,却可以写个从不手抖,有着用不完的肉的机器人来代劳。于是先实现一个HDOJ的自动提交机模块。

# HDOJAgent.pm
package HDOJAgent;
use strict;
use warnings;
use LWP::UserAgent;

my $prefix = "http://acm.hdu.edu.cn";
my $interval = 60;
my $maxretry = 2;

sub new {
    my $class = shift;
    my $self = {
        user => $_[0] || '',
        problemid => $_[1] || 1000,
        language => $_[2] || 0,
        ua => new LWP::UserAgent(
            agent => 'HDOJAgent (http://watashi.ws/wabots)',
            cookie_jar => {},
        )
    };
    bless $self, $class;
    return $self;
}

sub AUTOLOAD {
    my $self = shift;
    my $name = $HDOJAgent::AUTOLOAD;
    $name =~ s/.*://;
    return if $name eq 'DESTROY';
    $self->{$name} = shift if @_;
    return $self->{$name};
}

sub post {
    my ($self, $url, $form) = @_;
    my $ua = $self->ua;
    for (1 .. $maxretry) {
        my $response = $ua->post($url, $form);
        if (!$response->is_error) {
            return $response->decoded_content;
        }
        sleep $interval;
    }
    warn "maxretry exceeded!";
    return undef;
}

sub login {
    my ($self, $pass) = @_;
    $self->post("$prefix/userloginex.php?action=login", {
        username => $self->user,
        userpass => $pass,
        login => 'Sign In'
    });
}

sub submit {
    my ($self, $code) = @_;
    $self->post("$prefix/submit.php?action=submit", {
        problemid => $self->problemid,
        language => $self->language,
        usercode => $code
    });
}

sub laststatus {
    my $self = shift;
    my $user = $self->user;
    while (1) {
        my $_ = $self->post("http://acm.hdu.edu.cn/status.php?user=$user");
        s{^[\s\S]*Pro\.ID.*Exe\.Time.*Exe\.Memory}{}gs;
        s{</td><td><a href="/showproblem\.php\?pid=.*$}{}gs;
        s{^.*<td>}{}gs;
        s{^\s*|\s*|<[^>]*>}{}gs;
        return $_ unless /^$|Queuing|Compiling|Running/;
        sleep $interval;
    }
}

要完成提交操作需要提供cookie,通常有两种办法,一是直接在WebClient.Headers里设置好cookie,以前我用C#写的一个ZOJ的自动提交机就是这么实现的;更简单的办法是给UserAgent初始化一个空的cookie,通过完成login来设置cookie。有了cookie后就可以submit了,submit需要提供problemid, language和usercode。submit后可以通过laststatus来获得你最近一次提交的返回结果。先用A + B Problem来测试一下模块,这里用了caller函数,实现模块的测试和使用两不误。

# HDOJAgent.pm
return 1 if caller;

my $hdoj = new HDOJAgent('wabots');
$hdoj->login('~!@#$%^&*()_+');
$hdoj->problemid(1000); # A + B Problem
$hdoj->language(1); # GCC
$hdoj->submit(<<GCC
main(a,b){while(scanf("%d%d",&a,&b)>0)printf("%d\n",a+b);}
GCC
);
print $hdoj->laststatus, "\n";

最后在wabots.pl中使用HDOJAgent模块,不断通过七分法提交HDU3337,以得到输入数据中的字符,直到EOF。得到的输入数据,答案也就显而易见啦^ ^

#!/usr/bin/perl -w
# http://watashi.ws/wabots

use strict;
use warnings;
use HDOJAgent;

$| = 1;

sub getcpp {
    return <<CPP;
...
CPP
}

sub getpos {
    my ($min, $max, $cnt) = @_;
    my @ret = ();
    $max -= $min;
    for (my $i = 0; $i <= $cnt; ++$i) {
        push @ret, $min + int($max * $i / $cnt);
    }
    return @ret;
}

my @status = qw(Time Memory Output ACCESS STACK INTEGER Wrong);

my @charset = (' ', '0' .. '9', 'a' .. 'z');
@charset = sort {$a <=> $b} map {ord $_} @charset;
unshift @charset, -1;

my $hdoj = new HDOJAgent('wabots', 3337, 0);
$hdoj->login('~!@#$%^&*()_+');

my ($try, $off, $min, $max, $res) = (0, 0, 0, scalar @charset, '');
while (1) {
    ++$try;
    print "wabots# TRY #$try: [$off] in [$min, $max)\n";
    my @pos = getpos($min, $max, scalar @status);
    $hdoj->submit(getcpp($off, @charset[@pos[1 .. $#pos - 1]]));
    my $status = $hdoj->laststatus;
    print "wabots# \t$status\n";
    for (my $i = 0; $i < @status; ++$i) {
        if ($status =~ /$status[$i]/i) {
            $min = $pos[$i];
            $max = $pos[$i + 1];
        }
    }
    if ($min == $max - 1) {
        last if $charset[$min] < 0;
        $res .= chr $charset[$min];
        print "wabots# \t[$off] = $charset[$min] ($res)\n";
        ++$off;
        $min = 0;
        $max = @charset;
    }
    sleep 5;
}
print "RESULT = $res\n";

运行上面的程序,输出的日志如下:

由于文件中包含答案,为防止剧透,您需要输入本题正确答案以获取该文件:

Comments 6 Comments »

RSS极大的方便了我们及时跟踪页面的最新变化,可惜不是所有的地方都提供了RSS。Google Reader虽然提供了为没有RSS的页面生成RSS的功能,但是只能处理英文网页,对于中文或日语网页,与及阻止了Google爬虫的网页就无能为力了,例如:

Generated feed for “http://www.zju.edu.cn/”
from http://www.zju.edu.cn/ Google feed by Google
* Google was not able to access this page to check for updates. This page may be unavailable or have other restrictions that prevent Google from getting updates.

于是自己写了一个简单的脚本,自己为这些页面生成一个RSS。

#!/usr/bin/perl
# wafeed.pl

use AnyDBM_File;
use DBM_Filter;
use Encode qw(decode_utf8);
use LWP::Simple qw(get);
use XML::FeedPP;

$config = $ARGV[0] || 'config.pl';
require $config;

$time = time;
if (-e $rssfile) {
    $feed = new XML::FeedPP::RSS($rssfile, utf8_flag => 1);
} else {
    $feed = new XML::FeedPP::RSS;
}
$feed->title($title);
$feed->link($link);
$feed->pubDate($time);
$feed->description($description);

dbmopen(%history, $dmbfile, 0666);
(tied %history)->Filter_Push('utf8');
while (($key, $cfg) = each %config) {
    $value = get($cfg->{'link'});
    $value = $cfg->{'handler'}($value) if defined $cfg->{'hand'};
    $value = decode_utf8($value);
    if ($value !~ /^\s*$/ && $value ne $history{$key}) {
        $history{$key} = $value;
        $feed->add_item(
            title => $cfg->{'title'},
            link => $cfg->{'link'},
            pubDate => $time,
            description => $value);
    }
}
dbmclose %history;

$feed->sort_item();
$feed->limit_item($itemnum);
$feed->to_file($rssfile);

程序中

Comments 7 Comments »

正则表达式(regular expression)有着强大的功能,但也不是万能的,匹配(match)匹配(balanced)的括号(parentheses)就是一个挺头疼的问题。不过perl正则表达式中的一个扩展(??{ code })却能很好的处理这个问题。直接就能把上下文无关文法(Content-Free Grammar, CFG)

P --> <empty>
P --> ( P )
P --> P P

改写成对应的正则表达式

$paren = qr#|\((??{$paren})\)|(??{$paren})(??{$paren})#;

不过由于(??{$paren})(??{$paren})中的第一个(??{$paren})可以不断匹配0个字符,因此它不能正常工作,不过只要稍加修改,其等价形式

$paren = qr#|\((??{$paren})\)(??{$paren})?#;

就能够完成匹配balanced parentheses的工作了。

(??{ code })是动态正则表达式,code将在运行时求值,所求值再作为正则表达式。

This is a “postponed” regular subexpression. The “code” is evaluated at run time, at the moment this subexpression may match. The result of evaluation is considered as a regular expression and matched as if it were inserted instead of this construct.

其很重要的一个用途就是实现正则表达式的递归(recursion)

利用这个扩展,可以实现一个简单利用递归判断html标签是否合法匹配的正

Comments 4 Comments »

Python里有个特殊的变量__name__,如果当前模块是主模块,则为’__main__’,否则为模块名。通过判断

if __name__ == '__main__':

执行不同的代码,这样一个模块即可被重用,又可以单独执行,这种结构在Python里非常常见。也可以在if里简单的做一些模块的测试:

# gao.py
def scanl(s, f, a):
	retval = [s]
	for v in a:
		s = f(s, v)
		retval.append(s)
	return retval

if __name__ == '__main__':
	print scanl(1, int.__mul__, range(1, 10))
else:
	print __name__, 'imported'
#> [1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880]

而当gao被import时,这些测试将不被执行:

# gaogao.py
import gao
print 'in' + __name__ + ':', sum(gao.scanl(10000000, int.__div__, range(1, 20)))
#> gao imported
#> in__main__: 27182814

在Perl中虽然有个类似的__PACKAGE__可以得到包的名字(get package name),但是却不像Python中的__name__那样可以判断是否是直接执行的。我没

Comments No Comments »