Как получить список листовых подкаталогов в корневой папке на Perl - PullRequest
Новая
       59

Как получить список листовых подкаталогов в корневой папке на Perl

1 голос
/ 18 ноября 2011

Я очень новичок в Perl (скриптовые языки в целом), и мне было интересно, как использовать Perl для получения списка всех листовых каталогов в Perl. Например, допустим, мой корневой каталог - C: 

C: -> I have folder "A" and "B" and files a.txt and b.txt

Folder "A" -> I have folder "D" and file c.html
Folder "B" -> I have folder "E" and "F" and file d.html 
Folder "D", "E" and "F" -> bunch of text files

Как получить несколько путей к каталогам в качестве вывода для этого сценария: 

C:\A\D\
C:\B\E\
C:\B\F\

Как видите, я просто хочу список всех возможных листовых каталогов. Я не хочу, чтобы C: \ A \ и C: \ B \ появлялись. После того, как я сам выполнил некоторые исследования, я заметил, что я могу каким-то образом использовать модуль File :: Find в Perl, но я также не уверен на 100%, что делать дальше.

Спасибо за любую помощь, которую вы можете оказать:)

Ответы [ 3 ]

1 голос
/ 18 ноября 2011

Другой подход: 

use strict;
use warnings;
use feature qw( say );

use File::Find::Rule qw( );
use Path::Class      qw( dir );

my $root = dir('.')->absolute();

my @dirs = File::Find::Rule->directory->in($root);
shift(@dirs);

my @leaf_dirs;
if (@dirs) {
   my $last = shift(@dirs);
   for (@dirs) {
      push @leaf_dirs, $last if !/^\Q$last/;
      $last = $_ . "/";
   }
   push @leaf_dirs, $last;
}

say for @leaf_dirs;
1 голос
/ 18 ноября 2011

Или с использованием опции find preprocess: 

use strict;
use warnings;
use File::Find;

find({  wanted    =>sub{1}, # required--in version 5.8.4 at least
        preprocess=>sub{    # @_ is files in current directory
            @_ = grep { -d && !/\.{1,2}$/ } @_;
            print "$File::Find::dir\n" unless @_;
            return @_;
        }
    }, ".");
0 голосов
/ 18 ноября 2011

Из ответа на вопрос Как получить последние подкаталоги с помощью liverpole на Perlmonks :

печатает все листовые каталоги в текущем каталоге (см. "./"): 

use strict;
use warnings;

my $h_dirs = terminal_subdirs("./");
my @dirs   = sort keys %$h_dirs;
print "Terminal Directories:\n", join("\n", @dirs);

sub terminal_subdirs {
    my ($top, $h_results) = @_;
    $h_results ||= { };
    opendir(my $dh, $top) or die "Arrggghhhh -- can't open '$top' ($!)\n";
    my @files = readdir($dh);
    closedir $dh;
    my $nsubdirs = 0;
    foreach my $fn (@files) {
        next if ($fn eq '.' or $fn eq '..');
        my $full = "$top/$fn";
        if (!-l $full and -d $full) {
            ++$nsubdirs;
            terminal_subdirs($full, $h_results);
        }
    }

    $nsubdirs or $h_results->{$top} = 1;
    return $h_results;
}
...