Type de paramétrage avec un autre type en utilisant Type :: Tiny

Question

Je souhaite créer un type, basé sur la chaîne, qui aura une limite de longueur supérieure et, éventuellement, une limite de longueur inférieure. C'est-à-dire, type paramétré, où la plage de longueur serait un paramètre.
Ce que je veux dans ma mise en œuvre:

• un type distinct pour la gamme de longueur de la chaîne.
• Ne pas utiliser MooseX :: Types ::
• paramétrables Un sucre de paramétrisant type droit avec arrayref, pas hashref:
  • Ce: isa=>Varchar[1, 15]
  • Non ceci: isa=>Varchar[{min=>1, max=>15,}]

Voilà ce que j'ai jusqu'à présent:
Fichier 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; 

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

Ok, fonctionne VarcharRange. Maintenant, je dois ajouter Varchar lui-même. Et c'est là je suis coincé instantanément:
ajouté à 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; 
    }; 
}; 

Mon cerveau est en ébullition. J'ai mon ArrayRef prêt. Tout ce dont j'ai besoin est un objet VarcharRange (qui est fondamentalement un objet HashRef). Mais VarcharRange est un type - un ensemble de contraintes de nom et de règles de coercition. Cela ne correspond pas à un objet en soi. Les objets pour les types sont créés lorsque les attributs de classe sont créés, mais je n'ai aucune classe en jeu ici.

Answer 1

Voilà ce que j'ai fini avec. J'ai dû introduire une classe supplémentaire. Cela fonctionne, et je vais probablement arrêter ici.

classe pour une plage de longueur de la chaîne:

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; 

Type Paramétrable:

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; 

et un modèle test pour jouer avec:

#!/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

Ceci est une réponse que vous donne la possibilité pour donner des paramètres au type "Varchar". La magie qui permet les types paramétrés est de fournir un constraint_generator au type. Cette solution n'a pas le hashref intermédiaire, et il n'a qu'un seul type.

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; 

testeur

.pl:

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