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

Question

目前拥有:

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 

寻找一个解决方案，而不是两个属性 pathstr和 path将只有一个 path a 它应该从 Str 强制到:

Path::Class::Dir(如果 Str 是一个目录)

路径::类::文件(在任何其他情况下)

就像是:

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'

:)

Answer 1

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

如果路径不存在或发生另一个错误，则上面假设路径是文件的路径。