Skip navigation.

极湖

无不用其“极”

Posts tagged with "Perl"

给 perl 增加 trim 函数

, ,

这个虽然简单,却常用,因此纪录一下。
#!/usr/bin/perl

sub trim($) {
    ($string) = $_[0];
    $string =~ s/^\s*(.+)\s*$/$1/;
    return  $string;
}

#测试
print trim(" abcd   ");
print "\n";

收藏: Perl 的内置特殊变量

, , ,

$- 当前页可打印的行数,属于 Perl 格式系统的一部分
$! 根据上下文内容返回错误号或者错误串
$" 列表分隔符
$# 打印数字时默认的数字输出格式
$$ Perl 解释器的进程ID
$% 当前输出通道的当前页号
$& 与上个格式匹配的字符串
$( 当前进程的组ID
$) 当前进程的有效组ID
$* 设置1表示处理多行格式.现在多以/s和/m修饰符取代之.
$, 当前输出字段分隔符
$. 上次阅读的文件的当前输入行号
$/ 当前输入记录分隔符,默认情况是新行
$: 字符设置,此后的字符串将被分开,以填充连续的字段.
$; 在仿真多维数组时使用的分隔符.
$? 返回上一个外部命令的状态
$@ Perl 解释器从eval语句返回的错误消息
$[ 数组中第一个元素的索引号
$ 当前输出记录的分隔符
$] Perl 解释器的子版本号
$^ 当前通道最上面的页面输出格式名字
$^A 打印前用于保存格式化数据的变量
$^D 调试标志的值
$^E 在非UNIX环境中的操作系统扩展错误信息
$^F 最大的文件捆述符数值
$^H 由编译器激活的语法检查状态
$^I 内置控制编辑器的值
$^L 发送到输出通道的走纸换页符
$^M 备用内存池的大小
$^O 操作系统名
$^P 指定当前调试值的内部变量
$^R 正则表达式块的上次求值结果
$^S 当前解释器状态
$^T 从新世纪开始算起,脚步本以秒计算的开始运行的时间
$^W 警告开关的当前值
$^X Perl 二进制可执行代码的名字
$_ 默认的输入/输出和格式匹配空间
$| 控制对当前选择的输出文件句柄的缓冲
$~ 当前报告格式的名字
$` 在上个格式匹配信息前的字符串
$' 在上个格式匹配信息后的字符串
$+ 与上个正则表达式搜索格式匹配的最后一个括号
$< 当前执行解释器的用户的真实ID
$ 含有与上个匹配正则表达式对应括号结果
$= 当前页面可打印行的数目
$> 当前进程的有效用户ID
$0 包含正在执行的脚本的文件名
$ARGV 从默认的文件句柄中读取时的当前文件名
$ENV 环境变量列表
$INC 通过do或require包含的文件列表
$SIG 信号列表及其处理方式
$_ 传给子程序的参数列表
$ARGV 传给脚本的命令行参数列表
$INC 在导入模块时需要搜索的目录列表
$-[0]和$+[0] 代表当前匹配的正则表达式在被匹配的字符串中的起始和终止的位置。

来源: http://blog.chinaunix.net/u/12631/showart_254782.html

CVS 密码加密小程序

, ,

用 Perl 作一个脚本文件如下:
#!/usr/bin/perl
 
($u, $p)=@ARGV;
@d=(A..Z,a..z);
$s=$d[rand(52)].$d[rand(52)];
print $u.":".crypt($p, $s).":cvs\n";


若给文件取名 cvspass.pl,首先给他可执行的权限:

# chmod a+x cvspass.pl

调用方法:

# ./cvspass.pl user password

命令中的 password 是未加密的密码字符串。输出的结果须追加到 CVSROOT/passwd 。

用命令一次替换多个文件中的字符串

, ,

下面这个命令,不时要翻出来用一下:

find /path/to/ -name "*.html" -type f | xargs grep -l -e "StringOrPattern" | xargs -n 100 perl -e "s/StringOrPattern/AfterReplace/g;" -pi

没有 Perl 的 Linux/Unix 环境应该很少吧?如果没有perl,这个命令可不好使。

命令太长,难记,因此在这儿纪录一下。

用LWP::UserAgent访问Basic认证网站的方法

,

很简单的代码,如下:
  use strict;
  use LWP::UserAgent;

  my $ua = LWP::UserAgent->new;
  my $req = HTTP::Request->new(GET => 'http://www.hoge.com/secret.html');
  $req->authorization_basic('user', 'password');
  my $res = $ua->request($req);

在Perl程序中关闭输入回显功能

, ,

在Perl程序中,若有输入密码的功能,或许你不想让输入的内容回显到屏幕上,这时候可以用stty命令让echo无效。

程序例:
#!/usr/bin/perl

system("stty -echo");
print "Enter your password: ";
chomp($passwd = <>);
print "\n(Test) Your password is $passwd\n";
system("stty echo");

用LWP::UserAgent实现“Web浏览自动化”

, ,

想用Perl做一个自动登录、自动发送请求并取得执行结果的程序,这时候通常要用到LWP::UserAgent。

做了一个POST数据的例子如下:
#!/usr/bin/perl 

use LWP::UserAgent;
use HTTP::Request::Common qw(POST);

my %ua_option = (
    agent => "Mozilla/5.0", 
    timeout => 180,
);

my $ua = LWP::UserAgent->new(%ua_option);

my $url = 'http://your.domain.here/script_name.cgi'; # or 'https://...';

my %form;
$form{USER_ID} = 'user_id';
$form{PASSWORD} = 'password';

my $req  = POST($url, [%form]);

my $res = $ua->request($req);

if ($res->is_success) {
print $res->header("Content-Type") . "\n";
print $res->status_line . "\n";
print $res->code . "\n";
print $res->header("Server") . "\n";
#print $res->header("Client-SSL-Cipher") . "\n";
#print $res->header("Client-SSL-Cert-Subject") . "\n";
#print $res->header("Client-SSL-Cert-Issuer") . "\n";
#print $res->header("If-SSL-Cert-Object") . "\n";
print $res->content;
} else {
print $res->status_line . "\n";
}

如果用SSL,需安装Crypt::SSLeay。

打印由ezmlm管理的邮件列表成员清单

, ,

新作的一个Perl小程序,用来打印由ezmlm管理的邮件列表成员清单。
#!/usr/local/bin/perl
use strict;

use vars qw($result_file);

$result_file = './ml_members.txt';

&main();

sub main()
{
        if( -e $result_file ) {
                unlink($result_file);
        }
        
        my $ezmlm_list = '/usr/local/bin/ezmlm/ezmlm-list';
        my $ml_root = '/var/qmail/alias';
        

        opendir(DIR, $ml_root) || die "Open dir $ml_root failed !";
        my @all_ml = grep !/^\..*$/, readdir DIR;

        my $user_id = '';
        my $mail_addr = '';
        my $list_cmd = '';
        for my $ml_name (@all_ml) {
                next if ($ml_name eq 'Mailbox' || $ml_name eq 'ezmlmadmtools' );
                
                $list_cmd = "$ezmlm_list $ml_root/$ml_name";
                system("echo $ml_name >> $result_file");
                system("$list_cmd >> $result_file");
                system("echo '' >> $result_file");

        }

}

判断文件新旧的Perl代码

,

有时候需要在Perl程序中判断文件的新旧,用“-M”符号即可简单实现。
例:
#!/usr/bin/perl

$term = 10/(24*60);   # 10 min
$file = '/tmp/testfile';
$age = (-M $file);
if($age > $term ) {
        print "$file age: $age - old file\n";
} else {
        print "$file age: $age - new file\n";
}

一句Perl求素数

,

执行一个perl命令,就能一个一个往下找素数:

perl -le '$_ = 1; (1 x $_) !~ /^(11+)\1+$/ && print while $_++';

神奇吧?!
November 2009
S M T W T F S
October 2009December 2009
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30