Perl Moose:在BUILD子例程中提到的属性仅被设置

时间:2017-02-04 00:52:19

标签: perl moose

我正在构建一个脚本,以递归方式构建目录子目录/文件的名称,并将这些子目录中的文件名称作为对象:

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 个答案:

答案 0 :(得分:2)

问题是如果有斜杠,你的模式会失败。

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

如果$self->path/some/thing则有效。如果它是/some/thing/它“有效”但[^\/]*高兴地匹配一个空字符串。所以你没有得到警告。

您可以输入一个可选的斜杠,并将其更改为匹配一个或多个非斜杠。另外,通过使用替代分隔符,我们可以清理所有那些倾斜的牙签。

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

但实际上不应该用正则表达式解析路径。使用众多内置模块之一,例如File::BasenameFile::Spec

return basename($self->path);

一些旁注。

Moose启动速度非常慢,最适合Web服务器等长时间运行的进程。对于像File和Dir类一样通用的东西,请考虑使用Moo。它主要与Moose兼容,速度更快,与Types::Standard结合使用时,类型更好。例如,制作一个StrNotEmpty类型可以避免这种问题。

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

答案 1 :(得分:2)

lazy => 1的属性仅在调用其访问者时创建,而不是在构造之后创建。

答案 2 :(得分:2)

只是旁注:

如果您对其父目录没有权限,则您错误地声明路径不存在。此外,如果您没有对其父目录的权限,则错误地声明目录的路径不是一个。

你也不必要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之间状态可能发生变化的可能性。