Perl Moose: атрибут устанавливается только когда упоминается в подпрограмме BUILD

У меня есть сценарий, который рекурсивно создает имена подкаталогов / файлов каталога и имена файлов в этих подкаталогах в виде объектов:

package Dir;
use Moose;
use Modern::Perl;
use File;
use strict;
use warnings;

has 'path' => (is => 'ro', isa => 'Str', required => 1); 
has 'name' => (is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; my ($name) = $self->path =~ /\/([^\/]*)$/; return $name; } );
has 'subdirs' => (is => 'rw', isa => 'ArrayRef[Dir]' );  
has 'files' => (is => 'rw', isa => 'ArrayRef[File]' );  
has 'num_dirs' => (is => 'ro', isa => 'Int', lazy => 1, default => sub { my $self = shift; scalar @{$self->subdirs}; } );


sub BUILD {
  my $self = shift;
  my $path = $self->path;

  # run some tests
  logf('Path to the directory does not exist.')             if (!-e $path);
  logf('The path should point to a directory, not a file.') if (!-d $path);

  # populate subdirs attribute with Dir objects
  opendir my $dh, $path or die "Can't opendir '$path': $!";

  # Get files and dirs and separate them out into categories
  my @dirs_and_files = grep { ! m{^\.$|^\.\.$} } readdir $dh;
  closedir $dh or die "Can't closedir '$path': $!";
  my @subdir_names        = grep { -d "$path/$_" } grep { !m{^\.}  } @dirs_and_files;
  my @file_names          = grep { -f "$path/$_" } grep { !m{^\.}  } @dirs_and_files;

  # Create objects
  my @dir_objects =          map { Dir->new  ( path => $path . '/' . $_ ) } @subdir_names;
  my @file_objects =         map { File->new ( path => $path . '/' . $_ ) } @file_names;

  # Populate this with file and directory objects
  $self->subdirs             ( \@dir_objects );
  $self->files               ( \@file_objects );
}

1;

Обратите внимание, что код имеет files атрибут, который содержит массив File объекты. File имеет следующие атрибуты:

has 'path' => (is => 'ro', isa => 'Str', required => 1); 
has 'name' => (is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; my ($name) = $self->path =~ /\/([^\/]*)$/; return $name; } );

Проблема в том, что name атрибут никогда не устанавливается, когда File объект создан. Я не уверен почему.

РЕДАКТИРОВАТЬ 1: Решение (вроде) Итак, я ударил это в File объект, чтобы увидеть, вызвало ли это создание атрибута:

sub BUILD {
  my $self = shift;
}

Это не решило проблему. Тем не менее, это сделал:

sub BUILD {
  my $self = shift;
  $self->name;
}

У меня вопрос, однако, почему я должен был это сделать?

Источник

3 ответа

Атрибуты с lazy => 1 создаются только когда вызывается их метод доступа, а не после создания.

Источник

Просто примечание:

Вы неправильно утверждаете, что путь не существует, если у вас нет разрешения на родительский каталог. Кроме того, вы неправильно утверждаете, что путь к каталогу не тот, если у вас нет разрешения на его родительский каталог.

Вы также без необходимости stat файл дважды. На самом деле, вам не нужно stat файл вообще с тех пор opendir уже делает проверки, которые вы делаете.

Просто замени

logf('Path to the directory does not exist.')             if (!-e $path);
logf('The path should point to a directory, not a file.') if (!-d $path);

opendir my $dh, $path or die "Can't opendir '$path': $!";

с

opendir(my $dh, $path)
   or do {
      logf("Can't open directory \"$path\": $!");
      die("Can't open directory \"$path\": $!");
   };

Это также позволяет избежать состояния гонки в вашем коде, вероятность того, что положение вещей может измениться между проверками и opendir,

Источник

Проблема в том, что ваш паттерн не работает, если есть косая черта.

my ($name) = $self->path =~ /\/([^\/]*)$/;

Если $self->path является /some/thing оно работает. Если это /some/thing/ это "работает", но [^\/]* счастливо совпадает с пустой строкой Так что вы не получите предупреждение.

Вы можете добавить дополнительную косую черту и изменить ее так, чтобы она соответствовала ОДНОЙ или нескольким не косым чертам. Также, используя альтернативные разделители, мы можем очистить все эти зубочистки.

my ($name) = $self->path =~ m{/ ([^/]+) /? $}x;

Но на самом деле не следует разбирать пути с помощью регулярных выражений. Используйте один из множества встроенных модулей, таких как File:: Basename или File:: Spec.

return basename($self->path);

Некоторые примечания стороны.

Moose очень медленно запускается и лучше всего подходит для длительных процессов, таких как веб-серверы. Для чего-то общего, такого как класс File и Dir, рассмотрите возможность использования Moo. Он в основном совместим с Moose, гораздо быстрее, и при использовании вместе с Types:: Standard делает типы лучше. Например, было бы хорошо создать тип StrNotEmpty, чтобы избежать подобных проблем.

Если это не упражнение, в Perl уже есть отличный модуль для подобных вещей. Посмотрите в Path:: Tiny.

Источник
Другие вопросы по тегам