Perl Moose：仅在 BUILD 子例程中提及时才设置属性

Question

我正在构建一个脚本，它递归地构建目录的子目录/文件的名称以及这些子目录中的文件名称作为对象：

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;
}

不过，我的问题是，为什么我需要这样做？

Answer 1

问题是如果有斜线，你的模式就会失败。

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 启动速度非常慢，最适合长时间运行的进程，例如 Web 服务器。对于像 File 和 Dir 类这样通用的东西，可以考虑使用Moo。它主要与 Moose 兼容，速度更快，并且当与 Types::Standard 结合使用时，类型会更好。例如，最好创建一个 StrNotEmpty 类型来避免此类问题。

除非这是一个练习，否则 Perl 已经有一个很棒的模块来做这种事情。查看Path::Tiny。

Answer 2

带有lazy => 1 的属性仅在调用其访问器时创建，而不是在构造后创建。

Answer 3

只是一个旁注：

如果您无权访问其父目录，则您错误地声称该路径不存在。此外，如果您没有对其父目录的权限，则您错误地声称该目录的路径不是一个目录。

您还不必要地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\": $!");
   };

这也避免了代码中的race condition，避免检查和opendir之间的状态可能发生变化。