使用Type :: Tiny的另一种类型的参数化类型

Question

我想创建一个基于字符串的类型，它具有较高的长度限制，以及 - 可选的 - 较低的长度限制。即，参数化类型，其中长度范围将是参数。
我在执行中想要什么：

• 字符串长度范围的单独类型。
• 不使用MooseX ::种类::参数化
• 参数化的直线与数组引用类型的糖，而不是hashref：
  • 此：isa=>Varchar[1, 15]
  • 不是这个：isa=>Varchar[{min=>1, max=>15,}]

这就是我到目前为止：
文件MyTypesTiny.pm

package MyTypesTiny; 

use strict; 
use warnings; 

use Type::Library 
    -base, 
    -declare => qw(VarcharRange Varchar); 

use Type::Utils -all; 
use Types::Standard -types; 
use MooseX::Types::Common::Numeric qw(PositiveOrZeroInt); 

declare VarcharRange, 
    as HashRef [PositiveOrZeroInt], 
    where { 
    return 0 if (grep { $_ ne 'min' && $_ ne 'max' } keys %{$_}); 
    return ($_->{min} <= $_->{max}) 
     if (defined $_->{max} && defined $_->{min}); 
    return 1; 
    }, message { "$_" }; 

coerce VarcharRange, from ArrayRef [PositiveOrZeroInt], via { 
    my $result; 
    my @keys = qw(min max); 
    foreach my $val (reverse @$_) { 
     my $key = pop @keys // 'bad_range'; 
     $result->{$key} = $val; 
    } 
    return $result; 
}; 

1; 

文件test_varchar.pl

#!/usr/bin/env perl 

package MyClass; 

use Moose; 
use MyTypesTiny qw(VarcharRange); 

has 'my_range' => (isa=>VarcharRange, is=>'ro', coerce=>1); 

package main; 
use MyClass; 

my $check = MyClass->new( 
    my_range => [1, 15],  # works, as expected 
    # my_range => [1, 0], # fails, as expected 
    # my_range => [0, 1, 2], # fails, as expected 
); 

好吧，VarcharRange工作。 现在我必须添加Varchar本身。而这也正是我得到瞬间探出：
加入MyTypesTiny.pm：

declare Varchar, as Str, where {}, constraint_generator => sub { 
    # here I have @_ which is an ArrayRef 
    # and I want to create a VarcharRange object $range from it 
    # but what exactly should I do? 
    return sub { 
     my $len = length($_); 
     return 0 if ($range->{min} && $len < $range->{min}); 
     return 0 if ($range->{max} && $len > $range->{max}); 
     return 1; 
    }; 
}; 

我的大脑沸腾。我准备好了ArrayRef。我需要的是一个VarcharRange（它基本上是一个HashRef）对象。但是VarcharRange是一种类型 - 一种标记约束和强制规则集合的名称。它本身不对应于一个对象。对象类型是在创建类属性时创建的，但我在这里没有任何类。

Answer 1

这就是我最终的结果。必须引入额外的课程。它有效，我可能会在这里停下来。

类的字符串长度范围：

package VarcharRange; 

use strict; 
use warnings; 
use Moose; 
use Moose::Util::TypeConstraints; 

subtype 'AuxRange', as 'HashRef[Int]', where { 
    foreach my $range_id (keys %{$_}) { 
     return 0 if ($range_id ne 'min' && $range_id ne 'max'); 
     return 0 if ($_->{$range_id} < 0); 
    } 
    return ($_->{min} <= $_->{max}) 
     if (defined $_->{max} && defined $_->{min}); 
    return 1; 
}, message { 
    'invalid VarcharRange' 
}; 

coerce 'AuxRange', from 'ArrayRef[Int]', via { 
    my $result; 
    my @keys = qw(min max); 
    foreach my $val (reverse @$_) { 
     my $key = pop @keys // 'bad_range'; 
     $result->{$key} = $val; 
    } 
    return $result; 
}; 

has range => (
    isa  => 'AuxRange', 
    traits => ['Hash'], 
    coerce => 1, 
    handles => { 
     'max' => [ get => 'max' ], 
     'min' => [ get => 'min' ], 
    }, 
); 

1; 

参数化类型：

package MyTypesTiny; 

use strict; 
use warnings; 

use Type::Library 
    -base, 
    -declare => qw(Varchar); 

use Type::Utils -all; 
use Types::Standard -types; 

use VarcharRange; 

declare Varchar, as Str, where { 
    1; 
}, inline_as { 
    my ($constraint, $varname) = @_; 
    return $constraint->parent->inline_check($varname); 
}, constraint_generator => sub { 
    my $range = VarcharRange->new(range => \@_); 
    return sub { 
     my $len = length($_); 
     return 0 if ($range->min() && $len < $range->min()); 
     return 0 if ($range->max() && $len > $range->max()); 
     return 1; 
    }; 
}, inline_generator => sub { 
    my $range = VarcharRange->new(range => \@_); 
    return sub { 
     my ($constraint, $varname) = @_; 
     my $check_line; 
     $check_line .= "length('$varname') >= $range->min()" 
      if ($range->min()); 
     if ($range->max()) { 
      $check_line .= ' && ' if ($range->min()); 
      $check_line .= "length('$varname') <= $range->max()"; 
     } 
     return $check_line; 
    }; 
}; 

1; 

和测试模板一起玩：

#!/usr/bin/env perl 

package MyClass; 

use Moose; 
use MyTypesTiny qw(Varchar); 

# Varchar  means no length limitation 
# Varchar[1, 1] means min length is 1, max is 1 
# Varchar[15] means min length is 0, max is 15 
# Varchar[1, 15] means min length is 1, max is 15 

# put your parametrization here 
has 'my_string' => (isa => Varchar [ 9, 10 ], is => 'ro'); 

package main; 
use MyClass; 

# put your test string here 
my $check = MyClass->new(my_string => 'ASDef45F%',); 

Answer 2

这是一个答案，让你的能力给“Varchar”类型提供参数。启用参数化类型的魔法是为类型提供constraint_generator。该解决方案没有中间hashref，只有一种类型。

MyTypesTiny.pm：

package MyTypesTiny; 

use Types::Standard -all; 
use Type::Library -base, -declare => qw(Varchar); 
use Type::Utils -all; 

sub _get_varchar_args { 
    die "can only give 0-2 parameters" if @_ > 2; 
    map assert_Int($_), @_; 
    return @_ == 1 ? (0, @_) : @_; 
} 

declare "Varchar", 
    as Str, 
    constraint_generator => sub { 
    my ($min_length, $max_length) = _get_varchar_args(@_); 
    return sub { 
     length($_) >= $min_length and length($_) <= $max_length; 
    }; 
    }, 
    inline_generator => sub { 
    my ($min_length, $max_length) = _get_varchar_args(@_); 
    return sub { 
     my ($constraint, $varname) = @_; 
     return sprintf(
     'length(%s) >= %d and length(%s) <= %d', 
     $varname, 
     $min_length, 
     $varname, 
     $max_length, 
    ); 
    }; 
    }; 

1; 

MyClass.pm：

package MyClass; 

use Moo; 
use MyTypesTiny -all; 

has my_string => (
    is => 'ro', 
    isa => Varchar[9, 10], 
); 

1; 

测试仪。pl：

#!perl 
use MyClass; 
my $check = MyClass->new(my_string => 'ASDef45F%'); # length 9, ok 
$check = MyClass->new(my_string => 'f45F%'); # length 5, not ok