使用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