perl – Path :: Class :: File或:: Dir&Moose初始化和强制

2023年8月31日 277次阅读

目前有：

package Local;
use warnings;
use Moose;
use Method::Signatures::Simple;
use Path::Class::File;
use Path::Class::Dir;

method _build_path_class {
    my $str = $self->pathstr;
    return Path::Class::Dir->new($str) if (-d $str);
    return Path::Class::File->new($str);
}

has 'pathstr' => (is => 'rw', isa => 'Str', required => 1);
has 'path'    => (
    is => 'rw',
    lazy => 1,
    #isa => 'Path::Class::File|Path::Class::Dir', #this didn't work
    isa => 'Object',
    builder => '_build_path_class',
);

no Moose;
__PACKAGE__->meta->make_immutable();
1;

它正在发挥作用

my $d = Local->new(pathstr => '/tmp')->path;        #is isa Path::Class::Dir
my $f = Local->new(pathstr => "/etc/passwd)->path;  #is isa Path::Class::File

寻找一个解决方案,而不是两个attribues pathtr和path将只是一个路径,它应该从Str强制到：

> Path :: Class :: Dir(如果Str是目录)
> Path :: Class :: File(在任何其他情况下)

就像是：

package Local;
use warnings;
use Moose;
use Method::Signatures::Simple;
use Path::Class::File;
use Path::Class::Dir;

#how to coerce conditionally from Str to
coerce 'Path::Class::Dir',
    from Str, via { Path::Class::Dir->new($_) }; #but only if the Str is pointing to directory

#or to
coerce 'Path::Class::Dir',
    from Str, via { Path::Class::Fiel->new($_) }; #in all other cases

has 'path' => (
    is => 'rw',
    lazy => 1,
    isa => 'Path::Class::File|Path::Class::Dir', #<--How to write this corectly
    required => 1,
    coerce => 1,
);

no Moose;
__PACKAGE__->meta->make_immutable();
1;

编辑,扩展了这个问题 – 因为得到了一个“不清楚是什么要求”的投票.希望现在更清楚了.

为了记录,池上的工作版本：

package Ike;
use warnings;
use namespace::sweep;
use Moose;
use Moose::Util::TypeConstraints;

class_type('Path::Class::Entity');

coerce 'Path::Class::Entity',
   from 'Str',
      via {
         if (-d $_) {
            Path::Class::Dir->new($_)
         } else {
            Path::Class::File->new($_)
         }
      };

has 'path' => (
    is       => 'rw',
    isa      => 'Path::Class::Entity',
    required => 1,
    coerce   => 1,
);

__PACKAGE__->meta->make_immutable;
1;

我的测试程序

#!/usr/bin/env perl
use strict;
use warnings;
use Path::Class;
use Test::More tests => 8;
use Ike;

my $temp = Path::Class::tempdir(CLEANUP => 1);  #create tempdir for testing

my $d1 = dir($temp, "d1");
my $d2 = dir($temp, "d2");
$d1->mkpath;                #create a directory d1
symlink("$d1", "$d2");      #symlink d2 -> d1

my $f1 = file($temp,'f1');
my $f2 = file($temp,'f2');
$f1->touch;                 #create a file f1
symlink("$f1", "$f2");      #symlink f2 -> f1

sub getpath { return Ike->new( path => shift )->path; }

isa_ok( getpath( $d1 ), 'Path::Class::Dir' );
isa_ok( getpath( $d2 ), 'Path::Class::Dir' );
isa_ok( getpath( $f1 ), 'Path::Class::File' );
isa_ok( getpath( $f2 ), 'Path::Class::File' );

isa_ok( getpath("$d1"), 'Path::Class::Dir' );
isa_ok( getpath("$d2"), 'Path::Class::Dir' );
isa_ok( getpath("$f1"), 'Path::Class::File' );
isa_ok( getpath("$f2"), 'Path::Class::File' );

结果：

1..8
ok 1 - An object of class 'Path::Class::Dir' isa 'Path::Class::Dir'
ok 2 - An object of class 'Path::Class::Dir' isa 'Path::Class::Dir'
ok 3 - An object of class 'Path::Class::File' isa 'Path::Class::File'
ok 4 - An object of class 'Path::Class::File' isa 'Path::Class::File'
ok 5 - An object of class 'Path::Class::Dir' isa 'Path::Class::Dir'
ok 6 - An object of class 'Path::Class::Dir' isa 'Path::Class::Dir'
ok 7 - An object of class 'Path::Class::File' isa 'Path::Class::File'
ok 8 - An object of class 'Path::Class::File' isa 'Path::Class::File'

🙂

最佳答案

coerce 'Path::Class::Entity',  # Base class of ::Dir and ::File
   from Str,
      via {
         if (-d $_) {
            Path::Class::Dir->new($_)
         } else {
            Path::Class::File->new($_)
         }
      };

has 'path' => (
    is       => 'rw',
    lazy     => 1,
    isa      => 'Path::Class::Entity',
    required => 1,
    coerce   => 1,
);

如果路径不存在或发生其他错误,则上述假定路径是文件的路径.

点赞