垦荒学园

简体中文

English

简体中文

English

切换主题

Perl Directory Operations ​

打开和读取目录 ​

打开目录 ​

perl
use strict;
use warnings;

opendir(my $dh, '.') or die "Cannot open directory: $!";

while (my $entry = readdir($dh)) {
    next if $entry eq '.' or $entry eq '..';
    print "$entry\n";
}

closedir($dh);

读取目录到数组 ​

perl
use strict;
use warnings;

opendir(my $dh, '.') or die "Cannot open directory: $!";

my @entries = readdir($dh);

closedir($dh);

# 过滤掉 . 和 ..
@entries = grep { !/^\.\.?$/ } @entries;

print "Entries:\n";
print "$_\n" for @entries;

使用 glob 模式 ​

perl
# 列出所有 .pl 文件
my @perl_files = glob('*.pl');
print "Perl files:\n";
print "$_\n" for @perl_files;

# 列出所有文本文件
my @text_files = glob('*.txt');

# 列出所有文件
my @all_files = glob('*');

# 递归列出所有文件
my @all_files_recursive = glob('**/*');

创建和删除目录 ​

创建目录 ​

perl
# 创建单个目录
mkdir('new_dir') or die "Cannot create directory: $!";

# 创建多级目录（使用 File::Path）
use File::Path qw(make_path);

make_path('dir1/dir2/dir3') or die "Cannot create path: $!";

# 设置权限
mkdir('secure_dir', 0755) or die "Cannot create directory: $!";

删除目录 ​

perl
# 删除空目录
rmdir('empty_dir') or die "Cannot remove directory: $!";

# 删除非空目录（使用 File::Path）
use File::Path qw(remove_tree);

remove_tree('dir_to_delete') or die "Cannot remove directory: $!";

# 保留根目录
remove_tree('dir_to_remove', {keep_root => 1});

使用 File::Path 进行高级操作 ​

perl
use File::Path qw(make_path remove_tree);

# 创建目录并设置权限
make_path(
    'new/path',
    {
        mode => 0755,
        verbose => 1
    }
);

# 删除目录时显示详细信息
remove_tree(
    'path/to/remove',
    {
        verbose => 1,
        error => \my $err_list
    }
);

if (@$err_list) {
    for my $err (@$err_list) {
        print "Error: $err->{path}\n";
    }
}

目录遍历 ​

递归遍历目录 ​

perl
use strict;
use warnings;

sub traverse_directory {
    my ($dir) = @_;
    
    opendir(my $dh, $dir) or die "Cannot open $dir: $!";
    
    while (my $entry = readdir($dh)) {
        next if $entry eq '.' or $entry eq '..';
        
        my $path = "$dir/$entry";
        
        if (-d $path) {
            print "DIR: $path\n";
            traverse_directory($path);  # 递归
        } else {
            print "FILE: $path\n";
        }
    }
    
    closedir($dh);
}

traverse_directory('.');

使用 File::Find ​

perl
use strict;
use warnings;
use File::Find;

# 查找所有 .pl 文件
find(\&wanted_pl, '.');

sub wanted_pl {
    /\.pl$/ && print "$File::Find::name\n";
}

# 查找并统计
my %stats;

find(sub {
    if (-d $_) {
        $stats{directories}++;
    } elsif (-f $_) {
        $stats{files}++;
        $stats{total_size} += -s $_;
    }
}, '.');

print "Statistics:\n";
print "Directories: $stats{directories}\n";
print "Files: $stats{files}\n";
print "Total size: $stats{total_size} bytes\n";

使用 File::Find::Rule ​

perl
use strict;
use warnings;
use File::Find::Rule;

# 查找所有 .pl 文件
my @perl_files = File::Find::Rule
    ->file
    ->name('*.pl')
    ->in('.');

print "Perl files:\n";
print "$_\n" for @perl_files;

# 查找大于 1MB 的文件
my @large_files = File::Find::Rule
    ->file
    ->size('>1M')
    ->in('.');

print "\nLarge files (>1MB):\n";
print "$_\n" for @large_files;

# 组合条件
my @files = File::Find::Rule
    ->file
    ->name('*.pl')
    ->size('>1K')
    ->in('.');

路径操作 ​

使用 File::Spec ​

perl
use File::Spec;

# 拼接路径
my $path = File::Spec->catfile('dir', 'subdir', 'file.txt');
print "Path: $path\n";

# 分割路径
my ($volume, $directories, $file) = File::Spec->splitpath($path);
print "Volume: $volume\n";
print "Directories: $directories\n";
print "File: $file\n";

# 获取目录名
my $dir = File::Spec->catpath($volume, $directories, '');
print "Directory: $dir\n";

# 规范化路径
my $normalized = File::Spec->canonpath('dir/../dir/./file.txt');
print "Normalized: $normalized\n";

使用 File::Basename ​

perl
use File::Basename;

my $path = '/home/user/documents/file.txt';

# 获取文件名
my $filename = basename($path);
print "Filename: $filename\n";  # file.txt

# 获取目录名
my $dirname = dirname($path);
print "Dirname: $dirname\n";  # /home/user/documents

# 获取文件名（不带扩展名）
my $name = fileparse($path, qr/\.[^.]*/);
print "Name: $name\n";  # file

# 获取扩展名
my ($name2, $dir2, $suffix) = fileparse($path);
print "Suffix: $suffix\n";  # .txt

使用 Cwd 获取当前目录 ​

perl
use Cwd;

# 获取当前工作目录
my $cwd = cwd();
print "Current directory: $cwd\n";

# 获取脚本所在目录
use File::Basename;
my $script_dir = dirname($0);
print "Script directory: $script_dir\n";

目录操作 ​

改变目录 ​

perl
# 改变当前工作目录
chdir('/tmp') or die "Cannot change directory: $!";
print "Current dir: " . cwd() . "\n";

# 保存并恢复目录
my $original_dir = cwd();
chdir('/tmp');

# 执行操作...

chdir($original_dir) or die "Cannot restore directory: $!";

创建符号链接 ​

perl
# 创建符号链接
symlink('target', 'link') or die "Cannot create symlink: $!";

# 读取符号链接
my $target = readlink('link');
print "Link points to: $target\n";

硬链接 ​

perl
# 创建硬链接
link('original.txt', 'hardlink.txt') or die "Cannot create hard link: $!";

获取目录大小 ​

perl
use File::Find;

sub get_directory_size {
    my ($dir) = @_;
    my $total_size = 0;
    
    find(sub {
        $total_size += -s $_ if -f $_;
    }, $dir);
    
    return $total_size;
}

my $size = get_directory_size('.');
print "Directory size: $size bytes\n";
print "Directory size: " . ($size / 1024 / 1024) . " MB\n";

实践示例 ​

示例 1：文件查找工具 ​

perl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;

sub find_files {
    my ($pattern, $start_dir) = @_;
    my @found_files;
    
    find(sub {
        if (/$pattern/ && -f $_) {
            push @found_files, $File::Find::name;
        }
    }, $start_dir);
    
    return @found_files;
}

print "请输入要查找的文件模式（如 *.txt）: ";
chomp(my $pattern = <STDIN>);

# 将 glob 模式转换为正则表达式
$pattern =~ s/\./\\./g;  # 转义点
$pattern =~ s/\*/.*/g;   # * 替换为 .*
$pattern =~ s/\?/./g;    # ? 替换为 .
$pattern = "^$pattern\$";

my @files = find_files(qr/$pattern/, '.');

print "\n找到 " . scalar(@files) . " 个文件:\n";
print "$_\n" for @files;

示例 2：目录清理工具 ​

perl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
use File::Basename;

sub cleanup_temp_files {
    my ($dir, $days_old) = @_;
    my $removed_count = 0;
    
    find(sub {
        return unless -f $_;
        
        my $file_age = -M $_;
        
        if ($file_age > $days_old) {
            print "Deleting: $File::Find::name ($file_age days old)\n";
            unlink $_ or warn "Cannot delete $File::Find::name: $!";
            $removed_count++;
        }
    }, $dir);
    
    return $removed_count;
}

print "请输入要清理的目录: ";
chomp(my $dir = <STDIN>);

print "请输入天数（删除多少天前的文件）: ";
chomp(my $days = <STDIN>);

if (-d $dir) {
    print "\n开始清理...\n";
    my $count = cleanup_temp_files($dir, $days);
    print "\n删除了 $count 个文件\n";
} else {
    print "目录不存在\n";
}

示例 3：目录同步工具 ​

perl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;
use File::Copy;
use File::Basename;

sub sync_directories {
    my ($source, $destination) = @_;
    
    print "Syncing from $source to $destination\n";
    
    find(sub {
        my $source_path = $File::Find::name;
        
        # 计算目标路径
        my $relative = $File::Find::name;
        $relative =~ s/^\Q$source\E//;
        my $dest_path = "$destination$relative";
        
        # 创建目标目录结构
        if (-d $source_path) {
            my $dest_dir = dirname($dest_path);
            unless (-d $dest_dir) {
                print "Creating directory: $dest_dir\n";
                make_path($dest_dir);
            }
        }
        # 复制文件
        elsif (-f $source_path) {
            unless (-e $dest_path) {
                print "Copying: $source_path -> $dest_path\n";
                copy($source_path, $dest_path) or warn "Cannot copy: $!";
            }
        }
    }, $source);
}

print "请输入源目录: ";
chomp(my $source = <STDIN>);

print "请输入目标目录: ";
chomp(my $dest = <STDIN>);

if (-d $source) {
    sync_directories($source, $dest);
    print "\n同步完成\n";
} else {
    print "源目录不存在\n";
}

示例 4：磁盘使用分析 ​

perl
#!/usr/bin/perl
use strict;
use warnings;
use File::Find;

sub analyze_disk_usage {
    my ($dir) = @_;
    my %stats = (
        files => 0,
        directories => 0,
        total_size => 0,
        file_types => {}
    );
    
    find(sub {
        if (-d $_) {
            $stats{directories}++;
        } elsif (-f $_) {
            $stats{files}++;
            $stats{total_size} += -s $_;
            
            # 统计文件类型
            if (/\.(.+)$/) {
                my $ext = uc($1);
                $stats{file_types}{$ext}++;
            }
        }
    }, $dir);
    
    return \%stats;
}

my $directory = '.';
print "分析目录: $directory\n";

my $stats = analyze_disk_usage($directory);

print "\n=== 磁盘使用统计 ===\n";
printf "目录数: %d\n", $stats->{directories};
printf "文件数: %d\n", $stats->{files};
printf "总大小: %.2f MB\n", $stats->{total_size} / 1024 / 1024;

print "\n=== 文件类型统计 ===\n";
foreach my $ext (sort { $stats->{file_types}{$b} <=> $stats->{file_types}{$a} } 
                 keys %{$stats->{file_types}}) {
    printf "%-10s: %d\n", ".$ext", $stats->{file_types}{$ext};
}

小结 ​

本章节学习了 Perl 的目录操作：

  1. ✅ 打开和读取目录
  2. ✅ 创建和删除目录
  3. ✅ 目录遍历
  4. ✅ 路径操作
  5. ✅ 目录操作
  6. ✅ 实用工具示例

接下来，我们将学习 Perl 错误处理。