Parametrierung Typ mit einem anderen Typ mit Type :: Tiny

Question

Ich möchte einen Typ, basierend auf der Zeichenfolge, die obere Längengrenze und - optional - untere Längengrenze haben. Das heißt, ein parametrisierter Typ, bei dem der Längenbereich ein Parameter wäre.
Was ich in meiner Implementierung will:

• Ein separater Typ für Streichlängenbereich.
• Nicht mit MooseX :: Typen :: parametrierbare
• Ein Zucker von der Art gerade mit ArrayRef Parametrisierung, hashref NICHT:
  • Dies: isa=>Varchar[1, 15]
  • Nicht dies: isa=>Varchar[{min=>1, max=>15,}]

Das habe ich bisher:
Datei 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; 

Datei 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, arbeitet VarcharRange. Jetzt muss ich Varchar selbst hinzufügen. Und das ist, wo ich sofort stecken:
hinzugefügt 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; 
    }; 
}; 

Mein Gehirn kocht. Ich habe meine ArrayRef bereit. Alles, was ich brauche, ist ein VarcharRange (was im Grunde ein HashRef-Objekt ist), das daraus gemacht werden soll. Aber VarcharRange ist ein Typ - ein Namenskennzeichnungssatz von Zwangsbedingungen und Zwangsregeln. Es entspricht nicht einem Objekt an sich. Objekte für Typen werden erstellt, wenn Klassenattribute erstellt werden, aber ich habe hier keine Klasse im Spiel.

Answer 1

Das ist, was ich endete. Musste eine zusätzliche Klasse einführen. Es funktioniert, und ich werde wahrscheinlich hier aufhören.

Klasse für Streichlängenbereich:

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; 

parametrierbare Typ:

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; 

und Testvorlage spielen mit:

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

Dies ist eine Antwort, die Ihnen die Möglichkeit gibt, um dem Typ "Varchar" Parameter zu geben. Die Magie, die parametrisierte Typen ermöglicht, ist die Bereitstellung einer constraint_generator an den Typ. Diese Lösung verfügt nicht über die Zwischen-Hashref und hat nur einen Typ.

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; 

Tester.pl:

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