Perl: Как искать файл с именем «.cfg» в каталоге и во всех его родительских каталогах

#perl

Вопрос:

Как искать файл с именем «.cfg» в каталоге и во всех его родительских каталогах я выбираю имя, как показано ниже, но я хотел бы знать, есть ли лучший способ сделать это. Также я хотел бы знать рекурсивный способ сделать то же самое.

 sub get_p4_config_updir($ $)
{
  my ($client_root, $cfg_file) = @_;
  # Dir from where search starts - it's a client root here
  my $cur_dir = $client_root;
  printf("**** cur_dir: $cur_dir ****n");
  my $slashes = $cur_dir =~ y////;
  printf("**** no of back slashes: $slashes ****n");
  while($slashes > 2) {
     my ($parent_dir, $b) = $cur_dir =~ /(.*)/(.*)/;
     printf("**** parent_dir: $parent_dir, b: $b ****n");
     $slashes--;
     if (-e "$cur_dir/$cfg_file") {
        printf("**** File exists in dir: $cur_dir ****n");
        return $cur_dir;
     }
     $cur_dir = $parent_dir;
  }
  return "";
}

my $cfg = '.cfg';
my $dir = '/user/home/wkspace/abc/def/MAIN';
my $path = get_p4_config_updir($dir, $cfg);
if ($path ne "") {
  printf("**** File exists in dir: $path ****n");
} else {
  printf("**** File not found ****n");
}

 

Комментарии:

1. return $dir_root/$cfg_file — Чтобы прояснить проблему, Perl рассматривает это как сумму деления.

2. $cur_dir == $parent_dir — Это почти всегда будет попыткой. Вам нужно использовать eq вместо == сравнения строк.

3. Вместо того, чтобы манипулировать путями с помощью регулярных выражений, было бы намного проще, если бы вы делали это с помощью Path::Tiny (или даже более старого файла::Spec )!

Ответ №1:

Пример использования Path::Tiny :

 #!/usr/bin/env perl
use warnings;
use strict;
use feature qw/say/;
use Path::Tiny;

# Returns a Path::Tiny object to the directory containing the file
# being looked for, or undef if not found.
sub get_p4_config_updir {
    my ($client_root, $cfg_file) = @_;
    my $dir = path($client_root)->realpath;
    while (1) {
        # say "Looking at $dir";
        if ($dir->child($cfg_file)->exists) {
            return $dir;
        } elsif ($dir->is_rootdir) {
            return undef;
        } else {
            $dir = $dir->parent;
        }
    }
}

my $cfg = '.cfg';
my $dir = '/user/home/wkspace/abc/def/MAIN';
say get_p4_config_updir($dir, $cfg) // "File not found";
 

Или версия, которая похожа на идею @rajashekar о том, чтобы обойти дерево каталогов, используя chdir его для получения родительского каталога каждого каталога. Он используется File::chdir , что позволяет вам local вносить изменения в текущий рабочий каталог (и восстанавливать исходный, когда функция/область действия завершается), а также обеспечивает удобное представление массива текущего каталога и его родителей, которыми можно управлять:

 use File::chdir;

...

sub get_p4_config_updir {
    my ($client_root, $cfg_file) = @_;
    local $CWD = $client_root; # Magic happens here
    while (1) {
        # say "Looking at $CWD";
        if (-e $cfg_file) {
            return $CWD;
        } elsif ($CWD eq "/") {
            return undef;
        } else {
            pop @CWD; # CDs to the next parent directory
        }
    }
}
 

Ответ №2:

Вы можете использовать основные библиотеки, чтобы сделать это независимым от платформы, читаемым способом, без необходимости использовать cwd и, возможно, вызывать эффекты действия на расстоянии в остальной части вашего кода:

 #!/usr/bin/env perl

use strict;
use warnings;

use File::Spec::Functions qw(catfile rel2abs updir);

sub get_p4_config_updir
{
    my ($dir, $file) = @_;
    $dir = rel2abs($dir);

    do {
        my $path = catfile $dir => $file;
        return $dir if -e $path;

        return if $dir eq (my $new_dir = rel2abs(catfile $dir, updir));
        $dir = $new_dir;
    } while ('NOT_DONE');

    return;
}

sub main {
    my ($cfg, $dir) = @_;

    my $path = get_p4_config_updir($dir, $cfg);

    if (defined $path) {
        printf("Found '%s' in '%s'n", $cfg, $path);
    }
    else {
        printf(
            "Did not find '%s' in '%s' or any of its parent directoriesn",
            $cfg,
            $dir,
        );
    }
}

main(@ARGV);
 

Выход:

 C:UsersuAppDataLocalTemp> perl p.pl linux.bin .
Found 'linux.bin' in 'C:'
 

Ответ №3:

Зачем иметь дело с именами путей, когда вы можете просмотреть структуру каталогов .. ?

  • если файл существует в текущем каталоге, верните его.
  • в противном случае поднимитесь .. и повторите процесс.
 use Cwd qw(cwd);

sub search_up {
  my ($dir, $file) = @_;
  chdir($dir);

  while (1) {
    if (-e $file) {
      print "$file exists in $dirn";
      return $dir;
    } elsif ($dir eq "/") {
      return;
    } else {
      chdir("..");
      $dir = cwd;
    }
  };
}
 

Комментарии:

1. не могу выполнить «chdir» и «cwd», так как я буду выполнять этот фрагмент кода полностью из какой-либо другой рабочей области или каталога.

2. Почему нет? Вы можете сохранить начальный рабочий каталог и восстановить его при выходе, если ваш сценарий является частью более крупной программы.

Ответ №4:

Пожалуйста, посмотрите, соответствует ли следующий фрагмент кода вашим требованиям.

Скрипт ищет файл конфигурации в корне файловой системы, найденные имена файлов хранятся в массиве @found .

 use strict;
use warnings;
use feature 'say';

my $dir = '/user/home/wkspace/abc/def/MAIN';
my $ext = 'cfg';

my($cwd,@found);

for( split('/',$dir) ) {
        $cwd .= "$_/";
        push @found, glob( $cwd . "*.$ext" );
}

if( @found ) {
        say for @found;
} else {
        say 'No file(s) was found';
}

exit 0;
 

Следующий фрагмент кода ищет файлы конфигурации вдали от корневой файловой системы, начиная с $dir .

Если какие-либо файлы будут найдены, они будут сохранены под ссылкой на массив $found , а затем распечатаны на терминале.

Если файлы не будут найдены, вам будет сообщено об этом сообщением.

 use strict;
use warnings;
use feature 'say';

my $dir = '/user/home/wkspace/abc/def/MAIN';
my $ext = 'cfg';

my $found = find($dir,$ext);

if( $found ) {
    say for @$found;
} else {
    say 'No file(s) was found';
}

exit 0;

sub find {
    my $dir = shift;
    my $ext = shift;
    my $ret;
    
    for( glob("$dir/*") ) {
        push @$ret, $_ if /.$extz/;
        if( -d ) {
            my $found = find($_,$ext);
            push @$ret, @$found if $found;  
        }
    }
    
    return $ret;
}