Como faço para usar File :: Procurar :: Regra no modo mácula?

Question

Eu estou tentando obter uma lista de subdiretórios em um determinado diretório usando algo como o seguinte:

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

use File::Find::Rule;
use Data::Dumper;

my @subdirs = File::Find::Rule->maxdepth(1)->directory->relative->in('mydir');

print Dumper(@subdirs);

No entanto, executando o que dá o resultado:

Insecure dependency in chdir while running with -T switch

Eu entendo que File::Find tem opções para lidar com o modo de mancha, mas eu posso 't parecem encontrar um equivalente em File::Find::Rule . É possível fazer o acima? Devo usar um método alternativo para listando subdiretórios? Estou mal-entendido completamente algo óbvio que eu realmente deve entender sobre o modo de mancha?

Answer 1

(! Editar ) Ok, a lógica sugere que jogar a seguir funcionaria:

->extras( {untaint => 1, untaint_pattern => $untaint_pattern, untaint_skip => 1} )

Isso permite que você use os recursos de modo mancha de Arquivo :: Find passando argumentos diretamente para a função find() desse módulo. Aliás, File :: Find menciona que um deve definir $untaint_pattern usando o operador qr//. Por exemplo, o valor padrão é

$untaint_pattern = qr|^([-+@\w./]+)$|

No entanto , isso não funciona! Na verdade, o problema é um bug conhecido em File :: Find :: Regra. (Por exemplo, aqui estão os CPAN e Debian relatórios de bugs.) Se você gostaria de um bugfix, em seguida, ambos esses relatórios de erros têm patches.

Se você estiver em um ambiente restrito, uma coisa que você pode fazer é essencialmente implementar o patch-se em seu código. Por exemplo, se você quer manter tudo em um arquivo, você pode adicionar o bloco de código grande abaixo após use File::Find::Rule. Note que esta é uma solução muito rápida e pode ser abaixo do ideal. Se isso não funcionar para você (por exemplo, porque você tem espaços em seus nomes de arquivos), altere o qr|^([-+@\w./]+)$| padrão que é utilizado.

Note finalmente que, se você deseja que sua organização código para ser um pouco melhor, você pode querer despejar isso em um pacote separado, talvez chamado MyFileFindRuleFix ou algo assim, que você sempre use após si File::Find::Rule.

package File::Find::Rule;
no warnings qw(redefine);
sub in {
    my $self = _force_object shift;

    my @found;
    my $fragment = $self->_compile( $self->{subs} );
    my @subs = @{ $self->{subs} };

    warn "relative mode handed multiple paths - that's a bit silly\n"
      if $self->{relative} && @_ > 1;

    my $topdir;
    my $code = 'sub {
        (my $path = $File::Find::name)  =~ s#^(?:\./+)+##;
        $path = "." if ($path eq ""); # See Debian bug #329377
        my @args = ($_, $File::Find::dir, $path);
        my $maxdepth = $self->{maxdepth};
        my $mindepth = $self->{mindepth};
        my $relative = $self->{relative};

        # figure out the relative path and depth
        my $relpath = $File::Find::name;
        $relpath =~ s{^\Q$topdir\E/?}{};
        my $depth = scalar File::Spec->splitdir($relpath);
        #print "name: \'$File::Find::name\' ";
        #print "relpath: \'$relpath\' depth: $depth relative: $relative\n";

        defined $maxdepth && $depth >= $maxdepth
           and $File::Find::prune = 1;

        defined $mindepth && $depth < $mindepth
           and return;

        #print "Testing \'$_\'\n";

        my $discarded;
        return unless ' . $fragment . ';
        return if $discarded;
        if ($relative) {
            push @found, $relpath if $relpath ne "";
        }
        else {
            push @found, $path;
        }
    }';

    #use Data::Dumper;
    #print Dumper \@subs;
    #warn "Compiled sub: '$code'\n";

    my $sub = eval "$code" or die "compile error '$code' $@";
    my $cwd = getcwd;
    # Untaint it
    if ( $cwd =~ qr|^([-+@\w./]+)$| ) {
        $cwd = $1;
    } else {
        die "Couldn't untaint \$cwd: [$cwd]";
    }
    for my $path (@_) {
        # $topdir is used for relative and maxdepth
        $topdir = $path;
        # slice off the trailing slash if there is one (the
        # maxdepth/mindepth code is fussy)
        $topdir =~ s{/?$}{}
          unless $topdir eq '/';
        $self->_call_find( { %{ $self->{extras} }, wanted => $sub }, $path );
    }
    chdir $cwd;

    return @found;
}
use warnings;
package main;