如何使用Perl查找和读取多个.zip文件夹中的文件?

时间:2015-01-26 05:36:11

标签: perl unzip file-handling compression

我有一个像这样的目录结构:

Sample1
  Subdir1
    file.txt
    file.jpg
    file.fastq
    directory1.zip
          file.txt
          file.csv
          result.html
          summary.txt
    directory2.zip
          file.txt
          file.csv
          result.html
          summary.txt

一旦我处于Subdir1级别,如何找到解压缩两个.zip文件,并将两个summary.txt文件保存到两个不同的文件句柄?

这是为了进一步阅读这两个文件并将它们解析成一个数组。

我被要求发布到目前为止的内容。它非常混乱,但这里有:

my %cellHash = ();
while (my $cellDirectory = readdir(SEQ_RUN)) {
         %cellHash { $cellDirectory } = ()
         #Descend into "trimmed" subdirectory of cell.
    my $trimmedDirectory =  $cellDirectory . "/trimmed"
        opendir (TRIMMED_CELL_DIR, $trimmedDirectory) or die $!;
        # Read the 2 ZIP files
        while (my $fastQCzip = readdir(TRIMMED_CELL_DIR)) {
         #only if .zip  
        # File 1 always ends in _1_fastqc.zip
        # File 2 always ends in _2_fastqc.zip

my $summaryFastQC = Archive::Zip->new();
unless ( $summaryFastQC->read( $fastQCzip ) == AZ_OK ) {
    die 'read error'
    }
# Parse output: cellHash {cellName} [ R1 TESTS ] [ R2 TESTS ]
open QUALITY_SUMMARY, "filename.txt" or die $!;

1 个答案:

答案 0 :(得分:0)

使用模块File :: Find可以更轻松地查找zip文件。

通过将其传递给find2perl,甚至可以从通常的find命令创建用于搜索文件的代码块。

例如:     find2perl找到。 -name" * .zip"

产生:

sub wanted {
    /^.*\.zip\z/s
    && print("$name\n");
}

所以你可以这样做:

#!/usr/bin/perl
#

use strict;
use warnings;

use File::Find;


sub wanted {
    /^.*\.zip\z/s
    && print("$File::Find::dir/$_\n");
}

my @dirs = ("somedir", "anotherdir");

my @zips = find(\&wanted, @dirs);

print "@zips\n";

请参阅http://perldoc.perl.org/File/Find.html

然后,要保存summary.txt的实例,您将扫描该名称的存档并将文件保存到某个目录。为了避免覆盖,你可以通过一些任意扩展来区分它们:

my $wanted = "summary.txt";
my $suffix = 0;
foreach my $zipname (@zips)
{
    my $zip = Archive::Zip->new($zipname);
    foreach my $member ($zip->members)
    {
        next unless ($member->fileName =~ /\/$wanted$/);

        $suffix++;
        if ($member->extractToFileNamed("$wanted.$suffix") != 'AZ_OK') {
            die("Could not create $newname");
        }
    }
}

请参阅http://www.perlmonks.org/?node_id=104653