Почему я не могу удалить этот пустой каталог в Perl?

Question

Я преобразование Линукса скрипта http://www.perlmonks.org/index.pl?node_id=217166 конкретно это:

#!/usr/bin/perl -w 
use strict; 
use Getopt::Std; 
use File::Find; 

@ARGV > 0 and getopts('a:', \my %opt) or die << "USAGE"; 
# Deletes any old files from the directory tree(s) given and 
# removes empty directories en passant. 
usage: $0 [-a maxage] directory [directory ...] 
     -a maximum age in days, default is 120 
USAGE 

my $max_age_days = $opt{a} || 120; 

find({ 
    wanted => sub { unlink if -f $_ and -M _ > $max_age_days }, 
    postprocess => sub { rmdir $File::Find::dir }, 
}, @ARGV); 

моя попытка:

#!/usr/bin/perl -w 
use strict; 
use Getopt::Std; 
use File::Find; 


@ARGV > 0 and getopts('a:', \my %opt) or die << "USAGE"; 
# Deletes any old files from the directory tree(s) given and 
# removes empty directories en passant. 
usage: $0 [-a maxage] directory [directory ...] 
     -a maximum age in days, default is 120 
USAGE 

my $max_age_days = $opt{a} || 120; 

find({ 
    wanted => sub { unlink if -f $_ and -M _ > $max_age_days }, 
# postprocess => sub { rmdir $File::Find::dir }, 
    postprocess => sub { 
         my $expr = "$File::Find::dir"; 
         $expr =~ s/\//\\/g;  # replace/with \ 
         print "rmdir $expr\n"; 
         `rmdir $expr`; 
         }, 
}, @ARGV); 

Однако я получаю сообщение об ошибке, когда скрипт пытается удалить каталог говоря, что каталог находится в использование другим процессом (когда это не так). Есть идеи? Я запускаю сценарий на 64-разрядной версии Windows Server 2003 с пакетом обновления 2 (SP2) с помощью ActiveState 5.10.

Спасибо!

Answer 1

Из этого documentation

постобработки

Значение должно быть ссылка на код. Он вызывается непосредственно перед , оставляя обработанный в настоящее время каталог. Он называется in void контекстом без аргументов. Имя текущего каталога находится в $ Файл :: Найти :: dir. Этот крючок удобен для подведения итогов каталога, например , расчета его использования на диске. Когда действуют или follow_fast действуют, postprocess - это не-op.

Это означает, что ваш собственный код по-прежнему использует каталог при попытке его удалить. Попробуйте создать список имен и повторить это после вызова, чтобы найти.

Другим возможным решением является использование опции no_chdir, чтобы избежать поиска каталогов, которые вы хотите удалить.

EDIT: Этот комментарий также актуален, поэтому я продвигаю его тело главного ответа в:

Чтобы добавить к этому: проблема здесь в том, что на Linux можно удалять файлы и каталоги, в использовании, на окнах нельзя. Вот почему он не работает без изменений. - Leon Timmermans

Answer 2

Всего несколько нот:

1. Вам не нужно переворачивать/к \. Perl понимает, что/является разделителем каталогов, даже в Windows.
2. rmdir - это встроенный Perl, вам не нужно называть его обратными окнами.

Answer 3

Версия perlmonks использует метод Perl «rmdir» для удаления. Ваша версия порождает подоболочку с backquotes. Поэтому вполне возможно, что сообщение верное: каталог все еще используется Perl, когда rmdir пытается его использовать.

Answer 4

Спасибо за все ваши ответы. Мой окончательный сценарий выглядит так:

#!/usr/bin/perl -w 
use strict; 
use warnings; 
use Getopt::Std; 
use File::Find; 
use Win32::OLE; 

@ARGV > 0 and getopts('a:', \my %opt) or die << "USAGE"; 
Deletes any old files from the directory tree(s) given and 
removes empty directories en passant. 
usage: $0 [-a maxage] directory [directory ...] 
     -a maximum age in days, default is 30 
USAGE 

my $max_age_days = $opt{a} || 30; 
my @dir_list = undef; 

find({ 
    wanted => sub { if (-f $_ and -M _ > $max_age_days) { 
     unlink $_ or LogError ("$0: Could not delete $_ ($!)")}}, 
    postprocess => sub {push(@dir_list,$File::Find::dir)}, 
}, @ARGV); 

if (@dir_list) {foreach my $thisdir (@dir_list) { rmdir $thisdir if defined ($thisdir)}} 

############ 
sub LogError { 
    my ($strDescr) = @_; 
    use constant EVENT_SUCCESS => 0; 
    use constant EVENT_ERROR => 1; 
    use constant EVENT_WARNING => 3; 
    use constant EVENT_INFO => 4; 

    my $objWSHShell = Win32::OLE->new('WScript.Shell'); 
    $objWSHShell->LogEvent(EVENT_ERROR, $strDescr); 
} 

Кажется, отлично работает - можете ли вы придумать какой-либо способ его улучшить?