如果文件存在于关闭的文件夹中，则从子文件夹中删除文件

Question

首先，我不是 perl 程序员，但我知道足够危险......

我购买了一个拍卖脚本，其中有脚本卖家拒绝处理的问题。

有一个auctiondata 文件夹，其中包含所有类别文件夹，包括物品出售时的关闭文件夹。当一个项目被发布时，它进入一个类别文件夹，当它出售时，它应该被移动到关闭的文件夹中，但是一个副本被移动到关闭的文件夹中，原始文件留在它的类别文件夹中。

这会导致软件错误，直到从类别文件夹中删除有问题的文件。

所以我想知道是否有人可以帮助我编写一个搜索所有类别文件夹的脚本，并且文件名与关闭文件夹中的文件匹配的任何文件都将被删除。

我自己尝试过，但都失败了。

buyit.pl页面上的代码如下...

############################################## 
# Sub: Close Auction now 
# This sets an item's status to closed. 

sub closebuyit { 
  if ($form{'CATEGORY'},$form{'ITEM'} ne $config{'closedir'}) { 
      if ($config{'closedir'}) {
          umask(000); # UNIX file permission junk 
          mkdir("$config{'basepath'}$config{'closedir'}", 0777) unless (-d "$config{'basepath'}$config{'closedir'}"); 
          print "Please notify the site admin that this item cannot be copied to the closed directory even though it is closed.\n" 
              unless &movefile("$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat", "$config{'basepath'}$config{'closedir'}/$form{'CATEGORY'}$form{'ITEM'}.dat"); 

          unlink("$config{'basepath'}askseller/$form{'ITEM'}.dat");
          unlink("$config{'basepath'}$config{'countdir'}/$form{'ITEM'}.dat");
      }
      else { 
          print "Please notify the site admin that this item cannot be removed even though it is closed.\n" unless unlink("$config{'basepath'}$form{'CATEGORY'}/$form{'ITEM'}.dat"); 
      }
   }
}

################################################
1;

这应该将文件从类别文件夹移动到关闭的文件夹，但没有。文件夹的权限是755，但是里面创建的文件是644。

提前感谢您的帮助！

Answer 1

您应该在两个 unlink 行中添加错误处理：

unlink("$config{'basepath'}askseller/$form{'ITEM'}.dat")
    or die "Error $! deleting $config{'basepath'}askseller/$form{'ITEM'}.dat";
unlink("$config{'basepath'}$config{'countdir'}/$form{'ITEM'}.dat")
    or die "Error $! deleting $config{'basepath'}$config{'countdir'}/$form{'ITEM'}.dat";

这会使您的脚本崩溃，但您会收到可能导致最终解决方案的确切错误消息。

这是一个清理脚本的开始：

#!/usr/bin/perl -l
use strict;
use warnings;

# Read the files from the closed directory
# Quick exit the script if no files could be found
opendir my $closed_dh,'/path/to/closed' or die "$! opening closed dir";
my %closed_files =
    # Use each file ($_) as key with a fixed value of 1
    (map { $_ => 1 } readdir($closed_dh)) or exit;
closedir $closed_dh;

# Loop through a list of directories
for my $dir ('/path/to/other_dir1','..dir2','..dirN') {
    opendir my $search_dh,$dir or die "$! opening $dir";
    # Loop through all files in one directory
    for my $file (readdir($search_dh)) {
        # Remove file if it exists in the list of closed files
        unlink $dir.'/'.$file or die "Error $! deleting $dir/$file"
            if $closed_files{$file};
    }
}

刚开始只是未经测试的来源。所有 Perl 命令都在 http://perldoc.perl.org/ 上找到，更多信息在 http://perlmaven.com 和 http://learn.perl.org 上

Answer 2

谢谢 Sebastian，我创建了一个测试文件 - move1.pl，这是里面的代码...

#!/usr/bin/perl -l
use strict;
use warnings;

# Read the files from the closed directory
# Quick exit the script if no files could be found
opendir my $closed_dh,'/home/users/web/b1262/moo.mybidszcom/cgi-bin/1/closed' or die "$! opening closed dir";
my %closed_files =
# Use each file ($_) as key with a fixed value of 1
(map { $_ => 1 } readdir($closed_dh)) or exit;
closedir $closed_dh;

# Loop through a list of directories
for my $dir ('/home/users/web/b1262/moo.mybidszcom/cgi-bin/1','..dir2','..dirN') {
opendir my $search_dh,$dir or die "$! opening $dir";
# Loop through all files in one directory
for my $file (readdir($search_dh)) {
    # Remove file if it exists in the list of closed files
    unlink $dir.'/'.$file or die "Error $! deleting $dir/$file"
        if $closed_files{$file};
    }
}

很遗憾，它不起作用，我在服务器日志中发现了这个错误。

0160429T101358：mybidsz.com/cgi-bin/move1.pl 错误是目录正在删除 /home/users/web/b1262/moo.mybidszcom/cgi-bin/1/。在 /home/users/web/b1262/moo.mybidszcom/cgi-bin/move1.pl 第 19 行。

如果文件夹 1 是 Antiques18 文件夹，则里面有一个名为 1463148060.dat 的文件。

文件夹 1 内是一个封闭文件夹，该文件夹内还有一个名为 1463148060.dat 的文件以及其他文件名。

我希望找到一个解决方案，然后将其合并到buyit.pl代码的末尾...