perl的小技巧杂记（持续更新ing）

1、三行perl代码模拟生成注册码2011-04-06

my @str = ('A'..'Z');
my $lic = join '', map { $str[int rand @str] } (1..25);
$lic =~s/(\w{5})(?=\w{5})/$1-/g;
#print $lic,"\n";

    最近做了些工具给同事使用，但不想被随意扩散，所以想对工具做些限制，接下来准备学习些源码保护与软件的注册机制。

 

2、最近写的代码越来越长了，追求完美的我，总希望代码在书写的过程中就是整洁美观的，但生性懒惰的我又不想重复地perltidy，想到使用perl的多数是懒人，CPAN上可能会有模块能解决我的问题，于是找了一下还真找到了一个叫Acme::PerlTidy的模块。

    使用很简单，只要在IDE窗口的代码中“use Acme::PerlTidy;”，执行时就是tidy代码而非运行代码了，当不需要时，只要将其注释掉就可以了，即#use Acme::PerlTidy。这样实时tidy代码就变得很简单了。

 

3、YAML::Tiny的使用

use YAML::Tiny;

my $file = 'yaml.yml';
my @arr = ( undef, undef, 'babc' );

#追加写入文件的方式
YAML::Tiny::DumpFile( ">$file", \@arr );
my $yaml = YAML::Tiny->read($file);

print "最后一份记录初始值为：\n";
print Dump(\@arr);

#读入yaml后，整份文件的记录放在数组@{$yaml}中。
my $num= scalar @{$yaml}-1;
#取最后一份记录数组中的第三个元素
print "\n最后一份记录的第三个元素为：$yaml->[$num]->[2]\n";

my $i=0;
foreach my $v ( @{$yaml->[$num]} ) {
    if ( !defined $v ) {
        $yaml->[$num]->[$i] = $i;
    }
    else {
        delete $yaml->[$num]->[$i];#删除abc
    }
    $i++;
}
print "\n最后一份记录修改后为：\n";
print Dump(\@{$yaml->[$num]});

$yaml->write($file);#保存更改

 

4、Time::Interval可以计算两日期的相差天数，但区分不出是早了还是迟了，所以比较4月8号以后两日期$data1与$data2可以如下写：

#$data1-$data2
my $day=_CouDays(data1,'04-08-2011')-_CouDays(data1,'04-08-2011');
sub _CouDays {
    require Time::Interval;
    my ( $data1, $data2 ) = @_;
    my $days = Time::Interval::getInterval( $data1, $data2, "days" );
    $days =~ s/(\d+).*/$1/g;
    return $days;
}

5、提取介于某个区间的几行文字：$start 表示开始标记的模式，$end 表示结束标记的模式

if ( (/$start/ .. /$end/) and !/$end/ ){

}

6、查找安装了哪些perl模块。附件： pmtools.rar ，

来源：；解压后放于\perl\lib内。

使用：

# perl -Mpmtools -e 'pminst';

 

7、perl也能实现类似Ruby的迭代器：5.times { |each| ... }

use Moose::Autobox;
sub Moose::Autobox::SCALAR::times {
    my($count, $block) = @_;
    1->to($count)->each_key($block);
}

5->times(sub {$_->say});

use Moose::Autobox;
print "Squares: " . [ 1 .. 10 ]->map(sub { $_ * $_ })->join(', '),"\n";
print ["apple", "orange", "banana", "watermelon"]->grep(sub{/an/})->join("\n");

8、简单几句代码就能实现文件内容的替换

use Tie::File;
use Data::SearchReplace qw(sr);
tie @data, 'Tie::File', 'one.txt', autochomp => 1
  or die "Problem tying @array: $!";
sr( { REGEX => 's/mtk_color/%market/g' }, \@data );
untie @data;

9、0到4中挑选3个数可以组成哪些组合

use Math::Combinatorics;
@n = ( 0 .. 4 );
print join( "\n", map { join( " ", @{$_} ) } combine( 3, @n ) ), "\n";

10、初始化二维数组

sub array {
    my ( $x, $y ) = @_;
    map { [ (0) x $x ] } 1 .. $y;
}
my @square = array 3, 3;
$square[1][1] = 1;
print "@$_\n" for @square;

11、加密解密

sub encipher {
my ($_, $k, $decode) = @_;
$k = 26 - $k if $decode;
join('', map(chr(((ord(uc $_) - 65 + $k) % 26) + 65), /([a-z])/gi));
 }

my $msg = 'THE FIVE BOXING WIZARDS JUMP QUICKLY';
my $enc = encipher($msg, 12);
my $dec = encipher($enc, 12, 'decode');
print "msg: $msg\nenc: $enc\ndec: $dec\n";

12、函数根据上下文返回数组或数组引用

my @a=qw(1 2 3 4 5);
my $b=either(@a);
my @c=either(@a);
print join('-',@$b),"\n";
print join('-',@c),"\n";

sub either {
  my @a=@_;
  return wantarray ? @a: \@a;
}

13、一次取出数组的三个元素

my @whatever = ( 1, 2, 3, 4, 5, 6 );
while ( my ( $one, $two, $three ) = splice @whatever, 0, 3 ) {
    print "$one:$two:$three\n";
}