用户名: 密码: 忘记密码? 注册

Perl语言入门笔记:第十八天

作者:  时间: 2010-09-23

第十三章
 目标操作
 
在目录树中移动:
程序运行时会以自己的工作目录(working directory)作为相对路径的起点。也就是说,当我们说起fred这个文件时,其实指的是当前工作目录的fred。
我们可以用chdir操作符来改变当前的工作目录。它和Unix shell的cd命令差不多:
chdir "/etc" or die "cannot chdir to /etc: $!";

文件名通配:

[linscora@root ~]# cat show-args

foreach $arg (@ARGV) {
  print "one arg is $arg\n";
}
[linscora@root ~]
# perl show-args *.pm

one arg is barney.pm
one arg is dino.pm
one arg is Fred.pm
one arg is wilma.pm

不过有时候在程序内部,也可能会想要用*.pm之类的模式。我们可以不花太多力气就把它展开成相匹配的文件名吗?当然!只要用glob操作符就行了:
my @all_files = glob "*";
my @pm_files = glob "*.pm";

文件通配的另一种语法:
my @all_files = <*>; 和 my @all_files = glob "*"; 效果完全一致

#!/usr/bin/perl -w

my $dir = "/etc";
my @dir_files = <$dir/* $dir/.*>;
print "@dir_files\n";

如何区分尖括号是表示从文件句柄读取,还是表示文件名通配操作呢?
如果尖括号内是满足Perl标识符条件的,就作为文件句柄来读取;否则,它代表的就是文件名通配操作。如
my @files = <FRED/*>;   ##glob
my @files = <FRED>;   #从文件句柄读取
my $name ="FRED";
my @files = <$name/*>;  ##glob
my @name = "FRED";
my @lines = <$name>;  ##对句柄FRED进行间接文件句柄读取。

也可以使用readline操作符来执行间接文件句柄读取,让程序读起来更清楚些:
my $name = "FRED";
my @lines = readline FRED; ##从FRED读取
my @lines = readline $name; ##从FRED读取

目录句柄:
若想从目录里取得文件名列表,还可以使用目录句柄(directory handle)。目录句柄看起来像文件句柄,使用起来也没有多大的差别。

[linscora@root ~]# cat openfilehandle

#!/usr/bin/perl -w

use strict;
my $dir_to_process = "/etc";
opendir DH, $dir_to_process or die "Cannot open $dir_to_process:$!";
foreach my $file (readdir DH) {
  print "one file in $dir_to_process is $file\n";
}
closedir DH;

[linscora@root ~]
# perl openfilehandle |more

one file in /etc is .
one file in /etc is ..
one file in /etc is rhgb
one file in /etc is raddb
one file in /etc is gre.d
one file in /etc is dnsmasq.d
one file in /etc is shadow-
one file in /etc is httpd
one file in /etc is syslog.conf
one file in /etc is netplug.d
one file in /etc is udev
one file in /etc is netplug
--More--

和文件句柄一样,目录句柄会在程序束时自动关闭,也会在用这个句柄再打开另一个目录前目动关闭。

while ($name = readdir DIR) {
next unless $name =~ /\.pm$/;
#.....
}

请注意,上面是正则表达式的语法,而不是文件名通配。若想取得所有不以点号开头的文件,我们可以这么写:
next if $name =~ /^\./;
如果要排除. (当前目录)和..(上层目录)两个目录,则可以直接写明:
next if $name eq "." or $name eq "..";

请特别注意。readdir操作符返回的文件名并不包含路径,它们只是目录下的文件名而已。所以,我们不会看到/etc/passwd,而只会见到passwd(因为这是另一个与文件名通配操作的区别,所以很容易把人搞糊涂)。

[linscora@root ~]# cat fulldir

#!/usr/bin/perl -w

$dirname = "/etc";
opendir SOMEDIR, $dirname or die "Cannot open $dirname:$!";
while (my $name = readdir SOMEDIR) {
next if $name =~ /^\./;
$name = "$dirname/$name";
next unless -f $name and -r $name;
print "$name\n";
}
closedir SOMEDIR;

[linscora@root ~]
# perl fulldir |more

/etc/shadow-
/etc/syslog.conf
/etc/aliases
/etc/dhcp6c.conf
/etc/printcap
/etc/passwd.OLD
/etc/cron.deny
/etc/modprobe.conf.BeforeVMwareToolsInstall
--More--

递归的目录列表:
用File::Find模块很好实现。

操作文件与目录:

删除文件:
Unix shell下,我们用rm来删除文件:
在perl中则使用unlink操作符:
unlink "slate", "bedrock", "lava";
这将会把三个文件放进碎纸机,从此消失在系统中。

[linscora@root ~]# cat rmperltest

#!/usr/bin/perl -w

chdir "/tmp" or die "cannot chdir to /tmp: $!";
my @tmpfile = glob "*";
print "@tmpfile\n";
unlink @tmpfile;

[linscora@root ~]
# perl rmperltest

a b c d e gconfd-root orbit-root vmware-root
[linscora@root ~]
# perl rmperltest

gconfd-root orbit-root vmware-root
[linscora@root ~]
#


#!/usr/bin/perl -w

my $successful = unlink "slate", bedrock", "lava
";
print "
I deleted $successful file(s) just now\n
";

#如果要知道哪个被删除了:
foreach my $file (qw(slate bedrock lava)) {
  unlink $file or warn "
failed on $file: $!\n

在Unix上有个鲜为人知的事实:某个文件可能你无法读取、写入、执行。其实它根本就是别人的文件,但你还是是可以删除。这是因为删除文件的权限跟文件本身的权限位无关。它取决于文件所在目录的权限位。

重命名文件:
想为现有的文件取个新名字时,使用rename函数:
rename "old", "new";

批量把.old结尾的文件改名为.new结尾的。下面就是Perl擅长的做法:

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) {
    
#改名成功,什么都不需要做

   } else {
    warn "rename $file to $newfile failed:$!\n";
   }
 }
 
[linscora@root tmp]
# ls

a.old c.old e.old gconfd-root h.old j.old m.old vmware-root
b.old d.old f.old g.old i.old k.old orbit-root
[linscora@root tmp]
# vim chagename

[linscora@root tmp]
# perl chagename

[linscora@root tmp]
# ls

a.new chagename d.new f.new g.new i.new k.new orbit-root
b.new c.new e.new gconfd-root h.new j.new m.new vmware-root

链接与文件:
每个文件都存储在文件索引号(inode)对应的位置中。

link "chicken", "egg" or warn "can't link chicken to egg: $!"; 和ln chicken egg的效果一样的。做了硬链接。

symlink "dodyson", "carroll" or warn "can't symliink dodgson to carroll: $!"; 和ln -s dodyson carrol的效果一样的。做了软链接。

取得符号链接指向的位置,用readlink函数。它会返回符号链接指向的位置。或在参数不是符号链接时返回undef:
my $where =readlink "carroll";     #得到"dodgson"
my $perl = readlink "/usr/local/bin/perl";  #告诉你实际perl程序究竟躲在何处

建立及移除目录:
调用mkdir函数建立目录。
mkdir "fred", 0755 or warn "Cannot make fred directory:$!";
0755代表目录的初始权限。

#!/usr/bin/perl -w

my $name = "fred";
my $permissions = "0755";        
#危险,不能这么用

mkdir $name, $permissions;
#这样0755会被当成十进制处理,所以相当于我们用01363权限值建立了一个目录。要正确处理字符串,请使用oct函数。

mkdir $name, oct($permissions);

my ($name, $perm) = @ARGV;        
#从命令行最先传入的两个参数,分别是目录名称和权限

mkdir $name, oct($perm) or die "cannot create $name: $!";

移除空目录时,可以用rmdir函数,它的用法和unlink函数很像,只是每次调用只能删除一个目录:
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: $!";
....
将临时目录$temp_dir 作为所有临时文件存放的场所
...
unlink glob "$temp_dir/* $temp_dir/.*"; #删除临时目录$temp_dir中所有的文件
rmdir $temp_dir;

修改权限:
Unix的chmod命令可用来修改文件或目录的权限。Perl里对应的chmod函数也能进行一样的操作:但是chomd函数不能接受+x 或go=u-w的操作。
chmod 0755, "fred", "barney";

更改隶属关系:
只要操作系统许可,可以用chown函数更改一系列文件的拥有者以及它们所属的组。chown会同时更改拥有者和所属组,它们必须以数字形式的用户标识组标识符来指定。
my $user = 1004;
my group  = 100;
chown $user, $group, glob "*.o";

如果要处理的不是数字,而是像merlyn这样的字符串呢?只要用getpwnam函数翻译成数字,再用相应的getgrnam函数来把组名翻译成数字:
defined (my $user = getpwname "merlyn") or die "bad user";
defined (my $group = getprnam "users" ) or die "bad group";
chown $user, $group, glob "/home/merlyn/*";

修改时间戳:
修改当前目录下所有的文件,让它们看起来是在一天前被更改,却是在此刻被访问的,只要这样写:
my $now = time;
my $ago = $now ? 24 * 60 * 60;  #一天的秒数
utime $now, $age , glob "*";  #将最后访问时间改为当前时间,最后修改时间改为一天前

习题:

1
#!/usr/bin/perl -w

print "Which directory? (Default is your home directory)";
chomp(my $dir = <STDIN>);
if ($dir =~ /^\s*$/) {
  chdir or die "Can't chdir to your home directory:$!";
  } else {
  chdir $dir or die "Can't chdir to '$dir": $!
";
  }
  
my @files = <*>;
foreach (@files) {
 print "
$_\n
";
 }
 
2
print "
Which directory? (Default is your home directory)
";
chomp (my $dir = <STDIN> {
  chdir or die "
Can
't chdir to your home directory:$!";
  } else {
  chdir $dir or die "Can'
t chdir to '$dir':$!
";
  
my @files = <.* *>;
foreach (sort @files) {
  print "
$_\n
";
  }
  
3
#!/usr/bin/perl -w
print "
Which directory? (Default is your name home directory)
";
chomp (my $dir = <STDIN>);
if ($dir =~ /^\s*$/) {
  chdir or die "
Can
't chdir to your home directory: $!";
  } else {
  chdir $dir or dir "Can'
t chdir to '$dir': $!
";
  }
  
  open DOT, "
." or die "Can
't opendir dot: $!";
  foreach (sort readdir DOT) {
   #next if /^\./;
   print "$_\n";
   }
   
4
unlink @ARGV;

foreach (@ARGV) {
 unlink $_ or warn "Can'
t unlink '$_': $!, continuing...\n
";
 }
 
5
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";

6
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 rename '$source' to '$dest': $!\n
";

7
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 $sourc, $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
";
 
}

8
#!/usr/bin/perl -w
foreach (<.* *>) {
my $dest = readlink $_;
print "
$_ -> $dest\n