用于内务管理的Perl脚本

Question

我试图构建一个perl脚本，用于居家切换窗口服务器，但它正在变得越来越糟糕。如果你们能帮我的话。

so...this程序应该找到PDF文件，压缩它们，然后删除大于1mb的文件(在压缩文件之外)。

我认为问题是在如果文件大小的情况下。因此，当我将2个PDF文件放入目录(一个小于1mb，另一个大于1mb)时，不管我更改了多少次代码，结果如下：

1. 压缩所有文件，删除pdf文件(而不是那些在zip文件中)。
2. 压缩所有文件，删除更大的文件(而不是压缩文件中的文件)。
3. 压缩更大的文件，删除pdf文件(而不是压缩文件中的文件)。

这是我的密码：

#!/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中的文件，但我认为概念上的错误是在查找回调(= inside循环)中重新创建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;