Perl Moose: Attribute only getting set when mentio

问题:

I've building a script that recursively builds the names of a directory's subdirectories/files and the names of the files in those subdirectories as objects:

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;

Notice the code has a files attribute which holds an array of File objects. A File has the following attributes:

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

The problem is that the name attribute never gets set when a File object is created. I'm not sure why.

EDIT 1: Solution (sort of) So, I slapped this into the File object to see if it triggered the creation of the attribute:

sub BUILD {
  my $self = shift;
}

This did not solve the problem. However, this did:

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

The question I have, though, is why did I need to do this?

回答1:

The problem is your pattern is failing if there's a trailing slash.

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

If $self->path is /some/thing it works. If it's /some/thing/ it "works" but [^\/]* happily matches an empty string. So you get no warning.

You can put in an optional slash, and change it to match ONE or more non-slashes. Also by using alternative delimiters we can clean up all those leaning toothpicks.

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

But really one shouldn't be parsing paths with regular expressions. Use one of the many built in modules like File::Basename or File::Spec

return basename($self->path);

---

Some side notes.

Moose is very slow to start up and is best suited for long running processes like web servers. For something as generic as a File and Dir class, consider using Moo. It's mostly compatible with Moose, much faster, and when used in conjunction with Types::Standard, does types better. It would be good, for example, to make a StrNotEmpty type to avoid this sort of problem.

Unless this is an exercise, Perl already has a great module to do this sort of thing. Look into Path::Tiny.

回答2:

Attributes with lazy => 1 are only created when their accessor is called, not after construction.

回答3:

Just a side note:

You incorrectly claim a path doesn't exist if you have no permission to its parent dir. Also, you incorrectly claim a path to a directory isn't one if you have no permission to its parent dir.

You also needlessly stat the file twice. In fact, you needn't stat the file at all since opendir is already making the checks you are making.

Simply replace

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': $!";

with

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

This also avoids the race condition in your code, the possibility that the state of things might change between the checks and the opendir.