Question

我正在尝试构建一个用于管理Windows服务器的perl脚本，但它变得非常困难。所以，如果你们可以帮助我做出准备。

所以...这个程序应该找到PDF文件，压缩它们然后删除大于1mb的文件（在zip文件之外）。

我认为问题出在IF文件大小的情况下。所以当我把2个PDF文件放到一个目录中时（一个小于1mb，另一个小于1mb），无论我多少次更改代码，结果都是这样：

压缩所有文件，删除pdf文件（不是zip文件中的文件）。
压缩所有文件，删除较大的文件（不是zip文件中的文件）。
压缩较大的文件，删除pdf文件（不是zip文件中的文件）。

这是我的代码：

#!/usr/bin/perl

#1 megabyte = 1000000 bytes

use File::Find;
use lib qw(/st/APPL/PORTABLE/Perl/5.8.8);
use MIME::Lite;
use Strict;
use warnings;
use Win32::DriveInfo;
use Archive::Zip;
use Switch;
use IO::Compress::Zip qw(zip $ZipError);
use File::stat;

#my $backup_root = "/path/to/folder"

my $backup_root = "D:/st/APPL/PORTABLE/Perl/bin/teste";

# purge backups older than AGE in days
my @file_list;
my @find_dirs       = ($backup_root);              # directories to search
my $now             = time();                      # get current time
my $days            = 31;                          # how many days old
my $seconds_per_day = 60 * 60 * 24;                # seconds in a day
my $AGE             = $days * $seconds_per_day;    # age in seconds

find(
    sub {
        my $file     = $File::Find::name;
        my $filesize = stat($file)->size;

        if ( -f $file ) {
            push( @file_list, $file );
            print "Ficheiro $file encontrado!\n";
            print "Size: $filesize\n";
        }

        if ( $filesize >= 1105593 ) {
            #my @files = <*20131221*.pdf>;
            my @files = <*.pdf>;
            zip \@files => 'output.zip'
                or die "zip failed: $ZipError\n";

            for my $file (@file_list) {
                my @stats = stat($file);
                if ( $now - $stats[9] > $AGE ) {
                    unlink $file;
                }
            }

            print "Deleted files older than $days days.\n";

        } elsif ( $filesize <= 1105593 ) {
            print "O ficheiro e mais pequeno que 1 mb !";
        }
    },
    @find_dirs
);

Answer 1

目前尚不清楚output.zip如何与$ backup_root中的文件相关联，但我认为概念错误是在find callback（= inside loop）中重新创建zip文件。

请尝试以下代码：

#!/usr/bin/perl

# purge backups older than AGE in days

use strict;
use warnings;

use File::Find;
use lib qw(/st/APPL/PORTABLE/Perl/5.8.8);
use IO::Compress::Zip qw(zip $ZipError);
use File::stat;

my $backup_root = "D:/st/APPL/PORTABLE/Perl/bin/teste";

my @file_list;
my @find_dirs       = ($backup_root);              # directories to search
my $now             = time();                      # get current time
my $days            = 31;                          # how many days old
my $seconds_per_day = 60 * 60 * 24;                # seconds in a day
my $AGE             = $days * $seconds_per_day;    # age in seconds

# get list of all files and directories in @find_dirs
find( sub { push @file_list, $File::Find::name; }, @find_dirs );

# zip all pdfs found in $backup_root directory
my @found_pdfs = grep{/\.pdf$/} grep {-f} @file_list;
zip \@found_pdfs => 'output.zip' or die "zip failed: $ZipError\n";

# unlink old big files in $backup_root directory
unlink $_ for grep {$now - stat($_)->mtime > $AGE } grep {-s >= 1105593} grep {-f} @file_list;

用于管家的Perl脚本

1 个答案: