Perl笔记5

第十三章：目录操作
(1) 在目录树中移动
使用chdir操作符来改变当前的工作目录
chdir '/etc' or die "cannot chdir to /etc: $!";


(2) 文件名通配
foreach $arg (@ARGV)
{
    print "one arg is $arg\n";
}


perl show-args *.pm
one arg is barney.pm
one arg is dino.pm
......


程序内部可以使用glob操作符来实现通配功能：
chdir 'D:\PerlModule\DateTime-1.03' or die "Cannot chdir to D: $!";
my @all_files = glob '*.yml'; #列出所有以.yml结尾的文件名
print "@all_files\n";


my @all_files = glob '.* *'; #如果要一次匹配多种模式，可以在参数中用空格隔开各个模式 .*表示.和..  *匹配所有的文件
print "@all_files\n";


(3) 文件名通配的另一种语法
在glob出现之前，使用<>来调用此功能：
my @all_files = <.*>;
my $dir = '/etc';
my @dir_files = <$dir/* $dir/.*>;


(4) 目录句柄
若想从目录里取得文件名列表，还可以使用目录句柄
opendir
readdir
closedir


my $dir_to_process = 'D:\PerlModule\DateTime-1.03';
opendir my $dh, $dir_to_process or die "Cannot open $dir_to_process: $!";
foreach $file (readdir $dh) #readdir返回的是文件名，不包括路径名
{
    print "one file in $dir_to_process is $file\n";
}
close $dh;


#会列出D:\PerlModule\DateTime-1.03目录下面所有的文件
one file in D:\PerlModule\DateTime-1.03 is .
one file in D:\PerlModule\DateTime-1.03 is ..
one file in D:\PerlModule\DateTime-1.03 is Build
one file in D:\PerlModule\DateTime-1.03 is Build.bat
one file in D:\PerlModule\DateTime-1.03 is Build.PL
......
one file in D:\PerlModule\DateTime-1.03 is README
one file in D:\PerlModule\DateTime-1.03 is t
one file in D:\PerlModule\DateTime-1.03 is TODO
one file in D:\PerlModule\DateTime-1.03 is tools
one file in D:\PerlModule\DateTime-1.03 is _build




也可以使用裸字作为目录句柄的名称：
my $dir_to_process = 'D:\PerlModule\DateTime-1.03';
opendir DIR, $dir_to_process or die "Cannot open $dir_to_process: $!";
foreach $file (readdir DIR) #readdir返回的是文件名，不包括路径名
{
    print "one file in $dir_to_process is $file\n";
}
close DIR;


#为了让程序更具可移植性，可以使用File::Spec::Functions模块构造适合本地系统文件名
use File::Spec::Functions;
$dirname = 'D:\PerlModule\DateTime-1.03';
opendir my $somedir, $dirname or die "Cannot open $dirname: $!";
while (my $name = readdir $somedir)
{
    next if $name =~ /^\./;
    $name = catfile($dirname, $name);
    next unless -f $name and -r $name;
    
    print "$name\n";
}


(5) 递归访问目录
Perl自带了一个模块File::Find，可以实现目录的递归处理。


(6) 目录和文件的操作
1. 在Perl里面，我们可以使用unlink操作符，并指定要删除的文件列表
unlink 'slate', 'bedrock', 'lava';
unlink qw(slate bedrock lava);
unlink glob '*.o'; #glob '*.o'返回的是一个列表 unlink的参数正好要求一个列表


unlink返回值代表成功删除的文件数目
unlink不能用来删除目录，rmdir函数可以。


(7) 重命名文件
rename 'old', 'new';
rename '/home/hello.sh', '/etc/hello.sh'; #将文件移动到其他目录
rename '/home/hello.sh' => '/etc/hello.sh'; 




批量修改文件名:
foreach my $file (glob "*.old")
{
    my $newfile = $file;   
    $newfile =~ s/\.old$/.new/;  # 合并为:(my $newfile = $file) =~ s/\.old$/.new/;
    if (-e $newfile)
    {
        warn "can't rename $file to $newfile: $newfile exists\n";
    }
    elsif (rename $file => $newfile)
    {
        warn "rename $file to $newfile failed: $!\n";
    }
}


(8) 链接与文件
建立硬链接：
link 'egg', 'egg_hardlink' or warn "Can't link chicken to egg: $!";
建立软链接：
symlink 'egg', 'egg_softlink' or warn "Can't link chicken to egg: $!";
查看结果：
[root@etl10 scott]# ll -ail egg*
2238738 -rw-r--r-- 2 root root 256 Nov  8 11:01 egg
2238738 -rw-r--r-- 2 root root 256 Nov  8 11:01 egg_hardlink  --和egg有相同的inode 同一份内容的两个名字 起到备份的作用
2238690 lrwxrwxrwx 1 root root   3 Nov 21 09:51 egg_softlink -> egg    --和egg有不同的inode


要取得符号链接指向的位置，请使用readlink函数。它会返回符号链接指向的位置。
如果参数不是符号链接，则返回undef
my $where = readlink 'egg_softlink';
my $perl = readlink '/usr/local/bin/perl';
这两种链接都可以用unlink移除。


(9) 创建和删除目录
mkdir 'fred', 0755 or warn "Cannot make fred directory: $!";
oct()函数，可以强行把字符串当成八进制数据处理，无视它是否以0开头：
my $permissions = "0755";
mkdir $name, oct($permissions);
一般下面的情况下，需要使用oct函数：
my ($name, $perm) = @ARGV;
mkdir $name, oct($perm) or die "cannot create $name: $!";




如果移除空的目录，可以使用rmdir命令：
foreach my $dir (qw(fred barney betty))
{
    rmdir $dir or warn "cannot rmdir $dir: $!\n";    
}


如果对非空目录调用rmdir函数会导致失败。可以先用unlink删除目录中的内容，再试着删除已经清空的目录。
my $temp_dir = "/tmp/scratch_$$";
mkdir $temp_dir, 0700 or die "cannot create $temp_dir: $!";


unlink glob "$temp_dir/* $temp_dir/.*";
rmdir $tempdir;


(10) 修改权限
chmod 0755, 'fred', 'barney';


(11) 修改隶属关系
my $user = 1004;  --指定是必须给定数字的形式
my $group = 100;
chown $user, $group, glob "*.o";
如果处理的不是数字，而是字符串，如下处理：
使用getpwnam函数将用户名转换为用户编号。
使用getgrnam函数将用户组转换为用户组编号。


defined(my $user = getpwnam 'merlyn') or die 'bad user'; #获取merlyn用户名的UID
defined(my $group = getpwnam 'users') or die 'bad group';
chown $user,$group, glob '/home/merlyn/*';




(12) 修改时间戳
可以使用utime函数来修改文件的最近修改或访问的时间
它的前两个参数是新的访问时间和更改时间，其余参数就是要修改时间戳的文件名列表。


my $now = time;
my $ago = $now - 24 * 60 * 60;
utime $now, $ago, glob '*'; #将组后访问时间更改为当前时间，最后修改时间改为一天前


测试1：
print "Which directory? (Default is your home directory)";
chomp(my $dir = <STDIN>);
if ($dir =~ /\A\s*\Z/)
{
    chdir or die "Can't chdir to your home directory: $!";
}
else
{
    chdir $dir or die "Can't chdir to '$dir' : $!";
}


my @files = <*>; #不包含. ..和所有以点开头的文件或目录，如果使用my @files = <.* *>就显示所有的内容,.*显示所有以点号开头的内容。
foreach (@files) #如果上面用<.* *>，则这里使用foreach (sort @files)
{
    print "$_\n";
}




测试2：
print "Which directory? (Default is your home directory)";
chomp(my $dir = <STDIN>);
if ($dir =~ /\A\s*\Z/)
{
    chdir or die "Can't chdir to your home directory: $!";
}
else
{
    chdir $dir or die "Can't chdir to '$dir' : $!";
}


opendir DOT, '.' or die "Can't opendir dot: $!";
foreach (sort readdir DOT)
{
    #next if /\A./; #  如果跳过文件名以点号开头的文件
    print "$_\n";
}




测试3：
use File::Basename;
use File::Spec;


my ($source, $dest) = @ARGV;


if (-d $dest)
{
    my $basename = basename $source;
    $dest = File::Spec->catfile($dest, $basename);
}
rename $source, $dest or die "Can't rename '$source' to  '$dest': $!\n";




测试4：
use File::Basename;
use File::Spec;


my ($source, $dest) = @ARGV;


if (-d $dest)
{
    my $basename = basename $source;
    $dest = File::Spec->catfile($dest, $basename);
}
link $source, $dest or die "Can't link '$source' to  '$dest': $!\n";




测试5：
use File::Basename;
use File::Spec;


my $symlink = $ARGV[0] eq '-s';
shift @ARGV if $symlink;
my ($source, $dest) = @ARGV;
if (-d $dest)
{ 
    my $basename = basename $source;
    $dest = File::Spec->catfile($dest, $basename);
}


if ($symlink)
{
    symlink $source, $dest or die "Can't make soft link from '$source' to '$dest': $!\n";
}
else
{
    link $source, $dest or die "Can't make hard link from '$source' to '$dest': $!\n";
}


第十四章 字符串与排序
(1) 用index查找字符串 
$where = index($big, $small);
Perl会在$big字符串中寻找$small字符串首次出现的地方，并返回一个整数表示第一个字符的匹配位置，返回的字符位置是从零算起的。
如果index无法找到，则返回-1
可以加入第三个参数，表明从该参数指定的位置开始寻找子字符串。


使用rindex函数来搜索字符串最后出现的地方，从字符串末尾的地方开始找起：
my $last_slash = rindex("/etc/passwd", "/"); #值为4


rindex函数也有可选的第三个参数，但这里是用来限定返回值的上限。


(2) 用substr操作子字符串
三个参数：一个原始字符串，一个从零起算的起始位置以及字符串的长度。


my $long = "some very very long string";
my $right = substr($long, index($long, "l"));
print "$right\n";


Result:
long string


替换的操作：
my $string = "Hello, world!";
substr($string, 0, 5) = "Goodbye"; #string的值现在为Goodbye, world!


对指定范围的字符串进行操作：
处理字符串的最后20个字符串:
substr($string, -20) =~ s/fred/barney/g;


substr函数的第四个参数是替换字符串：
my $previous_value = substr($string, 0, 5, "Goodbye");


测试1：
#!/usr/bin/env perl
my $string = "Hello, world!";
my $previous_value = substr($string, 0, 5, "Goodbye");
print "$previous_value\n";
print "$string\n";


Result：
Hello  #返回的是替换之前的字符串
Goodbye, world! #返回的是替换之后的字符串


(3) 用sprintf格式化字符串
sprintf函数与printf有相同的参数，但是它返回的是所请求的字符串，而不会直接打印出来。
好处是可以将格式化后的字符串存放在变量里面以便稍后使用。
**使用sprintf格式化金额数字
sprintf的一种常见用法就是格式化小数点后具有特定精度的数字
my $money = sprintf "%.2f", 2.49997;
print "$money\n";
Result:
2.50


测试1：
sub big_money
{
    my $number = sprintf "%.2f", shift @_;
    1 while $number =~ s/^(-?\d+)(\d\d\d)/$1,$2/; #对$number数字进行不断的处理，每三个数字中间加入一个逗号 主要执行条件表达式
                                                  #1也可以替换成其他任何合法的代码。
    $number =~ s/^(-?)/$1\$/;
    print "$number\n";
    $number;
    
}


big_money(-323243435128172.21212);




**非十进制数字字符串的转换
如果字符串是以 特定的十六进制或二进制前缀字符开头的话，oct()函数能聪明地根据该进制进行转换，不过
十六进制字符串必须以0x开头。




**高级排序
排序子程序用来实现自定义的排序方式。
sub by_number
{
    if ($a < $b) 
    {
        -1
    }
    elsif ($a > $b)
    {
        1
    }
    else
    {
        0
    }
}   


my @result = sort by_number @some_number;


许多排序里面的程序的名字都是以by_开头的，用以说明排序规格。


飞船操作符：<=>  用来比较数字
这个操作符会比较两个数字并返回-1、0和1，好让它们依数字排序。
上面的代码优化：
sub by_number
{
    $a <=> $b;
}




三路字符串比较操作符：cmp  
cmp所提供的顺序和sort默认的排序规则相同。
sub by_code_point
{
    $a cmp $b;
}


my $strings = sort by_code_point @any_strings;


不区分大小写的排序：
@any_strings = ("Hello",'OK','ff');
sub by_code_point
{
    "\L$a" cmp "\L$b"; #强制转换成小写
}


my @strings = sort by_code_point @any_strings;
print "@strings\n";


一般来说,要对Unicode字符串排序，都会写成下面：
use Unicode::Normalize;
sub equivalents 
{
    NFKD($a) cmp NFKD($a);
}
在比较的过程中，我们并没有修改被比较的值。




将整个排序子程序内嵌到排序子程序名的位置即可：
my @numbers = sort { $a <=> $b } @some_numbers;


递减的排序子程序：
my @numbers = reverse sort { $a <=> $b } @some_numbers;
注：小窍门，比较操作符(<=>,cmp)是短视的，不知道哪个是操作数$a,哪个是操作符$b,只知道哪一个在左边，哪一个在右边，如果我们将
$a和$b对调，比较操作符每次就会得到相反的结果。
my @numbers = sort { $b <=> $a } @some_numbers;




**按哈希值排序
my %score = ("barney" => 195, "fred" => 205, "dino" => 30);
sub by_score
{
    $score{$a} <=> $score{$b}; #升序排列
}


**按多个键排序
my %score = ("barney" => 195, "fred" => 205, "dino" => 30, "bamm-bamm" => 195);
sub by_score_and_name
{
    $score{$a} <=> $score{$b} or $a cmp $b; #先根据分数降序排列，分数相同时再按照名字的ASCII码序排列
}


my @winners = sort by_score_and_name keys %score;


测试1：
将输入的数字进行排序：
my @numbers;
push @numbers, split while <>;
foreach (sort { $a <=> $b} @numbers)
{
    printf "%20g\n", $_;
}


[root@etl10 scott]# perl test.pl 
12
34
3
-9
50
050
03                 #以上为输入内容，以下为输出内容
                  -9
                   3
                   3
                  12
                  34
                  50
                  50
测试2：
my $keys = sort { "\L$last_name{$a]" cmp "\L$last_name{$b]" or "\L$a" cmp "\L$b"} keys %last_name;
foreach (@keys)
{
    print "$last_name{$_}, $_\n";
}




测试3：
print "Please enter a string: ";
chomp(my $string = <STDIN>);
print "Please enter a substring: ";
chomp(my $sub = <STDIN>);


my @placles;
for (my $pos = -1; ;)
{
    $pos = index($string, $sub, $pos + 1);
    last if $pos == -1;
    push @places, $pos;   
}
print "Location of '$sub' in '$string' were: @places\n";


[root@etl10 scott]# perl test.pl 
Please enter a string: helloisisgood
Please enter a substring: is
Location of 'is' in 'helloisisgood' were: 5 7




第十五章 智能匹配与given-when结构
智能匹配是从5.10.0开始出现的，后来Perl 5.10.1版本解决了Perl 5.10.0版本的绝大多数bug。
所以要使用智能匹配，需要使用Perl 5.10.1版本，否则会招致意外。
use 5.010001 #至少是5.10.1版本


(1) 智能匹配操作符
智能匹配操作符~~和绑定操作符=~非常相近，不过~~更能干些，有时可以取代绑定操作符。
print "I found Fred in the name!\n" if $name =~ /Fred/;
改用智能匹配操作符代替绑定操作符:
use 5.010001;
say "I found Fred in the name!" if $name ~~ /Fred/;


实例：
之前方法：兼容性好，但是繁琐
my $flag = 0;
foreach my $key (keys %names)
{
    next unless $key =~ /Fred/;
    $flag = $key;
    last;  
}


print "I found a key matching 'Fred'. It was $flag\n" if $flag;


智能匹配的写法为：
use 5.010001;
%names = ("Fred" => 12, "Name" => 'Hello');
say "I found a key matching 'Fred'!" if %names ~~ /Fred/; #写成这样也是OK的：say "I found a key matching 'Fred'!" if /Fred/ ~~ %names;  
[root@etl10 scott]# perl test.pl 
I found a key matching 'Fred'!


比较两个数组的大小：
$equal = 0;
foreach my $index (0..$#name1)
{
    last unless $names1[$index] eq $names2([$index];
    $equal++;
}


print "The arrays have the same elements!\n" if $equal == @names1; #只有相等时，才认为两者相同
智能匹配的写法为
use 5.010001;
print "The arrays have the same elements!\n" if @names1 ~~ @names2; 


判断数字数组中是否含有某个数字:
use 5.010001;
my $nums = qw( 1 2 34 5 42);
my $result = max( @nums );


say "The result [$result] is one of the input values (@nums)" if @nums ~~ $result;