30 lines
682 B
Perl
30 lines
682 B
Perl
package BeastBB::Types;
|
|
|
|
use 5.30.3;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Exporter qw/import/;
|
|
use Scalar::Util qw/blessed/;
|
|
use Type::Tiny;
|
|
our @EXPORT_OK = qw( &IsClassTypeGenerator );
|
|
|
|
my %generated_classes;
|
|
|
|
sub IsClassTypeGenerator {
|
|
my $class = shift;
|
|
if ( !exists $generated_classes{$class} ) {
|
|
my $sanitized_class = $class =~ s/:://gr;
|
|
$generated_classes{$class} = Type::Tiny->new(
|
|
name => "Is$sanitized_class",
|
|
constraint => sub {
|
|
my $item_to_test = shift;
|
|
return 1 if blessed $item_to_test && $item_to_test->isa($class);
|
|
},
|
|
);
|
|
}
|
|
return $generated_classes{$class};
|
|
}
|
|
1;
|