Specio-0.33/0000775000175000017500000000000013041701062012515 5ustar autarchautarchSpecio-0.33/lib/0000775000175000017500000000000013041701062013263 5ustar autarchautarchSpecio-0.33/lib/Specio/0000775000175000017500000000000013041701062014505 5ustar autarchautarchSpecio-0.33/lib/Specio/Registry.pm0000644000175000017500000000420113041701062016646 0ustar autarchautarchpackage Specio::Registry; use strict; use warnings; use parent 'Exporter'; our $VERSION = '0.33'; use Carp qw( confess croak ); our @EXPORT_OK = qw( exportable_types_for_package internal_types_for_package register ); my %Registry; sub register { confess 'register requires three or four arguments (package, name, type, [exportable])' unless @_ == 3 || @_ == 4; my $package = shift; my $name = shift; my $type = shift; my $exportable = shift; croak "The $package package already has a type named $name" if $Registry{$package}{internal}{$name}; # This is structured so that we can always return a _reference_ for # *_types_for_package. This means that the generated t sub sees any # changes to the registry as they happen. This is important inside a # package that is declaring new types. It needs to be able to see types it # has declared. $Registry{$package}{internal}{$name} = $type; $Registry{$package}{exportable}{$name} = $type if $exportable; return; } sub exportable_types_for_package { my $package = shift; return $Registry{$package}{exportable} ||= {}; } sub internal_types_for_package { my $package = shift; return $Registry{$package}{internal} ||= {}; } 1; # ABSTRACT: Implements the per-package type registry __END__ =pod =encoding UTF-8 =head1 NAME Specio::Registry - Implements the per-package type registry =head1 VERSION version 0.33 =head1 DESCRIPTION There's nothing public here. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Exporter.pm0000644000175000017500000000505213041701062016653 0ustar autarchautarchpackage Specio::Exporter; use strict; use warnings; our $VERSION = '0.33'; use Specio::Helpers qw( install_t_sub ); use Specio::Registry qw( exportable_types_for_package internal_types_for_package register ); sub import { my $package = shift; my $reexport = shift; my $caller = caller(); my $exported = exportable_types_for_package($package); while ( my ( $name, $type ) = each %{$exported} ) { register( $caller, $name, $type->clone, $reexport ); } install_t_sub( $caller, internal_types_for_package($caller), ); } 1; # ABSTRACT: Base class for type libraries __END__ =pod =encoding UTF-8 =head1 NAME Specio::Exporter - Base class for type libraries =head1 VERSION version 0.33 =head1 SYNOPSIS package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; declare( ... ); # more types here package MyApp::Foo; use MyApp::Type::Library =head1 DESCRIPTION Inheriting from this package makes your package a type exporter. By default, types defined in a package are never visible outside of the package. When you inherit from this package, all the types you define internally become available via exports. The exported types are available through the importing package's C subroutine. By default, types your package imports are not re-exported: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; In this case, the types provided by L are not exported to packages which C. You can explicitly ask for types to be re-exported: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins -reexport; In this case, packages which C will get all the types from L as well as any types defined in C. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Helpers.pm0000644000175000017500000000600513041701062016444 0ustar autarchautarchpackage Specio::Helpers; use strict; use warnings; use Carp qw( croak ); use Exporter 'import'; use overload (); our $VERSION = '0.33'; use Scalar::Util qw( blessed ); our @EXPORT_OK = qw( install_t_sub is_class_loaded _STRINGLIKE ); sub install_t_sub { # Specio::DeclaredAt use Specio::OO, which in turn uses # Specio::Helpers. If we load this with "use" we get a cirular require and # a big mess. require Specio::DeclaredAt; my $caller = shift; my $types = shift; # XXX - check to see if their t() is something else entirely? return if $caller->can('t'); my $t = sub { my $name = shift; croak 'The t subroutine requires a single non-empty string argument' unless _STRINGLIKE($name); croak "There is no type named $name available for the $caller package" unless exists $types->{$name}; my $found = $types->{$name}; return $found unless @_; my %p = @_; croak 'Cannot parameterize a non-parameterizable type' unless $found->can('parameterize'); return $found->parameterize( declared_at => Specio::DeclaredAt->new_from_caller(1), %p, ); }; { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; no warnings 'redefine'; *{ $caller . '::t' } = $t; } return; } ## no critic (Subroutines::ProhibitSubroutinePrototypes, Subroutines::ProhibitExplicitReturnUndef) sub _STRINGLIKE ($) { return $_[0] if _STRING( $_[0] ); return $_[0] if blessed $_[0] && overload::Method( $_[0], q{""} ) && length "$_[0]"; return undef; } # Borrowed from Params::Util sub _STRING ($) { return defined $_[0] && !ref $_[0] && length( $_[0] ) ? $_[0] : undef; } # Borrowed from Types::Standard sub is_class_loaded { my $stash = do { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; \%{ $_[0] . '::' }; }; return 1 if exists $stash->{ISA}; return 1 if exists $stash->{VERSION}; foreach my $globref ( values %{$stash} ) { return 1 if *{$globref}{CODE}; } return 0; } 1; # ABSTRACT: Helper subs for the Specio distro __END__ =pod =encoding UTF-8 =head1 NAME Specio::Helpers - Helper subs for the Specio distro =head1 VERSION version 0.33 =head1 DESCRIPTION There's nothing public here. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/OO.pm0000644000175000017500000002167513041701062015371 0ustar autarchautarchpackage Specio::OO; use strict; use warnings; use B qw( perlstring ); use Carp qw( confess ); use Eval::Closure qw( eval_closure ); use List::Util qw( all ); use MRO::Compat; use Role::Tiny; use Scalar::Util qw( blessed weaken ); use Specio::PartialDump qw( partial_dump ); use Specio::TypeChecks qw( does_role is_ArrayRef is_ClassName is_CodeRef is_HashRef is_Int is_Str isa_class ); use Storable qw( dclone ); our $VERSION = '0.33'; use Exporter qw( import ); ## no critic (Modules::ProhibitAutomaticExportation) our @EXPORT = qw( clone _ooify ); ## use critic ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _ooify { my $class = shift; my $attrs = $class->_attrs; for my $name ( sort keys %{$attrs} ) { my $attr = $attrs->{$name}; _inline_reader( $class, $name, $attr ); _inline_predicate( $class, $name, $attr ); } _inline_constructor($class); } ## use critic sub _inline_reader { my $class = shift; my $name = shift; my $attr = shift; my $reader; if ( $attr->{lazy} && ( my $builder = $attr->{builder} ) ) { $reader = "sub { \$_[0]->{$name} ||= \$_[0]->$builder; }"; } else { $reader = "sub { \$_[0]->{$name} }"; } { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; *{ $class . '::' . $name } = eval_closure( source => $reader, description => $class . '->' . $name, ); } } sub _inline_predicate { my $class = shift; my $name = shift; my $attr = shift; return unless $attr->{predicate}; my $predicate = "sub { exists \$_[0]->{$name} }"; { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; *{ $class . '::' . $attr->{predicate} } = eval_closure( source => $predicate, description => $class . '->' . $attr->{predicate}, ); } } my @RolesWithBUILD = qw( Specio::Constraint::Role::Interface ); sub _inline_constructor { my $class = shift; my @build_subs; for my $class ( @{ mro::get_linear_isa($class) } ) { { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; push @build_subs, $class . '::BUILD' if defined &{ $class . '::BUILD' }; } } # This is all a hack to avoid needing Class::Method::Modifiers to add a # BUILD from a role. We can't just call the method in the role "BUILD" or # it will be shadowed by a class's BUILD. So we give it a wacky unique # name. We need to explicitly know which roles have a _X_BUILD method # because Role::Tiny doesn't provide a way to list all the roles applied # to a class. for my $role (@RolesWithBUILD) { if ( Role::Tiny::does_role( $class, $role ) ) { ( my $build_name = $role ) =~ s/::/_/g; $build_name = q{_} . $build_name . '_BUILD'; push @build_subs, $role . '::' . $build_name; } } my $constructor = <<'EOF'; sub { my $class = shift; my %p = do { if ( @_ == 1 ) { if ( ref $_[0] eq 'HASH' ) { %{ shift() }; } else { Specio::OO::_constructor_confess( Specio::OO::_bad_args_message( $class, @_ ) ); } } else { Specio::OO::_constructor_confess( Specio::OO::_bad_args_message( $class, @_ ) ) if @_ % 2; @_; } }; my $self = bless {}, $class; EOF my $attrs = $class->_attrs; for my $name ( sort keys %{$attrs} ) { my $attr = $attrs->{$name}; my $key_name = defined $attr->{init_arg} ? $attr->{init_arg} : $name; if ( $attr->{required} ) { $constructor .= <<"EOF"; Specio::OO::_constructor_confess( "$class->new requires a $key_name argument.") unless exists \$p{$key_name}; EOF } if ( $attr->{builder} && !$attr->{lazy} ) { my $builder = $attr->{builder}; $constructor .= <<"EOF"; \$p{$key_name} = $class->$builder unless exists \$p{$key_name}; EOF } if ( $attr->{isa} ) { my $validator; if ( Specio::TypeChecks->can( 'is_' . $attr->{isa} ) ) { $validator = 'Specio::TypeChecks::is_' . $attr->{isa} . "( \$p{$key_name} )"; } else { my $quoted_class = perlstring( $attr->{isa} ); $validator = "Specio::TypeChecks::isa_class( \$p{$key_name}, $quoted_class )"; } $constructor .= <<"EOF"; if ( exists \$p{$key_name} && !$validator ) { Carp::confess( Specio::OO::_bad_value_message( "The value you provided to $class->new for $key_name is not a valid $attr->{isa}.", \$p{$key_name}, ) ); } EOF } if ( $attr->{does} ) { my $quoted_role = perlstring( $attr->{does} ); $constructor .= <<"EOF"; if ( exists \$p{$key_name} && !Specio::TypeChecks::does_role( \$p{$key_name}, $quoted_role ) ) { Carp::confess( Specio::OO::_bad_value_message( "The value you provided to $class->new for $key_name does not do the $attr->{does} role.", \$p{$key_name}, ) ); } EOF } if ( $attr->{weak_ref} ) { $constructor .= " Scalar::Util::weaken( \$p{$key_name} );\n"; } $constructor .= " \$self->{$name} = \$p{$key_name} if exists \$p{$key_name};\n"; $constructor .= "\n"; } $constructor .= ' $self->' . $_ . "(\\%p);\n" for @build_subs; $constructor .= <<'EOF'; return $self; } EOF { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; *{ $class . '::new' } = eval_closure( source => $constructor, description => $class . '->new', ); } } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _constructor_confess { local $Carp::CarpLevel = $Carp::CarpLevel + 1; confess shift; } sub _bad_args_message { my $class = shift; return "$class->new requires either a hashref or hash as arguments. You passed " . partial_dump(@_); } sub _bad_value_message { my $message = shift; my $value = shift; return $message . ' You passed ' . partial_dump($value); } ## use critic sub clone { my $self = shift; # Attributes which provide a clone method are cloned by calling that # method on the _clone_ (not the original). This is primarily to allow us # to clone the coercions contained by a type in a way that doesn't lead to # circular clone (type clones coercions which in turn need to clone their # to/from types which in turn ...). my $attrs = $self->_attrs; my %special = map { $_ => $attrs->{$_}{clone} } grep { $attrs->{$_}{clone} } keys %{$attrs}; my $new; for my $key ( keys %{$self} ) { my $value = $self->{$key}; if ( $special{$key} ) { $new->{$key} = $value; next; } # We need to special case arrays and hashes of Specio objects, as they # may contain code refs which cannot be cloned with dclone. if ( ( ref $value eq 'ARRAY' ) && all { ( blessed($_) || q{} ) =~ /Specio/ } @{$value} ) { $new->{$key} = [ map { $_->clone } @{$value} ]; next; } $new->{$key} = blessed $value ? $value->clone : ( ref $value eq 'CODE' ) ? $value : ref $value ? dclone($value) : $value; } bless $new, ( ref $self ); for my $key ( keys %special ) { my $method = $special{$key}; $new->{$key} = $new->$method; } return $new; } 1; # ABSTRACT: A painfully poor reimplementation of Moo(se) __END__ =pod =encoding UTF-8 =head1 NAME Specio::OO - A painfully poor reimplementation of Moo(se) =head1 VERSION version 0.33 =head1 DESCRIPTION Specio can't depend on Moo or Moose, so this module provides a terrible reimplementation of a small slice of their features. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Coercion.pm0000644000175000017500000002017413041701062016606 0ustar autarchautarchpackage Specio::Coercion; use strict; use warnings; our $VERSION = '0.33'; use Specio::OO; use Role::Tiny::With; use Specio::Role::Inlinable; with 'Specio::Role::Inlinable'; { ## no critic (Subroutines::ProtectPrivateSubs) my $role_attrs = Specio::Role::Inlinable::_attrs(); ## use critic my $attrs = { %{$role_attrs}, from => { does => 'Specio::Constraint::Role::Interface', required => 1, }, to => { does => 'Specio::Constraint::Role::Interface', required => 1, weak_ref => 1, }, _coercion => { isa => 'CodeRef', predicate => '_has_coercion', init_arg => 'coercion', }, _optimized_coercion => { isa => 'CodeRef', init_arg => undef, lazy => 1, builder => '_build_optimized_coercion', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub BUILD { my $self = shift; die 'A type coercion should have either a coercion or inline_generator parameter, not both' if $self->_has_coercion && $self->_has_inline_generator; die 'A type coercion must have either a coercion or inline_generator parameter' unless $self->_has_coercion || $self->_has_inline_generator; return; } sub coerce { my $self = shift; my $value = shift; return $self->_optimized_coercion->($value); } sub inline_coercion { my $self = shift; return $self->_inline_generator->( $self, @_ ); } sub _build_optimized_coercion { my $self = shift; if ( $self->_has_inline_generator ) { return $self->_generated_inline_sub; } else { return $self->_coercion; } } sub can_be_inlined { my $self = shift; return $self->_has_inline_generator && $self->from->can_be_inlined; } sub _build_description { my $self = shift; my $from_name = defined $self->from->name ? $self->from->name : 'anonymous type'; my $to_name = defined $self->to->name ? $self->to->name : 'anonymous type'; my $desc = "coercion from $from_name to $to_name"; $desc .= q{ } . $self->declared_at->description; return $desc; } sub clone_with_new_to { my $self = shift; my $new_to = shift; my $from = $self->from; local $self->{from} = undef; local $self->{to} = undef; my $clone = $self->clone; $clone->{from} = $from; $clone->{to} = $new_to; return $clone; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class representing a coercion from one type to another __END__ =pod =encoding UTF-8 =head1 NAME Specio::Coercion - A class representing a coercion from one type to another =head1 VERSION version 0.33 =head1 SYNOPSIS my $coercion = $type->coercion_from_type('Int'); my $new_value = $coercion->coerce_value(42); if ( $coercion->can_be_inlined() ) { my $code = $coercion->inline_coercion('$_[0]'); } =head1 DESCRIPTION This class represents a coercion from one type to another. Internally, a coercion is a piece of code that takes a value of one type returns a new value of a new type. For example, a coercion from c to C might round a number to its nearest integer and return that integer. Coercions can be implemented either as a simple subroutine reference or as an inline generator subroutine. Using an inline generator is faster but more complicated. =for Pod::Coverage BUILD clone_with_new_to =head1 API This class provides the following methods. =head2 Specio::Coercion->new( ... ) This method creates a new coercion object. It accepts the following named parameters: =over 4 =item * from => $type The type this coercion is from. The type must be an object which does the L interface. This parameter is required. =item * to => $type The type this coercion is to. The type must be an object which does the L interface. This parameter is required. =item * coercion => sub { ... } A subroutine reference implementing the coercion. It will be called as a method on the object and passed a single argument, the value to coerce. It should return the new value. This parameter is mutually exclusive with C. Either this parameter or the C parameter is required. You can also pass this option with the key C in the parameter list. =item * inline_generator => sub { ... } This should be a subroutine reference which returns a string containing a single term. This code should I end in a semicolon. This code should implement the coercion. The generator will be called as a method on the coercion with a single argument. That argument is the name of the variable being coerced, something like C<'$_[0]'> or C<'$var'>. This parameter is mutually exclusive with C. Either this parameter or the C parameter is required. You can also pass this option with the key C in the parameter list. =item * inline_environment => {} This should be a hash reference of variable names (with sigils) and values for that variable. The values should be I to the values of the variables. This environment will be used when compiling the coercion as part of a subroutine. The named variables will be captured as closures in the generated subroutine, using L. It should be very rare to need to set this in the constructor. It's more likely that a special coercion subclass would need to provide values that it generates internally. This parameter defaults to an empty hash reference. =item * declared_at => $declared_at This parameter must be a L object. This parameter is required. =back =head2 $coercion->from(), $coercion->to(), $coercion->declared_at() These methods are all read-only attribute accessors for the corresponding attribute. =head2 $coercion->description This returns a string describing the coercion. This includes the names of the to and from type and where the coercion was declared, so you end up with something like C<'coercion from Foo to Bar declared in package My::Lib (lib/My/Lib.pm) at line 42'>. =head2 $coercion->coerce($value) Given a value of the right "from" type, returns a new value of the "to" type. This method does not actually check that the types of given or return values. =head2 $coercion->inline_coercion($var) Given a variable name like C<'$_[0]'> this returns a string with code for the coercion. Note that this method will die if the coercion does not have an inline generator. =head2 $coercion->can_be_inlined() This returns true if the coercion has an inline generator I the constraint it is from can be inlined. This exists primarily for the benefit of the C method for type constraint object. =head2 $coercion->inline_environment() This returns a hash defining the variables that need to be closed over when inlining the coercion. The keys are full variable names like C<'$foo'> or C<'@bar'>. The values are I to a variable of the matching type. =head2 $coercion->clone() Returns a clone of this object. =head2 $coercion->clone_with_new_to($new_to_type) This returns a clone of the coercion, replacing the "to" type with a new one. This is intended for use when the to type itself is being cloned as part of importing that type. We need to make sure the newly cloned coercion has the newly cloned type as well. =head1 ROLES This class does the L role. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/0000775000175000017500000000000013041701062016631 5ustar autarchautarchSpecio-0.33/lib/Specio/Constraint/Enum.pm0000644000175000017500000000635413041701062020101 0ustar autarchautarchpackage Specio::Constraint::Enum; use strict; use warnings; our $VERSION = '0.33'; use B (); use Role::Tiny::With; use Scalar::Util qw( refaddr ); use Specio::Library::Builtins; use Specio::OO; use Storable qw( dclone ); use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = dclone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( parent _inline_generator )) { $attrs->{$name}{init_arg} = undef; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } $attrs->{values} = { isa => 'ArrayRef', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } { my $Str = t('Str'); sub _build_parent {$Str} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', $val, $self->_env_var_name, $val ); ( !ref( %s ) && $%s{ %s } ) EOF }; sub _build_inline_generator {$_inline_generator} } sub _build_inline_environment { my $self = shift; my %values = map { $_ => 1 } @{ $self->values }; return { '%' . $self->_env_var_name => \%values }; } sub _env_var_name { my $self = shift; return '_Specio_Constraint_Enum_' . refaddr($self); } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require a string matching one of a set of values __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Enum - A class for constraints which require a string matching one of a set of values =head1 VERSION version 0.33 =head1 SYNOPSIS my $type = Specio::Constraint::Enum->new(...); print $_, "\n" for @{ $type->values }; =head1 DESCRIPTION This is a specialized type constraint class for types which require a string that matches one of a list of values. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::Enum->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. Finally, this class requires an additional parameter, C. This must be a an arrayref of valid strings for the type. =head2 $enum->values Returns an array reference of valid values for the type. =head1 ROLES This class does the L and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/ObjectDoes.pm0000644000175000017500000000504613041701062021213 0ustar autarchautarchpackage Specio::Constraint::ObjectDoes; use strict; use warnings; our $VERSION = '0.33'; use B (); use Role::Tiny::With; use Scalar::Util (); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::DoesType; with 'Specio::Constraint::Role::DoesType'; { my $Object = t('Object'); sub _build_parent {$Object} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', ($val) x 3, B::perlstring( $self->role ) ); ( Scalar::Util::blessed( %s ) && %s->can('does') && %s->does(%s) ) EOF }; sub _build_inline_generator {$_inline_generator} } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require an object that does a specific role __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::ObjectDoes - A class for constraints which require an object that does a specific role =head1 VERSION version 0.33 =head1 SYNOPSIS my $type = Specio::Constraint::ObjectDoes->new(...); print $type->role; =head1 DESCRIPTION This is a specialized type constraint class for types which require an object that does a specific role. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::ObjectDoes->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be a single role name. =head2 $object_isa->role Returns the role name passed to the constructor. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/AnyDoes.pm0000644000175000017500000000524213041701062020532 0ustar autarchautarchpackage Specio::Constraint::AnyDoes; use strict; use warnings; our $VERSION = '0.33'; use B (); use Role::Tiny::With; use Scalar::Util (); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::DoesType; with 'Specio::Constraint::Role::DoesType'; { my $Defined = t('Defined'); sub _build_parent {$Defined} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', ($val) x 4, B::perlstring( $self->role ) ); ( ( Scalar::Util::blessed( %s ) || ( !ref( %s ) ) ) && %s->can('does') && %s->does(%s) ) EOF }; sub _build_inline_generator {$_inline_generator} } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require a class name or an object that does a specific role __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::AnyDoes - A class for constraints which require a class name or an object that does a specific role =head1 VERSION version 0.33 =head1 SYNOPSIS my $type = Specio::Constraint::AnyDoes->new(...); print $type->role; =head1 DESCRIPTION This is a specialized type constraint class for types which require a class name or an object that does a specific role. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::AnyDoes->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be a single role name. =head2 $any_isa->role Returns the role name passed to the constructor. =head1 ROLES This class does the L, L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/ObjectIsa.pm0000644000175000017500000000503313041701062021031 0ustar autarchautarchpackage Specio::Constraint::ObjectIsa; use strict; use warnings; our $VERSION = '0.33'; use B (); use Role::Tiny::With; use Scalar::Util (); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::IsaType; with 'Specio::Constraint::Role::IsaType'; { my $Object = t('Object'); sub _build_parent {$Object} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', $val, $val, B::perlstring( $self->class ) ); ( Scalar::Util::blessed( %s ) && %s->isa(%s) ) EOF }; sub _build_inline_generator {$_inline_generator} } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require an object that inherits from a specific class __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::ObjectIsa - A class for constraints which require an object that inherits from a specific class =head1 VERSION version 0.33 =head1 SYNOPSIS my $type = Specio::Constraint::ObjectIsa->new(...); print $type->class; =head1 DESCRIPTION This is a specialized type constraint class for types which require an object that inherits from a specific class. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::ObjectIsa->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be a single class name. =head2 $object_isa->class Returns the class name passed to the constructor. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/Intersection.pm0000644000175000017500000001031413041701062021632 0ustar autarchautarchpackage Specio::Constraint::Intersection; use strict; use warnings; our $VERSION = '0.33'; use List::Util qw( all ); use Role::Tiny::With; use Specio::OO; use Storable qw( dclone ); use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = dclone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( _constraint _inline_generator )) { delete $attrs->{$name}{predicate}; $attrs->{$name}{init_arg} = undef; $attrs->{$name}{lazy} = 1; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } delete $attrs->{parent}; delete $attrs->{name}{predicate}; $attrs->{name}{lazy} = 1; $attrs->{name}{builder} = '_build_name'; $attrs->{of} = { isa => 'ArrayRef', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub parent {undef} ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _has_parent {0} sub _has_name { my $self = shift; return defined $self->name; } sub _build_name { my $self = shift; return unless all { $_->_has_name } @{ $self->of }; return join q{ & }, map { $_->name } @{ $self->of }; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _has_constraint { my $self = shift; return !$self->_has_inline_generator; } ## use critic sub _build_constraint { return $_[0]->_optimized_constraint; } sub _build_optimized_constraint { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) my @c = map { $_->_optimized_constraint } @{ $self->of }; return sub { return all { $_->( $_[0] ) } @c; }; } sub _has_inline_generator { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) return all { $_->_has_inline_generator } @{ $self->of }; } sub _build_inline_generator { my $self = shift; return sub { return '(' . ( join q{ && }, map { sprintf( '( %s )', $_->_inline_generator->( $_, $_[1] ) ) } @{ $self->of } ) . ')'; } } sub _build_inline_environment { my $self = shift; my %env; for my $type ( @{ $self->of } ) { %env = ( %env, %{ $type->inline_environment }, ); } return \%env; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for intersection constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Intersection - A class for intersection constraints =head1 VERSION version 0.33 =head1 SYNOPSIS my $type = Specio::Constraint::Untion->new(...); =head1 DESCRIPTION This is a specialized type constraint class for intersections, which will allow a value which matches each one of several distinct types. =for Pod::Coverage parent =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::Intersection->new( ... ) The C parameter is ignored if it passed, as it is always C The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. Finally, this class requires an additional parameter, C. This must be an arrayref of type objects. =head2 $union->of Returns an array reference of the individual types which makes up this intersection. =head1 ROLES This class does the L and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/Parameterized.pm0000644000175000017500000000636513041701062021773 0ustar autarchautarchpackage Specio::Constraint::Parameterized; use strict; use warnings; our $VERSION = '0.33'; use Role::Tiny::With; use Specio::OO; use Storable qw( dclone ); use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = dclone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic $attrs->{parent}{isa} = 'Specio::Constraint::Parameterizable'; $attrs->{parent}{required} = 1; delete $attrs->{name}{predicate}; $attrs->{name}{lazy} = 1; $attrs->{name}{builder} = '_build_name'; $attrs->{parameter} = { does => 'Specio::Constraint::Role::Interface', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub _has_name { my $self = shift; return defined $self->name; } sub _build_name { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) return unless $self->parent->_has_name && $self->parameter->_has_name; return $self->parent->name . '[' . $self->parameter->name . ']'; } sub can_be_inlined { my $self = shift; return $self->_has_inline_generator && $self->parameter->can_be_inlined; } # Moose compatibility methods - these exist as a temporary hack to make Specio # work with Moose. sub type_parameter { shift->parameter; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class which represents parameterized constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Parameterized - A class which represents parameterized constraints =head1 VERSION version 0.33 =head1 SYNOPSIS my $arrayref = t('ArrayRef'); my $arrayref_of_int = $arrayref->parameterize( of => t('Int') ); my $parent = $arrayref_of_int->parent; # returns ArrayRef my $parameter = $arrayref_of_int->parameter; # returns Int =head1 DESCRIPTION This class implements the API for parameterized types. =for Pod::Coverage can_be_inlined type_parameter =head1 API This class implements the same API as L, with a few additions. =head2 Specio::Constraint::Parameterized->new(...) This class's constructor accepts two additional parameters: =over 4 =item * parent This should be the L object from which this object was created. This parameter is required. =item * parameter This is the type parameter for the parameterized type. This must be an object which does the L role. This parameter is required. =back =head2 $type->parameter Returns the type that was passed to the constructor. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/Union.pm0000644000175000017500000001023613041701062020257 0ustar autarchautarchpackage Specio::Constraint::Union; use strict; use warnings; our $VERSION = '0.33'; use List::Util qw( all any ); use Role::Tiny::With; use Specio::OO; use Storable qw( dclone ); use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = dclone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( _constraint _inline_generator )) { delete $attrs->{$name}{predicate}; $attrs->{$name}{init_arg} = undef; $attrs->{$name}{lazy} = 1; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } delete $attrs->{parent}; delete $attrs->{name}{predicate}; $attrs->{name}{lazy} = 1; $attrs->{name}{builder} = '_build_name'; $attrs->{of} = { isa => 'ArrayRef', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub parent {undef} ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _has_parent {0} sub _has_name { my $self = shift; return defined $self->name; } sub _build_name { my $self = shift; return unless all { $_->_has_name } @{ $self->of }; return join q{ | }, map { $_->name } @{ $self->of }; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _has_constraint { my $self = shift; return !$self->_has_inline_generator; } ## use critic sub _build_constraint { return $_[0]->_optimized_constraint; } sub _build_optimized_constraint { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) my @c = map { $_->_optimized_constraint } @{ $self->of }; return sub { return any { $_->( $_[0] ) } @c; }; } sub _has_inline_generator { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) return all { $_->_has_inline_generator } @{ $self->of }; } sub _build_inline_generator { my $self = shift; return sub { return '(' . ( join q{ || }, map { sprintf( '( %s )', $_->_inline_generator->( $_, $_[1] ) ) } @{ $self->of } ) . ')'; } } sub _build_inline_environment { my $self = shift; my %env; for my $type ( @{ $self->of } ) { %env = ( %env, %{ $type->inline_environment }, ); } return \%env; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for union constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Union - A class for union constraints =head1 VERSION version 0.33 =head1 SYNOPSIS my $type = Specio::Constraint::Untion->new(...); =head1 DESCRIPTION This is a specialized type constraint class for unions, which will allow a value which matches any one of several distinct types. =for Pod::Coverage parent =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::Union->new( ... ) The C parameter is ignored if it passed, as it is always C The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. Finally, this class requires an additional parameter, C. This must be an arrayref of type objects. =head2 $union->of Returns an array reference of the individual types which makes up this union. =head1 ROLES This class does the L and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/AnyCan.pm0000644000175000017500000000607513041701062020346 0ustar autarchautarchpackage Specio::Constraint::AnyCan; use strict; use warnings; our $VERSION = '0.33'; use B (); use List::Util 1.33 (); use Role::Tiny::With; use Scalar::Util (); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::CanType; with 'Specio::Constraint::Role::CanType'; { my $Defined = t('Defined'); sub _build_parent {$Defined} } { my $_inline_generator = sub { my $self = shift; my $val = shift; my $methods = join ', ', map { B::perlstring($_) } @{ $self->methods }; return sprintf( <<'EOF', $val, $methods ); ( do { # We need to assign this since if it's something like $_[0] then # inside the all block @_ gets redefined and we can no longer get at # the value. my $v = %s; ( Scalar::Util::blessed($v) || ( !ref($v) ) ) && List::Util::all { $v->can($_) } %s; } ) EOF }; sub _build_inline_generator {$_inline_generator} } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require a class name or object with a set of methods __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::AnyCan - A class for constraints which require a class name or object with a set of methods =head1 VERSION version 0.33 =head1 SYNOPSIS my $type = Specio::Constraint::AnyCan->new(...); print $_, "\n" for @{ $type->methods }; =head1 DESCRIPTION This is a specialized type constraint class for types which require a class name or object with a defined set of methods. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::AnyCan->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be an array reference of method names which the constraint requires. You can also pass a single string and it will be converted to an array reference internally. =head2 $any_can->methods Returns an array reference containing the methods this constraint requires. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/Role/0000775000175000017500000000000013041701062017532 5ustar autarchautarchSpecio-0.33/lib/Specio/Constraint/Role/Interface.pm0000644000175000017500000003514413041701062021775 0ustar autarchautarchpackage Specio::Constraint::Role::Interface; use strict; use warnings; our $VERSION = '0.33'; use Carp qw( confess ); use Eval::Closure qw( eval_closure ); use List::Util 1.33 qw( all any first ); use Specio::Exception; use Specio::PartialDump qw( partial_dump ); use Specio::TypeChecks qw( is_CodeRef ); use Role::Tiny 1.003003; use Specio::Role::Inlinable; with 'Specio::Role::Inlinable'; use overload( q{""} => sub { $_[0] }, '&{}' => '_subify', 'bool' => sub {1}, ); { ## no critic (Subroutines::ProtectPrivateSubs) my $role_attrs = Specio::Role::Inlinable::_attrs(); ## use critic my $attrs = { %{$role_attrs}, name => { isa => 'Str', predicate => '_has_name', }, parent => { does => 'Specio::Constraint::Role::Interface', predicate => '_has_parent', }, _constraint => { isa => 'CodeRef', init_arg => 'constraint', predicate => '_has_constraint', }, _optimized_constraint => { isa => 'CodeRef', init_arg => undef, lazy => 1, builder => '_build_optimized_constraint', }, _ancestors => { isa => 'ArrayRef', init_arg => undef, lazy => 1, builder => '_build_ancestors', }, _message_generator => { isa => 'CodeRef', init_arg => undef, }, _coercions => { builder => '_build_coercions', clone => '_clone_coercions', }, # Because types are cloned on import, we can't directly compare type # objects. Because type names can be reused between packages (no global # registry) we can't compare types based on name either. _signature => { isa => 'Str', init_arg => undef, lazy => 1, builder => '_build_signature', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } my $NullConstraint = sub {1}; # See Specio::OO to see how this is used. ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _Specio_Constraint_Role_Interface_BUILD { my $self = shift; my $p = shift; unless ( $self->_has_constraint || $self->_has_inline_generator ) { $self->{_constraint} = $NullConstraint; } die 'A type constraint should have either a constraint or inline_generator parameter, not both' if $self->_has_constraint && $self->_has_inline_generator; $self->{_message_generator} = $self->_wrap_message_generator( $p->{message_generator} ); return; } ## use critic sub _wrap_message_generator { my $self = shift; my $generator = shift; unless ( defined $generator ) { $generator = sub { my $description = shift; my $value = shift; return "Validation failed for $description with value " . partial_dump($value); }; } my $d = $self->description; return sub { $generator->( $d, @_ ) }; } sub coercions { values %{ $_[0]->{_coercions} } } sub coercion_from_type { $_[0]->{_coercions}{ $_[1] } } sub _has_coercion_from_type { exists $_[0]->{_coercions}{ $_[1] } } sub _add_coercion { $_[0]->{_coercions}{ $_[1] } = $_[2] } sub has_coercions { scalar keys %{ $_[0]->{_coercions} } } sub validate_or_die { my $self = shift; my $value = shift; return if $self->value_is_valid($value); Specio::Exception->throw( message => $self->_message_generator->($value), type => $self, value => $value, ); } sub value_is_valid { my $self = shift; my $value = shift; return $self->_optimized_constraint->($value); } sub _ancestors_and_self { my $self = shift; return ( ( reverse @{ $self->_ancestors } ), $self ); } sub is_a_type_of { my $self = shift; my $type = shift; return any { $_->_signature eq $type->_signature } $self->_ancestors_and_self; } sub is_same_type_as { my $self = shift; my $type = shift; return $self->_signature eq $type->_signature; } sub is_anon { my $self = shift; return !$self->_has_name; } sub has_real_constraint { my $self = shift; return ( $self->_has_constraint && $self->_constraint ne $NullConstraint ) || $self->_has_inline_generator; } sub can_be_inlined { my $self = shift; return 1 if $self->_has_inline_generator; return 0 if $self->_has_constraint && $self->_constraint ne $NullConstraint; # If this type is an empty subtype of an inlinable parent, then we can # inline this type as well. return 1 if $self->_has_parent && $self->parent->can_be_inlined; return 0; } sub _build_generated_inline_sub { my $self = shift; my $type = $self->_self_or_first_inlinable_ancestor; my $source = 'sub { ' . $type->_inline_generator->( $type, '$_[0]' ) . '}'; return eval_closure( source => $source, environment => $type->inline_environment, description => 'inlined sub for ' . $self->description, ); } sub _self_or_first_inlinable_ancestor { my $self = shift; my $type = first { $_->_has_inline_generator } reverse $self->_ancestors_and_self; # This should never happen because ->can_be_inlined should always be # checked before this builder is called. die 'Cannot generate an inline sub' unless $type; return $type; } sub _build_optimized_constraint { my $self = shift; if ( $self->can_be_inlined ) { return $self->_generated_inline_sub; } else { return $self->_constraint_with_parents; } } sub _constraint_with_parents { my $self = shift; my @constraints; for my $type ( $self->_ancestors_and_self ) { next unless $type->has_real_constraint; # If a type can be inlined, we can use that and discard all of the # ancestors we've seen so far, since we can assume that the inlined # constraint does all of the ancestor checks in addition to its own. if ( $type->can_be_inlined ) { @constraints = $type->_generated_inline_sub; } else { push @constraints, $type->_constraint; } } return $NullConstraint unless @constraints; return sub { all { $_->( $_[0] ) } @constraints; }; } # This is only used for identifying from types as part of coercions, but I # want to leave open the possibility of using something other than # _description in the future. sub id { my $self = shift; return $self->description; } sub add_coercion { my $self = shift; my $coercion = shift; my $from_id = $coercion->from->id; confess "Cannot add two coercions fom the same type: $from_id" if $self->_has_coercion_from_type($from_id); $self->_add_coercion( $from_id => $coercion ); return; } sub has_coercion_from_type { my $self = shift; my $type = shift; return $self->_has_coercion_from_type( $type->id ); } sub coerce_value { my $self = shift; my $value = shift; for my $coercion ( $self->coercions ) { next unless $coercion->from->value_is_valid($value); return $coercion->coerce($value); } return $value; } sub can_inline_coercion_and_check { my $self = shift; return all { $_->can_be_inlined } $self, $self->coercions; } sub inline_coercion_and_check { my $self = shift; die 'Cannot inline coercion and check' unless $self->can_inline_coercion_and_check; my %env; my $arg_name = $_[0]; my $source = 'do {'; if ( $self->has_coercions ) { $source .= 'my $value = ' . $arg_name . ';'; $arg_name = '$value'; for my $coercion ( $self->coercions ) { $source .= '$value = ' . $coercion->inline_coercion($arg_name) . ' if ' . $coercion->from->inline_check($arg_name) . ';'; %env = ( %env, %{ $coercion->inline_environment } ); } } my ( $assert, $assert_env ) = $self->inline_assert($arg_name); $source .= $assert; %env = ( %env, %{$assert_env} ); $source .= $arg_name . '};'; return ( $source, \%env ); } { my $counter = 1; sub inline_assert { my $self = shift; my $type_var_name = '$_Specio_Constraint_Interface_type' . $counter; my $message_generator_var_name = '$_Specio_Constraint_Interface_message_generator' . $counter; my %env = ( $type_var_name => \$self, $message_generator_var_name => \( $self->_message_generator ), %{ $self->inline_environment }, ); my $source = $self->inline_check( $_[0] ); $source .= ' or '; $source .= $self->_inline_throw_exception( $_[0], $message_generator_var_name, $type_var_name ); $source .= ';'; $counter++; return ( $source, \%env ); } } sub inline_check { my $self = shift; die 'Cannot inline' unless $self->can_be_inlined; my $type = $self->_self_or_first_inlinable_ancestor; return $type->_inline_generator->( $type, @_ ); } sub _subify { my $self = shift; if ( defined &Sub::Quote::quote_sub && $self->can_be_inlined ) { my $inline = $self->inline_check('$_[0]'); $inline .= ' or '; my %env = ( '$message_generator' => \( $self->_message_generator ), '$type' => \$self, ); $inline .= $self->_inline_throw_exception( '$_[0]', '$message_generator', '$type', ); return Sub::Quote::quote_sub( $inline, \%env ); } else { return sub { $self->validate_or_die( $_[0] ) }; } } sub _inline_throw_exception { my $self = shift; my $value_var = shift; my $message_generator_var_name = shift; my $type_var_name = shift; #<<< return 'Specio::Exception->throw( ' . ' message => ' . $message_generator_var_name . '->(' . $value_var . '),' . ' type => ' . $type_var_name . ',' . ' value => ' . $value_var . ' )'; #>>> } # This exists for the benefit of Moo sub coercion_sub { my $self = shift; if ( defined &Sub::Quote::quote_sub && all { $_->can_be_inlined } $self->coercions ) { my $inline = q{}; my %env; for my $coercion ( $self->coercions ) { $inline .= sprintf( '$_[0] = %s if %s;' . "\n", $coercion->inline_coercion('$_[0]'), $coercion->from->inline_check('$_[0]') ); %env = ( %env, %{ $coercion->inline_environment } ); } $inline .= sprintf( "%s;\n", '$_[0]' ); return Sub::Quote::quote_sub( $inline, \%env ); } else { return sub { $self->coerce_value(shift) }; } } sub _build_ancestors { my $self = shift; my @parents; my $type = $self; while ( $type = $type->parent ) { push @parents, $type; } return \@parents; } sub _build_description { my $self = shift; my $desc = $self->is_anon ? 'anonymous type' : 'type named ' . $self->name; $desc .= q{ } . $self->declared_at->description; return $desc; } sub _build_coercions { {} } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _clone_coercions { my $self = shift; my $coercions = $self->_coercions; my %clones; for my $name ( keys %{$coercions} ) { my $coercion = $coercions->{$name}; $clones{$name} = $coercion->clone_with_new_to($self); } return \%clones; } ## use critic sub _build_signature { my $self = shift; # This assumes that when a type is cloned, the underlying constraint or # generator sub is copied by _reference_, so it has the same memory # address and stringifies to the same value. XXX - will this break under # threads? return join "\n", ( $self->_has_parent ? $self->parent->_signature : () ), ( defined $self->_constraint ? $self->_constraint : $self->_inline_generator ); } # Moose compatibility methods - these exist as a temporary hack to make Specio # work with Moose. sub has_coercion { shift->has_coercions; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _inline_check { shift->inline_check(@_); } sub _compiled_type_constraint { shift->_optimized_constraint; } ## use critic; # This class implements the methods that Moose expects from coercions as well. sub coercion { return shift; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _compiled_type_coercion { my $self = shift; return sub { return $self->coerce_value(shift); }; } ## use critic sub has_message { 1; } sub message { shift->_message_generator; } sub get_message { my $self = shift; my $value = shift; return $self->_message_generator->( $self, $value ); } sub check { shift->value_is_valid(@_); } sub coerce { shift->coerce_value(@_); } 1; # ABSTRACT: The interface all type constraints should provide __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Role::Interface - The interface all type constraints should provide =head1 VERSION version 0.33 =head1 DESCRIPTION This role defines the interface that all type constraints must provide, and provides most (or all) of the implementation. The L class simply consumes this role and provides no additional code. Other constraint classes add features or override some of this role's functionality. =for Pod::Coverage .* =head1 API See the L documentation for details. See the internals of various constraint classes to see how this role can be overridden or expanded upon. =head1 ROLES This role does the L role. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/Role/DoesType.pm0000644000175000017500000000464513041701062021633 0ustar autarchautarchpackage Specio::Constraint::Role::DoesType; use strict; use warnings; our $VERSION = '0.33'; use Role::Tiny; use Specio::PartialDump qw( partial_dump ); use Storable qw( dclone ); use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = dclone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( parent _inline_generator )) { $attrs->{$name}{init_arg} = undef; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } $attrs->{role} = { isa => 'Str', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _wrap_message_generator { my $self = shift; my $generator = shift; my $role = $self->role; unless ( defined $generator ) { $generator = sub { my $description = shift; my $value = shift; return "Validation failed for $description with value " . partial_dump($value) . '(does not do ' . $role . ')'; }; } my $d = $self->description; return sub { $generator->( $d, @_ ) }; } ## use critic 1; # ABSTRACT: Provides a common implementation for Specio::Constraint::AnyDoes and Specio::Constraint::ObjectDoes __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Role::DoesType - Provides a common implementation for Specio::Constraint::AnyDoes and Specio::Constraint::ObjectDoes =head1 VERSION version 0.33 =head1 DESCRIPTION See L and L for details. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/Role/CanType.pm0000644000175000017500000000537513041701062021443 0ustar autarchautarchpackage Specio::Constraint::Role::CanType; use strict; use warnings; our $VERSION = '0.33'; use Scalar::Util qw( blessed ); use Storable qw( dclone ); use Role::Tiny; use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = dclone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( parent _inline_generator )) { $attrs->{$name}{init_arg} = undef; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } $attrs->{methods} = { isa => 'ArrayRef', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _wrap_message_generator { my $self = shift; my $generator = shift; my @methods = @{ $self->methods }; unless ( defined $generator ) { $generator = sub { shift; my $value = shift; my $class = blessed $value; $class ||= $value; my @missing = grep { !$value->can($_) } @methods; my $noun = @missing == 1 ? 'method' : 'methods'; my $list = _word_list( map {qq['$_']} @missing ); return "$class is missing the $list $noun"; }; } my $d = $self->description; return sub { $generator->( $d, @_ ) }; } ## use critic sub _word_list { my @items = shift; return $items[0] if @items == 1; return join ' and ', @items if @items == 2; my $final = pop @items; my $list = join ', ', @items; $list .= ', and ' . $final; return $list; } 1; # ABSTRACT: Provides a common implementation for Specio::Constraint::AnyCan and Specio::Constraint::ObjectCan __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Role::CanType - Provides a common implementation for Specio::Constraint::AnyCan and Specio::Constraint::ObjectCan =head1 VERSION version 0.33 =head1 DESCRIPTION See L and L for details. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/Role/IsaType.pm0000644000175000017500000000464413041701062021454 0ustar autarchautarchpackage Specio::Constraint::Role::IsaType; use strict; use warnings; our $VERSION = '0.33'; use Specio::PartialDump qw( partial_dump ); use Storable qw( dclone ); use Role::Tiny; use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = dclone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( parent _inline_generator )) { $attrs->{$name}{init_arg} = undef; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } $attrs->{class} = { isa => 'ClassName', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _wrap_message_generator { my $self = shift; my $generator = shift; my $class = $self->class; unless ( defined $generator ) { $generator = sub { my $description = shift; my $value = shift; return "Validation failed for $description with value " . partial_dump($value) . '(not isa ' . $class . ')'; }; } my $d = $self->description; return sub { $generator->( $d, @_ ) }; } ## use critic 1; # ABSTRACT: Provides a common implementation for Specio::Constraint::AnyIsa and Specio::Constraint::ObjectIsa __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Role::IsaType - Provides a common implementation for Specio::Constraint::AnyIsa and Specio::Constraint::ObjectIsa =head1 VERSION version 0.33 =head1 DESCRIPTION See L and L for details. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/Parameterizable.pm0000644000175000017500000001312313041701062022274 0ustar autarchautarchpackage Specio::Constraint::Parameterizable; use strict; use warnings; our $VERSION = '0.33'; use Carp qw( confess ); use Role::Tiny::With; use Specio::Constraint::Parameterized; use Specio::DeclaredAt; use Specio::OO; use Specio::TypeChecks qw( does_role isa_class ); use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $role_attrs = Specio::Constraint::Role::Interface::_attrs(); ## use critic my $attrs = { %{$role_attrs}, _parameterized_constraint_generator => { isa => 'CodeRef', init_arg => 'parameterized_constraint_generator', predicate => '_has_parameterized_constraint_generator', }, _parameterized_inline_generator => { isa => 'CodeRef', init_arg => 'parameterized_inline_generator', predicate => '_has_parameterized_inline_generator', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub BUILD { my $self = shift; if ( $self->_has_constraint ) { die 'A parameterizable constraint with a constraint parameter must also have a parameterized_constraint_generator' unless $self->_has_parameterized_constraint_generator; } if ( $self->_has_inline_generator ) { die 'A parameterizable constraint with an inline_generator parameter must also have a parameterized_inline_generator' unless $self->_has_parameterized_inline_generator; } return; } sub parameterize { my $self = shift; my %args = @_; my ( $parameter, $declared_at ) = @args{qw( of declared_at)}; does_role( $parameter, 'Specio::Constraint::Role::Interface' ) or confess 'The "of" parameter passed to ->parameterize must be an object which does the Specio::Constraint::Role::Interface role'; if ($declared_at) { isa_class( $declared_at, 'Specio::DeclaredAt' ) or confess 'The "declared_at" parameter passed to ->parameterize must be a Specio::DeclaredAt object'; } $declared_at = Specio::DeclaredAt->new_from_caller(1) unless defined $declared_at; my %p = ( parent => $self, parameter => $parameter, declared_at => $declared_at, ); if ( $self->_has_parameterized_constraint_generator ) { $p{constraint} = $self->_parameterized_constraint_generator->($parameter); } else { confess 'The "of" parameter passed to ->parameterize must be an inlinable constraint if the parameterizable type has an inline_generator' unless $parameter->can_be_inlined; my $ig = $self->_parameterized_inline_generator; $p{inline_generator} = sub { $ig->( shift, $parameter, @_ ) }; } return Specio::Constraint::Parameterized->new(%p); } __PACKAGE__->_ooify; 1; # ABSTRACT: A class which represents parameterizable constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Parameterizable - A class which represents parameterizable constraints =head1 VERSION version 0.33 =head1 SYNOPSIS my $arrayref = t('ArrayRef'); my $arrayref_of_int = $arrayref->parameterize( of => t('Int') ); =head1 DESCRIPTION This class implements the API for parameterizable types like C and C. =for Pod::Coverage BUILD =head1 API This class implements the same API as L, with a few additions. =head2 Specio::Constraint::Parameterizable->new(...) This class's constructor accepts two additional parameters: =over 4 =item * parameterized_constraint_generator This is a subroutine that generates a new constraint subroutine when the type is parameterized. It will be called as a method on the type and will be passed a single argument, the type object for the type parameter. This parameter is mutually exclusive with the C parameter. =item * parameterized_inline_generator This is a subroutine that generates a new inline generator subroutine when the type is parameterized. It will be called as a method on the L object when that object needs to generate inline constraint. It will receive the type parameter as the first argument and the variable name as a string as the second. This probably seems fairly confusing, so looking at the examples in the L code may be helpful. This parameter is mutually exclusive with the C parameter. =back =head2 $type->parameterize(...) This method takes two arguments. The C argument should be an object which does the L role, and is required. The other argument, C, is optional. If it is not given, then a new L object is creating using a call stack depth of 1. This method returns a new L object. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/AnyIsa.pm0000644000175000017500000000521613041701062020355 0ustar autarchautarchpackage Specio::Constraint::AnyIsa; use strict; use warnings; our $VERSION = '0.33'; use B (); use Role::Tiny::With; use Scalar::Util (); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::IsaType; with 'Specio::Constraint::Role::IsaType'; { my $Defined = t('Defined'); sub _build_parent {$Defined} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', ($val) x 3, B::perlstring( $self->class ) ); ( ( Scalar::Util::blessed( %s ) || ( !ref( %s ) ) ) && %s->isa(%s) ) EOF }; sub _build_inline_generator {$_inline_generator} } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require a class name or an object that inherit from a specific class __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::AnyIsa - A class for constraints which require a class name or an object that inherit from a specific class =head1 VERSION version 0.33 =head1 SYNOPSIS my $type = Specio::Constraint::AnyIsa->new(...); print $type->class; =head1 DESCRIPTION This is a specialized type constraint class for types which require a class name or an object that inherit from a specific class. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::AnyIsa->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be a single class name. =head2 $any_isa->class Returns the class name passed to the constructor. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/Simple.pm0000644000175000017500000002370313041701062020423 0ustar autarchautarchpackage Specio::Constraint::Simple; use strict; use warnings; our $VERSION = '0.33'; use Role::Tiny::With; use Specio::OO; with 'Specio::Constraint::Role::Interface'; __PACKAGE__->_ooify; 1; # ABSTRACT: Class for simple (non-parameterized or specialized) types __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Simple - Class for simple (non-parameterized or specialized) types =head1 VERSION version 0.33 =head1 SYNOPSIS my $str = t('Str'); print $str->name; # Str my $parent = $str->parent; if ( $str->value_is_valid($value) ) { ... } $str->validate_or_die($value); my $code = $str->inline_coercion_and_check('$_[0]'); =head1 DESCRIPTION This class implements simple type constraints, constraints without special properties or parameterization. It does not actually contain any real code of its own. The entire implementation is provided by the L role, but the primary API for type constraints is documented here. All other type constraint classes in this distribution implement this API, except where otherwise noted. =head1 API This class provides the following methods. =head2 Specio::Constraint::Simple->new(...) This creates a new constraint. It accepts the following named parameters: =over 4 =item * name => $name This is the type's name. The name is optional, but if provided it must be a string. =item * parent => $type The type's parent type. This must be an object which does the L role. This parameter is optional. =item * constraint => sub { ... } A subroutine reference implementing the constraint. It will be called as a method on the object and passed a single argument, the value to check. It should return true or false to indicate whether the value matches the constraint. This parameter is mutually exclusive with C. You can also pass this option with the key C in the parameter list. =item * inline_generator => sub { ... } This should be a subroutine reference which returns a string containing a single term. This code should I end in a semicolon. This code should implement the constraint. The generator will be called as a method on the constraint with a single argument. That argument is the name of the variable being coerced, something like C<'$_[0]'> or C<'$var'>. The inline generator is expected to include code to implement both the current type and all its parents. Typically, the easiest way to do this is to write a subroutine something like this: sub { my $self = shift; my $var = shift; return $_[0]->parent->inline_check( $_[1] ) . ' and more checking code goes here'; } This parameter is mutually exclusive with C. You can also pass this option with the key C in the parameter list. =item * inline_environment => {} This should be a hash reference of variable names (with sigils) and values for that variable. The values should be I to the values of the variables. This environment will be used when compiling the constraint as part of a subroutine. The named variables will be captured as closures in the generated subroutine, using L. It should be very rare to need to set this in the constructor. It's more likely that a special type subclass would need to provide values that it generates internally. If you do set this, you are responsible for generating variable names that won't clash with anything else in the inlined code. This parameter defaults to an empty hash reference. =item * message_generator => sub { ... } A subroutine to generate an error message when the type check fails. The default message says something like "Validation failed for type named Int declared in package Specio::Library::Builtins (.../Specio/blib/lib/Specio/Library/Builtins.pm) at line 147 in sub named (eval) with value 1.1". You can override this to provide something more specific about the way the type failed. The subroutine you provide will be called as a subroutine, I, with two arguments. The first is the description of the type (the bit in the message above that starts with "type named Int ..." and ends with "... in sub named (eval)". This description says what the thing is and where it was defined. The second argument is the value that failed the type check, after any coercions that might have been applied. You can also pass this option with the key C in the parameter list. =item * declared_at => $declared_at This parameter must be a L object. This parameter is required. =back It is possible to create a type without a constraint of its own. =head2 $type->name Returns the name of the type as it was passed the constructor. =head2 $type->parent Returns the parent type passed to the constructor. If the type has no parent this returns C. =head2 $type->is_anon Returns false for named types, true otherwise. =head2 $type->is_a_type_of($other_type) Given a type object, this returns true if the type this method is called on is a descendant of that type or is that type. =head2 $type->is_same_type_as($other_type) Given a type object, this returns true if the type this method is called on is the same as that type. =head2 $type->coercions Returns a list of L objects which belong to this constraint. =head2 $type->coercion_from_type($name) Given a type name, this method returns a L object which coerces from that type, if such a coercion exists. =head2 $type->validate_or_die($value) This method does nothing if the value is valid. If it is not, it throws a L. =head2 $type->value_is_valid($value) Returns true or false depending on whether the C<$value> passes the type constraint. =head2 $type->has_real_constraint This returns true if the type was created with a C or C parameter. This is used internally to skip type checks for types that don't actually implement a constraint. =head2 $type->description This returns a string describing the type. This includes the type's name and where it was declared, so you end up with something like C<'type named Foo declared in package My::Lib (lib/My/Lib.pm) at line 42'>. If the type is anonymous the name will be "anonymous type". =head2 $type->id This is a unique id for the type as a string. This is useful if you need to make a hash key based on a type, for example. This should be treated as an essentially arbitrary and opaque string, and could change at any time in the future. If you want something human-readable, use the C<< $type->description >> method. =head2 $type->add_coercion($coercion) This adds a new L to the type. If the type already has a coercion from the same type as the new coercion, it will throw an error. =head2 $type->has_coercion_from_type($other_type) This method returns true if the type can coerce from the other type. =head2 $type->coerce_value($value) This attempts to coerce a value into a new value that matches the type. It checks all of the type's coercions. If it finds one which has a "from" type that accepts the value, it runs the coercion and returns the new value. If it cannot find a matching coercion it returns the original value. =head2 $type->inline_coercion_and_check($var) Given a variable name, this returns a string of code and an environment hash that implements all of the type's coercions as well as the type check itself. This will throw an exception unless both the type and all of its coercions are inlinable. The generated code will throw a L if the type constraint fails. If the constraint passes, then the generated code returns the (possibly coerced) value. The return value is a two-element list. The first element is the code. The second is a hash reference containing variables which need to be in scope for the code to work. This is intended to be passed to L's C subroutine. The returned code is a single C block without a terminating semicolon. =head2 $type->inline_assert($var) Given a variable name, this generates code that implements the constraint and throws an exception if the variable does not pass the constraint. The return value is a two-element list. The first element is the code. The second is a hash reference containing variables which need to be in scope for the code to work. This is intended to be passed to L's C subroutine. =head2 $type->inline_check($var) Given a variable name, this returns a string of code that implements the constraint. If the type is not inlinable, this method throws an error. =head2 $type->inline_environment() This returns a hash defining the variables that need to be closed over when inlining the type. The keys are full variable names like C<'$foo'> or C<'@bar'>. The values are I to a variable of the matching type. =head2 $type->coercion_sub This method returns a sub ref that takes a single argument and applied all relevant coercions to it. This sub ref will use L if all the type's coercions are inlinable. This method exists primarily for the benefit of L. =head1 OVERLOADING All constraints overloading subroutine de-referencing for the benefit of L. The returned subroutine uses L if the type constraint is inlinable. =head1 ROLES This role does the L and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Constraint/ObjectCan.pm0000644000175000017500000000554213041701062021023 0ustar autarchautarchpackage Specio::Constraint::ObjectCan; use strict; use warnings; our $VERSION = '0.33'; use B (); use List::Util 1.33 (); use Role::Tiny::With; use Scalar::Util (); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::CanType; with 'Specio::Constraint::Role::CanType'; { my $Object = t('Object'); sub _build_parent {$Object} } { my $_inline_generator = sub { my $self = shift; my $val = shift; my $methods = join ', ', map { B::perlstring($_) } @{ $self->methods }; return sprintf( <<'EOF', $val, $methods ); ( do { my $v = %s; Scalar::Util::blessed($v) && List::Util::all { $v->can($_) } %s; } ) EOF }; sub _build_inline_generator {$_inline_generator} } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require an object with a set of methods __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::ObjectCan - A class for constraints which require an object with a set of methods =head1 VERSION version 0.33 =head1 SYNOPSIS my $type = Specio::Constraint::ObjectCan->new(...); print $_, "\n" for @{ $type->methods }; =head1 DESCRIPTION This is a specialized type constraint class for types which require an object with a defined set of methods. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::ObjectCan->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be an array reference of method names which the constraint requires. You can also pass a single string and it will be converted to an array reference internally. =head2 $object_can->methods Returns an array reference containing the methods this constraint requires. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Library/0000775000175000017500000000000013041701062016111 5ustar autarchautarchSpecio-0.33/lib/Specio/Library/Builtins.pm0000644000175000017500000002652013041701062020243 0ustar autarchautarchpackage Specio::Library::Builtins; use strict; use warnings; our $VERSION = '0.33'; use parent 'Specio::Exporter'; use List::Util 1.33 (); use overload (); use re (); use Scalar::Util (); use Specio::Constraint::Parameterizable; use Specio::Declare; use Specio::Helpers (); declare( 'Item', inline => sub {'1'} ); declare( 'Undef', parent => t('Item'), inline => sub { '!defined(' . $_[1] . ')'; } ); declare( 'Defined', parent => t('Item'), inline => sub { 'defined(' . $_[1] . ')'; } ); declare( 'Bool', parent => t('Item'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 8 ); ( ( !ref( %s ) && ( !defined( %s ) || %s eq q{} || %s eq '1' || %s eq '0' ) ) || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, 'bool' ) ) ) EOF } ); declare( 'Value', parent => t('Defined'), inline => sub { $_[0]->parent->inline_check( $_[1] ) . ' && !ref(' . $_[1] . ')'; } ); declare( 'Ref', parent => t('Defined'), # no need to call parent - ref also checks for definedness inline => sub { 'ref(' . $_[1] . ')' } ); declare( 'Str', parent => t('Value'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 7 ); ( ( defined( %s ) && !ref( %s ) && ( ( ref( \%s ) eq 'SCALAR' ) || do { ( ref( \( my $val = %s ) ) eq 'SCALAR' ) } ) ) || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, q{""} ) ) ) EOF } ); my $value_type = t('Value'); declare( 'Num', parent => t('Str'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 6 ); ( ( defined( %s ) && !ref( %s ) && ( do { ( my $val = %s ) =~ /\A -?[0-9]+(?:\.[0-9]+)? (?:[Ee][\-+]?[0-9]+)? \z/x } ) ) || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, '0+' ) ) ) EOF } ); declare( 'Int', parent => t('Num'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 7 ) ( ( defined( %s ) && !ref( %s ) && ( do { ( my $val1 = %s ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/ } ) ) || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, '0+' ) && do { ( my $val2 = %s + 0 ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/ } ) ) EOF } ); declare( 'CodeRef', parent => t('Ref'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 4 ); ( ref( %s ) eq 'CODE' || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, '&{}' ) ) ) EOF } ); # This is a 5.8 back-compat shim stolen from Type::Tiny's Devel::Perl58Compat # module. unless ( exists &re::is_regexp ) { require B; *re::is_regexp = sub { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { B::svref_2object( $_[0] )->MAGIC->TYPE eq 'r' }; }; } declare( 'RegexpRef', parent => t('Ref'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 4 ); ( re::is_regexp( %s ) || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, 'qr' ) ) ) EOF }, ); declare( 'GlobRef', parent => t('Ref'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 4 ); ( ref( %s ) eq 'GLOB' || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, '*{}' ) ) ) EOF } ); # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a # filehandle declare( 'FileHandle', parent => t('Ref'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 7 ); ( ( ref( %s ) eq 'GLOB' && Scalar::Util::openhandle( %s ) ) || ( Scalar::Util::blessed( %s ) && ( %s->isa('IO::Handle') || ( overload::Overloaded( %s ) && defined overload::Method( %s, '*{}' ) && Scalar::Util::openhandle( *{ %s } ) ) ) ) ) EOF } ); declare( 'Object', parent => t('Ref'), inline => sub { 'Scalar::Util::blessed(' . $_[1] . ')' }, ); declare( 'ClassName', parent => t('Str'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), ( $_[1] ) x 2 ) ( ( %s ) && length "%s" && Specio::Helpers::is_class_loaded( "%s" ) ) EOF }, ); { my $base_scalarref_check = sub { return sprintf( <<'EOF', ( $_[0] ) x 5 ); ( ( ref( %s ) eq 'SCALAR' || ref( %s ) eq 'REF' ) || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, '${}' ) ) ) EOF }; declare( 'ScalarRef', type_class => 'Specio::Constraint::Parameterizable', parent => t('Ref'), inline => sub { $base_scalarref_check->( $_[1] ) }, parameterized_inline_generator => sub { my $self = shift; my $parameter = shift; my $val = shift; return sprintf( '( ( %s ) && ( %s ) )', $base_scalarref_check->($val), $parameter->inline_check( '${' . $val . '}' ), ); } ); } { my $base_arrayref_check = sub { return sprintf( <<'EOF', ( $_[0] ) x 4 ); ( ref( %s ) eq 'ARRAY' || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, '@{}' ) ) ) EOF }; declare( 'ArrayRef', type_class => 'Specio::Constraint::Parameterizable', parent => t('Ref'), inline => sub { $base_arrayref_check->( $_[1] ) }, parameterized_inline_generator => sub { my $self = shift; my $parameter = shift; my $val = shift; return sprintf( '( ( %s ) && ( List::Util::all { %s } @{ %s } ) )', $base_arrayref_check->($val), $parameter->inline_check('$_'), $val, ); } ); } { my $base_hashref_check = sub { return sprintf( <<'EOF', ( $_[0] ) x 4 ); ( ref( %s ) eq 'HASH' || ( Scalar::Util::blessed( %s ) && overload::Overloaded( %s ) && defined overload::Method( %s, '%%{}' ) ) ) EOF }; declare( 'HashRef', type_class => 'Specio::Constraint::Parameterizable', parent => t('Ref'), inline => sub { $base_hashref_check->( $_[1] ) }, parameterized_inline_generator => sub { my $self = shift; my $parameter = shift; my $val = shift; return sprintf( '( ( %s ) && ( List::Util::all { %s } values %%{ %s } ) )', $base_hashref_check->($val), $parameter->inline_check('$_'), $val, ); } ); } declare( 'Maybe', type_class => 'Specio::Constraint::Parameterizable', parent => t('Item'), inline => sub {'1'}, parameterized_inline_generator => sub { my $self = shift; my $parameter = shift; my $val = shift; return sprintf( <<'EOF', $val, $parameter->inline_check($val) ) ( !defined( %s ) || ( %s ) ) EOF }, ); 1; # ABSTRACT: Implements type constraint objects for Perl's built-in types __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Builtins - Implements type constraint objects for Perl's built-in types =head1 VERSION version 0.33 =head1 DESCRIPTION This library provides a set of types parallel to those provided by Moose. The types are in the following hierarchy Item Bool Maybe (of `a) Undef Defined Value Str Num Int ClassName Ref ScalarRef (of `a) ArrayRef (of `a) HashRef (of `a) CodeRef RegexpRef GlobRef FileHandle Object =head2 Item Accepts any value =head2 Bool Accepts a non-reference that is C, an empty string, C<0>, or C<1>. It also accepts any object which overloads boolification. =head2 Maybe (of `a) A parameterizable type which accepts C or the type C<`a>. If not parameterized this type will accept any value. =head2 Undef Only accepts C. =head2 Value Accepts any non-reference value. =head2 Str Accepts any non-reference value or an object which overloads stringification. =head2 Num Accepts nearly the same values as C, but does not accept numbers with leading or trailing spaces, infinities, or NaN. Also accepts an object which overloads numification. =head2 Int Accepts any integer value, or an object which overloads numification and numifies to an integer. =head2 ClassName Accepts any value which passes C where the string is a loaded package. =head2 Ref Accepts any reference. =head2 ScalarRef (of `a) Accepts a scalar reference or an object which overloads scalar dereferencing. If parameterized, the dereferenced value must be of type C<`a>. =head2 ArrayRef (of `a) Accepts a array reference or an object which overloads array dereferencing. If parameterized, the values in the arrayref must be of type C<`a>. =head2 HashRef (of `a) Accepts a hash reference or an object which overloads hash dereferencing. If parameterized, the values in the hashref must be of type C<`a>. =head2 CodeRef Accepts a code (sub) reference or an object which overloads code dereferencing. =head2 RegexpRef Accepts a regex object created by C or an object which overloads regex interpolation. =head2 GlobRef Accepts a glob reference or an object which overloads glob dereferencing. =head2 FileHandle Accepts a glob reference which is an open file handle, any C Object or subclass, or an object which overloads glob dereferencing and returns a glob reference which is an open file handle. =head2 Object Accepts any blessed object. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Library/String.pm0000644000175000017500000000422013041701062017711 0ustar autarchautarchpackage Specio::Library::String; use strict; use warnings; our $VERSION = '0.33'; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'NonEmptySimpleStr', parent => t('Str'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), ( $_[1] ) x 3 ); ( %s && length %s > 0 && length %s <= 255 && %s !~ /[\n\r\x{2028}\x{2029}]/ ) EOF }, ); declare( 'NonEmptyStr', parent => t('Str'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && length %s ) EOF }, ); declare( 'SimpleStr', parent => t('Str'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), ( $_[1] ) x 2 ); ( %s && length %s <= 255 && %s !~ /[\n\r\x{2028}\x{2029}]/ ) EOF }, ); 1; # ABSTRACT: Implements type constraint objects for some common string types __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::String - Implements type constraint objects for some common string types =head1 VERSION version 0.33 =head1 DESCRIPTION This library provides some additional string types for common cases. =head2 NonEmptyStr A string which has at least one character. =head2 SimpleStr A string that is 255 characters or less with no vertical whitespace characters. =head2 NonEmptySimpleStr A non-empty string that is 255 characters or less with no vertical whitespace characters. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Library/Perl.pm0000644000175000017500000001033513041701062017351 0ustar autarchautarchpackage Specio::Library::Perl; use strict; use warnings; our $VERSION = '0.33'; use parent 'Specio::Exporter'; use Specio::Library::String; use version 0.83 (); use Specio::Declare; my $package_inline = sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s =~ /\A[^\W\d]\w*(?:::\w+)*\z/ ) EOF }; declare( 'PackageName', parent => t('NonEmptyStr'), inline => $package_inline, ); declare( 'ModuleName', parent => t('NonEmptyStr'), inline => $package_inline, ); declare( 'DistName', parent => t('NonEmptyStr'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s =~ /\A[^\W\d]\w*(?:-\w+)*\z/ ) EOF }, ); declare( 'Identifier', parent => t('NonEmptyStr'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s =~ /\A[^\W\d]\w*\z/ ) EOF }, ); declare( 'SafeIdentifier', parent => t('Identifier'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s !~ /\A[_ab]\z/ ) EOF }, ); declare( 'LaxVersion', parent => t('NonEmptyStr'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && version::is_lax(%s) ) EOF }, ); declare( 'StrictVersion', parent => t('NonEmptyStr'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && version::is_strict(%s) ) EOF }, ); 1; # ABSTRACT: Implements type constraint objects for some common Perl language things __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Perl - Implements type constraint objects for some common Perl language things =head1 VERSION version 0.33 =head1 DESCRIPTION This library provides some additional string types for common cases. =head2 PackageName A valid package name. Unlike the C constraint from the L library, this package does not need to be loaded. This type does allow Unicode characters. =head2 ModuleName Same as C. =head2 DistName A valid distribution name like C Basically this is the same as a package name with the double-colons replaced by dashes. Note that there are some historical distribution names that don't fit this pattern, like C. This type does allow Unicode characters. =head2 Identifier An L is something that could be used as a symbol name or other identifier (filehandle, directory handle, subroutine name, format name, or label). It's what you put after the sigil (dollar sign, at sign, percent sign) in a variable name. Generally, it's a bunch of word characters not starting with a digit. This type does allow Unicode characters. =head2 SafeIdentifier This is just like an C but it exclude the single-character variables underscore (C<_>), C< and C, as these are special variables to the Perl interpreter. =head2 LaxVersionStr and StrictVersionStr Lax and strict version strings use the L and L methods from C to check if the given string would be a valid lax or strict version. L covers the details but basically: lax versions are everything you may do, and strict omit many of the usages best avoided. =head2 CREDITS Much of the code and docs for this library comes from MooseX::Types::Perl, written by Ricardo SIGNES . =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Library/Numeric.pm0000644000175000017500000000633513041701062020056 0ustar autarchautarchpackage Specio::Library::Numeric; use strict; use warnings; our $VERSION = '0.33'; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'PositiveNum', parent => t('Num'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s > 0 ) EOF }, ); declare( 'PositiveOrZeroNum', parent => t('Num'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s >= 0 ) EOF }, ); declare( 'PositiveInt', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s > 0 ) EOF }, ); declare( 'PositiveOrZeroInt', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s >= 0 ) EOF }, ); declare( 'NegativeNum', parent => t('Num'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s < 0 ) EOF }, ); declare( 'NegativeOrZeroNum', parent => t('Num'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s <= 0 ) EOF }, ); declare( 'NegativeInt', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s < 0 ) EOF }, ); declare( 'NegativeOrZeroInt', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s <= 0 ) EOF }, ); declare( 'SingleDigit', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), ( $_[1] ) x 2 ); ( %s && %s >= -9 && %s <= 9 ) EOF }, ); 1; # ABSTRACT: Implements type constraint objects for some common numeric types __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Numeric - Implements type constraint objects for some common numeric types =head1 VERSION version 0.33 =head1 DESCRIPTION This library provides some additional string numeric for common cases. =head2 PositiveNum =head2 PositiveOrZeroNum =head2 PositiveInt =head2 PositiveOrZeroInt =head2 NegativeNum =head2 NegativeOrZeroNum =head2 NegativeInt =head2 NegativeOrZeroInt =head2 SingleDigit A single digit from -9 to 9. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Role/0000775000175000017500000000000013041701062015406 5ustar autarchautarchSpecio-0.33/lib/Specio/Role/Inlinable.pm0000644000175000017500000000605713041701062017647 0ustar autarchautarchpackage Specio::Role::Inlinable; use strict; use warnings; our $VERSION = '0.33'; use Eval::Closure qw( eval_closure ); use Role::Tiny; requires '_build_description'; { my $attrs = { _inline_generator => { is => 'ro', isa => 'CodeRef', predicate => '_has_inline_generator', init_arg => 'inline_generator', }, inline_environment => { is => 'ro', isa => 'HashRef', lazy => 1, init_arg => 'inline_environment', builder => '_build_inline_environment', }, _generated_inline_sub => { is => 'ro', isa => 'CodeRef', init_arg => undef, lazy => 1, builder => '_build_generated_inline_sub', }, declared_at => { is => 'ro', isa => 'Specio::DeclaredAt', required => 1, }, description => { is => 'ro', isa => 'Str', init_arg => undef, lazy => 1, builder => '_build_description', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } # These are here for backwards compatibility. Some other packages that I wrote # may call the private methods. ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _description { $_[0]->description } sub _inline_environment { $_[0]->inline_environment } ## use critic sub can_be_inlined { my $self = shift; return $self->_has_inline_generator; } sub _build_generated_inline_sub { my $self = shift; my $source = 'sub { ' . $self->_inline_generator->( $self, '$_[0]' ) . '}'; return eval_closure( source => $source, environment => $self->inline_environment, description => 'inlined sub for ' . $self->description, ); } sub _build_inline_environment { return {}; } 1; # ABSTRACT: A role for things which can be inlined (type constraints and coercions) __END__ =pod =encoding UTF-8 =head1 NAME Specio::Role::Inlinable - A role for things which can be inlined (type constraints and coercions) =head1 VERSION version 0.33 =head1 DESCRIPTION This role implements a common API for inlinable things, type constraints and coercions. It is fully documented in the relevant classes. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/DeclaredAt.pm0000644000175000017500000000617713041701062017044 0ustar autarchautarchpackage Specio::DeclaredAt; use strict; use warnings; our $VERSION = '0.33'; use Specio::OO; { my $attrs = { package => { isa => 'Str', required => 1, }, filename => { isa => 'Str', required => 1, }, line => { isa => 'Int', required => 1, }, subroutine => { isa => 'Str', predicate => 'has_subroutine', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub new_from_caller { my $class = shift; my $depth = shift; my %p; @p{qw( package filename line )} = ( caller($depth) )[ 0, 1, 2 ]; my $sub = ( caller( $depth + 1 ) )[3]; $p{subroutine} = $sub if defined $sub; return $class->new(%p); } sub description { my $self = shift; my $package = $self->package; my $filename = $self->filename; my $line = $self->line; my $desc = "declared in package $package ($filename) at line $line"; if ( $self->has_subroutine ) { $desc .= ' in sub named ' . $self->subroutine; } return $desc; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class to represent where a type or coercion was declared __END__ =pod =encoding UTF-8 =head1 NAME Specio::DeclaredAt - A class to represent where a type or coercion was declared =head1 VERSION version 0.33 =head1 SYNOPSIS my $declared = Specio::DeclaredAt->new_from_caller(1); print $declared->description; =head1 DESCRIPTION This class provides a thin wrapper around some of the return values from Perl's C built-in. It's used internally to identify where types and coercions are being declared, which is useful when generating error messages. =head1 API This class provides the following methods. =head2 Specio::DeclaredAt->new_from_caller($depth) Given a call stack depth, this method returns a new C object. =head2 $declared_at->package, $declared_at->filename, $declared_at->line Returns the call stack information recorded when the object was created. These values are always populated. =head2 $declared_at->subroutine Returns the subroutine from the call stack. This may be an C =head2 $declared_at->has_subroutine Returns true if there is a subroutine name associated with this object. =head2 $declared_at->description Puts all the information together into a single string like "declared in package Foo::Bar (.../Foo/Bar.pm) at line 42 in sub named blah". =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/PartialDump.pm0000644000175000017500000001340713041701062017270 0ustar autarchautarchpackage Specio::PartialDump; use strict; use warnings; our $VERSION = '0.33'; use Scalar::Util qw( looks_like_number reftype blessed ); use Exporter qw( import ); our @EXPORT_OK = qw( partial_dump ); my $MaxLength = 100; my $MaxElements = 6; my $MaxDepth = 2; sub partial_dump { my (@args) = @_; my $dump = _should_dump_as_pairs(@args) ? _dump_as_pairs( 1, @args ) : _dump_as_list( 1, @args ); if ( length($dump) > $MaxLength ) { my $max_length = $MaxLength - 3; $max_length = 0 if $max_length < 0; substr( $dump, $max_length, length($dump) - $max_length ) = '...'; } return $dump; } sub _should_dump_as_pairs { my (@what) = @_; return if @what % 2 != 0; # must be an even list for ( my $i = 0; $i < @what; $i += 2 ) { return if ref $what[$i]; # plain strings are keys } return 1; } sub _dump_as_pairs { my ( $depth, @what ) = @_; my $truncated; if ( defined $MaxElements and ( @what / 2 ) > $MaxElements ) { $truncated = 1; @what = splice( @what, 0, $MaxElements * 2 ); } return join( ', ', _dump_as_pairs_recursive( $depth, @what ), ( $truncated ? "..." : () ) ); } sub _dump_as_pairs_recursive { my ( $depth, @what ) = @_; return unless @what; my ( $key, $value, @rest ) = @what; return ( ( _format_key( $depth, $key ) . ': ' . _format( $depth, $value ) ), _dump_as_pairs_recursive( $depth, @rest ), ); } sub _dump_as_list { my ( $depth, @what ) = @_; my $truncated; if ( @what > $MaxElements ) { $truncated = 1; @what = splice( @what, 0, $MaxElements ); } return join( ', ', ( map { _format( $depth, $_ ) } @what ), ( $truncated ? "..." : () ) ); } sub _format { my ( $depth, $value ) = @_; defined($value) ? ( ref($value) ? ( blessed($value) ? _format_object( $depth, $value ) : _format_ref( $depth, $value ) ) : ( looks_like_number($value) ? _format_number( $depth, $value ) : _format_string( $depth, $value ) ) ) : _format_undef( $depth, $value ), } sub _format_key { my ( undef, $key ) = @_; return $key; } sub _format_ref { my ( $depth, $ref ) = @_; if ( $depth > $MaxDepth ) { return overload::StrVal($ref); } else { my $reftype = reftype($ref); $reftype = 'SCALAR' if $reftype eq 'REF' || $reftype eq 'LVALUE'; my $method = "_format_" . lc $reftype; if ( my $sub = __PACKAGE__->can($method) ) { return $sub->( $depth, $ref ); } else { return overload::StrVal($ref); } } } sub _format_array { my ( $depth, $array ) = @_; my $class = blessed($array) || ''; $class .= "=" if $class; return $class . "[ " . _dump_as_list( $depth + 1, @$array ) . " ]"; } sub _format_hash { my ( $depth, $hash ) = @_; my $class = blessed($hash) || ''; $class .= "=" if $class; return $class . "{ " . _dump_as_pairs( $depth + 1, map { $_ => $hash->{$_} } sort keys %$hash ) . " }"; } sub _format_scalar { my ( $depth, $scalar ) = @_; my $class = blessed($scalar) || ''; $class .= "=" if $class; return $class . "\\" . _format( $depth + 1, $$scalar ); } sub _format_object { my ( $depth, $object ) = @_; return _format_ref( $depth, $object ); } sub _format_string { my ( undef, $str ) = @_; # FIXME use String::Escape ? # remove vertical whitespace $str =~ s/\n/\\n/g; $str =~ s/\r/\\r/g; # reformat nonprintables $str =~ s/(\P{IsPrint})/"\\x{" . sprintf("%x", ord($1)) . "}"/ge; _quote($str); } sub _quote { my ($str) = @_; qq{"$str"}; } sub _format_undef {"undef"} sub _format_number { my ( undef, $value ) = @_; return "$value"; } # ABSTRACT: A partially rear-ended copy of Devel::PartialDump without prereqs 1; __END__ =pod =encoding UTF-8 =head1 NAME Specio::PartialDump - A partially rear-ended copy of Devel::PartialDump without prereqs =head1 VERSION version 0.33 =head1 SYNOPSIS use Specio::PartialDump qw( partial_dump ); partial_dump( { foo => 42 } ); partial_dump(qw( a b c d e f g )); partial_dump( foo => 42, bar => [ 1, 2, 3 ], ); =head1 DESCRIPTION This is a copy of Devel::PartialDump with all the OO bits and prereqs removed. You may want to use this module in your own code to generate nicely formatted messages when a type constraint fails. This module optionally exports one sub, C. This sub accepts any number of arguments. If given more than one, it will assume that it's either been given a list of key/value pairs (to build a hash) or a list of values (to build an array) and dump them appropriately. Objects and references are stringified in a sane way. =for Pod::Coverage partial_dump =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2008 by יובל קוג'מן (Yuval Kogman). This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Exception.pm0000644000175000017500000000563513041701062017010 0ustar autarchautarchpackage Specio::Exception; use strict; use warnings; use overload q{""} => 'as_string', fallback => 1; our $VERSION = '0.33'; use Devel::StackTrace; use Scalar::Util qw( blessed ); use Specio::OO; { my $attrs = { message => { isa => 'Str', required => 1, }, type => { does => 'Specio::Constraint::Role::Interface', required => 1, }, value => { required => 1, }, stack_trace => { init_arg => undef, }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub BUILD { my $self = shift; $self->{stack_trace} = Devel::StackTrace->new( ignore_package => __PACKAGE__ ); return; } sub as_string { my $self = shift; my $str = $self->message; $str .= "\n\n" . $self->stack_trace->as_string; return $str; } sub throw { my $self = shift; die $self if blessed $self; die $self->new(@_); } __PACKAGE__->_ooify; 1; # ABSTRACT: A Throwable::Error subclass for type constraint failures __END__ =pod =encoding UTF-8 =head1 NAME Specio::Exception - A Throwable::Error subclass for type constraint failures =head1 VERSION version 0.33 =head1 DESCRIPTION This exception class is thrown by Specio when a type check fails. It emulates the L API, but doesn't use that module to avoid adding a dependency on L. =head1 DESCRIPTION use Try::Tiny; try { $type->validate_or_die($value); } catch { if ( $_->isa('Specio::Exception') ) { print $_->message, "\n"; print $_->type->name, "\n"; print $_->value, "\n"; } }; =for Pod::Coverage BUILD throw =head1 API This class provides the following methods: =head2 $exception->message The error message associated with the exception. =head2 $exception->stack_trace A L object for the exception. =head2 $exception->type The type constraint object against which the value failed. =head2 $exception->value The value that failed the type check. =head2 $exception->as_string The exception as a string. This includes the method and the stack trace. =head1 OVERLOADING This class overloads stringification to call the C method. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/Declare.pm0000644000175000017500000004435213041701062016410 0ustar autarchautarchpackage Specio::Declare; use strict; use warnings; use parent 'Exporter'; our $VERSION = '0.33'; use Carp qw( croak ); use Specio::Coercion; use Specio::Constraint::Simple; use Specio::DeclaredAt; use Specio::Helpers qw( install_t_sub _STRINGLIKE ); use Specio::Registry qw( internal_types_for_package register ); ## no critic (Modules::ProhibitAutomaticExportation) our @EXPORT = qw( anon any_can_type any_does_type any_isa_type coerce declare enum intersection object_can_type object_does_type object_isa_type union ); ## use critic sub import { my $package = shift; # What the heck is this monstrosity? # # Moose version 2.0901 included a first pass at support for Specio. This # was based on Specio c. 0.06 when Specio itself still used # Moose. Unfortunately, recent changes to Specio broke this support and # the Moose core needs updating. # # However, stable versions of Moose have since shipped with a test that # attempts to test itself with Specio 0.07+. This was fine until I wanted # to release a non-TRIAL Specio. # # Once that's out, anyone installing Specio will cause future attempts to # install Moose to fail until Moose includes updated Specio support! # Breaking Moose is not acceptable, thus this mess. # # Note that since Moose 2.1207 this test was renamed and the Specio tests # actually run (and pass). We still need to leave this in here for quite # some time. People should be able to install Specio and then install an # older Moose indefinitely (or at least for a year or two). if ( $ENV{HARNESS_ACTIVE} && $0 =~ m{t[\\/]type_constraints[\\/]specio\.t$} ) { require Test::More; Test::More::plan( skip_all => 'These tests will not pass with this version of Specio' ); exit 0; } my $caller = caller(); $package->export_to_level( 1, $package, @_ ); install_t_sub( $caller, internal_types_for_package($caller) ); return; } sub declare { my $name = _STRINGLIKE(shift) or croak 'You must provide a name for declared types'; my %p = @_; my $tc = _make_tc( name => $name, %p ); register( scalar caller(), $name, $tc, 'exportable' ); return $tc; } sub anon { return _make_tc(@_); } sub enum { my $name; $name = shift if @_ % 2; my %p = @_; require Specio::Constraint::Enum; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), values => $p{values}, type_class => 'Specio::Constraint::Enum', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub object_can_type { my $name; $name = shift if @_ % 2; my %p = @_; # This cannot be loaded earlier, since it loads Specio::Library::Builtins, # which in turn wants to load Specio::Declare (the current module). require Specio::Constraint::ObjectCan; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), methods => $p{methods}, type_class => 'Specio::Constraint::ObjectCan', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub object_does_type { my $name = shift; my %p = @_; my $caller = scalar caller(); # If we are being called repeatedly with a single argument, then we don't # want to blow up because the type has already been declared. This would # force the user to use t() for all calls but the first, making their code # pointlessly more complicated. unless ( keys %p ) { if ( my $tc = internal_types_for_package($caller)->{$name} ) { return $tc; } } require Specio::Constraint::ObjectDoes; my $tc = _make_tc( name => $name, role => ( defined $p{role} ? $p{role} : $name ), type_class => 'Specio::Constraint::ObjectDoes', ); register( scalar caller(), $name, $tc, 'exportable' ); return $tc; } sub object_isa_type { my $name = shift; my %p = @_; my $caller = scalar caller(); unless ( keys %p ) { if ( my $tc = internal_types_for_package($caller)->{$name} ) { return $tc; } } require Specio::Constraint::ObjectIsa; my $tc = _make_tc( name => $name, class => ( defined $p{class} ? $p{class} : $name ), type_class => 'Specio::Constraint::ObjectIsa', ); register( $caller, $name, $tc, 'exportable' ); return $tc; } sub any_can_type { my $name; $name = shift if @_ % 2; my %p = @_; # This cannot be loaded earlier, since it loads Specio::Library::Builtins, # which in turn wants to load Specio::Declare (the current module). require Specio::Constraint::AnyCan; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), methods => $p{methods}, type_class => 'Specio::Constraint::AnyCan', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub any_does_type { my $name = shift; my %p = @_; my $caller = scalar caller(); unless ( keys %p ) { if ( my $tc = internal_types_for_package($caller)->{$name} ) { return $tc; } } require Specio::Constraint::AnyDoes; my $tc = _make_tc( name => $name, role => ( defined $p{role} ? $p{role} : $name ), type_class => 'Specio::Constraint::AnyDoes', ); register( scalar caller(), $name, $tc, 'exportable' ); return $tc; } sub any_isa_type { my $name = shift; my %p = @_; my $caller = scalar caller(); unless ( keys %p ) { if ( my $tc = internal_types_for_package($caller)->{$name} ) { return $tc; } } require Specio::Constraint::AnyIsa; my $tc = _make_tc( name => $name, class => ( defined $p{class} ? $p{class} : $name ), type_class => 'Specio::Constraint::AnyIsa', ); register( scalar caller(), $name, $tc, 'exportable' ); return $tc; } sub intersection { my $name; $name = shift if @_ % 2; my %p = @_; require Specio::Constraint::Intersection; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), %p, type_class => 'Specio::Constraint::Intersection', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub union { my $name; $name = shift if @_ % 2; my %p = @_; require Specio::Constraint::Union; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), %p, type_class => 'Specio::Constraint::Union', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub _make_tc { my %p = @_; my $class = delete $p{type_class} || 'Specio::Constraint::Simple'; $p{constraint} = delete $p{where} if exists $p{where}; $p{message_generator} = delete $p{message} if exists $p{message}; $p{inline_generator} = delete $p{inline} if exists $p{inline}; return $class->new( %p, declared_at => Specio::DeclaredAt->new_from_caller(2), ); } sub coerce { my $to = shift; my %p = @_; $p{coercion} = delete $p{using} if exists $p{using}; $p{inline_generator} = delete $p{inline} if exists $p{inline}; return $to->add_coercion( Specio::Coercion->new( to => $to, %p, declared_at => Specio::DeclaredAt->new_from_caller(1), ) ); } 1; # ABSTRACT: Specio declaration subroutines __END__ =pod =encoding UTF-8 =head1 NAME Specio::Declare - Specio declaration subroutines =head1 VERSION version 0.33 =head1 SYNOPSIS package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'Foo', parent => t('Str'), where => sub { $_[0] =~ /foo/i }, ); declare( 'ArrayRefOfInt', parent => t( 'ArrayRef', of => t('Int') ), ); my $even = anon( parent => t('Int'), inline => sub { my $type = shift; my $value_var = shift; return $value_var . ' % 2 == 0'; }, ); coerce( t('ArrayRef'), from => t('Foo'), using => sub { [ $_[0] ] }, ); coerce( $even, from => t('Int'), using => sub { $_[0] % 2 ? $_[0] + 1 : $_[0] }, ); # Specio name is DateTime any_isa_type('DateTime'); # Specio name is DateTimeObject object_isa_type( 'DateTimeObject', class => 'DateTime' ); any_can_type( 'Duck', methods => [ 'duck_walk', 'quack' ], ); object_can_type( 'DuckObject', methods => [ 'duck_walk', 'quack' ], ); enum( 'Colors', values => [qw( blue green red )], ); intersection( 'HashRefAndArrayRef', of => [ t('HashRef'), t('ArrayRef') ], ); union( 'IntOrArrayRef', of => [ t('Int'), t('ArrayRef') ], ); =head1 DESCRIPTION This package exports a set of type declaration helpers. Importing this package also causes it to create a C subroutine the caller. =head1 SUBROUTINES This module exports the following subroutines. =head2 t('name') This subroutine lets you access any types you have declared so far, as well as any types you imported from another type library. If you pass an unknown name, it throws an exception. =head2 declare(...) This subroutine declares a named type. The first argument is the type name, followed by a set of key/value parameters: =over 4 =item * parent => $type The parent should be another type object. Specifically, it can be anything which does the L role. The parent can be a named or anonymous type. =item * where => sub { ... } This is a subroutine which defines the type constraint. It will be passed a single argument, the value to check, and it should return true or false to indicate whether or not the value is valid for the type. This parameter is mutually exclusive with the C parameter. =item * inline => sub { ... } This is a subroutine that is called to generate inline code to validate the type. Inlining can be I faster than simply providing a subroutine with the C parameter, but is often more complicated to get right. The inline generator is called as a method on the type with one argument. This argument is a I containing the variable name to use in the generated code. Typically this is something like C<'$_[0]'> or C<'$value'>. The inline generator subroutine should return a I of code representing a single term, and it I be terminated with a semicolon. This allows the inlined code to be safely included in an C statement, for example. You can use C blocks and ternaries to get everything into one term. Do not assign to the variable you are testing. This single term should evaluate to true or false. The inline generator is expected to include code to implement both the current type and all its parents. Typically, the easiest way to do this is to write a subroutine something like this: sub { my $self = shift; my $var = shift; return $_[0]->parent->inline_check( $_[1] ) . ' and more checking code goes here'; } This parameter is mutually exclusive with the C parameter. =item * message_generator => sub { ... } A subroutine to generate an error message when the type check fails. The default message says something like "Validation failed for type named Int declared in package Specio::Library::Builtins (.../Specio/blib/lib/Specio/Library/Builtins.pm) at line 147 in sub named (eval) with value 1.1". You can override this to provide something more specific about the way the type failed. The subroutine you provide will be called as a method on the type with two arguments. The first is the description of the type (the bit in the message above that starts with "type named Int ..." and ends with "... in sub named (eval)". This description says what the thing is and where it was defined. The second argument is the value that failed the type check, after any coercions that might have been applied. =back =head2 anon(...) This subroutine declares an anonymous type. It is identical to C except that it expects a list of key/value parameters without a type name as the first parameter. =head2 coerce(...) This declares a coercion from one type to another. The first argument should be an object which does the L role. This can be either a named or anonymous type. This type is the type that the coercion is I. The remaining arguments are key/value parameters: =over 4 =item * from => $type This must be an object which does the L role. This is type that we are coercing I. Again, this can be either a named or anonymous type. =item * using => sub { ... } This is a subroutine which defines the type coercion. It will be passed a single argument, the value to coerce. It should return a new value of the type this coercion is to. This parameter is mutually exclusive with the C parameter. =item * inline => sub { ... } This is a subroutine that is called to generate inline code to perform the coercion. The inline generator is called as a method on the type with one argument. This argument is a I containing the variable name to use in the generated code. Typically this is something like C<'$_[0]'> or C<'$value'>. The inline generator subroutine should return a I of code representing a single term, and it I be terminated with a semicolon. This allows the inlined code to be safely included in an C statement, for example. You can use C blocks and ternaries to get everything into one term. This single term should evaluate to the new value. =back =head1 DECLARATION HELPERS This module also exports some helper subs for declaring certain kinds of types: =head2 any_isa_type, object_isa_type The C helper creates a type which accepts a class name or object of the given class. The C helper creates a type which only accepts an object of the given class. These subroutines take a type name as the first argument. The remaining arguments are key/value pairs. Currently this is just the C key, which should be a class name. This is the class that the type requires. You can also pass just a single argument, in which case that will be used as both the type's name and the class for the constraint to check. =head2 any_does_type, object_does_type The C helper creates a type which accepts a class name or object which does the given role. The C helper creates a type which only accepts an object which does the given role. These subroutines take a type name as the first argument. The remaining arguments are key/value pairs. Currently this is just the C key, which should be a role name. This is the class that the type requires. This should just work (I hope) with roles created by L, L, and L (using L). You can also pass just a single argument, in which case that will be used as both the type's name and the role for the constraint to check. =head2 any_can_type, object_can_type The C helper creates a type which accepts a class name or object with the given methods. The C helper creates a type which only accepts an object with the given methods. These subroutines take a type name as the first argument. The remaining arguments are key/value pairs. Currently this is just the C key, which can be either a string or array reference of strings. These strings are the required methods for the type. The type name argument can be omitted to create an anonymous type. =head2 enum This creates a type which accepts a string matching a given list of acceptable values. The first argument is the type name. The remaining arguments are key/value pairs. Currently this is just the C key. This should an array reference of acceptable string values. The type name argument can be omitted to create an anonymous type. =head2 intersection This creates a type which is the intersection of two or more other types. A union only accepts values which match all of its underlying types. The first argument is the type name. The remaining arguments are key/value pairs. Currently this is just the C key. This should an array reference of types. The type name argument can be omitted to create an anonymous type. =head2 union This creates a type which is the union of two or more other types. A union accepts any of its underlying types. The first argument is the type name. The remaining arguments are key/value pairs. Currently this is just the C key. This should an array reference of types. The type name argument can be omitted to create an anonymous type. =head1 PARAMETERIZED TYPES You can create a parameterized type by calling C with additional parameters, like this: my $arrayref_of_int = t( 'ArrayRef', of => t('Int') ); my $arrayref_of_hashref_of_int = t( 'ArrayRef', of => t( 'HashRef', of => t('Int'), ), ); The C subroutine assumes that if it receives more than one argument, it should look up the named type and call C<< $type->parameterize(...) >> with the additional arguments. If the named type cannot be parameterized, it throws an error. You can also call C<< $type->parameterize >> directly if needed. See L for details. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio/TypeChecks.pm0000644000175000017500000000363713041701062017114 0ustar autarchautarchpackage Specio::TypeChecks; use strict; use warnings; our $VERSION = '0.33'; use Exporter qw( import ); use Specio::Helpers qw( is_class_loaded ); use Scalar::Util qw( blessed ); our @EXPORT_OK = qw( does_role is_ArrayRef is_ClassName is_CodeRef is_HashRef is_Int is_Str isa_class ); sub is_ArrayRef { return ref $_[0] eq 'ARRAY'; } sub is_CodeRef { return ref $_[0] eq 'CODE'; } sub is_HashRef { return ref $_[0] eq 'HASH'; } sub is_Str { defined( $_[0] ) && !ref( $_[0] ) && ref( \$_[0] ) eq 'SCALAR' || ref( \( my $val = $_[0] ) eq 'SCALAR' ); } sub is_Int { ( defined( $_[0] ) && !ref( $_[0] ) && ref( \$_[0] ) eq 'SCALAR' || ref( \( my $val = $_[0] ) eq 'SCALAR' ) ) && $_[0] =~ /^[0-9]+$/; } sub is_ClassName { is_class_loaded( $_[0] ); } sub isa_class { blessed( $_[0] ) && $_[0]->isa( $_[1] ); } sub does_role { blessed( $_[0] ) && $_[0]->can('does') && $_[0]->does( $_[1] ); } 1; # ABSTRACT: Type checks used internally for Specio classes (it's not self-bootstrapping (yet?)) __END__ =pod =encoding UTF-8 =head1 NAME Specio::TypeChecks - Type checks used internally for Specio classes (it's not self-bootstrapping (yet?)) =head1 VERSION version 0.33 =head1 DESCRIPTION There's nothing public here. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Test/0000775000175000017500000000000013041701062014202 5ustar autarchautarchSpecio-0.33/lib/Test/Specio.pm0000644000175000017500000002747713041701062016001 0ustar autarchautarchpackage Test::Specio; use strict; use warnings; our $VERSION = '0.33'; use B (); use IO::File; use Scalar::Util qw( blessed looks_like_number openhandle ); use Specio::Library::Builtins; use Specio::Library::Numeric; use Specio::Library::Perl; use Specio::Library::String; use Test::Fatal; use Test::More 0.96; use Exporter qw( import ); our $ZERO = 0; our $ONE = 1; our $INT = 100; our $NEG_INT = -100; our $NUM = 42.42; our $NEG_NUM = -42.42; our $EMPTY_STRING = q{}; our $STRING = 'foo'; our $NUM_IN_STRING = 'has 42 in it'; our $INT_WITH_NL1 = "1\n"; our $INT_WITH_NL2 = "\n1"; our $SCALAR_REF = do { ## no critic (Variables::ProhibitUnusedVariables) \( my $var ); }; our $SCALAR_REF_REF = \$SCALAR_REF; our $ARRAY_REF = []; our $HASH_REF = {}; our $CODE_REF = sub { }; our $GLOB_REF = \*GLOB; our $FH; ## no critic (InputOutput::RequireBriefOpen) open $FH, '<', $INC{'Test/Specio.pm'} or die "Could not open $INC{'Test/Specio.pm'} for the test"; our $FH_OBJECT = IO::File->new( $INC{'Test/Specio.pm'}, 'r' ) or die "Could not open $INC{'Test/Specio.pm'} for the test"; our $REGEX = qr/../; our $REGEX_OBJ = bless qr/../, 'BlessedQR'; our $FAKE_REGEX = bless {}, 'Regexp'; our $OBJECT = bless {}, 'Foo'; our $UNDEF = undef; ## no critic (Modules::ProhibitMultiplePackages) { package _T::Thing; sub foo { } } our $CLASS_NAME = '_T::Thing'; { package _T::BoolOverload; use overload 'bool' => sub { ${ $_[0] } }, fallback => 0; sub new { my $bool = $_[1]; bless \$bool, __PACKAGE__; } } our $BOOL_OVERLOAD_TRUE = _T::BoolOverload->new(1); our $BOOL_OVERLOAD_FALSE = _T::BoolOverload->new(0); { package _T::StrOverload; use overload q{""} => sub { ${ $_[0] } }, fallback => 0; sub new { my $str = $_[1]; bless \$str, __PACKAGE__; } } our $STR_OVERLOAD_EMPTY = _T::StrOverload->new(q{}); our $STR_OVERLOAD_FULL = _T::StrOverload->new('full'); our $STR_OVERLOAD_CLASS_NAME = _T::StrOverload->new('_T::StrOverload'); { package _T::NumOverload; use overload q{0+} => sub { ${ $_[0] } }, '+' => sub { ${ $_[0] } + $_[1] }, fallback => 0; sub new { my $num = $_[1]; bless \$num, __PACKAGE__; } } our $NUM_OVERLOAD_ZERO = _T::NumOverload->new(0); our $NUM_OVERLOAD_ONE = _T::NumOverload->new(1); our $NUM_OVERLOAD_NEG = _T::NumOverload->new(-42); our $NUM_OVERLOAD_DECIMAL = _T::NumOverload->new(42.42); our $NUM_OVERLOAD_NEG_DECIMAL = _T::NumOverload->new(42.42); { package _T::CodeOverload; use overload q{&{}} => sub { ${ $_[0] } }, fallback => 0; sub new { my $code = $_[1]; bless \$code, __PACKAGE__; } } our $CODE_OVERLOAD = _T::CodeOverload->new( sub { } ); { package _T::RegexOverload; use overload q{qr} => sub { ${ $_[0] } }, fallback => 0; sub new { my $regex = $_[1]; bless \$regex, __PACKAGE__; } } our $REGEX_OVERLOAD = _T::RegexOverload->new(qr/foo/); { package _T::GlobOverload; use overload q[*{}] => sub { ${ $_[0] } }, fallback => 0; sub new { my $glob = $_[1]; bless \$glob, __PACKAGE__; } } { package _T::ScalarOverload; use overload q[${}] => sub { ${ $_[0] } }, fallback => 0; sub new { my $scalar = $_[1]; bless \$scalar, __PACKAGE__; } } our $SCALAR_OVERLOAD = _T::ScalarOverload->new('x'); { package _T::ArrayOverload; use overload q[@{}] => sub { $_[0] }, fallback => 0; sub new { my $array = $_[1]; bless $array, __PACKAGE__; } } our $ARRAY_OVERLOAD = _T::ArrayOverload->new( [ 1, 2, 3 ] ); { package _T::HashOverload; use overload q[%{}] => sub { $_[0] }, fallback => 0; sub new { my $hash = $_[1]; bless $hash, __PACKAGE__; } } our $HASH_OVERLOAD = _T::HashOverload->new( { x => 42, y => 84 } ); my @vars; BEGIN { open my $fh, '<', $INC{'Test/Specio.pm'} or die $!; while (<$fh>) { push @vars, $1 if /^our (\$[A-Z0-9_]+)(?: +=|;)/; } } our @EXPORT_OK = ( @vars, qw( describe test_constraint ) ); our %EXPORT_TAGS = ( vars => \@vars ); sub test_constraint { my $type = shift; my $tests = shift; my $describer = shift || \&describe; local $Test::Builder::Level = $Test::Builder::Level + 1; $type = t($type) unless blessed $type; subtest( ( $type->name || '' ), sub { my $not_inlined = $type->_constraint_with_parents; my $inlined; if ( $type->can_be_inlined ) { $inlined = $type->_generated_inline_sub; } for my $accept ( @{ $tests->{accept} || [] } ) { my $described = $describer->($accept); ok( $type->value_is_valid($accept), "accepts $described using ->value_is_valid" ); is( exception { $type->($accept) }, undef, "accepts $described using subref overloading" ); ok( $not_inlined->($accept), "accepts $described using non-inlined constraint" ); if ($inlined) { ok( $inlined->($accept), "accepts $described using inlined constraint" ); } } for my $reject ( @{ $tests->{reject} || [] } ) { my $described = $describer->($reject); ok( !$type->value_is_valid($reject), "rejects $described using ->value_is_valid" ); if ($inlined) { ok( !$inlined->($reject), "rejects $described using inlined constraint" ); } } } ); } sub describe { my $val = shift; return 'undef' unless defined $val; if ( !ref $val ) { return q{''} if $val eq q{}; return looks_like_number($val) && $val !~ /\n/ ? $val : B::perlstring($val); } return 'open filehandle' if openhandle $val && !blessed $val; if ( blessed $val ) { my $desc = ( ref $val ) . ' object'; if ( $val->isa('_T::StrOverload') ) { $desc .= ' (' . describe("$val") . ')'; } elsif ( $val->isa('_T::BoolOverload') ) { $desc .= ' (' . ( $val ? 'true' : 'false' ) . ')'; } elsif ( $val->isa('_T::NumOverload') ) { $desc .= ' (' . describe( ${$val} ) . ')'; } return $desc; } else { return ( ref $val ) . ' reference'; } } 1; # ABSTRACT: Test helpers for Specio __END__ =pod =encoding UTF-8 =head1 NAME Test::Specio - Test helpers for Specio =head1 VERSION version 0.33 =head1 SYNOPSIS use Test::Specio qw( test_constraint :vars ); test_constraint( t('Foo'), { accept => [ 'foo', 'bar' ], reject => [ 42, {}, $EMPTY_STRING, $HASH_REF ], } ); =head1 DESCRIPTION This package provides some helper functions and variables for testing Specio types. =head1 EXPORTS This module provides the following exports: =head2 test_constraint( $type, $tests, [ $describer ] ) This subroutine accepts two arguments. The first should be a Specio type object. The second is hashref which can contain the keys C and C. Each key should contain an arrayref of values which the type accepts or rejects. The third argument is optional. This is a sub reference which will be called to generate a description of the value being tested. This defaults to calling this package's C sub, but you can provide your own. =head2 describe($value) Given a value, this subroutine returns a string describing that value in a useful way for test output. It know about the various classes used for the variables exported by this package and will do something intelligent when such a variable. =head2 Variables This module also exports many variables containing values which are useful for testing constraints. Note that references are always empty unless stated otherwise. You can import these variables individually or import all of them with the C<:vars> import tag. =over 4 =item * C<$ZERO> =item * C<$ONE> =item * C<$INT> An arbitrary positive integer. =item * C<$NEG_INT> An arbitrary negative integer. =item * C<$NUM> An arbitrary positive non-integer number. =item * C<$NEG_NUM> An arbitrary negative non-integer number. =item * C<$EMPTY_STRING> =item * C<$STRING> An arbitrary non-empty string. =item * C<$NUM_IN_STRING> An arbitrary string which contains a number. =item * C<$INT_WITH_NL1> An string containing an integer followed by a newline. =item * C<$INT_WITH_NL2> An string containing a newline followed by an integer. =item * C<$SCALAR_REF> =item * C<$SCALAR_REF_REF> A reference containing a reference to a scalar. =item * C<$ARRAY_REF> =item * C<$HASH_REF> =item * C<$CODE_REF> =item * C<$GLOB_REF> =item * C<$FH> An opened filehandle. =item * C<$FH_OBJECT> An opened L object. =item * C<$REGEX> A regex created with C. =item * C<$REGEX_OBJ> A regex created with C that was then blessed into class. =item * C<$FAKE_REGEX> A non-regex blessed into the C class which Perl uses internally for C objects. =item * C<$OBJECT> An arbitrary object. =item * C<$UNDEF> =item * C<$CLASS_NAME> A string containing a loaded package name. =item * C<$BOOL_OVERLOAD_TRUE> An object which overloads boolification to return true. =item * C<$BOOL_OVERLOAD_FALSE> An object which overloads boolification to return false. =item * C<$STR_OVERLOAD_EMPTY> An object which overloads stringification to return an empty string. =item * C<$STR_OVERLOAD_FULL> An object which overloads stringification to return a non-empty string. =item * C<$STR_OVERLOAD_CLASS_NAME> An object which overloads stringification to return a loaded package name. =item * C<$NUM_OVERLOAD_ZERO> =item * C<$NUM_OVERLOAD_ONE> =item * C<$NUM_OVERLOAD_NEG> =item * C<$NUM_OVERLOAD_DECIMAL> =item * C<$NUM_OVERLOAD_NEG_DECIMAL> =item * C<$CODE_OVERLOAD> =item * C<$SCALAR_OVERLOAD> An object which overloads scalar dereferencing to return a non-empty string. =item * C<$ARRAY_OVERLOAD> An object which overloads array dereferencing to return a non-empty array. =item * C<$HASH_OVERLOAD> An object which overloads hash dereferencing to return a non-empty hash. =back =head2 _T::GlobOverload package This package is defined when you load C so you can create your own glob overloading objects. Such objects cannot be exported because the glob they return does not transfer across packages properly. You can create such a variable like this: local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); If you want to create a glob overloading object that returns filehandle, do this: local *BAR; open BAR, '<', $0 or die "Could not open $0 for the test"; my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/lib/Specio.pm0000644000175000017500000003407313041701062015050 0ustar autarchautarchpackage Specio; use strict; use warnings; use 5.008; our $VERSION = '0.33'; 1; # ABSTRACT: Type constraints and coercions for Perl __END__ =pod =encoding UTF-8 =head1 NAME Specio - Type constraints and coercions for Perl =head1 VERSION version 0.33 =head1 SYNOPSIS package MyApp::Type::Library; use Specio::Declare; use Specio::Library::Builtins; declare( 'PositiveInt', parent => t('Int'), inline => sub { $_[0]->parent->inline_check( $_[1] ) . ' && ( ' . $_[1] . ' > 0 )'; }, ); # or ... declare( 'PositiveInt', parent => t('Int'), where => sub { $_[0] > 0 }, ); declare( 'ArrayRefOfPositiveInt', parent => t( 'ArrayRef', of => t('PositiveInt'), ), ); coerce( 'ArrayRefOfPositiveInt', from => t('PositiveInt'), using => sub { [ $_[0] ] }, ); any_can_type( 'Duck', methods => [ 'duck_walk', 'quack' ], ); object_isa_type('MyApp::Person'); =head1 DESCRIPTION The C distribution provides classes for representing type constraints and coercion, along with syntax sugar for declaring them. Note that this is not a proper type system for Perl. Nothing in this distribution will magically make the Perl interpreter start checking a value's type on assignment to a variable. In fact, there's no built-in way to apply a type to a variable at all. Instead, you can explicitly check a value against a type, and optionally coerce values to that type. My long-term goal is to replace Moose's built-in types and L with this module. =head1 WHAT IS A TYPE? At it's core, a type is simply a constraint. A constraint is code that checks a value and returns true or false. Most constraints are represented by L objects. However, there are other type constraint classes for specialized kinds of constraints. Types can be named or anonymous, and each type can have a parent type. A type's constraint is optional because sometimes you may want to create a named subtype of some existing type without adding additional constraints. Constraints can be expressed either in terms of a simple subroutine reference or in terms of an inline generator subroutine reference. The former is easier to write but the latter is preferred because it allow for better optimization. A type can also have an optional message generator subroutine reference. You can use this to provide a more intelligent error message when a value does not pass the constraint, though the default message should suffice for most cases. Finally, you can associate a set of coercions with a type. A coercion is a subroutine reference (or inline generator, like constraints), that takes a value of one type and turns it into a value that matches the type the coercion belongs to. =head1 BUILTIN TYPES This distribution ships with a set of builtin types representing the types provided by the Perl interpreter itself. They are arranged in a hierarchy as follows: Item Bool Maybe (of `a) Undef Defined Value Str Num Int ClassName Ref ScalarRef (of `a) ArrayRef (of `a) HashRef (of `a) CodeRef RegexpRef GlobRef FileHandle Object The C type accepts anything and everything. The C type only accepts C, C<0>, or C<1>. The C type only accepts C. The C type accepts anything I C. The C and C types are stricter about numbers than Perl is. Specifically, they do not allow any sort of space in the number, nor do they accept "Nan", "Inf", or "Infinity". The C type constraint checks that the name is valid I that the class is loaded. The C type accepts either a glob, a scalar filehandle, or anything that isa L. All types accept overloaded objects that support the required operation. See below for details. =head2 Overloading Perl's overloading is horribly broken and doesn't make much sense at all. However, unlike Moose, all type constraints allow overloaded objects where they make sense. For types where overloading makes sense, we explicitly check that the object provides the type overloading we expect. We I simply try to use the object as the type in question and hope it works. This means that these checks effectively ignore the C setting for the overloaded object. In other words, an object that overloads stringification will not pass the C type check unless it I overloads boolification. Most types do not check that the overloaded method actually returns something that matches the constraint. This may change in the future. The C type accepts an object that provides C overloading. The C type accepts an object that provides string (C) overloading. The C type accepts an object that provides numeric C<'0+'}> overloading. The C type does as well, but it will check that the overloading returns an actual integer. The C type will accept an object with string overloading that returns a class name. To make this all more confusing, the C type will I accept an object, even though some of its subtypes will. The various reference types all accept objects which provide the appropriate overloading. The C type accepts an object which overloads globification as long as the returned glob is an open filehandle. =head1 PARAMETERIZABLE TYPES Any type followed by a type parameter C in the hierarchy above can be parameterized. The parameter is itself a type, so you can say you want an "ArrayRef of Int", or even an "ArrayRef of HashRef of ScalarRef of ClassName". When they are parameterized, the C and C types check that the value(s) they refer to match the type parameter. For the C type, the parameter applies to the values (keys are never checked). =head2 Maybe The C type is a special parameterized type. It allows for either C or a value. All by itself, it is meaningless, since it is equivalent to "Maybe of Item", which is equivalent to Item. When parameterized, it accepts either an C or the type of its parameter. This is useful for optional attributes or parameters. However, you're probably better off making your code simply not pass the parameter at all This usually makes for a simpler API. =head1 REGISTRIES AND IMPORTING Types are local to each package where they are used. When you "import" types from some other library, you are actually making a copy of that type. This means that a type named "Foo" in one package may not be the same as "Foo" in another package. This has potential for confusion, but it also avoids the magic action at a distance pollution that comes with a global type naming system. The registry is managed internally by the Specio distribution's modules, and is not exposed to your code. To access a type, you always call C. This returns the named type or dies if no such type exists. Because types are always copied on import, it's safe to create coercions on any type. Your coercion from C to C will not be seen by any other package, unless that package explicitly imports your C type. When you import types, you import every type defined in the package you import from. However, you I overwrite an imported type with your own type definition. You I define the same type twice internally. =head1 CREATING A TYPE LIBRARY By default, all types created inside a package are invisible to other packages. If you want to create a type library, you need to inherit from L package: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'Foo', parent => t('Str'), where => sub { $_[0] =~ /foo/i }, ); Now the MyApp::Type::Library package will export a single type named C. It I re-export the types provided by L. If you want to make your library re-export some other libraries types, you can ask for this explicitly: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins -reexport; declare( 'Foo, ... ); Now MyApp::Types::Library exports any types it defines, as well as all the types defined in L. =head1 DECLARING TYPES Use the L module to declare types. It exports a set of helpers for declaring types. See that module's documentation for more details on these helpers. =head1 USING SPECIO WITH L This should just work. Use a Specio type anywhere you'd specify a type. =head1 USING SPECIO WITH L Using Specio with Moo is easy. You can pass Specio constraint objects as C parameters for attributes. For coercions, simply call C<< $type->coercion_sub >>. package Foo; use Specio::Declare; use Specio::Library::Builtins; use Moo; my $str_type = t('Str'); has string => ( is => 'ro', isa => $str_type, ); my $ucstr = declare( 'UCStr', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr => ( is => 'ro', isa => $ucstr, coerce => $ucstr->coercion_sub, ); The subs returned by Specio use L internally and are suitable for inlining. =head1 USING SPECIO WITH OTHER THINGS See L for the API that all constraint objects share. =head1 L, L, and Specio This module aims to supplant both L's built-in type system (see L aka MUTC) and L, which attempts to patch some of the holes in the Moose built-in type design. Here are some of the salient differences: =over 4 =item * Types names are strings, but they're not global Unlike Moose and MooseX::Types, type names are always local to the current package. There is no possibility of name collision between different modules, so you can safely use short type names. Unlike MooseX::Types, types are strings, so there is no possibility of colliding with existing class or subroutine names. =item * No type auto-creation Types are always retrieved using the C subroutine. If you pass an unknown name to this subroutine it dies. This is different from Moose and MooseX::Types, which assume that unknown names are class names. =item * Anon types are explicit With L and L, you use the same subroutine, C, to declare both named and anonymous types. With Specio, you use C for named types and C for anonymous types. =item * Class and object types are separate Moose and MooseX::Types have C and C. The former type requires an object, while the latter accepts a class name or object. With Specio, the distinction between accepting an object versus object or class is explicit. There are six declaration helpers, C, C, C, C, C, and C. =item * Overloading support is baked in Perl's overloading is quite broken but ignoring it makes Moose's type system frustrating to use in many cases. =item * Types can either have a constraint or inline generator, not both Moose and MooseX::Types types can be defined with a subroutine reference as the constraint, an inline generator subroutine, or both. This is purely for backwards compatibility, and it makes the internals more complicated than they need to be. With Specio, a constraint can have I a subroutine reference or an inline generator, not both. =item * Coercions can be inlined I simply never got around to implementing this in Moose. =item * No crazy coercion features Moose has some bizarre (and mostly) undocumented features relating to coercions and parameterizable types. This is a misfeature. =back =head1 WHY THE NAME? This distro was originally called "Type", but that's an awfully generic top level namespace. Specio is Latin for for "look at" and "spec" is the root for the word "species". It's short, relatively easy to type, and not used by any other distro. =head1 LONG-TERM PLANS Eventually I'd like to see this distro replace Moose's internal type system, which would also make MooseX::Types obsolete. =head1 SUPPORT Bugs may be submitted at L. I am also usually active on IRC as 'autarch' on C. =head1 SOURCE The source code repository for Specio can be found at L. =head1 DONATIONS If you'd like to thank me for the work I've done on this module, please consider making a "donation" to me via PayPal. I spend a lot of free time creating free software, and would appreciate any support you'd care to offer. Please note that B in order for me to continue working on this particular software. I will continue to do so, inasmuch as I have in the past, for as long as it interests me. Similarly, a donation made in this way will probably not make me work on this software much more, unless I get so many donations that I can consider working on free software full time (let's all have a chuckle at that together). To donate, log into PayPal and send money to autarch@urth.org, or use the button at L. =head1 AUTHOR Dave Rolsky =head1 CONTRIBUTOR =for stopwords Karen Etheridge Karen Etheridge =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.33/cpanfile0000644000175000017500000000403013041701062014214 0ustar autarchautarchrequires "B" => "0"; requires "Carp" => "0"; requires "Devel::StackTrace" => "0"; requires "Eval::Closure" => "0"; requires "Exporter" => "0"; requires "IO::File" => "0"; requires "List::Util" => "1.33"; requires "MRO::Compat" => "0"; requires "Role::Tiny" => "1.003003"; requires "Role::Tiny::With" => "0"; requires "Scalar::Util" => "0"; requires "Storable" => "0"; requires "Test::Fatal" => "0"; requires "Test::More" => "0.96"; requires "overload" => "0"; requires "parent" => "0"; requires "perl" => "5.008"; requires "re" => "0"; requires "strict" => "0"; requires "version" => "0.83"; requires "warnings" => "0"; on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "Test::More" => "0.96"; requires "Test::Needs" => "0"; requires "lib" => "0"; requires "open" => "0"; requires "utf8" => "0"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'develop' => sub { requires "Code::TidyAll::Plugin::Test::Vars" => "0.02"; requires "File::Spec" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Moo" => "0"; requires "Moose" => "2.1207"; requires "Mouse" => "0"; requires "Parallel::ForkManager" => "1.19"; requires "Perl::Critic" => "1.126"; requires "Perl::Tidy" => "20160302"; requires "Pod::Coverage::TrustPod" => "0"; requires "Pod::Wordlist" => "0"; requires "Sub::Quote" => "0"; requires "Test::CPAN::Changes" => "0.19"; requires "Test::CPAN::Meta::JSON" => "0.16"; requires "Test::Code::TidyAll" => "0.50"; requires "Test::EOL" => "0"; requires "Test::Mojibake" => "0"; requires "Test::More" => "0.88"; requires "Test::NoTabs" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Pod::Coverage" => "1.08"; requires "Test::Portability::Files" => "0"; requires "Test::Spelling" => "0.12"; requires "Test::Vars" => "0.009"; requires "Test::Version" => "2.05"; requires "blib" => "1.01"; requires "namespace::autoclean" => "0"; }; Specio-0.33/perlcriticrc0000644000175000017500000000347113041701062015130 0ustar autarchautarchseverity = 3 verbose = 11 theme = core + pbp + bugs + maintenance + cosmetic + complexity + security + tests + moose program-extensions = pl psgi t exclude = Subroutines::ProhibitCallsToUndeclaredSubs [BuiltinFunctions::ProhibitStringySplit] severity = 3 [CodeLayout::RequireTrailingCommas] severity = 3 [ControlStructures::ProhibitCStyleForLoops] severity = 3 [InputOutput::RequireCheckedSyscalls] functions = :builtins exclude_functions = sleep severity = 3 [RegularExpressions::ProhibitComplexRegexes] max_characters = 200 [RegularExpressions::ProhibitUnusualDelimiters] severity = 3 [Subroutines::ProhibitUnusedPrivateSubroutines] private_name_regex = _(?!build)\w+ [TestingAndDebugging::ProhibitNoWarnings] allow = redefine [ValuesAndExpressions::ProhibitEmptyQuotes] severity = 3 [ValuesAndExpressions::ProhibitInterpolationOfLiterals] severity = 3 [ValuesAndExpressions::RequireUpperCaseHeredocTerminator] severity = 3 [Variables::ProhibitPackageVars] add_packages = Carp Test::Builder [-Subroutines::RequireFinalReturn] # This incorrectly thinks signatures are prototypes. [-Subroutines::ProhibitSubroutinePrototypes] [-ErrorHandling::RequireCarping] # No need for /xsm everywhere [-RegularExpressions::RequireDotMatchAnything] [-RegularExpressions::RequireExtendedFormatting] [-RegularExpressions::RequireLineBoundaryMatching] # http://stackoverflow.com/questions/2275317/why-does-perlcritic-dislike-using-shift-to-populate-subroutine-variables [-Subroutines::RequireArgUnpacking] # "use v5.14" is more readable than "use 5.014" [-ValuesAndExpressions::ProhibitVersionStrings] # Explicitly returning undef is a _good_ thing in many cases, since it # prevents very common errors when using a sub in list context to construct a # hash and ending up with a missing value or key. [-Subroutines::ProhibitExplicitReturnUndef] Specio-0.33/INSTALL0000644000175000017500000000213113041701062013541 0ustar autarchautarchThis is the Perl distribution Specio. Installing Specio is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm Specio If it does not have permission to install modules to the current perl, cpanm will automatically set up and install to a local::lib in your home directory. See the local::lib documentation (https://metacpan.org/pod/local::lib) for details on enabling it in your environment. ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan Specio ## Manual installation As a last resort, you can manually install it. Download the tarball, untar it, then build it: % perl Makefile.PL % make && make test Then install it: % make install If your perl is system-managed, you can create a local::lib in your home directory to install modules to. For details, see the local::lib documentation: https://metacpan.org/pod/local::lib ## Documentation Specio documentation is available as POD. You can run perldoc from a shell to read the documentation: % perldoc Specio Specio-0.33/LICENSE0000644000175000017500000002152713041701062013527 0ustar autarchautarchThis software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Specio-0.33/tidyall.ini0000644000175000017500000000131213041701062014653 0ustar autarchautarch[PerlCritic] select = **/*.{pl,pm,t,psgi} ignore = .build/**/* ignore = Specio-*/**/* ignore = blib/**/* ignore = lib/Specio/PartialDump.pm ignore = t/00-* ignore = t/author-* ignore = t/release-* ignore = t/zzz-* ignore = xt/**/* argv = --profile=$ROOT/perlcriticrc [PerlTidy] select = **/*.{pl,pm,t,psgi} ignore = .build/**/* ignore = Specio-*/**/* ignore = blib/**/* ignore = t/00-* ignore = t/author-* ignore = t/release-* ignore = t/zzz-* ignore = xt/**/* argv = --profile=$ROOT/perltidyrc [SortLines] select = .stopwords [Test::Vars] select = **/*.pm ignore = .build/**/* ignore = Specio-*/**/* ignore = blib/**/* ignore = t/00-* ignore = t/author-* ignore = t/release-* ignore = t/zzz-* ignore = xt/**/* Specio-0.33/CONTRIBUTING.md0000644000175000017500000001002413041701062014741 0ustar autarchautarch# CONTRIBUTING Thank you for considering contributing to this distribution. This file contains instructions that will help you work with the source code. Please note that if you have any questions or difficulties, you can reach the maintainer(s) through the bug queue described later in this document (preferred), or by emailing the releaser directly. You are not required to follow any of the steps in this document to submit a patch or bug report; these are just recommendations, intended to help you (and help us help you faster). The distribution is managed with [Dist::Zilla](https://metacpan.org/release/Dist-Zilla). However, you can still compile and test the code with the `Makefile.PL` or `Build.PL` in the repository: perl Makefile.PL make make test or perl Build.PL ./Build ./Build test As well as: $ prove -bvr t or $ perl -Mblib t/some_test_file.t You may need to satisfy some dependencies. The easiest way to satisfy dependencies is to install the last release. This is available at https://metacpan.org/release/Specio If you use cpanminus, you can do it without downloading the tarball first: $ cpanm --reinstall --installdeps --with-recommends Specio Dist::Zilla is a very powerful authoring tool, but requires a number of author-specific plugins. If you would like to use it for contributing, install it from CPAN, then run one of the following commands, depending on your CPAN client: $ cpan `dzil authordeps --missing` or $ dzil authordeps --missing | cpanm They may also be additional requirements not needed by the dzil build which are needed for tests or other development: $ cpan `dzil listdeps --author --missing` or $ dzil listdeps --author --missing | cpanm Or, you can use the 'dzil stale' command to install all requirements at once: $ cpan Dist::Zilla::App::Command::stale $ cpan `dzil stale --all` or $ cpanm Dist::Zilla::App::Command::stale $ dzil stale --all | cpanm You can also do this via cpanm directly: $ cpanm --reinstall --installdeps --with-develop --with-recommends Specio Once installed, here are some dzil commands you might try: $ dzil build $ dzil test $ dzil test --release $ dzil xtest $ dzil listdeps --json $ dzil build --notgz You can learn more about Dist::Zilla at http://dzil.org/. The code for this distribution is [hosted at GitHub](https://github.com/houseabsolute/Specio). You can submit code changes by forking the repository, pushing your code changes to your clone, and then submitting a pull request. Detailed instructions for doing that is available here: https://help.github.com/articles/creating-a-pull-request If you have found a bug, but do not have an accompanying patch to fix it, you can submit an issue report [via the web](https://github.com/houseabsolute/Specio/issues) ). This is a good place to send your questions about the usage of this distribution. ## Travis All pull requests for this distribution will be automatically tested by [Travis](https://travis-ci.org/) and the build status will be reported on the pull request page. If your build fails, please take a look at the output. ## Tidyall This distribution uses [Code::TidyAll](https://metacpan.org/release/Code-TidyAll) to enforce a uniform coding style. This is tested as part of the author testing suite. You can install and run tidyall by running the following commands: $ cpanm Code::TidyAll $ tidyall -a Please run this before committing your changes and address any issues it brings up. ## Contributor Names If you send a patch or pull request, your name and email address will be included in the documentation as a contributor (using the attribution on the commit or patch), unless you specifically request for it not to be. If you wish to be listed under a different name or address, you should submit a pull request to the .mailmap file to contain the correct mapping. This file was generated via Dist::Zilla::Plugin::GenerateFile::FromShareDir 0.013 from a template file originating in Dist-Zilla-PluginBundle-DROLSKY-0.80. Specio-0.33/Changes0000644000175000017500000001750213041701062014013 0ustar autarchautarch0.33 2017-01-24 - Fixed a mistake in the SYNOPSIS for Specio::Declare. The example for the *_isa_type helpers was not correct. - Removed the alpha warning from the docs. This is being used by enough of my modules on CPAN that I don't plan on doing any big breaking changes without a deprecation first. 0.32 2017-01-12 - Fixed a bug in the inlining for types create by any_can_type() and object_can_type(). This inlining mostly worked by accident because of some List::Util XS magic, but this broke under the debugger. Reported by Christian Walde (GH #6) and Chan Wilson (https://github.com/houseabsolute/DateTime.pm/issues/49). 0.31 2016-11-05 - The stack trace contained by Specio::Exception objects no longer includes a stack frames for the Specio::Exception package. - Made the inline_environment() and description() methods public on type and coercion objects. 0.30 2016-10-15 - Fix a bug with the Sub::Quoted sub returned by $type->coercion_sub. If a type had more than one coercion, the generated sub could end up coercing the value to undef some of the time. Depending on hash key ordering, this could end up being a heisenbug that only occured some of the time. 0.29 2016-10-09 - Doc Specio::PartialDump because you may want to use it as part of the failure message generation code for a type. 0.28 2016-10-02 - Added a Test::Specio module to provide helpers for testing Specio libraries. - Fixed another bug with a subtype of special types and inlining. 0.27 2016-10-01 - Cloning a type with coercions defined on it would cause an exception. - Creating a subtype of a special type created by *_isa_type, *_can_type, or *_does_type, or enum would die when trying to inline the type constraint. - Removed the never-documented Any type. - Added documentation for each type in Specio::Library::Builtins. 0.26 2016-09-24 - Require Role::Tiny 1.003003. This should fix the test failures some CPANTesters reported with this error: Can't resolve method "???" overloading "&{}" in package "Specio::Constraint::Simple" at Specio::Constraint::Simple->new line 35. 0.25 2016-09-04 - Calling {any,object}_{isa,does}_type repeatedly in a package with the same class or role name would die. These subs are now special-cased to simply return an existing type for the given name when they receive a single argument (the name of the class or role). This could come up if you had two attributes both of which required an object of the same type. 0.24 2016-06-20 - Fix a bizarre failure on Perl before 5.14. AFAICT this was a test problem, not a library problem. 0.23 2016-06-20 - Added intersection types. 0.22 2016-06-18 - Require version.pm 0.83. I know 0.77 doesn't work but I'm not sure exactly which version fixed the problem, since I cannot install older versions. Reported by Slaven Rezic. RT #115418. 0.21 2016-06-18 - Don't load Sub::Quote, but use it if it's already loaded. Since Moo uses it, this should make Specio constraints just work with Moo. 0.20 2016-06-18 - Removed test dependency on namespace::autoclean. 0.19 2016-06-17 - Removed dependency on Devel::PartialDump by making a copy of just the bits we need. Gross but effective. 0.18 2016-06-15 - Added union types. - If a subtype's parent could be inlined and the subtype itself did not specify any additional constraints (inlinable or not), then the subtype was not being inlined, even though it could be. - This distro now works with Perl 5.8 (though it was only tested with 5.8.8). 0.17 2016-06-01 - Change "use v5.10" to "use 5.010". The former appears to cause warnings on older Perls. 0.16 2016-05-30 - Remove use of Class::Load and Module::Runtime. 0.15 2016-05-30 - The Num and Int type now accepts numbers in scientific notation such as 1e10 or -1.2e-5. - Removed various prereqs that weren't really needed. - Added three new libraries, Specio::Library::String, ::Numeric, and ::Perl. These provide additional commonly used string and numeric types, as well as some types related to Perl syntax. 0.14 2016-05-22 - Added an inline_assert method for constraint objects. This makes certain types of inlining tasks easier. - Parameterized constraint objects now have a default name based on the parent type and contained type. - Rewrote the code used for inlined types so that the generated inline code is optimized to check the most common cases first. - Fixed a bug where two enum types could not be inlined together in the same sub. 0.13 2016-05-15 - Parameterizing a type which generated inline parameterized constraints (like the ArrayRef and HashRef builtins) now dies if given a parameter which cannot itself be inlined. Mixing inlinable and non-inlinable constraints previously caused very confusing errors. 0.12 2015-12-19 - Fixed tests that failed if Moose wasn't installed. Reported by Karen Etheridge. RT #109247. 0.11 2014-05-27 - Remove a Perl 5.14-ism. 0.10 2014-05-26 - Added Class::Method::Modifiers to prereqs. - Made Specio classes faster by inlining all accessors and constructors. - Added support for Moo. Specio constraints now overloading sub-ification so you can pass them as "isa" values for Moo attributes. Also added a new $type->coercion_sub() method which returns a sub ref suitable for the "coerce" value. These all use Sub::Quote so that the returned sub refs can be inlined. 0.09 2014-05-25 - Reimplemented entirely without Moose. This module now implements its own half-assed (really, more like eighth-assed) OO system. * TODO: Integrate cleanly with Moo and Moose. * TODO: Improve the internal OO system to do some eighth-assed inlining so creating type objects is faster. 0.08 2013-06-08 - Removed the use of the encoding pragma from the tests. This pragma is deprecated in 5.18. 0.07 2013-03-03 - Disabled the tests that rely on an as-yet-unreleased Moose. These were mostly disabled but some cpan testers boxes were set up in a way that made them run. 0.06 2013-03-02 - Renamed Type to Specio. 0.05 2012-10-14 - This module didn't really need XS. It turns out that 5.10 added re::is_regexp() so we can use that instead. Thanks to Jesse Luehrs for pointing this out. 0.04 2012-09-30 - Added any_does_type and object_does_type declaration helpers. These check whether a class and/or object does a given role. They work with Moose, Mouse, and Role::Tiny. - Fixed implementation of any_isa_type and object_isa_type to match docs. If given more than one argument, the docs said they expected named parameters but internally the code expected positional parameters. 0.03 2012-09-30 - Various hacks to make Specio::Constraint objects play nice with Moose. Needs changes to Moose to work properly, however. - The message generator sub is no longer called as a method. It is called as a sub so it doesn't receive the type as an argument. - The inline environment variable names used for each type are now unique. This means that types will not step on each other if you want to inline more than one type check in the same scope. - Non-inlined type coercions were completely broken. - Added $type->is_same_type_as and $type->is_a_type_of methods. - The Maybe type was a subtype of Ref in the code, which is wrong. It is now a subtype of Item. - This module now explicitly requires Perl 5.10. 0.02 2012-05-14 - Now with lots more documentation, but this is still very alpha. Feedback from potential users is welcome. 0.01 2012-05-13 - First release upon an unsuspecting world. This is very alpha and subject to change. I'm mostly releasing it to get some feedback on the design. Do not use this in your code yet, unless you promise not to complain about the lack of docs or the fact that the next release breaks your code. Specio-0.33/META.json0000644000175000017500000011723313041701062014143 0ustar autarchautarch{ "abstract" : "Type constraints and coercions for Perl", "author" : [ "Dave Rolsky " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150010", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Specio", "no_index" : { "directory" : [ "t/lib" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Code::TidyAll::Plugin::Test::Vars" : "0.02", "File::Spec" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Moo" : "0", "Moose" : "2.1207", "Mouse" : "0", "Parallel::ForkManager" : "1.19", "Perl::Critic" : "1.126", "Perl::Tidy" : "20160302", "Pod::Coverage::TrustPod" : "0", "Pod::Wordlist" : "0", "Sub::Quote" : "0", "Test::CPAN::Changes" : "0.19", "Test::CPAN::Meta::JSON" : "0.16", "Test::Code::TidyAll" : "0.50", "Test::EOL" : "0", "Test::Mojibake" : "0", "Test::More" : "0.88", "Test::NoTabs" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Portability::Files" : "0", "Test::Spelling" : "0.12", "Test::Vars" : "0.009", "Test::Version" : "2.05", "blib" : "1.01", "namespace::autoclean" : "0" } }, "runtime" : { "requires" : { "B" : "0", "Carp" : "0", "Devel::StackTrace" : "0", "Eval::Closure" : "0", "Exporter" : "0", "IO::File" : "0", "List::Util" : "1.33", "MRO::Compat" : "0", "Role::Tiny" : "1.003003", "Role::Tiny::With" : "0", "Scalar::Util" : "0", "Storable" : "0", "Test::Fatal" : "0", "Test::More" : "0.96", "overload" : "0", "parent" : "0", "perl" : "5.008", "re" : "0", "strict" : "0", "version" : "0.83", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "Test::More" : "0.96", "Test::Needs" : "0", "lib" : "0", "open" : "0", "utf8" : "0" } } }, "provides" : { "Specio" : { "file" : "lib/Specio.pm", "version" : "0.33" }, "Specio::Coercion" : { "file" : "lib/Specio/Coercion.pm", "version" : "0.33" }, "Specio::Constraint::AnyCan" : { "file" : "lib/Specio/Constraint/AnyCan.pm", "version" : "0.33" }, "Specio::Constraint::AnyDoes" : { "file" : "lib/Specio/Constraint/AnyDoes.pm", "version" : "0.33" }, "Specio::Constraint::AnyIsa" : { "file" : "lib/Specio/Constraint/AnyIsa.pm", "version" : "0.33" }, "Specio::Constraint::Enum" : { "file" : "lib/Specio/Constraint/Enum.pm", "version" : "0.33" }, "Specio::Constraint::Intersection" : { "file" : "lib/Specio/Constraint/Intersection.pm", "version" : "0.33" }, "Specio::Constraint::ObjectCan" : { "file" : "lib/Specio/Constraint/ObjectCan.pm", "version" : "0.33" }, "Specio::Constraint::ObjectDoes" : { "file" : "lib/Specio/Constraint/ObjectDoes.pm", "version" : "0.33" }, "Specio::Constraint::ObjectIsa" : { "file" : "lib/Specio/Constraint/ObjectIsa.pm", "version" : "0.33" }, "Specio::Constraint::Parameterizable" : { "file" : "lib/Specio/Constraint/Parameterizable.pm", "version" : "0.33" }, "Specio::Constraint::Parameterized" : { "file" : "lib/Specio/Constraint/Parameterized.pm", "version" : "0.33" }, "Specio::Constraint::Role::CanType" : { "file" : "lib/Specio/Constraint/Role/CanType.pm", "version" : "0.33" }, "Specio::Constraint::Role::DoesType" : { "file" : "lib/Specio/Constraint/Role/DoesType.pm", "version" : "0.33" }, "Specio::Constraint::Role::Interface" : { "file" : "lib/Specio/Constraint/Role/Interface.pm", "version" : "0.33" }, "Specio::Constraint::Role::IsaType" : { "file" : "lib/Specio/Constraint/Role/IsaType.pm", "version" : "0.33" }, "Specio::Constraint::Simple" : { "file" : "lib/Specio/Constraint/Simple.pm", "version" : "0.33" }, "Specio::Constraint::Union" : { "file" : "lib/Specio/Constraint/Union.pm", "version" : "0.33" }, "Specio::Declare" : { "file" : "lib/Specio/Declare.pm", "version" : "0.33" }, "Specio::DeclaredAt" : { "file" : "lib/Specio/DeclaredAt.pm", "version" : "0.33" }, "Specio::Exception" : { "file" : "lib/Specio/Exception.pm", "version" : "0.33" }, "Specio::Exporter" : { "file" : "lib/Specio/Exporter.pm", "version" : "0.33" }, "Specio::Helpers" : { "file" : "lib/Specio/Helpers.pm", "version" : "0.33" }, "Specio::Library::Builtins" : { "file" : "lib/Specio/Library/Builtins.pm", "version" : "0.33" }, "Specio::Library::Numeric" : { "file" : "lib/Specio/Library/Numeric.pm", "version" : "0.33" }, "Specio::Library::Perl" : { "file" : "lib/Specio/Library/Perl.pm", "version" : "0.33" }, "Specio::Library::String" : { "file" : "lib/Specio/Library/String.pm", "version" : "0.33" }, "Specio::OO" : { "file" : "lib/Specio/OO.pm", "version" : "0.33" }, "Specio::PartialDump" : { "file" : "lib/Specio/PartialDump.pm", "version" : "0.33" }, "Specio::Registry" : { "file" : "lib/Specio/Registry.pm", "version" : "0.33" }, "Specio::Role::Inlinable" : { "file" : "lib/Specio/Role/Inlinable.pm", "version" : "0.33" }, "Specio::TypeChecks" : { "file" : "lib/Specio/TypeChecks.pm", "version" : "0.33" }, "Test::Specio" : { "file" : "lib/Test/Specio.pm", "version" : "0.33" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/houseabsolute/Specio/issues" }, "homepage" : "http://metacpan.org/release/Specio", "repository" : { "type" : "git", "url" : "git://github.com/houseabsolute/Specio.git", "web" : "https://github.com/houseabsolute/Specio" } }, "version" : "0.33", "x_Dist_Zilla" : { "perl" : { "version" : "5.024000" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::MakeMaker", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : 1 } }, "name" : "@DROLSKY/MakeMaker", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "config" : { "Dist::Zilla::Plugin::GatherDir" : { "exclude_filename" : [ "CONTRIBUTING.md", "LICENSE", "Makefile.PL", "README.md", "cpanfile" ], "exclude_match" : [], "follow_symlinks" : 0, "include_dotfiles" : 0, "prefix" : "", "prune_directory" : [], "root" : "." }, "Dist::Zilla::Plugin::Git::GatherDir" : { "include_untracked" : 0 } }, "name" : "@DROLSKY/Git::GatherDir", "version" : "2.041" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "@DROLSKY/ManifestSkip", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@DROLSKY/License", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@DROLSKY/ExecDir", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@DROLSKY/ShareDir", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@DROLSKY/Manifest", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::CheckVersionIncrement", "name" : "@DROLSKY/CheckVersionIncrement", "version" : "0.121750" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@DROLSKY/TestRelease", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@DROLSKY/ConfirmRelease", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@DROLSKY/UploadToCPAN", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::VersionFromMainModule", "name" : "@DROLSKY/VersionFromMainModule", "version" : "0.02" }, { "class" : "Dist::Zilla::Plugin::Authority", "name" : "@DROLSKY/Authority", "version" : "1.009" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "@DROLSKY/AutoPrereqs", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::CopyFilesFromBuild", "name" : "@DROLSKY/CopyFilesFromBuild", "version" : "0.163040" }, { "class" : "Dist::Zilla::Plugin::GitHub::Meta", "name" : "@DROLSKY/GitHub::Meta", "version" : "0.43" }, { "class" : "Dist::Zilla::Plugin::GitHub::Update", "config" : { "Dist::Zilla::Plugin::GitHub::Update" : { "metacpan" : 1 } }, "name" : "@DROLSKY/GitHub::Update", "version" : "0.43" }, { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "@DROLSKY/MetaResources", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Package", "config" : { "Dist::Zilla::Plugin::MetaProvides::Package" : { "finder_objects" : [ { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.008" } ], "include_underscores" : 0 }, "Dist::Zilla::Role::MetaProvider::Provider" : { "Dist::Zilla::Role::MetaProvider::Provider::VERSION" : "2.001011", "inherit_missing" : 1, "inherit_version" : 1, "meta_noindex" : 1 }, "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000031", "version" : "0.003" } }, "name" : "@DROLSKY/MetaProvides::Package", "version" : "2.004002" }, { "class" : "Dist::Zilla::Plugin::Meta::Contributors", "name" : "@DROLSKY/Meta::Contributors", "version" : "0.003" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@DROLSKY/MetaConfig", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@DROLSKY/MetaJSON", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@DROLSKY/MetaYAML", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@DROLSKY/NextRelease", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "@DROLSKY/Test::More with subtest", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "requires" } }, "name" : "@DROLSKY/Modules for use with tidyall", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "requires" } }, "name" : "@DROLSKY/Test::Version which fixes https://github.com/plicease/Test-Version/issues/7", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : 0, "check_all_prereqs" : 0, "modules" : [ "Dist::Zilla::PluginBundle::DROLSKY" ], "phase" : "build", "run_under_travis" : 0, "skip" : [] } }, "name" : "@DROLSKY/Dist::Zilla::PluginBundle::DROLSKY", "version" : "0.051" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : 1, "check_all_prereqs" : 1, "modules" : [], "phase" : "release", "run_under_travis" : 0, "skip" : [ "Dist::Zilla::Plugin::DROLSKY::Contributors", "Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch", "Dist::Zilla::Plugin::DROLSKY::License", "Dist::Zilla::Plugin::DROLSKY::TidyAll", "Pod::Weaver::PluginBundle::DROLSKY" ] } }, "name" : "@DROLSKY/PromptIfStale", "version" : "0.051" }, { "class" : "Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable", "name" : "@DROLSKY/Test::Pod::Coverage::Configurable", "version" : "0.06" }, { "class" : "Dist::Zilla::Plugin::Test::PodSpelling", "config" : { "Dist::Zilla::Plugin::Test::PodSpelling" : { "directories" : [ "bin", "lib" ], "spell_cmd" : "", "stopwords" : [ "API", "ClassName", "Coercions", "DROLSKY", "DROLSKY's", "Kogman", "LaxVersionStr", "MUTC", "ModuleName", "NegativeInt", "NegativeNum", "NegativeOrZeroInt", "NegativeOrZeroNum", "NonEmptySimpleStr", "NonEmptyStr", "Num", "PARAMETERIZABLE", "PackageName", "PayPal", "PayPal", "PositiveInt", "PositiveNum", "PositiveOrZeroInt", "PositiveOrZeroNum", "RegexpRef", "Rolsky", "Rolsky", "Rolsky's", "SIGNES", "SPECIO", "SafeIdentifier", "ScalarRef", "SimpleStr", "SingleDigit", "Specio", "Str", "StrictVersionStr", "Throwable", "Yuval", "boolification", "coercions", "de", "distro", "drolsky", "globification", "inlinable", "inline", "isa", "namespace", "numification", "parameterizable", "parameterization", "parameterized", "reimplementation", "sigils", "subtype", "subtypes" ], "wordlist" : "Pod::Wordlist" } }, "name" : "@DROLSKY/Test::PodSpelling", "version" : "2.007004" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@DROLSKY/PodSyntaxTests", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::RunExtraTests", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : 1 } }, "name" : "@DROLSKY/RunExtraTests", "version" : "0.029" }, { "class" : "Dist::Zilla::Plugin::MojibakeTests", "name" : "@DROLSKY/MojibakeTests", "version" : "0.8" }, { "class" : "Dist::Zilla::Plugin::Test::CPAN::Changes", "config" : { "Dist::Zilla::Plugin::Test::CPAN::Changes" : { "changelog" : "Changes" } }, "name" : "@DROLSKY/Test::CPAN::Changes", "version" : "0.012" }, { "class" : "Dist::Zilla::Plugin::Test::CPAN::Meta::JSON", "name" : "@DROLSKY/Test::CPAN::Meta::JSON", "version" : "0.004" }, { "class" : "Dist::Zilla::Plugin::Test::EOL", "config" : { "Dist::Zilla::Plugin::Test::EOL" : { "filename" : "xt/author/eol.t", "finder" : [ ":ExecFiles", ":InstallModules", ":TestFiles" ], "trailing_whitespace" : 1 } }, "name" : "@DROLSKY/Test::EOL", "version" : "0.19" }, { "class" : "Dist::Zilla::Plugin::Test::NoTabs", "config" : { "Dist::Zilla::Plugin::Test::NoTabs" : { "filename" : "xt/author/no-tabs.t", "finder" : [ ":InstallModules", ":ExecFiles", ":TestFiles" ] } }, "name" : "@DROLSKY/Test::NoTabs", "version" : "0.15" }, { "class" : "Dist::Zilla::Plugin::Test::Portability", "config" : { "Dist::Zilla::Plugin::Test::Portability" : { "options" : "" } }, "name" : "@DROLSKY/Test::Portability", "version" : "2.001000" }, { "class" : "Dist::Zilla::Plugin::Test::TidyAll", "name" : "@DROLSKY/Test::TidyAll", "version" : "0.04" }, { "class" : "Dist::Zilla::Plugin::Test::Compile", "config" : { "Dist::Zilla::Plugin::Test::Compile" : { "bail_out_on_fail" : 0, "fail_on_warning" : "author", "fake_home" : 0, "filename" : "xt/author/00-compile.t", "module_finder" : [ ":InstallModules" ], "needs_display" : 0, "phase" : "develop", "script_finder" : [ ":PerlExecFiles" ], "skips" : [], "switch" : [] } }, "name" : "@DROLSKY/Test::Compile", "version" : "2.056" }, { "class" : "Dist::Zilla::Plugin::Test::ReportPrereqs", "name" : "@DROLSKY/Test::ReportPrereqs", "version" : "0.025" }, { "class" : "Dist::Zilla::Plugin::Test::Version", "name" : "@DROLSKY/Test::Version", "version" : "1.09" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::Contributors", "name" : "@DROLSKY/DROLSKY::Contributors", "version" : "0.80" }, { "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { "git --version" : "2.7.4", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", "paths" : [] } }, "name" : "@DROLSKY/Git::Contributors", "version" : "0.029" }, { "class" : "Dist::Zilla::Plugin::SurgicalPodWeaver", "config" : { "Dist::Zilla::Plugin::PodWeaver" : { "config_plugins" : [ "@DROLSKY" ], "finder" : [ ":InstallModules", ":ExecFiles" ], "plugins" : [ { "class" : "Pod::Weaver::Plugin::EnsurePod5", "name" : "@CorePrep/EnsurePod5", "version" : "4.013" }, { "class" : "Pod::Weaver::Plugin::H1Nester", "name" : "@CorePrep/H1Nester", "version" : "4.013" }, { "class" : "Pod::Weaver::Plugin::SingleEncoding", "name" : "@DROLSKY/SingleEncoding", "version" : "4.013" }, { "class" : "Pod::Weaver::Plugin::Transformer", "name" : "@DROLSKY/List", "version" : "4.013" }, { "class" : "Pod::Weaver::Plugin::Transformer", "name" : "@DROLSKY/Verbatim", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@DROLSKY/header", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Name", "name" : "@DROLSKY/Name", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Version", "name" : "@DROLSKY/Version", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@DROLSKY/prelude", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "SYNOPSIS", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "DESCRIPTION", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "OVERVIEW", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "ATTRIBUTES", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "METHODS", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "FUNCTIONS", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "TYPES", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Leftovers", "name" : "@DROLSKY/Leftovers", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@DROLSKY/postlude", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::GenerateSection", "name" : "@DROLSKY/generate SUPPORT", "version" : "1.01" }, { "class" : "Pod::Weaver::Section::AllowOverride", "name" : "@DROLSKY/allow override SUPPORT", "version" : "0.05" }, { "class" : "Pod::Weaver::Section::GenerateSection", "name" : "@DROLSKY/generate SOURCE", "version" : "1.01" }, { "class" : "Pod::Weaver::Section::GenerateSection", "name" : "@DROLSKY/generate DONATIONS", "version" : "1.01" }, { "class" : "Pod::Weaver::Section::Authors", "name" : "@DROLSKY/Authors", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Contributors", "name" : "@DROLSKY/Contributors", "version" : "0.009" }, { "class" : "Pod::Weaver::Section::Legal", "name" : "@DROLSKY/Legal", "version" : "4.013" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@DROLSKY/footer", "version" : "4.013" } ] } }, "name" : "@DROLSKY/SurgicalPodWeaver", "version" : "0.0023" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::WeaverConfig", "name" : "@DROLSKY/DROLSKY::WeaverConfig", "version" : "0.80" }, { "class" : "Dist::Zilla::Plugin::ReadmeAnyFromPod", "config" : { "Dist::Zilla::Role::FileWatcher" : { "version" : "0.006" } }, "name" : "@DROLSKY/README.md in build", "version" : "0.163250" }, { "class" : "Dist::Zilla::Plugin::GenerateFile::FromShareDir", "config" : { "Dist::Zilla::Plugin::GenerateFile::FromShareDir" : { "destination_filename" : "CONTRIBUTING.md", "dist" : "Dist-Zilla-PluginBundle-DROLSKY", "encoding" : "UTF-8", "has_xs" : 0, "location" : "build", "source_filename" : "CONTRIBUTING.md" }, "Dist::Zilla::Role::RepoFileInjector" : { "allow_overwrite" : 1, "repo_root" : ".", "version" : "0.006" } }, "name" : "@DROLSKY/Generate CONTRIBUTING.md", "version" : "0.013" }, { "class" : "Dist::Zilla::Plugin::InstallGuide", "name" : "@DROLSKY/InstallGuide", "version" : "1.200007" }, { "class" : "Dist::Zilla::Plugin::CPANFile", "name" : "@DROLSKY/CPANFile", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::License", "name" : "@DROLSKY/DROLSKY::License", "version" : "0.80" }, { "class" : "Dist::Zilla::Plugin::CheckStrictVersion", "name" : "@DROLSKY/CheckStrictVersion", "version" : "0.001" }, { "class" : "Dist::Zilla::Plugin::CheckSelfDependency", "config" : { "Dist::Zilla::Plugin::CheckSelfDependency" : { "finder" : [ ":InstallModules" ] }, "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000031", "version" : "0.003" } }, "name" : "@DROLSKY/CheckSelfDependency", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::CheckPrereqsIndexed", "name" : "@DROLSKY/CheckPrereqsIndexed", "version" : "0.020" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch", "config" : { "Dist::Zilla::Role::Git::Repo" : { "git --version" : "2.7.4", "repo_root" : "." } }, "name" : "@DROLSKY/DROLSKY::Git::CheckFor::CorrectBranch", "version" : "0.80" }, { "class" : "Dist::Zilla::Plugin::EnsureChangesHasContent", "name" : "@DROLSKY/EnsureChangesHasContent", "version" : "0.02" }, { "class" : "Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts", "config" : { "Dist::Zilla::Role::Git::Repo" : { "git --version" : "2.7.4", "repo_root" : "." } }, "name" : "@DROLSKY/Git::CheckFor::MergeConflicts", "version" : "0.014" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::TidyAll", "name" : "@DROLSKY/DROLSKY::TidyAll", "version" : "0.80" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "config" : { "Dist::Zilla::Plugin::Git::Check" : { "untracked_files" : "die" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "CONTRIBUTING.md", "Changes", "LICENSE", "Makefile.PL", "README.md", "cpanfile", "tidyall.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git --version" : "2.7.4", "repo_root" : "." } }, "name" : "@DROLSKY/Git::Check", "version" : "2.041" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], "commit_msg" : "v%v%n%n%c" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "CONTRIBUTING.md", "Changes", "LICENSE", "Makefile.PL", "README.md", "cpanfile", "tidyall.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git --version" : "2.7.4", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@DROLSKY/Commit generated files", "version" : "2.041" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "config" : { "Dist::Zilla::Plugin::Git::Tag" : { "branch" : null, "changelog" : "Changes", "signed" : 0, "tag" : "v0.33", "tag_format" : "v%v", "tag_message" : "v%v" }, "Dist::Zilla::Role::Git::Repo" : { "git --version" : "2.7.4", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@DROLSKY/Git::Tag", "version" : "2.041" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "config" : { "Dist::Zilla::Plugin::Git::Push" : { "push_to" : [ "origin" ], "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { "git --version" : "2.7.4", "repo_root" : "." } }, "name" : "@DROLSKY/Git::Push", "version" : "2.041" }, { "class" : "Dist::Zilla::Plugin::BumpVersionAfterRelease", "config" : { "Dist::Zilla::Plugin::BumpVersionAfterRelease" : { "finders" : [ ":ExecFiles", ":InstallModules" ], "global" : 0, "munge_makefile_pl" : 1 } }, "name" : "@DROLSKY/BumpVersionAfterRelease", "version" : "0.015" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], "commit_msg" : "Bump version after release" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [ "(?^:.+)" ], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git --version" : "2.7.4", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@DROLSKY/Commit version bump", "version" : "2.041" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "config" : { "Dist::Zilla::Plugin::Git::Push" : { "push_to" : [ "origin" ], "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { "git --version" : "2.7.4", "repo_root" : "." } }, "name" : "@DROLSKY/Push version bump", "version" : "2.041" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "requires" } }, "name" : "DevelopRequires", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::MetaNoIndex", "name" : "MetaNoIndex", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExtraTestFiles", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":PerlExecFiles", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", "version" : "6.008" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.008" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : 0 }, "version" : "6.008" } }, "x_authority" : "cpan:DROLSKY", "x_contributors" : [ "Karen Etheridge " ], "x_serialization_backend" : "Cpanel::JSON::XS version 3.0213" } Specio-0.33/dist.ini0000644000175000017500000000102113041701062014151 0ustar autarchautarchname = Specio author = Dave Rolsky license = Artistic_2_0 copyright_holder = Dave Rolsky copyright_year = 2012 [@DROLSKY] dist = Specio prereqs_skip = Moo prereqs_skip = Moose prereqs_skip = Mouse prereqs_skip = namespace::autoclean stopwords_file = .stopwords use_github_issues = 1 -remove = Test::CleanNamespaces -remove = Test::Pod::No404s -remove = Test::Synopsis [Prereqs / DevelopRequires] Moo = 0 Moose = 2.1207 Mouse = 0 namespace::autoclean = 0 Sub::Quote = 0 [MetaNoIndex] directory = t/lib Specio-0.33/perltidyrc0000644000175000017500000000045513041701062014623 0ustar autarchautarch-l=78 -i=4 -ci=4 -se -b -bar -boc -vt=0 -vtc=0 -cti=0 -pt=1 -bt=1 -sbt=1 -bbt=1 -nolq -npro -nsfs --blank-lines-before-packages=0 --opening-hash-brace-right --no-outdent-long-comments --iterations=2 -wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" Specio-0.33/MANIFEST0000644000175000017500000000370613041701062013652 0ustar autarchautarch# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.008. CONTRIBUTING.md Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README.md TODO.md cpanfile dist.ini lib/Specio.pm lib/Specio/Coercion.pm lib/Specio/Constraint/AnyCan.pm lib/Specio/Constraint/AnyDoes.pm lib/Specio/Constraint/AnyIsa.pm lib/Specio/Constraint/Enum.pm lib/Specio/Constraint/Intersection.pm lib/Specio/Constraint/ObjectCan.pm lib/Specio/Constraint/ObjectDoes.pm lib/Specio/Constraint/ObjectIsa.pm lib/Specio/Constraint/Parameterizable.pm lib/Specio/Constraint/Parameterized.pm lib/Specio/Constraint/Role/CanType.pm lib/Specio/Constraint/Role/DoesType.pm lib/Specio/Constraint/Role/Interface.pm lib/Specio/Constraint/Role/IsaType.pm lib/Specio/Constraint/Simple.pm lib/Specio/Constraint/Union.pm lib/Specio/Declare.pm lib/Specio/DeclaredAt.pm lib/Specio/Exception.pm lib/Specio/Exporter.pm lib/Specio/Helpers.pm lib/Specio/Library/Builtins.pm lib/Specio/Library/Numeric.pm lib/Specio/Library/Perl.pm lib/Specio/Library/String.pm lib/Specio/OO.pm lib/Specio/PartialDump.pm lib/Specio/Registry.pm lib/Specio/Role/Inlinable.pm lib/Specio/TypeChecks.pm lib/Test/Specio.pm perlcriticrc perltidyrc t/00-report-prereqs.dd t/00-report-prereqs.t t/anon.t t/builtins-sanity.t t/builtins.t t/coercion.t t/combines.t t/conflicts.t t/declare-helpers.t t/does-type.t t/exception.t t/inline-environment.t t/inline.t t/intersection.t t/lib/Specio/Library/Combines.pm t/lib/Specio/Library/Conflict.pm t/lib/Specio/Library/Union.pm t/lib/Specio/Library/XY.pm t/multiple-libraries.t t/numeric-sanity.t t/parameterized.t t/perl-sanity.t t/string-sanity.t t/t-clean.t t/union-library.t t/union.t t/with-moo.t t/with-moose.t tidyall.ini xt/author/00-compile.t xt/author/eol.t xt/author/mojibake.t xt/author/no-tabs.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/portability.t xt/author/test-version.t xt/author/tidyall.t xt/release/cpan-changes.t xt/release/meta-json.t Specio-0.33/META.yml0000644000175000017500000006265313041701062014000 0ustar autarchautarch--- abstract: 'Type constraints and coercions for Perl' author: - 'Dave Rolsky ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' Test::More: '0.96' Test::Needs: '0' lib: '0' open: '0' utf8: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.008, CPAN::Meta::Converter version 2.150010' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Specio no_index: directory: - t/lib provides: Specio: file: lib/Specio.pm version: '0.33' Specio::Coercion: file: lib/Specio/Coercion.pm version: '0.33' Specio::Constraint::AnyCan: file: lib/Specio/Constraint/AnyCan.pm version: '0.33' Specio::Constraint::AnyDoes: file: lib/Specio/Constraint/AnyDoes.pm version: '0.33' Specio::Constraint::AnyIsa: file: lib/Specio/Constraint/AnyIsa.pm version: '0.33' Specio::Constraint::Enum: file: lib/Specio/Constraint/Enum.pm version: '0.33' Specio::Constraint::Intersection: file: lib/Specio/Constraint/Intersection.pm version: '0.33' Specio::Constraint::ObjectCan: file: lib/Specio/Constraint/ObjectCan.pm version: '0.33' Specio::Constraint::ObjectDoes: file: lib/Specio/Constraint/ObjectDoes.pm version: '0.33' Specio::Constraint::ObjectIsa: file: lib/Specio/Constraint/ObjectIsa.pm version: '0.33' Specio::Constraint::Parameterizable: file: lib/Specio/Constraint/Parameterizable.pm version: '0.33' Specio::Constraint::Parameterized: file: lib/Specio/Constraint/Parameterized.pm version: '0.33' Specio::Constraint::Role::CanType: file: lib/Specio/Constraint/Role/CanType.pm version: '0.33' Specio::Constraint::Role::DoesType: file: lib/Specio/Constraint/Role/DoesType.pm version: '0.33' Specio::Constraint::Role::Interface: file: lib/Specio/Constraint/Role/Interface.pm version: '0.33' Specio::Constraint::Role::IsaType: file: lib/Specio/Constraint/Role/IsaType.pm version: '0.33' Specio::Constraint::Simple: file: lib/Specio/Constraint/Simple.pm version: '0.33' Specio::Constraint::Union: file: lib/Specio/Constraint/Union.pm version: '0.33' Specio::Declare: file: lib/Specio/Declare.pm version: '0.33' Specio::DeclaredAt: file: lib/Specio/DeclaredAt.pm version: '0.33' Specio::Exception: file: lib/Specio/Exception.pm version: '0.33' Specio::Exporter: file: lib/Specio/Exporter.pm version: '0.33' Specio::Helpers: file: lib/Specio/Helpers.pm version: '0.33' Specio::Library::Builtins: file: lib/Specio/Library/Builtins.pm version: '0.33' Specio::Library::Numeric: file: lib/Specio/Library/Numeric.pm version: '0.33' Specio::Library::Perl: file: lib/Specio/Library/Perl.pm version: '0.33' Specio::Library::String: file: lib/Specio/Library/String.pm version: '0.33' Specio::OO: file: lib/Specio/OO.pm version: '0.33' Specio::PartialDump: file: lib/Specio/PartialDump.pm version: '0.33' Specio::Registry: file: lib/Specio/Registry.pm version: '0.33' Specio::Role::Inlinable: file: lib/Specio/Role/Inlinable.pm version: '0.33' Specio::TypeChecks: file: lib/Specio/TypeChecks.pm version: '0.33' Test::Specio: file: lib/Test/Specio.pm version: '0.33' requires: B: '0' Carp: '0' Devel::StackTrace: '0' Eval::Closure: '0' Exporter: '0' IO::File: '0' List::Util: '1.33' MRO::Compat: '0' Role::Tiny: '1.003003' Role::Tiny::With: '0' Scalar::Util: '0' Storable: '0' Test::Fatal: '0' Test::More: '0.96' overload: '0' parent: '0' perl: '5.008' re: '0' strict: '0' version: '0.83' warnings: '0' resources: bugtracker: https://github.com/houseabsolute/Specio/issues homepage: http://metacpan.org/release/Specio repository: git://github.com/houseabsolute/Specio.git version: '0.33' x_Dist_Zilla: perl: version: '5.024000' plugins: - class: Dist::Zilla::Plugin::MakeMaker config: Dist::Zilla::Role::TestRunner: default_jobs: 1 name: '@DROLSKY/MakeMaker' version: '6.008' - class: Dist::Zilla::Plugin::Git::GatherDir config: Dist::Zilla::Plugin::GatherDir: exclude_filename: - CONTRIBUTING.md - LICENSE - Makefile.PL - README.md - cpanfile exclude_match: [] follow_symlinks: 0 include_dotfiles: 0 prefix: '' prune_directory: [] root: . Dist::Zilla::Plugin::Git::GatherDir: include_untracked: 0 name: '@DROLSKY/Git::GatherDir' version: '2.041' - class: Dist::Zilla::Plugin::ManifestSkip name: '@DROLSKY/ManifestSkip' version: '6.008' - class: Dist::Zilla::Plugin::License name: '@DROLSKY/License' version: '6.008' - class: Dist::Zilla::Plugin::ExecDir name: '@DROLSKY/ExecDir' version: '6.008' - class: Dist::Zilla::Plugin::ShareDir name: '@DROLSKY/ShareDir' version: '6.008' - class: Dist::Zilla::Plugin::Manifest name: '@DROLSKY/Manifest' version: '6.008' - class: Dist::Zilla::Plugin::CheckVersionIncrement name: '@DROLSKY/CheckVersionIncrement' version: '0.121750' - class: Dist::Zilla::Plugin::TestRelease name: '@DROLSKY/TestRelease' version: '6.008' - class: Dist::Zilla::Plugin::ConfirmRelease name: '@DROLSKY/ConfirmRelease' version: '6.008' - class: Dist::Zilla::Plugin::UploadToCPAN name: '@DROLSKY/UploadToCPAN' version: '6.008' - class: Dist::Zilla::Plugin::VersionFromMainModule name: '@DROLSKY/VersionFromMainModule' version: '0.02' - class: Dist::Zilla::Plugin::Authority name: '@DROLSKY/Authority' version: '1.009' - class: Dist::Zilla::Plugin::AutoPrereqs name: '@DROLSKY/AutoPrereqs' version: '6.008' - class: Dist::Zilla::Plugin::CopyFilesFromBuild name: '@DROLSKY/CopyFilesFromBuild' version: '0.163040' - class: Dist::Zilla::Plugin::GitHub::Meta name: '@DROLSKY/GitHub::Meta' version: '0.43' - class: Dist::Zilla::Plugin::GitHub::Update config: Dist::Zilla::Plugin::GitHub::Update: metacpan: 1 name: '@DROLSKY/GitHub::Update' version: '0.43' - class: Dist::Zilla::Plugin::MetaResources name: '@DROLSKY/MetaResources' version: '6.008' - class: Dist::Zilla::Plugin::MetaProvides::Package config: Dist::Zilla::Plugin::MetaProvides::Package: finder_objects: - class: Dist::Zilla::Plugin::FinderCode name: '@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM' version: '6.008' include_underscores: 0 Dist::Zilla::Role::MetaProvider::Provider: Dist::Zilla::Role::MetaProvider::Provider::VERSION: '2.001011' inherit_missing: '1' inherit_version: '1' meta_noindex: '1' Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000031' version: '0.003' name: '@DROLSKY/MetaProvides::Package' version: '2.004002' - class: Dist::Zilla::Plugin::Meta::Contributors name: '@DROLSKY/Meta::Contributors' version: '0.003' - class: Dist::Zilla::Plugin::MetaConfig name: '@DROLSKY/MetaConfig' version: '6.008' - class: Dist::Zilla::Plugin::MetaJSON name: '@DROLSKY/MetaJSON' version: '6.008' - class: Dist::Zilla::Plugin::MetaYAML name: '@DROLSKY/MetaYAML' version: '6.008' - class: Dist::Zilla::Plugin::NextRelease name: '@DROLSKY/NextRelease' version: '6.008' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: '@DROLSKY/Test::More with subtest' version: '6.008' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: requires name: '@DROLSKY/Modules for use with tidyall' version: '6.008' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: requires name: '@DROLSKY/Test::Version which fixes https://github.com/plicease/Test-Version/issues/7' version: '6.008' - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 0 check_all_prereqs: 0 modules: - Dist::Zilla::PluginBundle::DROLSKY phase: build run_under_travis: 0 skip: [] name: '@DROLSKY/Dist::Zilla::PluginBundle::DROLSKY' version: '0.051' - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 1 check_all_prereqs: 1 modules: [] phase: release run_under_travis: 0 skip: - Dist::Zilla::Plugin::DROLSKY::Contributors - Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch - Dist::Zilla::Plugin::DROLSKY::License - Dist::Zilla::Plugin::DROLSKY::TidyAll - Pod::Weaver::PluginBundle::DROLSKY name: '@DROLSKY/PromptIfStale' version: '0.051' - class: Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable name: '@DROLSKY/Test::Pod::Coverage::Configurable' version: '0.06' - class: Dist::Zilla::Plugin::Test::PodSpelling config: Dist::Zilla::Plugin::Test::PodSpelling: directories: - bin - lib spell_cmd: '' stopwords: - API - ClassName - Coercions - DROLSKY - "DROLSKY's" - Kogman - LaxVersionStr - MUTC - ModuleName - NegativeInt - NegativeNum - NegativeOrZeroInt - NegativeOrZeroNum - NonEmptySimpleStr - NonEmptyStr - Num - PARAMETERIZABLE - PackageName - PayPal - PayPal - PositiveInt - PositiveNum - PositiveOrZeroInt - PositiveOrZeroNum - RegexpRef - Rolsky - Rolsky - "Rolsky's" - SIGNES - SPECIO - SafeIdentifier - ScalarRef - SimpleStr - SingleDigit - Specio - Str - StrictVersionStr - Throwable - Yuval - boolification - coercions - de - distro - drolsky - globification - inlinable - inline - isa - namespace - numification - parameterizable - parameterization - parameterized - reimplementation - sigils - subtype - subtypes wordlist: Pod::Wordlist name: '@DROLSKY/Test::PodSpelling' version: '2.007004' - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@DROLSKY/PodSyntaxTests' version: '6.008' - class: Dist::Zilla::Plugin::RunExtraTests config: Dist::Zilla::Role::TestRunner: default_jobs: 1 name: '@DROLSKY/RunExtraTests' version: '0.029' - class: Dist::Zilla::Plugin::MojibakeTests name: '@DROLSKY/MojibakeTests' version: '0.8' - class: Dist::Zilla::Plugin::Test::CPAN::Changes config: Dist::Zilla::Plugin::Test::CPAN::Changes: changelog: Changes name: '@DROLSKY/Test::CPAN::Changes' version: '0.012' - class: Dist::Zilla::Plugin::Test::CPAN::Meta::JSON name: '@DROLSKY/Test::CPAN::Meta::JSON' version: '0.004' - class: Dist::Zilla::Plugin::Test::EOL config: Dist::Zilla::Plugin::Test::EOL: filename: xt/author/eol.t finder: - ':ExecFiles' - ':InstallModules' - ':TestFiles' trailing_whitespace: 1 name: '@DROLSKY/Test::EOL' version: '0.19' - class: Dist::Zilla::Plugin::Test::NoTabs config: Dist::Zilla::Plugin::Test::NoTabs: filename: xt/author/no-tabs.t finder: - ':InstallModules' - ':ExecFiles' - ':TestFiles' name: '@DROLSKY/Test::NoTabs' version: '0.15' - class: Dist::Zilla::Plugin::Test::Portability config: Dist::Zilla::Plugin::Test::Portability: options: '' name: '@DROLSKY/Test::Portability' version: '2.001000' - class: Dist::Zilla::Plugin::Test::TidyAll name: '@DROLSKY/Test::TidyAll' version: '0.04' - class: Dist::Zilla::Plugin::Test::Compile config: Dist::Zilla::Plugin::Test::Compile: bail_out_on_fail: '0' fail_on_warning: author fake_home: 0 filename: xt/author/00-compile.t module_finder: - ':InstallModules' needs_display: 0 phase: develop script_finder: - ':PerlExecFiles' skips: [] switch: [] name: '@DROLSKY/Test::Compile' version: '2.056' - class: Dist::Zilla::Plugin::Test::ReportPrereqs name: '@DROLSKY/Test::ReportPrereqs' version: '0.025' - class: Dist::Zilla::Plugin::Test::Version name: '@DROLSKY/Test::Version' version: '1.09' - class: Dist::Zilla::Plugin::DROLSKY::Contributors name: '@DROLSKY/DROLSKY::Contributors' version: '0.80' - class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: 'git --version': 2.7.4 include_authors: 0 include_releaser: 1 order_by: name paths: [] name: '@DROLSKY/Git::Contributors' version: '0.029' - class: Dist::Zilla::Plugin::SurgicalPodWeaver config: Dist::Zilla::Plugin::PodWeaver: config_plugins: - '@DROLSKY' finder: - ':InstallModules' - ':ExecFiles' plugins: - class: Pod::Weaver::Plugin::EnsurePod5 name: '@CorePrep/EnsurePod5' version: '4.013' - class: Pod::Weaver::Plugin::H1Nester name: '@CorePrep/H1Nester' version: '4.013' - class: Pod::Weaver::Plugin::SingleEncoding name: '@DROLSKY/SingleEncoding' version: '4.013' - class: Pod::Weaver::Plugin::Transformer name: '@DROLSKY/List' version: '4.013' - class: Pod::Weaver::Plugin::Transformer name: '@DROLSKY/Verbatim' version: '4.013' - class: Pod::Weaver::Section::Region name: '@DROLSKY/header' version: '4.013' - class: Pod::Weaver::Section::Name name: '@DROLSKY/Name' version: '4.013' - class: Pod::Weaver::Section::Version name: '@DROLSKY/Version' version: '4.013' - class: Pod::Weaver::Section::Region name: '@DROLSKY/prelude' version: '4.013' - class: Pod::Weaver::Section::Generic name: SYNOPSIS version: '4.013' - class: Pod::Weaver::Section::Generic name: DESCRIPTION version: '4.013' - class: Pod::Weaver::Section::Generic name: OVERVIEW version: '4.013' - class: Pod::Weaver::Section::Collect name: ATTRIBUTES version: '4.013' - class: Pod::Weaver::Section::Collect name: METHODS version: '4.013' - class: Pod::Weaver::Section::Collect name: FUNCTIONS version: '4.013' - class: Pod::Weaver::Section::Collect name: TYPES version: '4.013' - class: Pod::Weaver::Section::Leftovers name: '@DROLSKY/Leftovers' version: '4.013' - class: Pod::Weaver::Section::Region name: '@DROLSKY/postlude' version: '4.013' - class: Pod::Weaver::Section::GenerateSection name: '@DROLSKY/generate SUPPORT' version: '1.01' - class: Pod::Weaver::Section::AllowOverride name: '@DROLSKY/allow override SUPPORT' version: '0.05' - class: Pod::Weaver::Section::GenerateSection name: '@DROLSKY/generate SOURCE' version: '1.01' - class: Pod::Weaver::Section::GenerateSection name: '@DROLSKY/generate DONATIONS' version: '1.01' - class: Pod::Weaver::Section::Authors name: '@DROLSKY/Authors' version: '4.013' - class: Pod::Weaver::Section::Contributors name: '@DROLSKY/Contributors' version: '0.009' - class: Pod::Weaver::Section::Legal name: '@DROLSKY/Legal' version: '4.013' - class: Pod::Weaver::Section::Region name: '@DROLSKY/footer' version: '4.013' name: '@DROLSKY/SurgicalPodWeaver' version: '0.0023' - class: Dist::Zilla::Plugin::DROLSKY::WeaverConfig name: '@DROLSKY/DROLSKY::WeaverConfig' version: '0.80' - class: Dist::Zilla::Plugin::ReadmeAnyFromPod config: Dist::Zilla::Role::FileWatcher: version: '0.006' name: '@DROLSKY/README.md in build' version: '0.163250' - class: Dist::Zilla::Plugin::GenerateFile::FromShareDir config: Dist::Zilla::Plugin::GenerateFile::FromShareDir: destination_filename: CONTRIBUTING.md dist: Dist-Zilla-PluginBundle-DROLSKY encoding: UTF-8 has_xs: '0' location: build source_filename: CONTRIBUTING.md Dist::Zilla::Role::RepoFileInjector: allow_overwrite: 1 repo_root: . version: '0.006' name: '@DROLSKY/Generate CONTRIBUTING.md' version: '0.013' - class: Dist::Zilla::Plugin::InstallGuide name: '@DROLSKY/InstallGuide' version: '1.200007' - class: Dist::Zilla::Plugin::CPANFile name: '@DROLSKY/CPANFile' version: '6.008' - class: Dist::Zilla::Plugin::DROLSKY::License name: '@DROLSKY/DROLSKY::License' version: '0.80' - class: Dist::Zilla::Plugin::CheckStrictVersion name: '@DROLSKY/CheckStrictVersion' version: '0.001' - class: Dist::Zilla::Plugin::CheckSelfDependency config: Dist::Zilla::Plugin::CheckSelfDependency: finder: - ':InstallModules' Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000031' version: '0.003' name: '@DROLSKY/CheckSelfDependency' version: '0.011' - class: Dist::Zilla::Plugin::CheckPrereqsIndexed name: '@DROLSKY/CheckPrereqsIndexed' version: '0.020' - class: Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch config: Dist::Zilla::Role::Git::Repo: 'git --version': 2.7.4 repo_root: . name: '@DROLSKY/DROLSKY::Git::CheckFor::CorrectBranch' version: '0.80' - class: Dist::Zilla::Plugin::EnsureChangesHasContent name: '@DROLSKY/EnsureChangesHasContent' version: '0.02' - class: Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts config: Dist::Zilla::Role::Git::Repo: 'git --version': 2.7.4 repo_root: . name: '@DROLSKY/Git::CheckFor::MergeConflicts' version: '0.014' - class: Dist::Zilla::Plugin::DROLSKY::TidyAll name: '@DROLSKY/DROLSKY::TidyAll' version: '0.80' - class: Dist::Zilla::Plugin::Git::Check config: Dist::Zilla::Plugin::Git::Check: untracked_files: die Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - CONTRIBUTING.md - Changes - LICENSE - Makefile.PL - README.md - cpanfile - tidyall.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: 'git --version': 2.7.4 repo_root: . name: '@DROLSKY/Git::Check' version: '2.041' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] commit_msg: v%v%n%n%c Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - CONTRIBUTING.md - Changes - LICENSE - Makefile.PL - README.md - cpanfile - tidyall.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: 'git --version': 2.7.4 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@DROLSKY/Commit generated files' version: '2.041' - class: Dist::Zilla::Plugin::Git::Tag config: Dist::Zilla::Plugin::Git::Tag: branch: ~ changelog: Changes signed: 0 tag: v0.33 tag_format: v%v tag_message: v%v Dist::Zilla::Role::Git::Repo: 'git --version': 2.7.4 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@DROLSKY/Git::Tag' version: '2.041' - class: Dist::Zilla::Plugin::Git::Push config: Dist::Zilla::Plugin::Git::Push: push_to: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: 'git --version': 2.7.4 repo_root: . name: '@DROLSKY/Git::Push' version: '2.041' - class: Dist::Zilla::Plugin::BumpVersionAfterRelease config: Dist::Zilla::Plugin::BumpVersionAfterRelease: finders: - ':ExecFiles' - ':InstallModules' global: 0 munge_makefile_pl: 1 name: '@DROLSKY/BumpVersionAfterRelease' version: '0.015' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] commit_msg: 'Bump version after release' Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: - (?^:.+) changelog: Changes Dist::Zilla::Role::Git::Repo: 'git --version': 2.7.4 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@DROLSKY/Commit version bump' version: '2.041' - class: Dist::Zilla::Plugin::Git::Push config: Dist::Zilla::Plugin::Git::Push: push_to: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: 'git --version': 2.7.4 repo_root: . name: '@DROLSKY/Push version bump' version: '2.041' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: requires name: DevelopRequires version: '6.008' - class: Dist::Zilla::Plugin::MetaNoIndex name: MetaNoIndex version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':ExtraTestFiles' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':PerlExecFiles' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' version: '6.008' - class: Dist::Zilla::Plugin::FinderCode name: '@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM' version: '6.008' zilla: class: Dist::Zilla::Dist::Builder config: is_trial: '0' version: '6.008' x_authority: cpan:DROLSKY x_contributors: - 'Karen Etheridge ' x_serialization_backend: 'YAML::Tiny version 1.69' Specio-0.33/t/0000775000175000017500000000000013041701062012760 5ustar autarchautarchSpecio-0.33/t/lib/0000775000175000017500000000000013041701062013526 5ustar autarchautarchSpecio-0.33/t/lib/Specio/0000775000175000017500000000000013041701062014750 5ustar autarchautarchSpecio-0.33/t/lib/Specio/Library/0000775000175000017500000000000013041701062016354 5ustar autarchautarchSpecio-0.33/t/lib/Specio/Library/Conflict.pm0000644000175000017500000000030513041701062020447 0ustar autarchautarchpackage Specio::Library::Conflict; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'X', parent => t('Int'), ); 1; Specio-0.33/t/lib/Specio/Library/Union.pm0000644000175000017500000000103413041701062017776 0ustar autarchautarchpackage Specio::Library::Union; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; my $locale_object = declare( 'LocaleObject', parent => t('Object'), inline => sub { # Using $_[1] directly in the string causes some weirdness with 5.8 my $var = $_[1]; return <<"EOF"; ( $var->isa('DateTime::Locale::FromData') || $var->isa('DateTime::Locale::Base') ) EOF }, ); union( 'Union', of => [ t('Str'), $locale_object ], ); 1; Specio-0.33/t/lib/Specio/Library/Combines.pm0000644000175000017500000000025713041701062020453 0ustar autarchautarchpackage Specio::Library::Combines; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Library::Builtins -reexport; use Specio::Library::XY -reexport; 1; Specio-0.33/t/lib/Specio/Library/XY.pm0000644000175000017500000000046313041701062017253 0ustar autarchautarchpackage Specio::Library::XY; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'X', parent => t('Str'), where => sub { $_[0] =~ /x/ }, ); declare( 'Y', parent => t('X'), where => sub { $_[0] =~ /y/ }, ); 1; Specio-0.33/t/intersection.t0000644000175000017500000001465613041701062015665 0ustar autarchautarchuse strict; use warnings; use lib 't/lib'; use Test::Fatal; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Constraint::Intersection; use Specio::Declare; use Specio::DeclaredAt; use Specio::Library::Builtins; # The test output looks something like this: # # "Attempt to free unreferenced scalar: SV 0xf64bf0 at /home/autarch/perl5/perlbrew/perls/perl-5.12.5/lib/site_perl/5.12.5/Test/Builder.pm line 302." # # But the problem isn't in Test::Builder. It's something to do with # overloading, because it happens when we try to test the non-inlined types # with a NumOverload object. plan skip_all => 'This test triggers some odd overloading bug that causes a segfault on older perls' if $] < 5.014; # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $0 or die "Could not open $0 for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); { package HashArray; use overload '@{}' => sub { return [ x => 42 ] }; use overload '%{}' => sub { return { x => 42 } }; } my $HASH_ARRAY_OBJECT = bless {}, 'HashArray'; my %tests = ( accept => [$HASH_ARRAY_OBJECT], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, qw( 1e20 1e100 -1e10 -1e+10 1E20 ), $ARRAY_REF, $ARRAY_OVERLOAD, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM, $NEG_NUM, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, qw( 1e-10 -1e-10 1.23456e10 1.23456e-10 -1.23456e10 -1.23456e-10 -1.23456e+10 ), ], ); subtest( 'unnamed intersection made of two builtins', sub { my $unnamed_intersection = Specio::Constraint::Intersection->new( of => [ t('HashRef'), t('ArrayRef') ], declared_at => Specio::DeclaredAt->new_from_caller(0), ); ok( $unnamed_intersection->_has_inline_generator, 'intersection of two types with inline generator has a generator' ); is( $unnamed_intersection->name, 'HashRef & ArrayRef', 'name is generated from constituent types' ); ok( !$unnamed_intersection->is_anon, 'unnamed intersection is not anonymous because name is generated' ); is( $unnamed_intersection->parent, undef, 'parent method returns undef' ); ok( !$unnamed_intersection->_has_parent, 'intersection has no parent' ); test_constraint( $unnamed_intersection, \%tests ); } ); subtest( 'explicitly named intersection made of two builtins', sub { my $named_intersection = intersection( 'MyIntersection', of => [ t('HashRef'), t('ArrayRef') ], ); is( $named_intersection->name, 'MyIntersection', 'name passed to intersection() is used' ); test_constraint( $named_intersection, \%tests ); } ); subtest( 'intersection made of two types without inline generators', sub { my $my_hashref = anon( parent => t('Ref'), constraint => sub { return ( ref( $_[0] ) eq 'HASH' || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '%{}' ) ) ); }, ); my $my_arrayref = anon( parent => t('Ref'), constraint => sub { return ( ref( $_[0] ) eq 'ARRAY' || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '@{}' ) ) ); }, ); my $no_inline_intersection = intersection( of => [ $my_hashref, $my_arrayref ], ); is( $no_inline_intersection->name, undef, 'no name if intersection includes anonymous types', ); ok( $no_inline_intersection->is_anon, 'intersection is anonymous if any of its constituents are anonymous' ); test_constraint( $no_inline_intersection, \%tests ); } ); subtest( 'intersection made of builtin and type without inline generator', sub { my $my_hashref = anon( parent => t('Ref'), constraint => sub { return ( ref( $_[0] ) eq 'HASH' || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '%{}' ) ) ); }, ); my $mixed_inline_intersection = intersection( of => [ $my_hashref, t('ArrayRef') ], ); is( $mixed_inline_intersection->name, undef, 'no name if intersection includes anonymous types', ); ok( $mixed_inline_intersection->is_anon, 'intersection is anonymous if any of its constituents are anonymous' ); test_constraint( $mixed_inline_intersection, \%tests ); } ); done_testing(); Specio-0.33/t/declare-helpers.t0000644000175000017500000001250613041701062016206 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Declare; use Specio::PartialDump qw( partial_dump ); ## no critic (Modules::ProhibitMultiplePackages) { package Foo; sub new { return bless {}, shift; } sub foo {42} } { package Bar; ## no critic (ClassHierarchies::ProhibitExplicitISA) our @ISA = 'Foo'; sub bar {84} } { package Quux; sub whatever { } } { my $tc = object_can_type( 'Need2O', methods => [qw( foo bar )], ); is( $tc->name, 'Need2O', 'constraint has the expected name' ); ok( $tc->value_is_valid( Bar->new ), 'Bar object is valid for named ObjectCan type' ); ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { $tc->validate_or_die( Foo->new ) }; ## use critic my $e = $@; like( $e->message, qr/\QFoo is missing the 'bar' method/, 'got expected error message for failure with ObjectCan type' ); } { my $tc = any_can_type( 'Need2A', methods => [qw( foo bar )], ); is( $tc->name, 'Need2A', 'constraint has the expected name' ); for my $thing ( 'Bar', Bar->new ) { my $desc = ref $thing ? 'Bar class name' : 'Bar object'; ok( $tc->value_is_valid('Bar'), "$desc is valid for named AnyCan type" ); } for my $thing ( 'Foo', Foo->new ) { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { $tc->validate_or_die($thing) }; ## use critic my $e = $@; like( $e->message, qr/\QFoo is missing the 'bar' method/, 'got expected error message for failure with AnyCan type' ); } } { my $tc = object_can_type( 'Need3', methods => [qw( foo bar baz )], ); ok( !$tc->value_is_valid( Bar->new ), 'Bar object is not valid for named ObjectCan type' ); } { my $tc = object_can_type( methods => [qw( foo bar )], ); ok( $tc->value_is_valid( Bar->new ), 'Bar object is valid for anon ObjectCan type' ); } { my $tc = object_can_type( methods => [qw( foo bar baz )], ); ok( !$tc->value_is_valid( Bar->new ), 'Bar object is not valid for anon ObjectCan type' ); } { my $tc = object_isa_type('Foo'); is( $tc->name, 'Foo', 'name defaults to class name' ); ok( $tc->value_is_valid( Foo->new ), 'Foo object is valid for object isa type (requires Foo)' ); ok( $tc->value_is_valid( Bar->new ), 'Bar object is valid for object isa type (requires Foo)' ); is( exception { is( $tc . q{}, object_isa_type('Foo') . q{}, 'object_isa_type returns the same type for the same class each time' ); }, undef, 'no exception calling object_isa_type repeatedly with the same class name' ); } { my $tc = any_isa_type( 'FooAny', class => 'Foo', ); is( $tc->name, 'FooAny', 'can provide an explicit name' ); for my $class (qw( Foo Bar )) { for my $thing ( $class, $class->new ) { my $desc = ref $thing ? ( ref $thing ) . ' object' : "$thing class name"; ok( $tc->value_is_valid( Foo->new ), "$desc is valid for any isa type (requires Foo)" ); } } is( exception { is( $tc . q{}, any_isa_type('FooAny') . q{}, 'any_isa_type returns the same type for the same class each time' ); }, undef, 'no exception calling any_isa_type repeatedly with the same class name' ); } { my $tc = object_isa_type('Quux'); ok( !$tc->value_is_valid( Foo->new ), 'Foo object is not valid for object isa type (requires NonExistent)' ); ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { $tc->validate_or_die( Foo->new ) }; ## use critic my $e = $@; like( $e->message, qr/\Q/, 'got expected error message for failure with ObjectCan type' ); } { my $tc = any_isa_type( 'QuuxAny', class => 'Quux', ); for my $thing ( 'Foo', Foo->new ) { my $desc = ref $thing ? 'Foo class name' : 'Foo object'; ok( !$tc->value_is_valid($thing), "$desc is not valid for any isa type (requires Quux)" ); ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { $tc->validate_or_die($thing) }; ## use critic my $e = $@; like( $e->message, qr/\Q/, 'got expected error message for failure with AnyCan type' ); } } { require Specio::Constraint::Enum; my $tc = enum( 'Enum1', values => [qw( a b c )], ); for my $value (qw( a b c )) { ok( $tc->value_is_valid($value), "enum type accepts '$value'" ); } for my $value ( 'd', 42, [] ) { ok( !$tc->value_is_valid($value), 'enum type rejects ' . partial_dump($value) ); } } done_testing(); Specio-0.33/t/parameterized.t0000644000175000017500000000572613041701062016011 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Declare; use Specio::Library::Builtins; { my $arrayref = t('ArrayRef'); ok( $arrayref->value_is_valid( [ {}, 42, 'foo' ] ), 'ArrayRef does not care about member types' ); my $from_method = t1($arrayref); for my $pair ( [ filename => __FILE__ ], [ line => 42 ], [ package => 'main' ], [ subroutine => 'main::t1' ], ) { my ( $key, $expect ) = @{$pair}; is( $from_method->declared_at->$key, $expect, "declared_at $key is the expected value for parameterized type made from ->parameterize" ); } my $from_t = t2(); for my $pair ( [ filename => __FILE__ ], [ line => 84 ], [ package => 'main' ], [ subroutine => 'main::t2' ], ) { my ( $key, $expect ) = @{$pair}; is( $from_t->declared_at->$key, $expect, "declared_at $key is the expected value for parameterized type made from calling t" ); } declare( 'ArrayRefOfInt', parent => t( 'ArrayRef', of => t('Int') ), ); ok( t('ArrayRefOfInt'), 'there is an ArrayRefOfInt type declared' ); my $anon = anon( parent => t( 'ArrayRef', of => t('Int') ), ); for my $pair ( [ $from_method, '->parameterize' ], [ $from_t, 't(...)' ], [ t('ArrayRefOfInt'), 'named type' ], [ $anon, 'anon type' ], ) { my ( $arrayref_of_int, $desc ) = @{$pair}; ok( !$arrayref_of_int->value_is_valid( [ {}, 42, 'foo' ] ), "ArrayRef of Int [$desc] does care about member types" ); ok( $arrayref_of_int->value_is_valid( [ -1, 42, 1_000_000 ] ), "ArrayRef of Int [$desc] accepts array ref of all integers" ); ok( !$arrayref_of_int->value_is_valid(42), "ArrayRef of Int [$desc] rejects integer" ); ok( !$arrayref_of_int->value_is_valid( {} ), "ArrayRef of Int [$desc] rejects hashref" ); } } { like( exception { declare( 'MyInt', where => sub { $_[0] =~ /\A-?[0-9]+\z/ }, ); declare( 'ArrayRefOfMyInt', parent => t( 'ArrayRef', of => t('MyInt') ), ); }, qr/\QThe "of" parameter passed to ->parameterize must be an inlinable constraint if the parameterizable type has an inline_generator/, 'A parameterizable type with an inline generator cannot be parameterized with a type that cannot be inlined', ); } done_testing(); sub t1 { my $arrayref = shift; # line 42 return $arrayref->parameterize( of => t('Int') ); } sub t2 { # line 84 return t( 'ArrayRef', of => t('Int') ),; } Specio-0.33/t/union.t0000644000175000017500000001617013041701062014300 0ustar autarchautarchuse strict; use warnings; use lib 't/lib'; use Test::Fatal; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Constraint::Union; use Specio::Declare; use Specio::DeclaredAt; use Specio::Library::Builtins; # The test output looks something like this: # # "Attempt to free unreferenced scalar: SV 0xf64bf0 at /home/autarch/perl5/perlbrew/perls/perl-5.12.5/lib/site_perl/5.12.5/Test/Builder.pm line 302." # # But the problem isn't in Test::Builder. It's something to do with # overloading, because it happens when we try to test the non-inlined types # with a NumOverload object. plan skip_all => 'This test triggers some odd overloading bug that causes a segfault on older perls' if $] < 5.014; # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $0 or die "Could not open $0 for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); my %tests = ( accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, qw( 1e20 1e100 -1e10 -1e+10 1E20 ), $ARRAY_REF, $ARRAY_OVERLOAD, ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM, $NEG_NUM, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, qw( 1e-10 -1e-10 1.23456e10 1.23456e-10 -1.23456e10 -1.23456e-10 -1.23456e+10 ), ], ); subtest( 'unnamed union made of two builtins', sub { my $unnamed_union = Specio::Constraint::Union->new( of => [ t('Int'), t('ArrayRef') ], declared_at => Specio::DeclaredAt->new_from_caller(0), ); ok( $unnamed_union->_has_inline_generator, 'union of two types with inline generator has a generator' ); is( $unnamed_union->name, 'Int | ArrayRef', 'name is generated from constituent types' ); ok( !$unnamed_union->is_anon, 'unnamed union is not anonymous because name is generated' ); is( $unnamed_union->parent, undef, 'parent method returns undef' ); ok( !$unnamed_union->_has_parent, 'union has no parent' ); test_constraint( $unnamed_union, \%tests ); } ); subtest( 'explicitly named union made of two builtins', sub { my $named_union = union( 'MyUnion', of => [ t('Int'), t('ArrayRef') ], ); is( $named_union->name, 'MyUnion', 'name passed to union() is used' ); test_constraint( $named_union, \%tests ); } ); subtest( 'union made of two types without inline generators', sub { my $my_int = anon( parent => t('Num'), constraint => sub { return ( ( defined( $_[0] ) && !ref( $_[0] ) && ( do { ( my $val1 = $_[0] ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ) ) || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '0+' ) && do { ( my $val2 = $_[0] + 0 ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ) ); }, ); my $my_arrayref = anon( parent => t('Ref'), constraint => sub { return ( ref( $_[0] ) eq 'ARRAY' || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '@{}' ) ) ); }, ); my $no_inline_union = union( of => [ $my_int, $my_arrayref ], ); is( $no_inline_union->name, undef, 'no name if union includes anonymous types', ); ok( $no_inline_union->is_anon, 'union is anonymous if any of its constituents are anonymous' ); test_constraint( $no_inline_union, \%tests ); } ); subtest( 'union made of builtin and type without inline generator', sub { my $my_int = anon( parent => t('Num'), constraint => sub { return ( ( defined( $_[0] ) && !ref( $_[0] ) && ( do { ( my $val1 = $_[0] ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ) ) || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '0+' ) && do { ( my $val2 = $_[0] + 0 ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ) ); }, ); my $mixed_inline_union = union( of => [ $my_int, t('ArrayRef') ], ); is( $mixed_inline_union->name, undef, 'no name if union includes anonymous types', ); ok( $mixed_inline_union->is_anon, 'union is anonymous if any of its constituents are anonymous' ); test_constraint( $mixed_inline_union, \%tests ); } ); done_testing(); Specio-0.33/t/with-moo.t0000644000175000017500000001213413041701062014707 0ustar autarchautarchuse strict; use warnings; use Test::Needs 'Moo'; use Test::Fatal; use Test::More 0.96; { package Foo; use Specio::Declare; use Specio::Library::Builtins; use Moo; ::is( ::exception { has size => ( is => 'ro', isa => t('Int'), ); }, undef, 'no exception passing a Specio object as the isa parameter for a Moo attr' ); has numbers => ( is => 'ro', isa => t( 'ArrayRef', of => t('Int') ), ); my $ucstr = declare( 'UCStr', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr => ( is => 'ro', isa => $ucstr, coerce => $ucstr->coercion_sub, ); my $ucstr2 = declare( 'Ucstr2', parent => t('Str'), inline_as => sub { my $type = shift; my $value_var = shift; return $value_var . ' =~ /^[A-Z]+$/'; }, ); coerce( $ucstr2, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr2 => ( is => 'ro', isa => $ucstr2, coerce => $ucstr2->coercion_sub, ); my $ucstr3 = declare( 'Ucstr3', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr3, from => t('Str'), inline_generator => sub { my $coercion = shift; my $value_var = shift; return 'uc ' . $value_var; }, ); has ucstr3 => ( is => 'ro', isa => $ucstr3, coerce => $ucstr3->coercion_sub, ); my $ucstr4 = declare( 'Ucstr4', parent => t('Str'), inline_as => sub { my $type = shift; my $value_var = shift; return $value_var . ' =~ /^[A-Z]+$/'; }, ); coerce( $ucstr4, from => t('Str'), inline_generator => sub { my $coercion = shift; my $value_var = shift; return 'uc ' . $value_var; }, ); has ucstr4 => ( is => 'ro', isa => $ucstr4, coerce => $ucstr4->coercion_sub, ); } is( exception { Foo->new( size => 42 ) }, undef, 'no exception with new( size => $int )' ); like( exception { Foo->new( size => 'foo' ) }, qr/\QValidation failed for type named Int\E.+\Qwith value "foo"/, 'got exception with new( size => $str )' ); is( exception { Foo->new( numbers => [ 1, 2, 3 ] ) }, undef, 'no exception with new( numbers => [$int, $int, $int] )' ); is( exception { Foo->new( ucstr => 'ABC' ) }, undef, 'no exception with new( ucstr => $ucstr )' ); { my $foo; is( exception { $foo = Foo->new( ucstr => 'abc' ) }, undef, 'no exception with new( ucstr => $lcstr )' ); is( $foo->ucstr, 'ABC', 'ucstr attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr2 => 'abc' ) }, undef, 'no exception with new( ucstr2 => $lcstr )' ); is( $foo->ucstr2, 'ABC', 'ucstr2 attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr3 => 'abc' ) }, undef, 'no exception with new( ucstr3 => $lcstr )' ); is( $foo->ucstr3, 'ABC', 'ucstr3 attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr4 => 'abc' ) }, undef, 'no exception with new( ucstr4 => $lcstr )' ); is( $foo->ucstr4, 'ABC', 'ucstr4 attribute was coerced to upper case' ); } # There was a bug in Specio for any attribute with a type with more than one # coercion. In order to guarantee that it occurs, you need a a class with just # one attribute. { ## no critic (Modules::ProhibitMultiplePackages) package Bar; use Specio::Declare; use Specio::Library::Builtins; use Moo; coerce( t('Str'), from => t('ArrayRef'), inline_generator => sub { my $coercion = shift; my $value_var = shift; return "join q{}, \@{$value_var}"; }, ); coerce( t('Str'), from => t('HashRef'), inline_generator => sub { my $coercion = shift; my $value_var = shift; return "join q{}, keys %{$value_var}"; }, ); has bar => ( is => 'ro', isa => t('Str'), coerce => t('Str')->coercion_sub, ); } { is( exception { Bar->new( bar => ['a'], ) }, undef, q{no exception with Bar->new( bar => ['a'] )} ); is( exception { Bar->new( bar => { a => 1 } ) }, undef, q{no exception with Bar->new( bar => { a => 1 } )} ); } done_testing(); Specio-0.33/t/conflicts.t0000644000175000017500000000055213041701062015131 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use lib 't/lib'; use Specio::Library::XY; require Specio::Library::Conflict; like( exception { Specio::Library::Conflict->import }, qr/\QThe main package already has a type named X/, 'Got an exception when a library import conflicts with already declared types' ); done_testing(); Specio-0.33/t/coercion.t0000644000175000017500000001173513041701062014753 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Eval::Closure qw( eval_closure ); use Specio::Declare; use Specio::Library::Builtins; { my $arrayref = t('ArrayRef'); ok( !$arrayref->has_coercions, 'ArrayRef type object does not have coercions' ); ok( !Specio::Library::Builtins::t('ArrayRef')->has_coercions, 'ArrayRef type in Specio::Library::Builtins package does not have coercions' ); coerce( $arrayref, from => t('Int'), using => sub { [ $_[0] ] }, ); my $clone; is( exception { $clone = $arrayref->clone }, undef, 'can clone constraint with coercions without an exception' ); for my $pair ( [ 'ArrayRef', $arrayref ], [ 'clone of Arrayref', $clone ] ) { my ( $name, $type ) = @{$pair}; subtest( $name, sub { ok( $type->has_coercions, 'ArrayRef type object has coercions' ); ok( !Specio::Library::Builtins::t('ArrayRef')->has_coercions, 'ArrayRef type in Specio::Library::Builtins package does not have coercions (coercions only apply to local copy of type)' ); ok( $type->has_coercion_from_type( t('Int') ), 'has a coercion for the Int type' ); ok( !$type->has_coercion_from_type( t('Str') ), 'does not have a coercion for the Str type' ); is_deeply( $type->coerce_value(42), [42], 'coerced int to arrayref', ); is( $type->coerce_value(42.1), 42.1, 'cannot coerce num to arrayref - returns original value', ); ok( !$type->can_inline_coercion_and_check, 'cannot inline coercion and check for arrayref' ); } ); } } { my $hashref = t('HashRef'); coerce( $hashref, from => t('ArrayRef'), inline_generator => sub { return '{ @{ ' . $_[1] . '} }'; }, ); ok( $hashref->can_inline_coercion_and_check, 'can inline coercion and check for hashref' ); coerce( $hashref, from => t('Int'), inline_generator => sub { return '{ ' . $_[1] . ' => 1 }'; }, ); ok( $hashref->can_inline_coercion_and_check, 'can inline coercion and check for hashref with two coercions' ); my ( $source, $environment ) = $hashref->inline_coercion_and_check('$_[0]'); my $coerce_and_check; ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { $coerce_and_check = eval_closure( source => 'sub { ' . $source . ' }', environment => $environment, description => 'inlined coerce and check sub', ); }; ## use critic is( $@, q{}, 'no error evaling closure for coercion and check' ); is_deeply( $coerce_and_check->( { x => 1 } ), { x => 1 }, 'hashref is passed through coerce and check unchanged' ); is_deeply( $coerce_and_check->( [ x => 1 ] ), { x => 1 }, 'arrayref is coerced to hashref' ); is_deeply( $coerce_and_check->(42), { 42 => 1 }, 'integer is coerced to hashref' ); like( exception { $coerce_and_check->('foo') }, qr/\QValidation failed for type named HashRef declared in package Specio::Library::Builtins\E.+\Qwith value "foo"/, 'string throws exception' ); } { my $hashref = declare( 'HashRef2', parent => t('HashRef'), ); coerce( $hashref, from => t('ArrayRef'), using => sub { return { @{ $_[0] } }; }, ); coerce( $hashref, from => t('Int'), using => sub { return { $_[0] => 1 }; }, ); is_deeply( $hashref->coerce_value( [ x => 1 ] ), { x => 1 }, 'arrayref is coerced to hashref' ); is_deeply( $hashref->coerce_value(42), { 42 => 1 }, 'integer is coerced to hashref' ); is( $hashref->coerce_value('foo'), 'foo', 'cannot coerce num to arrayref - returns original value', ); } { my $str = t('Str'); like( exception { coerce( $str, from => t('Int'), ); }, qr/\QA type coercion must have either a coercion or inline_generator parameter/, 'a coercion must have a coercion sub or an inline generator' ); } done_testing(); Specio-0.33/t/builtins-sanity.t0000644000175000017500000007440413041701062016312 0ustar autarchautarchuse strict; use warnings; use lib 't/lib'; use Test::More 0.96; use Test::Specio qw( describe test_constraint :vars ); use Specio::Library::Builtins; # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $0 or die "Could not open $0 for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); my %tests = ( Item => { accept => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Defined => { accept => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, ], reject => [ $UNDEF, ], }, Undef => { accept => [ $UNDEF, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, ], }, Bool => { accept => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $EMPTY_STRING, $UNDEF, ], reject => [ $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, ], }, Maybe => { accept => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Value => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Ref => { accept => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, $UNDEF, ], }, Num => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, qw( 1e10 1e-10 1.23456e10 1.23456e-10 1e10 1e-10 1.23456e10 1.23456e-10 -1e10 -1e-10 -1.23456e10 -1.23456e-10 -1e10 -1e-10 -1.23456e10 -1.23456e-10 -1e+10 1E10 ), ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $INT_WITH_NL1, $INT_WITH_NL2, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Int => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, qw( 1e20 1e100 -1e10 -1e+10 1E20 ), ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM, $NEG_NUM, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, qw( 1e-10 -1e-10 1.23456e10 1.23456e-10 -1.23456e10 -1.23456e-10 -1.23456e+10 ), ], }, Str => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ScalarRef => { accept => [ $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ArrayRef => { accept => [ $ARRAY_REF, $ARRAY_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, HashRef => { accept => [ $HASH_REF, $HASH_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, CodeRef => { accept => [ $CODE_REF, $CODE_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, RegexpRef => { accept => [ $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $OBJECT, $UNDEF, $FAKE_REGEX, ], }, GlobRef => { accept => [ $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $FH_OBJECT, $OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $UNDEF, ], }, FileHandle => { accept => [ $FH, $FH_OBJECT, $GLOB_OVERLOAD_FH, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $UNDEF, ], }, Object => { accept => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $CODE_OVERLOAD, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $SCALAR_OVERLOAD, $ARRAY_OVERLOAD, $HASH_OVERLOAD, $OBJECT, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $UNDEF, ], }, ClassName => { accept => [ $CLASS_NAME, $STR_OVERLOAD_CLASS_NAME, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); for my $name ( sort keys %tests ) { test_constraint( $name, $tests{$name} ); } my %ptype_tests = ( Maybe => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, $UNDEF, ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, ], }, ScalarRef => { accept => [ \$ZERO, \$ONE, \$INT, \$NEG_INT, \$NUM, \$NEG_NUM, \$EMPTY_STRING, \$STRING, \$NUM_IN_STRING, \$INT_WITH_NL1, \$INT_WITH_NL2, ], reject => [ \$BOOL_OVERLOAD_TRUE, \$BOOL_OVERLOAD_FALSE, \$STR_OVERLOAD_EMPTY, \$STR_OVERLOAD_FULL, \$NUM_OVERLOAD_ZERO, \$NUM_OVERLOAD_ONE, \$NUM_OVERLOAD_NEG, \$NUM_OVERLOAD_NEG_DECIMAL, \$NUM_OVERLOAD_DECIMAL, \$SCALAR_REF, \$SCALAR_REF_REF, \$SCALAR_OVERLOAD, \$ARRAY_REF, \$ARRAY_OVERLOAD, \$HASH_REF, \$HASH_OVERLOAD, \$CODE_REF, \$CODE_OVERLOAD, \$GLOB, \$GLOB_REF, \$GLOB_OVERLOAD, \$GLOB_OVERLOAD_FH, \$FH, \$FH_OBJECT, \$REGEX, \$REGEX_OBJ, \$REGEX_OVERLOAD, \$FAKE_REGEX, \$OBJECT, \$UNDEF, ], }, ArrayRef => { accept => [ [], ( map { [$_] } $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, ), ], reject => [ map { [$_] } $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, HashRef => { accept => [ {}, ( map { { foo => $_ } } $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, ) ], reject => [ map { { foo => $_ } } $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); # We want to test all parameterized types using a type parameter that actually # checks the value (so not Any or Item). for my $pair ( [ 'Maybe' => \&describe ], [ ScalarRef => sub { 'scalar ref to ' . describe( ${ $_[0] } ) } ], [ ArrayRef => sub { 'array ref to ' . describe( $_[0]->[0] ) } ], [ HashRef => sub { 'hash ref to ' . describe( $_[0]->{foo} ) } ], ) { my ( $ptype, $describe ) = @{$pair}; my $constraint = t( $ptype, of => t('Value') ); test_constraint( $constraint, $ptype_tests{$ptype}, $describe, ); next unless $tests{$ptype}{reject}; # A parameterized type should reject all of the things that the # unparameterized version rejects. test_constraint( $constraint, { reject => $tests{$ptype}{reject} }, \&describe, ); } my %substr_test_str = ( ClassName => 'x' . $CLASS_NAME, ); # We need to test that the Str constraint (and types that derive from it) # accept the return val of substr() - which means passing that return val # directly to the checking code for my $type_name (qw( Str Num Int ClassName )) { my $str = $substr_test_str{$type_name} || '123456789123456789'; my $type = t($type_name); my $name = $type->name; my $not_inlined = $type->_constraint_with_parents; my $inlined; if ( $type->can_be_inlined ) { $inlined = $type->_generated_inline_sub; } ok( $type->value_is_valid( substr( $str, 1, 9 ) ), $type_name . ' accepts return val from substr using ->value_is_valid' ); ok( $not_inlined->( substr( $str, 1, 9 ) ), $type_name . ' accepts return val from substr using unoptimized constraint' ); ok( $inlined->( substr( $str, 1, 9 ) ), $type_name . ' accepts return val from substr using inlined constraint' ); # only Str accepts empty strings. next unless $type_name eq 'Str'; ok( $type->value_is_valid( substr( $str, 0, 0 ) ), $type_name . ' accepts empty return val from substr using ->value_is_valid' ); ok( $not_inlined->( substr( $str, 0, 0 ) ), $type_name . ' accepts empty return val from substr using unoptimized constraint' ); ok( $inlined->( substr( $str, 0, 0 ) ), $type_name . ' accepts empty return val from substr using inlined constraint' ); } done_testing(); Specio-0.33/t/t-clean.t0000644000175000017500000000040413041701062014464 0ustar autarchautarchuse strict; use warnings; use Test::Needs 'namespace::autoclean'; use Test::More 0.96; { package Foo; use namespace::autoclean; use Specio::Library::Builtins; } ok( !Foo->can('t'), 't sub is cleaned by namespace::autoclean' ); done_testing(); Specio-0.33/t/numeric-sanity.t0000644000175000017500000000343713041701062016121 0ustar autarchautarchuse strict; use warnings; use lib 't/lib'; use Test::More 0.96; use Test::Specio qw( test_constraint ); use Specio::Library::Numeric; my %tests = ( PositiveNum => { accept => [ 1, 2, 3, 2**32, 1.2, 0.000000000000001, 1e20, 1.1e10 ], reject => [ 0, -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, -1e19, -1.1e10 ], }, PositiveOrZeroNum => { accept => [ 0, 1, 2, 3, 2**32, 1.2, 0.000000000000001, 1e20, 1.1e10 ], reject => [ -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, -1e19, -1.1e10 ], }, PositiveInt => { accept => [ 1, 2, 3, 2**32, 1e20 ], reject => [ 0, -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, 1.1 ], }, PositiveOrZeroInt => { accept => [ 0, 1, 2, 3, 2**32, 1e20 ], reject => [ -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, 1.1 ], }, NegativeNum => { accept => [ -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, -1e19, -1.1e10 ], reject => [ 0, 1, 2, 3, 2**32, 1.2, 0.000000000000001, 1e20, 1.1e10 ], }, NegativeOrZeroNum => { accept => [ 0, -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, -1e19, -1.1e10 ], reject => [ 1, 2, 3, 2**32, 1.2, 0.000000000000001, 1e20, 1.1e10 ], }, NegativeInt => { accept => [ -1, -2, -3, -1 * ( 2**32 ), -1e20 ], reject => [ 0, 1, 2**32, -1.2, -0.000000000000001, 1.1, 1.1e10 ], }, NegativeOrZeroInt => { accept => [ 0, -1, -2, -3, -1 * ( 2**32 ), -1e20 ], reject => [ 1, 2**32, -1.2, -0.000000000000001, 1.1, 1.1e10 ], }, SingleDigit => { accept => [ -9 .. 9 ], reject => [ 10, -10, 1.1, -1.1 ], }, ); for my $name ( sort keys %tests ) { test_constraint( $name, $tests{$name} ); } done_testing(); Specio-0.33/t/inline.t0000644000175000017500000001006213041701062014420 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Eval::Closure qw( eval_closure ); use Specio::Declare; use Specio::Library::Builtins; { my $str = t('Str'); my $int = t('Int'); my ( $str_source, $str_env ) = $str->inline_coercion_and_check('$value1'); my ( $int_source, $int_env ) = $int->inline_coercion_and_check('$value2'); my $sub = 'sub { ' . 'my $value1 = shift;' . 'my $value2 = shift;' . 'my $str_val = ' . $str_source . ';' . 'my $int_val = ' . $int_source . ';' . 'return ($str_val, $int_val)' . ' }'; my $coerce_and_check; is( exception { $coerce_and_check = eval_closure( source => $sub, environment => { %{$str_env}, %{$int_env}, }, description => 'inlined coerce and check sub for str and int', ); }, undef, 'no exception evaling a closure for str and int inlining in one sub', ); is_deeply( [ $coerce_and_check->( 'string', 42 ) ], [ 'string', 42 ], 'both types pass check and are returned' ); like( exception { $coerce_and_check->( [], 42 ) }, qr/Validation failed for type named Str/, 'got exception passing arrayref for Str value' ); like( exception { $coerce_and_check->( 'string', [] ) }, qr/Validation failed for type named Int/, 'got exception passing arrayref for Int value' ); } { my $enum1 = enum( Enum1 => values => [qw( foo bar baz )] ); my $enum2 = enum( Enum2 => values => [qw( a b c )] ); my ( $enum1_source, $enum1_env ) = $enum1->inline_coercion_and_check('$value1'); my ( $enum2_source, $enum2_env ) = $enum2->inline_coercion_and_check('$value2'); my $sub = 'sub { ' . 'my $value1 = shift;' . 'my $value2 = shift;' . 'my $enum1_val = ' . $enum1_source . ';' . 'my $enum2_val = ' . $enum2_source . ';' . 'return ($enum1_val, $enum2_val)' . ' }'; my $coerce_and_check; is( exception { $coerce_and_check = eval_closure( source => $sub, environment => { %{$enum1_env}, %{$enum2_env}, }, description => 'inlined coerce and check sub for two enums', ); }, undef, 'no exception evaling a closure for inlining two enums in one sub', ); is_deeply( [ $coerce_and_check->( 'foo', 'a' ) ], [ 'foo', 'a' ], 'both types pass check and are returned' ); like( exception { $coerce_and_check->( [], 'c' ) }, qr/Validation failed for type named Enum1/, 'got exception passing arrayref for Enum1 value' ); like( exception { $coerce_and_check->( 'bar', [] ) }, qr/Validation failed for type named Enum2/, 'got exception passing arrayref for Enum2 value' ); } { # Note that the same bug would apply to role types and other special types # that have a specialized _inline_generator. my $foo = declare( 'Foo', parent => any_isa_type('Specio::Coercion'), ); my $constraint; is( exception { $constraint = $foo->_generated_inline_sub }, undef, 'building an inline sub for an empty subtype of an any_isa_type does not die' ); ok( !$constraint->('Specio::Constraint::Simple'), 'generated constraint rejects values as expected' ); ok( $constraint->('Specio::Coercion'), 'generated constraint accepts values as expected' ); my $code; is( exception { $code = $foo->inline_check('$x') }, undef, 'building inline code for an empty subtype of an any_isa_type does not die' ); like( $code, qr/\$x->isa\((["'])Specio::Coercion\1\)/, 'generated code contains expected check' ); } done_testing(); Specio-0.33/t/multiple-libraries.t0000644000175000017500000000056713041701062016760 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Library::Builtins; use lib 't/lib'; use Specio::Library::XY; { for my $type (qw( X Y Str Undef )) { is( exception { ok( t($type), "type named $type is available" ) }, undef, "no exception retrieving $type type" ); } } done_testing(); Specio-0.33/t/00-report-prereqs.t0000644000175000017500000001271413041701062016357 0ustar autarchautarch#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.025 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do 't/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if $mod eq 'perl'; next if grep { $_ eq $mod } @exclude; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( @dep_errors ) { diag join("\n", "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n", "The following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass; # vim: ts=4 sts=4 sw=4 et: Specio-0.33/t/combines.t0000644000175000017500000000057513041701062014751 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use lib 't/lib'; use Specio::Library::Combines; { for my $type (qw( X Y Str Undef )) { is( exception { ok( t($type), "type named $type is available" ) }, undef, "no exception retrieving $type type - exported by combining library" ); } } done_testing(); Specio-0.33/t/builtins.t0000644000175000017500000000354613041701062015004 0ustar autarchautarchuse strict; use warnings; use utf8; use open ':encoding(UTF-8)', ':std'; use Test::More 0.96; use Specio::Declare; use Specio::Library::Builtins; use Specio::PartialDump qw( partial_dump ); { my $str = t('Str'); isa_ok( $str, 'Specio::Constraint::Simple' ); like( $str->declared_at->filename, qr/Builtins\.pm/, 'declared_at has the right filename' ); for my $value ( q{}, 'foo', 'bar::baz', "\x{3456}", 0, 42 ) { ok( $str->value_is_valid($value), partial_dump($value) . ' is a valid Str value' ); } ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; ## use critic my $foo = 'foo'; for my $value ( undef, \42, \$foo, [], {}, sub { }, *glob, \*globref ) { ok( !$str->value_is_valid($value), partial_dump($value) . ' is not a valid Str value' ); } } is( t('Str')->parent->name, 'Value', 'parent of Str is Value' ); my $str_clone = t('Str')->clone; for my $name (qw( Str Value Defined Item )) { ok( t('Str')->is_a_type_of( t($name) ), "Str is_a_type_of($name)" ); next if $name eq 'Str'; ok( $str_clone->is_a_type_of( t($name) ), "Str clone is_a_type_of($name)" ); } for my $name (qw( Maybe ArrayRef Object )) { ok( !t('Str')->is_a_type_of( t($name) ), "Str ! is_a_type_of($name)" ); ok( !$str_clone->is_a_type_of( t($name) ), "Str clone ! is_a_type_of($name)" ); } for my $type ( t('Str'), $str_clone ) { ok( $type->is_same_type_as( t('Str') ), $type->name . ' is_same_type_as Str' ); } { my $child = anon( parent => t('Str') ); ok( $child->can_be_inlined, 'child of builtin with no additional constraint can be inlined' ); } done_testing(); Specio-0.33/t/perl-sanity.t0000644000175000017500000000706013041701062015415 0ustar autarchautarchuse strict; use warnings; use lib 't/lib'; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use B (); use Specio::Library::String; my %tests = ( PackageName => { accept => [ $CLASS_NAME, $STR_OVERLOAD_CLASS_NAME, qw( Specio Spec::Library::Builtins strict _Foo A123::456 ), "Has::Chinese::\x{3403}::In::It" ], reject => [ $EMPTY_STRING, $STR_OVERLOAD_EMPTY, qw( 0Foo Foo:Bar Foo:::Bar Foo: Foo:: Foo::Bar:: ::Foo My-Distro ), 'Has::Spaces In It', ], }, DistName => { accept => [ qw( Specio Spec-Library-Builtins strict _Foo A123-456 ), "Has-Chinese-\x{3403}-In-It" ], reject => [ $EMPTY_STRING, $STR_OVERLOAD_EMPTY, qw( 0Foo Foo:Bar Foo-:Bar Foo: Foo- Foo-Bar- -Foo My::Package ), 'Has-Spaces In It', ], }, Identifier => { accept => [ qw( _ a b c d A B C D Foo Bar _what_ foo_bar f1234 f1j2_o1 ), "\x{3403}", "has_\x{3403}", "has_\x{3403}_in_it", ], reject => [ q{ }, $EMPTY_STRING, 'a b', '4foo', ] }, SafeIdentifier => { accept => [ qw( c d A B C D Foo Bar _what_ foo_bar f1234 f1j2_o1 ), "\x{3403}", "has_\x{3403}", "has_\x{3403}_in_it", ], reject => [ qw( _ a b ), q{ }, $EMPTY_STRING, 'a b', '4foo', ] }, LaxVersion => { accept => [ qw( v1.2.3.4 v1.2 1.2.3 1.2345.6 v1.23_4 1.2345 1.2345_01 0.1 v0.1.2 ) ], reject => [ qw( 1.2_3_4 42.a a.b vA.b ), ], }, StrictVersion => { accept => [ qw( v1.2.3.4 v1.234.5 2.3456 0.1 v0.1.2 ), ], reject => [ qw( v1.2 1.2345.6 v1.23_4 1.2345_01 ) ], }, ); $tests{ModuleName} = $tests{PackageName}; for my $name ( sort keys %tests ) { test_constraint( $name, $tests{$name} ); } done_testing(); Specio-0.33/t/anon.t0000644000175000017500000000152713041701062014103 0ustar autarchautarchuse strict; use warnings; use Test::More 0.96; use Specio::Declare; use Specio::Library::Builtins; { my $anon = anon( parent => t('Str'), where => sub { length $_[0] }, ); isa_ok( $anon, 'Specio::Constraint::Simple', 'return value from anon' ); ok( $anon->value_is_valid('x'), q{anon type allows "x"} ); ok( !$anon->value_is_valid(q{}), 'anon type reject empty string' ); } { my $anon = anon( parent => t('Str'), inline => sub { $_[0]->parent->inline_check( $_[1] ) . " && length $_[1]"; }, ); isa_ok( $anon, 'Specio::Constraint::Simple', 'return value from anon' ); ok( $anon->value_is_valid('x'), q{inlinable anon type allows "x"} ); ok( !$anon->value_is_valid(q{}), 'inlinable anon type reject empty string' ); } done_testing(); Specio-0.33/t/does-type.t0000644000175000017500000001045313041701062015057 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Declare; ## no critic (Modules::ProhibitMultiplePackages) { package Class::DoesNoRoles; sub new { return bless {}, shift; } } { package Role::MooseStyle; use Role::Tiny; } { package Class::MooseStyle; use Role::Tiny::With; with 'Role::MooseStyle'; sub new { bless {}, __PACKAGE__; } } { my $any_does_moose = any_does_type( 'AnyDoesMoose', role => 'Role::MooseStyle', ); _test_any_type( $any_does_moose, 'Class::MooseStyle' ); my $object_does_moose = object_does_type( 'ObjectDoesMoose', role => 'Role::MooseStyle', ); _test_object_type( $object_does_moose, 'Class::MooseStyle' ); } { is( exception { is( object_does_type('Role::MooseStyle') . q{}, object_does_type('Role::MooseStyle') . q{}, 'object_does_type returns the same type for the same role each time' ); }, undef, 'no exception calling object_does_type repeatedly with the same role name' ); is( exception { is( any_does_type('Role::MooseStyle') . q{}, any_does_type('Role::MooseStyle') . q{}, 'any_does_type returns the same type for the same role each time' ); }, undef, 'no exception calling any_does_type repeatedly with the same role name' ); } SKIP: { skip 'These tests require Mouse', 8 unless eval { require Mouse; 1 }; ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval) eval <<'EOF'; { package Role::MouseStyle; use Mouse::Role; } { package Class::MouseStyle; use Mouse; with 'Role::MouseStyle'; } EOF die $@ if $@; my $any_does_moose = any_does_type( 'AnyDoesMouse', role => 'Role::MouseStyle', ); _test_any_type( $any_does_moose, 'Class::MouseStyle' ); my $object_does_moose = object_does_type( 'ObjectDoesMouse', role => 'Role::MouseStyle', ); _test_object_type( $object_does_moose, 'Class::MouseStyle' ); } SKIP: { skip 'These tests require Moo', 8 unless eval { require Moo; 1 }; ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval) eval <<'EOF'; { package Role::MooStyle; use Moo::Role; } { package Class::MooStyle; use Moo; with 'Role::MooStyle'; } EOF ## use critic die $@ if $@; my $any_does_moose = any_does_type( 'AnyDoesMoo', role => 'Role::MooStyle', ); _test_any_type( $any_does_moose, 'Class::MooStyle' ); my $object_does_moose = object_does_type( 'ObjectDoesMoo', role => 'Role::MooStyle', ); _test_object_type( $object_does_moose, 'Class::MooStyle' ); } done_testing(); sub _test_any_type { my $type = shift; my $class_name = shift; my $type_name = $type->name; ok( $type->value_is_valid($class_name), "$class_name class name is valid for $type_name" ); ok( $type->value_is_valid( $class_name->new ), "$class_name object is valid for $type_name" ); ok( !$type->value_is_valid('Class::DoesNoRoles'), "Class::DoesNoRoles class name is not valid for $type_name" ); ok( !$type->value_is_valid( Class::DoesNoRoles->new ), "Class::DoesNoRoles object is not valid for $type_name" ); } sub _test_object_type { my $type = shift; my $class_name = shift; my $type_name = $type->name; ok( !$type->value_is_valid($class_name), "$class_name class name is not valid for $type_name" ); ok( $type->value_is_valid( $class_name->new ), "$class_name object is valid for $type_name" ); ok( !$type->value_is_valid('Class::DoesNoRoles'), "Class::DoesNoRoles class name is not valid for $type_name" ); ok( !$type->value_is_valid( Class::DoesNoRoles->new ), "Class::DoesNoRoles object is not valid for $type_name" ); } Specio-0.33/t/00-report-prereqs.dd0000644000175000017500000000766213041701062016511 0ustar autarchautarchdo { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0' } }, 'develop' => { 'requires' => { 'Code::TidyAll::Plugin::Test::Vars' => '0.02', 'File::Spec' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Moo' => '0', 'Moose' => '2.1207', 'Mouse' => '0', 'Parallel::ForkManager' => '1.19', 'Perl::Critic' => '1.126', 'Perl::Tidy' => '20160302', 'Pod::Coverage::TrustPod' => '0', 'Pod::Wordlist' => '0', 'Sub::Quote' => '0', 'Test::CPAN::Changes' => '0.19', 'Test::CPAN::Meta::JSON' => '0.16', 'Test::Code::TidyAll' => '0.50', 'Test::EOL' => '0', 'Test::Mojibake' => '0', 'Test::More' => '0.88', 'Test::NoTabs' => '0', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Portability::Files' => '0', 'Test::Spelling' => '0.12', 'Test::Vars' => '0.009', 'Test::Version' => '2.05', 'blib' => '1.01', 'namespace::autoclean' => '0' } }, 'runtime' => { 'requires' => { 'B' => '0', 'Carp' => '0', 'Devel::StackTrace' => '0', 'Eval::Closure' => '0', 'Exporter' => '0', 'IO::File' => '0', 'List::Util' => '1.33', 'MRO::Compat' => '0', 'Role::Tiny' => '1.003003', 'Role::Tiny::With' => '0', 'Scalar::Util' => '0', 'Storable' => '0', 'Test::Fatal' => '0', 'Test::More' => '0.96', 'overload' => '0', 'parent' => '0', 'perl' => '5.008', 're' => '0', 'strict' => '0', 'version' => '0.83', 'warnings' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'Test::More' => '0.96', 'Test::Needs' => '0', 'lib' => '0', 'open' => '0', 'utf8' => '0' } } }; $x; }Specio-0.33/t/with-moose.t0000644000175000017500000001460013041701062015237 0ustar autarchautarch## no critic (Modules::ProhibitMultiplePackages, Moose::RequireMakeImmutable, Moose::RequireCleanNamespace) use strict; use warnings; use Test::Needs { Moose => '2.1207', }; use Test::Fatal; use Test::More 0.96; { package Foo; use Specio::Declare; use Specio::Library::Builtins; use Moose; ::is( ::exception { has size => ( is => 'ro', isa => t('Int'), ); }, undef, 'no exception passing a Specio object as the isa parameter for a Moose attr' ); has numbers => ( is => 'ro', isa => t( 'ArrayRef', of => t('Int') ), ); my $ucstr = declare( 'UCStr', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr => ( is => 'ro', isa => $ucstr, coerce => 1, ); my $ucstr2 = declare( 'Ucstr2', parent => t('Str'), inline_as => sub { my $type = shift; my $value_var = shift; return $value_var . ' =~ /^[A-Z]+$/'; }, ); coerce( $ucstr2, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr2 => ( is => 'ro', isa => $ucstr2, coerce => 1, ); my $ucstr3 = declare( 'Ucstr3', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr3, from => t('Str'), inline_generator => sub { my $coercion = shift; my $value_var = shift; return 'uc ' . $value_var; }, ); has ucstr3 => ( is => 'ro', isa => $ucstr3, coerce => 1, ); my $ucstr4 = declare( 'Ucstr4', parent => t('Str'), inline_as => sub { my $type = shift; my $value_var = shift; return $value_var . ' =~ /^[A-Z]+$/'; }, ); coerce( $ucstr4, from => t('Str'), inline_generator => sub { my $coercion = shift; my $value_var = shift; return 'uc ' . $value_var; }, ); has ucstr4 => ( is => 'ro', isa => $ucstr4, coerce => 1, ); } is( exception { Foo->new( size => 42 ) }, undef, 'no exception with new( size => $int )' ); like( exception { Foo->new( size => 'foo' ) }, qr/\QAttribute (size) does not pass the type constraint/, 'got exception with new( size => $str )' ); is( exception { Foo->new( numbers => [ 1, 2, 3 ] ) }, undef, 'no exception with new( numbers => [$int, $int, $int] )' ); is( exception { Foo->new( ucstr => 'ABC' ) }, undef, 'no exception with new( ucstr => $ucstr )' ); { my $foo; is( exception { $foo = Foo->new( ucstr => 'abc' ) }, undef, 'no exception with new( ucstr => $lcstr )' ); is( $foo->ucstr, 'ABC', 'ucstr attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr2 => 'abc' ) }, undef, 'no exception with new( ucstr2 => $lcstr )' ); is( $foo->ucstr2, 'ABC', 'ucstr2 attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr3 => 'abc' ) }, undef, 'no exception with new( ucstr3 => $lcstr )' ); is( $foo->ucstr3, 'ABC', 'ucstr3 attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr4 => 'abc' ) }, undef, 'no exception with new( ucstr4 => $lcstr )' ); is( $foo->ucstr4, 'ABC', 'ucstr4 attribute was coerced to upper case' ); } { package Bar; use Specio::Library::Builtins; use Specio::Declare; use Moose; ::is( ::exception { has native => ( traits => ['Array'], is => 'ro', isa => t( 'ArrayRef', of => t('Int') ), default => sub { [] }, handles => { add_native => 'push' }, ); }, undef, 'no exception creating native Array attr where isa => ArrayRef of Int' ); declare( 'AofStr', parent => t( 'ArrayRef', of => t('Str') ), ); coerce( t('AofStr'), from => t('Str'), using => sub { [ $_[0] ] }, ); coerce( t('Str'), from => t('HashRef'), using => sub { return join '-', sort keys %{ $_[0] } }, ); ::is( ::exception { has coerced => ( traits => ['Array'], is => 'ro', isa => t('AofStr'), default => sub { [] }, coerce => 1, handles => { add_coerced => 'push' }, ); }, undef, 'no exception creating native Array attr where isa => AofStr and coerce => 1' ); ::like( ::exception { has native2 => ( traits => ['Array'], is => 'ro', isa => t('Str'), ); }, qr/\QThe type constraint for native2 must be a subtype of ArrayRef but it's a Str/, 'got exception creating native Array attr where isa => Str' ); } { my $bar = Bar->new; is( exception { $bar->add_native(42) }, undef, 'no exception pushing int onto native trait' ); like( exception { $bar->add_native('foo') }, qr/\QA new member value for native\E.+\Qfor type named Int\E.+\Qwith value "foo"/, 'got exception pushing str onto native trait' ); } { my $bar = Bar->new; is( exception { $bar->add_coerced( { a => 1, b => 2 } ) }, undef, 'no exception pushing hashref onto coerced attribute' ); is_deeply( $bar->coerced, ['a-b'], 'pushed value was coerced as expected', ); like( exception { $bar->add_coerced(qr/foobar/) }, qr/\QAttribute (coerced) does not pass the type constraint because/, 'got exception trying to push regex object onto coerced attribute' ); } done_testing(); Specio-0.33/t/string-sanity.t0000644000175000017500000001254313041701062015763 0ustar autarchautarchuse strict; use warnings; use lib 't/lib'; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Library::String; # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $0 or die "Could not open $0 for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); my $LONG_STR_255 = 'x' x 255; my $LONG_STR_256 = 'x' x 256; my $LONG_CODE_255 = '1' x 255; my $LONG_CODE_256 = '1' x 256; my @STRINGS_WITH_VSPACE = map { join $_, qw( foo bar ) } ( "\n", "\r", "\r\n", "\x{2028}", "\x{2029}", ); my %tests = ( NonEmptySimpleStr => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_FULL, $LONG_STR_255, ], reject => [ $EMPTY_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $STR_OVERLOAD_EMPTY, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, $LONG_STR_256, @STRINGS_WITH_VSPACE, ], }, NonEmptyStr => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $INT_WITH_NL1, $INT_WITH_NL2, $NUM, $NEG_NUM, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_FULL, $LONG_STR_255, $LONG_STR_256, @STRINGS_WITH_VSPACE, ], reject => [ $EMPTY_STRING, $STR_OVERLOAD_EMPTY, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, PackageName => { accept => [ $CLASS_NAME, $STR_OVERLOAD_CLASS_NAME, qw( Specio Spec::Library::Builtins strict _Foo A123::456 ), "Has::Chinese::\x{3403}::In::It" ], reject => [ $EMPTY_STRING, $STR_OVERLOAD_EMPTY, qw( 0Foo Foo:Bar Foo:::Bar Foo: Foo:: Foo::Bar:: ::Foo ), 'Has::Spaces In It', ], }, SimpleStr => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $LONG_STR_255, ], reject => [ $INT_WITH_NL1, $INT_WITH_NL2, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, $LONG_STR_256, @STRINGS_WITH_VSPACE, ], }, ); for my $name ( sort keys %tests ) { test_constraint( $name, $tests{$name} ); } done_testing(); Specio-0.33/t/union-library.t0000644000175000017500000000043113041701062015733 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use lib 't/lib'; use Specio::Library::Union; { is( exception { ok( t('Union'), 'type named Union is available' ) }, undef, 'no exception retrieving Union type' ); } done_testing(); Specio-0.33/t/exception.t0000644000175000017500000000127413041701062015145 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Library::Builtins; { my $str = t('Str'); my $e = exception { $str->validate_or_die(undef); }; ok( $e, 'validate_or_die throws something when given a bad value' ); isa_ok( $e, 'Specio::Exception' ); like( $e->message, qr/Validation failed for type named Str .+ with value undef/, 'exception contains expected error' ); $e = exception { $str->validate_or_die( [] ); }; like( $e->message, qr/Validation failed for type named Str .+ with value \[\s*\]/, 'exception contains expected error' ); } done_testing(); Specio-0.33/t/inline-environment.t0000644000175000017500000000302513041701062016763 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Constraint::Simple; use Specio::DeclaredAt; use Specio::Library::Builtins; { my $t = Specio::Constraint::Simple->new( name => 'Foo', parent => t('Str'), inline_generator => sub {'1'}, inline_environment => { '$scalar' => 42 }, declared_at => Specio::DeclaredAt->new_from_caller(0), ); my $from_int = Specio::Coercion->new( from => t('Int'), to => $t, inline_generator => sub {'1'}, inline_environment => { '%hash' => { y => 84 }, }, declared_at => Specio::DeclaredAt->new_from_caller(0), ); my $from_num = Specio::Coercion->new( from => t('Num'), to => $t, inline_generator => sub {'1'}, inline_environment => { '@array' => [ 1, 2, 3 ], }, declared_at => Specio::DeclaredAt->new_from_caller(0), ); $t->add_coercion($from_int); $t->add_coercion($from_num); my ( $code, $env ) = $t->inline_coercion_and_check('$var'); my %expect = ( '$scalar' => 42, '%hash' => { y => 84 }, '@array' => [ 1, 2, 3 ], ); for my $key ( sort keys %expect ) { is_deeply( $env->{$key}, $expect{$key}, "inline_coercion_and_check merges all inline environment hashes together - $key", ); } } done_testing(); Specio-0.33/README.md0000644000175000017500000003520513041701062013777 0ustar autarchautarch# NAME Specio - Type constraints and coercions for Perl # VERSION version 0.33 # SYNOPSIS package MyApp::Type::Library; use Specio::Declare; use Specio::Library::Builtins; declare( 'PositiveInt', parent => t('Int'), inline => sub { $_[0]->parent->inline_check( $_[1] ) . ' && ( ' . $_[1] . ' > 0 )'; }, ); # or ... declare( 'PositiveInt', parent => t('Int'), where => sub { $_[0] > 0 }, ); declare( 'ArrayRefOfPositiveInt', parent => t( 'ArrayRef', of => t('PositiveInt'), ), ); coerce( 'ArrayRefOfPositiveInt', from => t('PositiveInt'), using => sub { [ $_[0] ] }, ); any_can_type( 'Duck', methods => [ 'duck_walk', 'quack' ], ); object_isa_type('MyApp::Person'); # DESCRIPTION The `Specio` distribution provides classes for representing type constraints and coercion, along with syntax sugar for declaring them. Note that this is not a proper type system for Perl. Nothing in this distribution will magically make the Perl interpreter start checking a value's type on assignment to a variable. In fact, there's no built-in way to apply a type to a variable at all. Instead, you can explicitly check a value against a type, and optionally coerce values to that type. My long-term goal is to replace Moose's built-in types and [MooseX::Types](https://metacpan.org/pod/MooseX::Types) with this module. # WHAT IS A TYPE? At it's core, a type is simply a constraint. A constraint is code that checks a value and returns true or false. Most constraints are represented by [Specio::Constraint::Simple](https://metacpan.org/pod/Specio::Constraint::Simple) objects. However, there are other type constraint classes for specialized kinds of constraints. Types can be named or anonymous, and each type can have a parent type. A type's constraint is optional because sometimes you may want to create a named subtype of some existing type without adding additional constraints. Constraints can be expressed either in terms of a simple subroutine reference or in terms of an inline generator subroutine reference. The former is easier to write but the latter is preferred because it allow for better optimization. A type can also have an optional message generator subroutine reference. You can use this to provide a more intelligent error message when a value does not pass the constraint, though the default message should suffice for most cases. Finally, you can associate a set of coercions with a type. A coercion is a subroutine reference (or inline generator, like constraints), that takes a value of one type and turns it into a value that matches the type the coercion belongs to. # BUILTIN TYPES This distribution ships with a set of builtin types representing the types provided by the Perl interpreter itself. They are arranged in a hierarchy as follows: Item Bool Maybe (of `a) Undef Defined Value Str Num Int ClassName Ref ScalarRef (of `a) ArrayRef (of `a) HashRef (of `a) CodeRef RegexpRef GlobRef FileHandle Object The `Item` type accepts anything and everything. The `Bool` type only accepts `undef`, `0`, or `1`. The `Undef` type only accepts `undef`. The `Defined` type accepts anything _except_ `undef`. The `Num` and `Int` types are stricter about numbers than Perl is. Specifically, they do not allow any sort of space in the number, nor do they accept "Nan", "Inf", or "Infinity". The `ClassName` type constraint checks that the name is valid _and_ that the class is loaded. The `FileHandle` type accepts either a glob, a scalar filehandle, or anything that isa [IO::Handle](https://metacpan.org/pod/IO::Handle). All types accept overloaded objects that support the required operation. See below for details. ## Overloading Perl's overloading is horribly broken and doesn't make much sense at all. However, unlike Moose, all type constraints allow overloaded objects where they make sense. For types where overloading makes sense, we explicitly check that the object provides the type overloading we expect. We _do not_ simply try to use the object as the type in question and hope it works. This means that these checks effectively ignore the `fallback` setting for the overloaded object. In other words, an object that overloads stringification will not pass the `Bool` type check unless it _also_ overloads boolification. Most types do not check that the overloaded method actually returns something that matches the constraint. This may change in the future. The `Bool` type accepts an object that provides `bool` overloading. The `Str` type accepts an object that provides string (`q{""}`) overloading. The `Num` type accepts an object that provides numeric `'0+'}` overloading. The `Int` type does as well, but it will check that the overloading returns an actual integer. The `ClassName` type will accept an object with string overloading that returns a class name. To make this all more confusing, the `Value` type will _never_ accept an object, even though some of its subtypes will. The various reference types all accept objects which provide the appropriate overloading. The `FileHandle` type accepts an object which overloads globification as long as the returned glob is an open filehandle. # PARAMETERIZABLE TYPES Any type followed by a type parameter `` of `a `` in the hierarchy above can be parameterized. The parameter is itself a type, so you can say you want an "ArrayRef of Int", or even an "ArrayRef of HashRef of ScalarRef of ClassName". When they are parameterized, the `ScalarRef` and `ArrayRef` types check that the value(s) they refer to match the type parameter. For the `HashRef` type, the parameter applies to the values (keys are never checked). ## Maybe The `Maybe` type is a special parameterized type. It allows for either `undef` or a value. All by itself, it is meaningless, since it is equivalent to "Maybe of Item", which is equivalent to Item. When parameterized, it accepts either an `undef` or the type of its parameter. This is useful for optional attributes or parameters. However, you're probably better off making your code simply not pass the parameter at all This usually makes for a simpler API. # REGISTRIES AND IMPORTING Types are local to each package where they are used. When you "import" types from some other library, you are actually making a copy of that type. This means that a type named "Foo" in one package may not be the same as "Foo" in another package. This has potential for confusion, but it also avoids the magic action at a distance pollution that comes with a global type naming system. The registry is managed internally by the Specio distribution's modules, and is not exposed to your code. To access a type, you always call `t('TypeName')`. This returns the named type or dies if no such type exists. Because types are always copied on import, it's safe to create coercions on any type. Your coercion from `Str` to `Int` will not be seen by any other package, unless that package explicitly imports your `Int` type. When you import types, you import every type defined in the package you import from. However, you _can_ overwrite an imported type with your own type definition. You _cannot_ define the same type twice internally. # CREATING A TYPE LIBRARY By default, all types created inside a package are invisible to other packages. If you want to create a type library, you need to inherit from [Specio::Exporter](https://metacpan.org/pod/Specio::Exporter) package: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'Foo', parent => t('Str'), where => sub { $_[0] =~ /foo/i }, ); Now the MyApp::Type::Library package will export a single type named `Foo`. It _does not_ re-export the types provided by [Specio::Library::Builtins](https://metacpan.org/pod/Specio::Library::Builtins). If you want to make your library re-export some other libraries types, you can ask for this explicitly: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins -reexport; declare( 'Foo, ... ); Now MyApp::Types::Library exports any types it defines, as well as all the types defined in [Specio::Library::Builtins](https://metacpan.org/pod/Specio::Library::Builtins). # DECLARING TYPES Use the [Specio::Declare](https://metacpan.org/pod/Specio::Declare) module to declare types. It exports a set of helpers for declaring types. See that module's documentation for more details on these helpers. # USING SPECIO WITH [Moose](https://metacpan.org/pod/Moose) This should just work. Use a Specio type anywhere you'd specify a type. # USING SPECIO WITH [Moo](https://metacpan.org/pod/Moo) Using Specio with Moo is easy. You can pass Specio constraint objects as `isa` parameters for attributes. For coercions, simply call `$type->coercion_sub`. package Foo; use Specio::Declare; use Specio::Library::Builtins; use Moo; my $str_type = t('Str'); has string => ( is => 'ro', isa => $str_type, ); my $ucstr = declare( 'UCStr', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr => ( is => 'ro', isa => $ucstr, coerce => $ucstr->coercion_sub, ); The subs returned by Specio use [Sub::Quote](https://metacpan.org/pod/Sub::Quote) internally and are suitable for inlining. # USING SPECIO WITH OTHER THINGS See [Specio::Constraint::Simple](https://metacpan.org/pod/Specio::Constraint::Simple) for the API that all constraint objects share. # [Moose](https://metacpan.org/pod/Moose), [MooseX::Types](https://metacpan.org/pod/MooseX::Types), and Specio This module aims to supplant both [Moose](https://metacpan.org/pod/Moose)'s built-in type system (see [Moose::Util::TypeConstraints](https://metacpan.org/pod/Moose::Util::TypeConstraints) aka MUTC) and [MooseX::Types](https://metacpan.org/pod/MooseX::Types), which attempts to patch some of the holes in the Moose built-in type design. Here are some of the salient differences: - Types names are strings, but they're not global Unlike Moose and MooseX::Types, type names are always local to the current package. There is no possibility of name collision between different modules, so you can safely use short type names. Unlike MooseX::Types, types are strings, so there is no possibility of colliding with existing class or subroutine names. - No type auto-creation Types are always retrieved using the `t()` subroutine. If you pass an unknown name to this subroutine it dies. This is different from Moose and MooseX::Types, which assume that unknown names are class names. - Anon types are explicit With [Moose](https://metacpan.org/pod/Moose) and [MooseX::Types](https://metacpan.org/pod/MooseX::Types), you use the same subroutine, `subtype()`, to declare both named and anonymous types. With Specio, you use `declare()` for named types and `anon()` for anonymous types. - Class and object types are separate Moose and MooseX::Types have `class_type` and `duck_type`. The former type requires an object, while the latter accepts a class name or object. With Specio, the distinction between accepting an object versus object or class is explicit. There are six declaration helpers, `object_can_type`, `object_does_type`, `object_isa_type`, `any_can_type`, `any_does_type`, and `any_isa_type`. - Overloading support is baked in Perl's overloading is quite broken but ignoring it makes Moose's type system frustrating to use in many cases. - Types can either have a constraint or inline generator, not both Moose and MooseX::Types types can be defined with a subroutine reference as the constraint, an inline generator subroutine, or both. This is purely for backwards compatibility, and it makes the internals more complicated than they need to be. With Specio, a constraint can have _either_ a subroutine reference or an inline generator, not both. - Coercions can be inlined I simply never got around to implementing this in Moose. - No crazy coercion features Moose has some bizarre (and mostly) undocumented features relating to coercions and parameterizable types. This is a misfeature. # WHY THE NAME? This distro was originally called "Type", but that's an awfully generic top level namespace. Specio is Latin for for "look at" and "spec" is the root for the word "species". It's short, relatively easy to type, and not used by any other distro. # LONG-TERM PLANS Eventually I'd like to see this distro replace Moose's internal type system, which would also make MooseX::Types obsolete. # SUPPORT Bugs may be submitted at [https://github.com/houseabsolute/Specio/issues](https://github.com/houseabsolute/Specio/issues). I am also usually active on IRC as 'autarch' on `irc://irc.perl.org`. # SOURCE The source code repository for Specio can be found at [https://github.com/houseabsolute/Specio](https://github.com/houseabsolute/Specio). # DONATIONS If you'd like to thank me for the work I've done on this module, please consider making a "donation" to me via PayPal. I spend a lot of free time creating free software, and would appreciate any support you'd care to offer. Please note that **I am not suggesting that you must do this** in order for me to continue working on this particular software. I will continue to do so, inasmuch as I have in the past, for as long as it interests me. Similarly, a donation made in this way will probably not make me work on this software much more, unless I get so many donations that I can consider working on free software full time (let's all have a chuckle at that together). To donate, log into PayPal and send money to autarch@urth.org, or use the button at [http://www.urth.org/~autarch/fs-donation.html](http://www.urth.org/~autarch/fs-donation.html). # AUTHOR Dave Rolsky # CONTRIBUTOR Karen Etheridge # COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2017 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the `LICENSE` file included with this distribution. Specio-0.33/Makefile.PL0000644000175000017500000000406113041701062014466 0ustar autarchautarch# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.008. use strict; use warnings; use 5.008; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Type constraints and coercions for Perl", "AUTHOR" => "Dave Rolsky ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Specio", "LICENSE" => "artistic_2", "MIN_PERL_VERSION" => "5.008", "NAME" => "Specio", "PREREQ_PM" => { "B" => 0, "Carp" => 0, "Devel::StackTrace" => 0, "Eval::Closure" => 0, "Exporter" => 0, "IO::File" => 0, "List::Util" => "1.33", "MRO::Compat" => 0, "Role::Tiny" => "1.003003", "Role::Tiny::With" => 0, "Scalar::Util" => 0, "Storable" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "overload" => 0, "parent" => 0, "re" => 0, "strict" => 0, "version" => "0.83", "warnings" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "Test::More" => "0.96", "Test::Needs" => 0, "lib" => 0, "open" => 0, "utf8" => 0 }, "VERSION" => "0.33", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "B" => 0, "Carp" => 0, "Devel::StackTrace" => 0, "Eval::Closure" => 0, "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "IO::File" => 0, "List::Util" => "1.33", "MRO::Compat" => 0, "Role::Tiny" => "1.003003", "Role::Tiny::With" => 0, "Scalar::Util" => 0, "Storable" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "Test::Needs" => 0, "lib" => 0, "open" => 0, "overload" => 0, "parent" => 0, "re" => 0, "strict" => 0, "utf8" => 0, "version" => "0.83", "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Specio-0.33/xt/0000775000175000017500000000000013041701062013150 5ustar autarchautarchSpecio-0.33/xt/author/0000775000175000017500000000000013041701062014452 5ustar autarchautarchSpecio-0.33/xt/author/pod-coverage.t0000644000175000017500000000171313041701062017212 0ustar autarchautarch#!perl # This file was automatically generated by Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable. use Test::Pod::Coverage 1.08; use Test::More 0.88; BEGIN { if ( $] <= 5.008008 ) { plan skip_all => 'These tests require Pod::Coverage::TrustPod, which only works with Perl 5.8.9+'; } } use Pod::Coverage::TrustPod; my %skip = map { $_ => 1 } qw( ); my @modules; for my $module ( all_modules() ) { next if $skip{$module}; push @modules, $module; } plan skip_all => 'All the modules we found were excluded from POD coverage test.' unless @modules; plan tests => scalar @modules; my %trustme = (); my @also_private; for my $module ( sort @modules ) { pod_coverage_ok( $module, { coverage_class => 'Pod::Coverage::TrustPod', also_private => \@also_private, trustme => $trustme{$module} || [], }, "pod coverage for $module" ); } done_testing(); Specio-0.33/xt/author/no-tabs.t0000644000175000017500000000410313041701062016176 0ustar autarchautarchuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::NoTabs 0.15 use Test::More 0.88; use Test::NoTabs; my @files = ( 'lib/Specio.pm', 'lib/Specio/Coercion.pm', 'lib/Specio/Constraint/AnyCan.pm', 'lib/Specio/Constraint/AnyDoes.pm', 'lib/Specio/Constraint/AnyIsa.pm', 'lib/Specio/Constraint/Enum.pm', 'lib/Specio/Constraint/Intersection.pm', 'lib/Specio/Constraint/ObjectCan.pm', 'lib/Specio/Constraint/ObjectDoes.pm', 'lib/Specio/Constraint/ObjectIsa.pm', 'lib/Specio/Constraint/Parameterizable.pm', 'lib/Specio/Constraint/Parameterized.pm', 'lib/Specio/Constraint/Role/CanType.pm', 'lib/Specio/Constraint/Role/DoesType.pm', 'lib/Specio/Constraint/Role/Interface.pm', 'lib/Specio/Constraint/Role/IsaType.pm', 'lib/Specio/Constraint/Simple.pm', 'lib/Specio/Constraint/Union.pm', 'lib/Specio/Declare.pm', 'lib/Specio/DeclaredAt.pm', 'lib/Specio/Exception.pm', 'lib/Specio/Exporter.pm', 'lib/Specio/Helpers.pm', 'lib/Specio/Library/Builtins.pm', 'lib/Specio/Library/Numeric.pm', 'lib/Specio/Library/Perl.pm', 'lib/Specio/Library/String.pm', 'lib/Specio/OO.pm', 'lib/Specio/PartialDump.pm', 'lib/Specio/Registry.pm', 'lib/Specio/Role/Inlinable.pm', 'lib/Specio/TypeChecks.pm', 'lib/Test/Specio.pm', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/anon.t', 't/builtins-sanity.t', 't/builtins.t', 't/coercion.t', 't/combines.t', 't/conflicts.t', 't/declare-helpers.t', 't/does-type.t', 't/exception.t', 't/inline-environment.t', 't/inline.t', 't/intersection.t', 't/lib/Specio/Library/Combines.pm', 't/lib/Specio/Library/Conflict.pm', 't/lib/Specio/Library/Union.pm', 't/lib/Specio/Library/XY.pm', 't/multiple-libraries.t', 't/numeric-sanity.t', 't/parameterized.t', 't/perl-sanity.t', 't/string-sanity.t', 't/t-clean.t', 't/union-library.t', 't/union.t', 't/with-moo.t', 't/with-moose.t' ); notabs_ok($_) foreach @files; done_testing; Specio-0.33/xt/author/pod-spell.t0000644000175000017500000000221113041701062016530 0ustar autarchautarchuse strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007004 use Test::Spelling 0.12; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ API AnyCan AnyDoes AnyIsa Builtins CanType ClassName Coercion Coercions Constraint DROLSKY DROLSKY's Dave Declare DeclaredAt DoesType Enum Etheridge Exception Exporter Helpers Inlinable Interface Intersection IsaType Karen Kogman LaxVersionStr Library MUTC ModuleName NegativeInt NegativeNum NegativeOrZeroInt NegativeOrZeroNum NonEmptySimpleStr NonEmptyStr Num Numeric OO ObjectCan ObjectDoes ObjectIsa PARAMETERIZABLE PackageName Parameterizable Parameterized PartialDump PayPal Perl PositiveInt PositiveNum PositiveOrZeroInt PositiveOrZeroNum RegexpRef Registry Role Rolsky Rolsky's SIGNES SPECIO SafeIdentifier ScalarRef Simple SimpleStr SingleDigit Specio Str StrictVersionStr String Test Throwable TypeChecks Union Yuval autarch boolification coercions de distro drolsky ether globification inlinable inline isa lib namespace numification parameterizable parameterization parameterized reimplementation sigils subtype subtypes Specio-0.33/xt/author/mojibake.t0000644000175000017500000000015113041701062016413 0ustar autarchautarch#!perl use strict; use warnings qw(all); use Test::More; use Test::Mojibake; all_files_encoding_ok(); Specio-0.33/xt/author/tidyall.t0000644000175000017500000000067413041701062016306 0ustar autarchautarch# This file was automatically generated by Dist::Zilla::Plugin::Test::TidyAll v$VERSION use Test::More 0.88; BEGIN { if ( $] < 5.010 ) { plan skip_all => 'This test requires Perl version 5.010'; } } use Test::Code::TidyAll 0.24; tidyall_ok( verbose => ( exists $ENV{TEST_TIDYALL_VERBOSE} ? $ENV{TEST_TIDYALL_VERBOSE} : 1 ), jobs => ( exists $ENV{TEST_TIDYALL_JOBS} ? $ENV{TEST_TIDYALL_JOBS} : 4 ), ); done_testing; Specio-0.33/xt/author/eol.t0000644000175000017500000000413513041701062015417 0ustar autarchautarchuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::EOL 0.19 use Test::More 0.88; use Test::EOL; my @files = ( 'lib/Specio.pm', 'lib/Specio/Coercion.pm', 'lib/Specio/Constraint/AnyCan.pm', 'lib/Specio/Constraint/AnyDoes.pm', 'lib/Specio/Constraint/AnyIsa.pm', 'lib/Specio/Constraint/Enum.pm', 'lib/Specio/Constraint/Intersection.pm', 'lib/Specio/Constraint/ObjectCan.pm', 'lib/Specio/Constraint/ObjectDoes.pm', 'lib/Specio/Constraint/ObjectIsa.pm', 'lib/Specio/Constraint/Parameterizable.pm', 'lib/Specio/Constraint/Parameterized.pm', 'lib/Specio/Constraint/Role/CanType.pm', 'lib/Specio/Constraint/Role/DoesType.pm', 'lib/Specio/Constraint/Role/Interface.pm', 'lib/Specio/Constraint/Role/IsaType.pm', 'lib/Specio/Constraint/Simple.pm', 'lib/Specio/Constraint/Union.pm', 'lib/Specio/Declare.pm', 'lib/Specio/DeclaredAt.pm', 'lib/Specio/Exception.pm', 'lib/Specio/Exporter.pm', 'lib/Specio/Helpers.pm', 'lib/Specio/Library/Builtins.pm', 'lib/Specio/Library/Numeric.pm', 'lib/Specio/Library/Perl.pm', 'lib/Specio/Library/String.pm', 'lib/Specio/OO.pm', 'lib/Specio/PartialDump.pm', 'lib/Specio/Registry.pm', 'lib/Specio/Role/Inlinable.pm', 'lib/Specio/TypeChecks.pm', 'lib/Test/Specio.pm', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/anon.t', 't/builtins-sanity.t', 't/builtins.t', 't/coercion.t', 't/combines.t', 't/conflicts.t', 't/declare-helpers.t', 't/does-type.t', 't/exception.t', 't/inline-environment.t', 't/inline.t', 't/intersection.t', 't/lib/Specio/Library/Combines.pm', 't/lib/Specio/Library/Conflict.pm', 't/lib/Specio/Library/Union.pm', 't/lib/Specio/Library/XY.pm', 't/multiple-libraries.t', 't/numeric-sanity.t', 't/parameterized.t', 't/perl-sanity.t', 't/string-sanity.t', 't/t-clean.t', 't/union-library.t', 't/union.t', 't/with-moo.t', 't/with-moose.t' ); eol_unix_ok($_, { trailing_whitespace => 1 }) foreach @files; done_testing; Specio-0.33/xt/author/test-version.t0000644000175000017500000000063713041701062017305 0ustar autarchautarchuse strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.09 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 1, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; Specio-0.33/xt/author/00-compile.t0000644000175000017500000000460213041701062016504 0ustar autarchautarchuse 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.056 use Test::More; plan tests => 34; my @module_files = ( 'Specio.pm', 'Specio/Coercion.pm', 'Specio/Constraint/AnyCan.pm', 'Specio/Constraint/AnyDoes.pm', 'Specio/Constraint/AnyIsa.pm', 'Specio/Constraint/Enum.pm', 'Specio/Constraint/Intersection.pm', 'Specio/Constraint/ObjectCan.pm', 'Specio/Constraint/ObjectDoes.pm', 'Specio/Constraint/ObjectIsa.pm', 'Specio/Constraint/Parameterizable.pm', 'Specio/Constraint/Parameterized.pm', 'Specio/Constraint/Role/CanType.pm', 'Specio/Constraint/Role/DoesType.pm', 'Specio/Constraint/Role/Interface.pm', 'Specio/Constraint/Role/IsaType.pm', 'Specio/Constraint/Simple.pm', 'Specio/Constraint/Union.pm', 'Specio/Declare.pm', 'Specio/DeclaredAt.pm', 'Specio/Exception.pm', 'Specio/Exporter.pm', 'Specio/Helpers.pm', 'Specio/Library/Builtins.pm', 'Specio/Library/Numeric.pm', 'Specio/Library/Perl.pm', 'Specio/Library/String.pm', 'Specio/OO.pm', 'Specio/PartialDump.pm', 'Specio/Registry.pm', 'Specio/Role/Inlinable.pm', 'Specio/TypeChecks.pm', 'Test/Specio.pm' ); # no fake home requested my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ); Specio-0.33/xt/author/portability.t0000644000175000017500000000026713041701062017204 0ustar autarchautarchuse strict; use warnings; use Test::More; eval 'use Test::Portability::Files'; plan skip_all => 'Test::Portability::Files required for testing portability' if $@; run_tests(); Specio-0.33/xt/author/pod-syntax.t0000644000175000017500000000025213041701062016742 0ustar autarchautarch#!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Specio-0.33/xt/release/0000775000175000017500000000000013041701062014570 5ustar autarchautarchSpecio-0.33/xt/release/cpan-changes.t0000644000175000017500000000034413041701062017303 0ustar autarchautarchuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::CPAN::Changes 0.012 use Test::More 0.96 tests => 1; use Test::CPAN::Changes; subtest 'changes_ok' => sub { changes_file_ok('Changes'); }; Specio-0.33/xt/release/meta-json.t0000644000175000017500000000006413041701062016650 0ustar autarchautarch#!perl use Test::CPAN::Meta::JSON; meta_json_ok(); Specio-0.33/TODO.md0000644000175000017500000000546713041701062013616 0ustar autarchautarch## Use Sub::Quote One attempt at this exists in the sub-quotify branch. This has several parts. First, type constraints should accept a single `constraint` parameter, rather than both a constraint and an `inline_generator`. If the `constraint` is a Sub::Quote sub, we can use that for inlining. This greatly simplified the API. The same should be done for the `coercion` & `inline_generator` parameters for coercions. Finally, the message_generator should be allow for a Sub::Quote sub and use that for inlining if possible. I'm not sure what the best API for the Sub::Quote subs is. Unlike with the existing generators, Sub::Quote expects that parameters are always passed via `@_`. This probably means that the sub you write should always look at `$_[0]`, which is a little gross when inlining, as it means we have to jam things into `@_` with something like: local @_ = ($value); Note that this also means B passing in the type constraint/coercion as the first argument. In other words, these subs are no longer methods. This is probably better for inlining anyway. Anything you wanted from the object should be something you can inline anyway (I hope). Note that parameterizable types I need to provide a parameterized_inline_generator sub (not a Sub::Quote). This sub shoudl I a quoted sub based on the type parameter. Sub::Quote makes this harder than it should be because it doesn't have a very nice API. Oh well. ## Better integration with Moose Make Moose support inlining coercions and message generation with Specio objects. Also, define a real API for type objects and have Moose just use duck typing internally. However, this should I be the existing Moose TC API, since it's quite broken. In particular, the relationship between constraint & coercion objects is backwards. A constraint should have many coercions, not vice versa. Specio gets this right. ## Support MooseX::Types barewords and string types with SpecioX modules For barewords: use SpecioX::Declare::Barewords => qw( Specio::Library::Builtins My::Library ); use Moose; has foo => ( isa => Str ); For string types: use SpecioX::StringTypes => qw( Specio::Library::Builtins My::Library ); use Moose; has foo => ( isa => 'Str' ); Or something like that. Internally these can both provide an attr trait and class trait that together look up a registry for the class by name, something like: use Specio::Registry qw( registry_for_package ); my $registry = registry_for_package($package); To parse things like `"ArrayRef[Str]"` we need to separate the type string parsing into its module that can return a data structure like: %parsed = ( name => 'ArrayRef', parameter => 'Str', ); Then we can look these up with: my $type = t( $parsed{name}, of => t( $parsed{parameter} ) );