Type-Tiny-0.022/0000755000175000017500000000000012200124457011470 5ustar taitaiType-Tiny-0.022/.travis.yml0000644000175000017500000000025112161671330013602 0ustar taitailanguage: perl script: HARNESS_IS_VERBOSE=1 prove -Ilib t install: - cpanm Test::Requires Test::Fatal Moo perl: - "5.18" - "5.16" - "5.14" - "5.12" - "5.10" Type-Tiny-0.022/inc/0000755000175000017500000000000012200124456012240 5ustar taitaiType-Tiny-0.022/inc/YAML/0000755000175000017500000000000012200124456013002 5ustar taitaiType-Tiny-0.022/inc/YAML/Tiny.pm0000644000175000017500000003534412200123676014277 0ustar taitai#line 1 package YAML::Tiny; use strict; # UTF Support? sub HAVE_UTF8 () { $] >= 5.007003 } BEGIN { if ( HAVE_UTF8 ) { # The string eval helps hide this from Test::MinimumVersion eval "require utf8;"; die "Failed to load UTF-8 support" if $@; } # Class structure require 5.004; require Exporter; require Carp; $YAML::Tiny::VERSION = '1.51'; # $YAML::Tiny::VERSION = eval $YAML::Tiny::VERSION; @YAML::Tiny::ISA = qw{ Exporter }; @YAML::Tiny::EXPORT = qw{ Load Dump }; @YAML::Tiny::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw }; # Error storage $YAML::Tiny::errstr = ''; } # The character class of all characters we need to escape # NOTE: Inlined, since it's only used once # my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]'; # Printed form of the unprintable characters in the lowest range # of ASCII characters, listed by ASCII ordinal position. my @UNPRINTABLE = qw( z x01 x02 x03 x04 x05 x06 a x08 t n v f r x0e x0f x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x1a e x1c x1d x1e x1f ); # Printable characters for escapes my %UNESCAPES = ( z => "\x00", a => "\x07", t => "\x09", n => "\x0a", v => "\x0b", f => "\x0c", r => "\x0d", e => "\x1b", '\\' => '\\', ); # Special magic boolean words my %QUOTE = map { $_ => 1 } qw{ null Null NULL y Y yes Yes YES n N no No NO true True TRUE false False FALSE on On ON off Off OFF }; ##################################################################### # Implementation # Create an empty YAML::Tiny object sub new { my $class = shift; bless [ @_ ], $class; } # Create an object from a file sub read { my $class = ref $_[0] ? ref shift : shift; # Check the file my $file = shift or return $class->_error( 'You did not specify a file name' ); return $class->_error( "File '$file' does not exist" ) unless -e $file; return $class->_error( "'$file' is a directory, not a file" ) unless -f _; return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _; # Slurp in the file local $/ = undef; local *CFG; unless ( open(CFG, $file) ) { return $class->_error("Failed to open file '$file': $!"); } my $contents = ; unless ( close(CFG) ) { return $class->_error("Failed to close file '$file': $!"); } $class->read_string( $contents ); } # Create an object from a string sub read_string { my $class = ref $_[0] ? ref shift : shift; my $self = bless [], $class; my $string = $_[0]; eval { unless ( defined $string ) { die \"Did not provide a string to load"; } # Byte order marks # NOTE: Keeping this here to educate maintainers # my %BOM = ( # "\357\273\277" => 'UTF-8', # "\376\377" => 'UTF-16BE', # "\377\376" => 'UTF-16LE', # "\377\376\0\0" => 'UTF-32LE' # "\0\0\376\377" => 'UTF-32BE', # ); if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) { die \"Stream has a non UTF-8 BOM"; } else { # Strip UTF-8 bom if found, we'll just ignore it $string =~ s/^\357\273\277//; } # Try to decode as utf8 utf8::decode($string) if HAVE_UTF8; # Check for some special cases return $self unless length $string; unless ( $string =~ /[\012\015]+\z/ ) { die \"Stream does not end with newline character"; } # Split the file into lines my @lines = grep { ! /^\s*(?:\#.*)?\z/ } split /(?:\015{1,2}\012|\015|\012)/, $string; # Strip the initial YAML header @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines; # A nibbling parser while ( @lines ) { # Do we have a document header? if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) { # Handle scalar documents shift @lines; if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) { push @$self, $self->_read_scalar( "$1", [ undef ], \@lines ); next; } } if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { # A naked document push @$self, undef; while ( @lines and $lines[0] !~ /^---/ ) { shift @lines; } } elsif ( $lines[0] =~ /^\s*\-/ ) { # An array at the root my $document = [ ]; push @$self, $document; $self->_read_array( $document, [ 0 ], \@lines ); } elsif ( $lines[0] =~ /^(\s*)\S/ ) { # A hash at the root my $document = { }; push @$self, $document; $self->_read_hash( $document, [ length($1) ], \@lines ); } else { die \"YAML::Tiny failed to classify the line '$lines[0]'"; } } }; if ( ref $@ eq 'SCALAR' ) { return $self->_error(${$@}); } elsif ( $@ ) { require Carp; Carp::croak($@); } return $self; } # Deparse a scalar string to the actual scalar sub _read_scalar { my ($self, $string, $indent, $lines) = @_; # Trim trailing whitespace $string =~ s/\s*\z//; # Explitic null/undef return undef if $string eq '~'; # Single quote if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) { return '' unless defined $1; $string = $1; $string =~ s/\'\'/\'/g; return $string; } # Double quote. # The commented out form is simpler, but overloaded the Perl regex # engine due to recursion and backtracking problems on strings # larger than 32,000ish characters. Keep it for reference purposes. # if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) { if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\z/ ) { # Reusing the variable is a little ugly, # but avoids a new variable and a string copy. $string = $1; $string =~ s/\\"/"/g; $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex; return $string; } # Special cases if ( $string =~ /^[\'\"!&]/ ) { die \"YAML::Tiny does not support a feature in line '$string'"; } return {} if $string =~ /^{}(?:\s+\#.*)?\z/; return [] if $string =~ /^\[\](?:\s+\#.*)?\z/; # Regular unquoted string if ( $string !~ /^[>|]/ ) { if ( $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or $string =~ /:(?:\s|$)/ ) { die \"YAML::Tiny found illegal characters in plain scalar: '$string'"; } $string =~ s/\s+#.*\z//; return $string; } # Error die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines; # Check the indent depth $lines->[0] =~ /^(\s*)/; $indent->[-1] = length("$1"); if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { die \"YAML::Tiny found bad indenting in line '$lines->[0]'"; } # Pull the lines my @multiline = (); while ( @$lines ) { $lines->[0] =~ /^(\s*)/; last unless length($1) >= $indent->[-1]; push @multiline, substr(shift(@$lines), length($1)); } my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; return join( $j, @multiline ) . $t; } # Parse an array sub _read_array { my ($self, $array, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { die \"YAML::Tiny found bad indenting in line '$lines->[0]'"; } if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { # Inline nested hash my $indent2 = length("$1"); $lines->[0] =~ s/-/ /; push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) { # Array entry with a value shift @$lines; push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) { shift @$lines; unless ( @$lines ) { push @$array, undef; return 1; } if ( $lines->[0] =~ /^(\s*)\-/ ) { my $indent2 = length("$1"); if ( $indent->[-1] == $indent2 ) { # Null array entry push @$array, undef; } else { # Naked indenter push @$array, [ ]; $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines ); } } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines ); } else { die \"YAML::Tiny failed to classify line '$lines->[0]'"; } } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { # This is probably a structure like the following... # --- # foo: # - list # bar: value # # ... so lets return and let the hash parser handle it return 1; } else { die \"YAML::Tiny failed to classify line '$lines->[0]'"; } } return 1; } # Parse an array sub _read_hash { my ($self, $hash, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { die \"YAML::Tiny found bad indenting in line '$lines->[0]'"; } # Get the key unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) { if ( $lines->[0] =~ /^\s*[?\'\"]/ ) { die \"YAML::Tiny does not support a feature in line '$lines->[0]'"; } die \"YAML::Tiny failed to classify line '$lines->[0]'"; } my $key = $1; # Do we have a value? if ( length $lines->[0] ) { # Yes $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines ); } else { # An indent shift @$lines; unless ( @$lines ) { $hash->{$key} = undef; return 1; } if ( $lines->[0] =~ /^(\s*)-/ ) { $hash->{$key} = []; $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines ); } elsif ( $lines->[0] =~ /^(\s*)./ ) { my $indent2 = length("$1"); if ( $indent->[-1] >= $indent2 ) { # Null hash entry $hash->{$key} = undef; } else { $hash->{$key} = {}; $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines ); } } } } return 1; } # Save an object to a file sub write { my $self = shift; my $file = shift or return $self->_error('No file name provided'); # Write it to the file open( CFG, '>' . $file ) or return $self->_error( "Failed to open file '$file' for writing: $!" ); print CFG $self->write_string; close CFG; return 1; } # Save an object to a string sub write_string { my $self = shift; return '' unless @$self; # Iterate over the documents my $indent = 0; my @lines = (); foreach my $cursor ( @$self ) { push @lines, '---'; # An empty document if ( ! defined $cursor ) { # Do nothing # A scalar document } elsif ( ! ref $cursor ) { $lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent ); # A list at the root } elsif ( ref $cursor eq 'ARRAY' ) { unless ( @$cursor ) { $lines[-1] .= ' []'; next; } push @lines, $self->_write_array( $cursor, $indent, {} ); # A hash at the root } elsif ( ref $cursor eq 'HASH' ) { unless ( %$cursor ) { $lines[-1] .= ' {}'; next; } push @lines, $self->_write_hash( $cursor, $indent, {} ); } else { Carp::croak("Cannot serialize " . ref($cursor)); } } join '', map { "$_\n" } @lines; } sub _write_scalar { my $string = $_[1]; return '~' unless defined $string; return "''" unless length $string; if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) { $string =~ s/\\/\\\\/g; $string =~ s/"/\\"/g; $string =~ s/\n/\\n/g; $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g; return qq|"$string"|; } if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) { return "'$string'"; } return $string; } sub _write_array { my ($self, $array, $indent, $seen) = @_; if ( $seen->{refaddr($array)}++ ) { die "YAML::Tiny does not support circular references"; } my @lines = (); foreach my $el ( @$array ) { my $line = (' ' x $indent) . '-'; my $type = ref $el; if ( ! $type ) { $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); push @lines, $line; } elsif ( $type eq 'ARRAY' ) { if ( @$el ) { push @lines, $line; push @lines, $self->_write_array( $el, $indent + 1, $seen ); } else { $line .= ' []'; push @lines, $line; } } elsif ( $type eq 'HASH' ) { if ( keys %$el ) { push @lines, $line; push @lines, $self->_write_hash( $el, $indent + 1, $seen ); } else { $line .= ' {}'; push @lines, $line; } } else { die "YAML::Tiny does not support $type references"; } } @lines; } sub _write_hash { my ($self, $hash, $indent, $seen) = @_; if ( $seen->{refaddr($hash)}++ ) { die "YAML::Tiny does not support circular references"; } my @lines = (); foreach my $name ( sort keys %$hash ) { my $el = $hash->{$name}; my $line = (' ' x $indent) . "$name:"; my $type = ref $el; if ( ! $type ) { $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); push @lines, $line; } elsif ( $type eq 'ARRAY' ) { if ( @$el ) { push @lines, $line; push @lines, $self->_write_array( $el, $indent + 1, $seen ); } else { $line .= ' []'; push @lines, $line; } } elsif ( $type eq 'HASH' ) { if ( keys %$el ) { push @lines, $line; push @lines, $self->_write_hash( $el, $indent + 1, $seen ); } else { $line .= ' {}'; push @lines, $line; } } else { die "YAML::Tiny does not support $type references"; } } @lines; } # Set error sub _error { $YAML::Tiny::errstr = $_[1]; undef; } # Retrieve error sub errstr { $YAML::Tiny::errstr; } ##################################################################### # YAML Compatibility sub Dump { YAML::Tiny->new(@_)->write_string; } sub Load { my $self = YAML::Tiny->read_string(@_); unless ( $self ) { Carp::croak("Failed to load YAML document from string"); } if ( wantarray ) { return @$self; } else { # To match YAML.pm, return the last document return $self->[-1]; } } BEGIN { *freeze = *Dump; *thaw = *Load; } sub DumpFile { my $file = shift; YAML::Tiny->new(@_)->write($file); } sub LoadFile { my $self = YAML::Tiny->read($_[0]); unless ( $self ) { Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'"); } if ( wantarray ) { return @$self; } else { # Return only the last document to match YAML.pm, return $self->[-1]; } } ##################################################################### # Use Scalar::Util if possible, otherwise emulate it BEGIN { local $@; eval { require Scalar::Util; }; my $v = eval("$Scalar::Util::VERSION") || 0; if ( $@ or $v < 1.18 ) { eval <<'END_PERL'; # Scalar::Util failed to load or too old sub refaddr { my $pkg = ref($_[0]) or return undef; if ( !! UNIVERSAL::can($_[0], 'can') ) { bless $_[0], 'Scalar::Util::Fake'; } else { $pkg = undef; } "$_[0]" =~ /0x(\w+)/; my $i = do { local $^W; hex $1 }; bless $_[0], $pkg if defined $pkg; $i; } END_PERL } else { *refaddr = *Scalar::Util::refaddr; } } 1; __END__ #line 1175 Type-Tiny-0.022/inc/Try/0000755000175000017500000000000012200124456013016 5ustar taitaiType-Tiny-0.022/inc/Try/Tiny.pm0000644000175000017500000000636212200123721014300 0ustar taitai#line 1 package Try::Tiny; use strict; #use warnings; use vars qw(@EXPORT @EXPORT_OK $VERSION @ISA); BEGIN { require Exporter; @ISA = qw(Exporter); } $VERSION = "0.12"; $VERSION = eval $VERSION; @EXPORT = @EXPORT_OK = qw(try catch finally); $Carp::Internal{+__PACKAGE__}++; # Need to prototype as @ not $$ because of the way Perl evaluates the prototype. # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list # context & not a scalar one sub try (&;@) { my ( $try, @code_refs ) = @_; # we need to save this here, the eval block will be in scalar context due # to $failed my $wantarray = wantarray; my ( $catch, @finally ); # find labeled blocks in the argument list. # catch and finally tag the blocks by blessing a scalar reference to them. foreach my $code_ref (@code_refs) { next unless $code_ref; my $ref = ref($code_ref); if ( $ref eq 'Try::Tiny::Catch' ) { $catch = ${$code_ref}; } elsif ( $ref eq 'Try::Tiny::Finally' ) { push @finally, ${$code_ref}; } else { use Carp; confess("Unknown code ref type given '${ref}'. Check your usage & try again"); } } # save the value of $@ so we can set $@ back to it in the beginning of the eval my $prev_error = $@; my ( @ret, $error, $failed ); # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's # not perfect, but we could provide a list of additional errors for # $catch->(); { # localize $@ to prevent clobbering of previous value by a successful # eval. local $@; # failed will be true if the eval dies, because 1 will not be returned # from the eval body $failed = not eval { $@ = $prev_error; # evaluate the try block in the correct context if ( $wantarray ) { @ret = $try->(); } elsif ( defined $wantarray ) { $ret[0] = $try->(); } else { $try->(); }; return 1; # properly set $fail to false }; # copy $@ to $error; when we leave this scope, local $@ will revert $@ # back to its previous value $error = $@; } # set up a scope guard to invoke the finally block at the end my @guards = map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) } @finally; # at this point $failed contains a true value if the eval died, even if some # destructor overwrote $@ as the eval was unwinding. if ( $failed ) { # if we got an error, invoke the catch block. if ( $catch ) { # This works like given($error), but is backwards compatible and # sets $_ in the dynamic scope for the body of C<$catch> for ($error) { return $catch->($error); } # in case when() was used without an explicit return, the C # loop will be aborted and there's no useful return value } return; } else { # no failure, $@ is back to what it was, everything is fine return $wantarray ? @ret : $ret[0]; } } sub catch (&;@) { my ( $block, @rest ) = @_; return ( bless(\$block, 'Try::Tiny::Catch'), @rest, ); } sub finally (&;@) { my ( $block, @rest ) = @_; return ( bless(\$block, 'Try::Tiny::Finally'), @rest, ); } { package # hide from PAUSE Try::Tiny::ScopeGuard; sub _new { shift; bless [ @_ ]; } sub DESTROY { my @guts = @{ shift() }; my $code = shift @guts; $code->(@guts); } } __PACKAGE__ __END__ #line 603 Type-Tiny-0.022/inc/Test/0000755000175000017500000000000012200124456013157 5ustar taitaiType-Tiny-0.022/inc/Test/Requires.pm0000644000175000017500000000343312200123721015311 0ustar taitai#line 1 package Test::Requires; use strict; use warnings; our $VERSION = '0.06'; use base 'Test::Builder::Module'; use 5.006000; sub import { my $class = shift; my $caller = caller(0); # export methods { no strict 'refs'; *{"$caller\::test_requires"} = \&test_requires; } # test arguments if (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') { while (my ($mod, $ver) = each %{$_[0]}) { test_requires($mod, $ver, $caller); } } else { for my $mod (@_) { test_requires($mod, undef, $caller); } } } sub test_requires { my ( $mod, $ver, $caller ) = @_; return if $mod eq __PACKAGE__; if (@_ != 3) { $caller = caller(0); } $ver ||= ''; eval qq{package $caller; use $mod $ver}; ## no critic. if (my $e = $@) { my $skip_all = sub { my $builder = __PACKAGE__->builder; if (not defined $builder->has_plan) { $builder->skip_all(@_); } elsif ($builder->has_plan eq 'no_plan') { $builder->skip(@_); if ( $builder->can('parent') && $builder->parent ) { die bless {} => 'Test::Builder::Exception'; } exit 0; } else { for (1..$builder->has_plan) { $builder->skip(@_); } if ( $builder->can('parent') && $builder->parent ) { die bless {} => 'Test::Builder::Exception'; } exit 0; } }; if ( $e =~ /^Can't locate/ ) { $skip_all->("Test requires module '$mod' but it's not found"); } else { $skip_all->("$e"); } } } 1; __END__ #line 128 Type-Tiny-0.022/inc/Test/Fatal.pm0000644000175000017500000000246412200123721014544 0ustar taitai#line 1 use strict; use warnings; package Test::Fatal; { $Test::Fatal::VERSION = '0.010'; } # ABSTRACT: incredibly simple helpers for testing code with exceptions use Carp (); use Try::Tiny 0.07; use Exporter 5.57 'import'; our @EXPORT = qw(exception); our @EXPORT_OK = qw(exception success dies_ok lives_ok); sub exception (&) { my $code = shift; return try { $code->(); return undef; } catch { return $_ if $_; my $problem = defined $_ ? 'false' : 'undef'; Carp::confess("$problem exception caught by Test::Fatal::exception"); }; } sub success (&;@) { my $code = shift; return finally( sub { return if @_; # <-- only run on success $code->(); }, @_ ); } my $Tester; # Signature should match that of Test::Exception sub dies_ok (&;$) { my $code = shift; my $name = shift; require Test::Builder; $Tester ||= Test::Builder->new; my $ok = $Tester->ok( exception( \&$code ), $name ); $ok or $Tester->diag( "expected an exception but none was raised" ); return $ok; } sub lives_ok (&;$) { my $code = shift; my $name = shift; require Test::Builder; $Tester ||= Test::Builder->new; my $ok = $Tester->ok( !exception( \&$code ), $name ); $ok or $Tester->diag( "expected return but an exception was raised" ); return $ok; } 1; __END__ #line 212 Type-Tiny-0.022/inc/Module/0000755000175000017500000000000012200124456013465 5ustar taitaiType-Tiny-0.022/inc/Module/AutoInstall.pm0000644000175000017500000006216212200124300016255 0ustar taitai#line 1 package Module::AutoInstall; use strict; use Cwd (); use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps, $UpgradeDeps ); my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps, $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps, $PostambleActionsListAllDeps, $PostambleUsed, $NoTest); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub _installdeps_target { $InstallDepsTarget = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) { $UpgradeDeps = 1; __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } elsif ( $arg =~ /^--all(?:deps)?$/ ) { $AllDeps = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); # We want to know if we're under CPAN early to avoid prompting, but # if we aren't going to try and install anything anyway then skip the # check entirely since we don't want to have to load (and configure) # an old CPAN just for a cosmetic message $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget; while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. my $cur = _version_of($mod); if (_version_cmp ($cur, $arg) >= 0) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { if (not defined $cur) # indeed missing { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; } else { # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above print "too old. ($cur < $arg)\n"; } push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or ($mandatory and $UnderCPAN) or $AllDeps or $InstallDepsTarget or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } if ( @Missing and not( $CheckOnly or $UnderCPAN) ) { require Config; my $make = $Config::Config{make}; if ($InstallDepsTarget) { print "*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n"; } else { print "*** Dependencies will be installed the next time you type '$make'.\n"; } # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; return (@Existing, @Missing); } sub _running_under { my $thing = shift; print <<"END_MESSAGE"; *** Since we're running under ${thing}, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing or @_; if ($ENV{PERL5_CPANM_IS_RUNNING}) { return _running_under('cpanminus'); } my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING}; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS'); } require CPAN; if ($CPAN::VERSION > '1.89') { if ($cpan_env) { return _running_under('CPAN'); } return; # CPAN.pm new enough, don't need to check further } # last ditch attempt, this -will- configure CPAN, very sorry _load_cpan(1); # force initialize even though it's already loaded # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } if ($UpgradeDeps) { push @modules, @installed; @installed = (); } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } push @config, 'prereqs', $value; } elsif ( $key eq 'force' ) { push @config, $key, $value; } elsif ( $key eq 'notest' ) { push @config, 'skiptest', $value; } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^(?:force|notest)$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } if ($args{notest} && (not CPAN::Shell->can('notest'))) { die "Your version of CPAN is too old to support the 'notest' pragma"; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = do { if ($args{force}) { CPAN::Shell->force( install => $pkg ) } elsif ($args{notest}) { CPAN::Shell->notest( install => $pkg ) } else { CPAN::Shell->install($pkg) } }; $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # report version without loading a module sub _version_of { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; foreach my $dir ( @INC ) { next if ref $dir; my $path = File::Spec->catfile($dir, $file); next unless -e $path; require ExtUtils::MM_Unix; return ExtUtils::MM_Unix->parse_version($path); } return undef; } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION and $CPAN::Config and not @_; require CPAN; # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to # CPAN::HandleConfig->load. CPAN reports that the redirection # is deprecated in a warning printed at the user. # CPAN-1.81 expects CPAN::HandleConfig->load, does not have # $CPAN::HandleConfig::VERSION but cannot handle # CPAN::Config->load # Which "versions expect CPAN::Config->load? if ( $CPAN::HandleConfig::VERSION || CPAN::HandleConfig->can('load') ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison # return values same as <=> sub _version_cmp { my ( $cur, $min ) = @_; return -1 unless defined $cur; # if 0 keep comparing return 1 unless $min; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return version->new($cur) <=> version->new($min); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return Sort::Versions::versioncmp( $cur, $min ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return $cur <=> $min; } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); my $deps_list = join( ',', @Missing, @Existing ); $PostambleActionsUpgradeDeps = "\$(PERL) $0 --config=$config --upgradedeps=$deps_list"; my $config_notest = join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}), 'notest', 1 ) if $Config; $PostambleActionsNoTest = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); $PostambleActionsUpgradeDepsNoTest = "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list"; $PostambleActionsListDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing); my @all = (@Missing, @Existing); $PostambleActionsListAllDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; my $fragment; $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget; config :: installdeps \t\$(NOECHO) \$(NOOP) AUTO_INSTALL $fragment .= <<"END_MAKE"; checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions installdeps_notest :: \t$PostambleActionsNoTest upgradedeps :: \t$PostambleActionsUpgradeDeps upgradedeps_notest :: \t$PostambleActionsUpgradeDepsNoTest listdeps :: \t$PostambleActionsListDeps listalldeps :: \t$PostambleActionsListAllDeps END_MAKE return $fragment; } 1; __END__ #line 1193 Type-Tiny-0.022/inc/Module/Package.pm0000644000175000017500000000311412200124303015344 0ustar taitai#line 1 ## # name: Module::Package # abstract: Postmodern Perl Module Packaging # author: Ingy döt Net # license: perl # copyright: 2011 # see: # - Module::Package::Plugin # - Module::Install::Package # - Module::Package::Tutorial package Module::Package; use 5.005; use strict; BEGIN { $Module::Package::VERSION = '0.30'; $inc::Module::Package::VERSION ||= $Module::Package::VERSION; @inc::Module::Package::ISA = __PACKAGE__; } sub import { my $class = shift; $INC{'inc/Module/Install.pm'} = __FILE__; unshift @INC, 'inc' unless $INC[0] eq 'inc'; eval "use Module::Install 1.01 (); 1" or $class->error($@); package main; Module::Install->import(); eval { module_package_internals_version_check($Module::Package::VERSION); module_package_internals_init(@_); }; if ($@) { $Module::Package::ERROR = $@; die $@; } } # XXX Remove this when things are stable. sub error { my ($class, $error) = @_; if (-e 'inc' and not -e 'inc/.author') { require Data::Dumper; $Data::Dumper::Sortkeys = 1; my $dump1 = Data::Dumper::Dumper(\%INC); my $dump2 = Data::Dumper::Dumper(\@INC); die <<"..."; This should not have happened. Hopefully this dump will explain the problem: inc::Module::Package: $inc::Module::Package::VERSION Module::Package: $Module::Package::VERSION inc::Module::Install: $inc::Module::Install::VERSION Module::Install: $Module::Install::VERSION Error: $error %INC: $dump1 \@INC: $dump2 ... } else { die $error; } } 1; Type-Tiny-0.022/inc/Module/Install/0000755000175000017500000000000012200124456015073 5ustar taitaiType-Tiny-0.022/inc/Module/Install/Fetch.pm0000644000175000017500000000462712200124301016460 0ustar taitai#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Type-Tiny-0.022/inc/Module/Install/AutoInstall.pm0000644000175000017500000000416212200124300017657 0ustar taitai#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; my @features_require = Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); my %seen; my @requires = map @$_, map @$_, grep ref, $self->requires; while (my ($mod, $ver) = splice(@requires, 0, 2)) { $seen{$mod}{$ver}++; } my @build_requires = map @$_, map @$_, grep ref, $self->build_requires; while (my ($mod, $ver) = splice(@build_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires; while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @deduped; while (my ($mod, $ver) = splice(@features_require, 0, 2)) { push @deduped, $mod => $ver unless $seen{$mod}{$ver}++; } $self->requires(@deduped); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub installdeps_target { my ($self, @args) = @_; $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall::_installdeps_target(1); $self->auto_install(@args); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; Type-Tiny-0.022/inc/Module/Install/Package.pm0000644000175000017500000002340512200123676016773 0ustar taitai#line 1 ## # name: Module::Install::Package # abstract: Module::Install support for Module::Package # author: Ingy döt Net # license: perl # copyright: 2011 # see: # - Module::Package # This module contains the Module::Package logic that must be available to # both the Author and the End User. Author-only logic goes in a # Module::Package::Plugin subclass. package Module::Install::Package; use strict; use Module::Install::Base; use vars qw'@ISA $VERSION'; @ISA = 'Module::Install::Base'; $VERSION = '0.30'; #-----------------------------------------------------------------------------# # XXX BOOTBUGHACK # This is here to try to get us out of Module-Package-0.11 cpantesters hell... # Remove this when the situation has blown over. sub pkg { *inc::Module::Package::VERSION = sub { $VERSION }; my $self = shift; $self->module_package_internals_init($@); } #-----------------------------------------------------------------------------# # We allow the author to specify key/value options after the plugin. These # options need to be available both at author time and install time. #-----------------------------------------------------------------------------# # OO accessor for command line options: sub package_options { @_>1?($_[0]->{package_options}=$_[1]):$_[0]->{package_options}} my $default_options = { deps_list => 1, install_bin => 1, install_share => 1, manifest_skip => 1, requires_from => 1, }; #-----------------------------------------------------------------------------# # Module::Install plugin directives. Use long, ugly names to not pollute the # Module::Install plugin namespace. These are only intended to be called from # Module::Package. #-----------------------------------------------------------------------------# # Module::Package starts off life as a normal call to this Module::Install # plugin directive: my $module_install_plugin; my $module_package_plugin; my $module_package_dist_plugin; # XXX ARGVHACK This @argv thing is a temporary fix for an ugly bug somewhere in the # Wikitext module usage. my @argv; sub module_package_internals_init { my $self = $module_install_plugin = shift; my ($plugin_spec, %options) = @_; $self->package_options({%$default_options, %options}); if ($module_install_plugin->is_admin) { $module_package_plugin = $self->_load_plugin($plugin_spec); $module_package_plugin->mi($module_install_plugin); $module_package_plugin->version_check($VERSION); } else { $module_package_dist_plugin = $self->_load_dist_plugin($plugin_spec); $module_package_dist_plugin->mi($module_install_plugin) if ref $module_package_dist_plugin; } # NOTE - This is the point in time where the body of Makefile.PL runs... return; sub INIT { return unless $module_install_plugin; return if $Module::Package::ERROR; eval { if ($module_install_plugin->is_admin) { $module_package_plugin->initial(); $module_package_plugin->main(); } else { $module_install_plugin->_initial(); $module_package_dist_plugin->_initial() if ref $module_package_dist_plugin; $module_install_plugin->_main(); $module_package_dist_plugin->_main() if ref $module_package_dist_plugin; } }; if ($@) { $Module::Package::ERROR = $@; die $@; } @argv = @ARGV; # XXX ARGVHACK } # If this Module::Install plugin was used (by Module::Package) then wrap # up any loose ends. This will get called after Makefile.PL has completed. sub END { @ARGV = @argv; # XXX ARGVHACK return unless $module_install_plugin; return if $Module::Package::ERROR; $module_package_plugin ? do { $module_package_plugin->final; $module_package_plugin->replicate_module_package; } : do { $module_install_plugin->_final; $module_package_dist_plugin->_final() if ref $module_package_dist_plugin; } } } # Module::Package, Module::Install::Package and Module::Package::Plugin # must all have the same version. Seems wise. sub module_package_internals_version_check { my ($self, $version) = @_; return if $version < 0.1800001; # XXX BOOTBUGHACK!! die <<"..." unless $version == $VERSION; Error! Something has gone awry: Module::Package version=$version is using Module::Install::Package version=$VERSION If you are the author of this module, try upgrading Module::Package. Otherwise, please notify the author of this error. ... } # Find and load the author side plugin: sub _load_plugin { my ($self, $spec, $namespace) = @_; $spec ||= ''; $namespace ||= 'Module::Package'; my $version = ''; $Module::Package::plugin_version = 0; if ($spec =~ s/\s+(\S+)\s*//) { $version = $1; $Module::Package::plugin_version = $version; } my ($module, $plugin) = not($spec) ? ('Plugin', "Plugin::basic") : ($spec =~ /^\w(\w|::)*$/) ? ($spec, $spec) : ($spec =~ /^:(\w+)$/) ? ('Plugin', "Plugin::$1") : ($spec =~ /^(\S*\w):(\w+)$/) ? ($1, "$1::$2") : die "$spec is invalid"; $module = "${namespace}::${module}"; $plugin = "${namespace}::${plugin}"; eval "use $module $version (); 1" or die $@; return $plugin->new(); } # Find and load the user side plugin: sub _load_dist_plugin { my ($self, $spec, $namespace) = @_; $spec ||= ''; $namespace ||= 'Module::Package::Dist'; my $r = eval { $self->_load_plugin($spec, $namespace); }; return $r if ref $r; return; } #-----------------------------------------------------------------------------# # These are the user side analogs to the author side plugin API calls. # Prefix with '_' to not pollute Module::Install plugin space. #-----------------------------------------------------------------------------# sub _initial { my ($self) = @_; } sub _main { my ($self) = @_; } # NOTE These must match Module::Package::Plugin::final. sub _final { my ($self) = @_; $self->_all_from; $self->_requires_from; $self->_install_bin; $self->_install_share; $self->_WriteAll; } #-----------------------------------------------------------------------------# # This section is where all the useful code bits go. These bits are needed by # both Author and User side runs. #-----------------------------------------------------------------------------# my $all_from = 0; sub _all_from { my $self = shift; return if $all_from++; return if $self->name; my $file = shift || "$main::PM" or die "all_from has no file"; $self->all_from($file); } my $requires_from = 0; sub _requires_from { my $self = shift; return if $requires_from++; return unless $self->package_options->{requires_from}; my $file = shift || "$main::PM" or die "requires_from has no file"; $self->requires_from($main::PM) } my $install_bin = 0; sub _install_bin { my $self = shift; return if $install_bin++; return unless $self->package_options->{install_bin}; return unless -d 'bin'; my @bin; File::Find::find(sub { return unless -f $_; push @bin, $File::Find::name; }, 'bin'); $self->install_script($_) for @bin; } my $install_share = 0; sub _install_share { my $self = shift; return if $install_share++; return unless $self->package_options->{install_share}; return unless -d 'share'; $self->install_share; } my $WriteAll = 0; sub _WriteAll { my $self = shift; return if $WriteAll++; $self->WriteAll(@_); } # Base package for Module::Package plugin distributed components. package Module::Package::Dist; sub new { my ($class, %args) = @_; bless \%args, $class; } sub mi { @_ > 1 ? ($_[0]->{mi}=$_[1]) : $_[0]->{mi}; } sub _initial { my ($self) = @_; } sub _main { my ($self) = @_; } sub _final { my ($self) = @_; } 1; #-----------------------------------------------------------------------------# # Take a guess at the primary .pm and .pod files for 'all_from', and friends. # Put them in global magical vars in the main:: namespace. #-----------------------------------------------------------------------------# package Module::Package::PM; use overload '""' => sub { $_[0]->guess_pm unless @{$_[0]}; return $_[0]->[0]; }; sub set { $_[0]->[0] = $_[1] } sub guess_pm { my $pm = ''; my $self = shift; if (-e 'META.yml') { open META, 'META.yml' or die "Can't open 'META.yml' for input:\n$!"; my $meta = do { local $/; }; close META; $meta =~ /^module_name: (\S+)$/m or die "Can't get module_name from META.yml"; $pm = $1; $pm =~ s!::!/!g; $pm = "lib/$pm.pm"; } else { require File::Find; my @array = (); File::Find::find(sub { return unless /\.pm$/; my $name = $File::Find::name; my $num = ($name =~ s!/+!/!g); my $ary = $array[$num] ||= []; push @$ary, $name; }, 'lib'); shift @array while @array and not defined $array[0]; die "Can't guess main module" unless @array; (($pm) = sort @{$array[0]}) or die "Can't guess main module"; } my $pmc = $pm . 'c'; $pm = $pmc if -e $pmc; $self->set($pm); } $main::PM = bless [$main::PM ? ($main::PM) : ()], __PACKAGE__; package Module::Package::POD; use overload '""' => sub { return $_[0]->[0] if @{$_[0]}; (my $pod = "$main::PM") =~ s/\.pm/.pod/ or die "Module::Package's \$main::PM value should end in '.pm'"; return -e $pod ? $pod : ''; }; sub set { $_[0][0] = $_[1] } $main::POD = bless [$main::POD ? ($main::POD) : ()], __PACKAGE__; 1; Type-Tiny-0.022/inc/Module/Install/Contributors.pm0000644000175000017500000000055412200124242020123 0ustar taitai#line 1 package Module::Install::Contributors; use 5.006; use strict; use warnings; BEGIN { $Module::Install::Contributors::AUTHORITY = 'cpan:TOBYINK'; $Module::Install::Contributors::VERSION = '0.001'; } use base qw(Module::Install::Base); sub contributors { my $self = shift; push @{ $self->Meta->{values}{x_contributors} ||= [] }, @_; } 1; __END__ Type-Tiny-0.022/inc/Module/Install/Win32.pm0000644000175000017500000000340312200124301016320 0ustar taitai#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Type-Tiny-0.022/inc/Module/Install/Makefile.pm0000644000175000017500000002743712200123676017166 0ustar taitai#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 Type-Tiny-0.022/inc/Module/Install/Can.pm0000644000175000017500000000615712200124301016130 0ustar taitai#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 Type-Tiny-0.022/inc/Module/Install/Base.pm0000644000175000017500000000214712200123676016312 0ustar taitai#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 Type-Tiny-0.022/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612200124301017151 0ustar taitai#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; Type-Tiny-0.022/inc/Module/Install/Include.pm0000644000175000017500000000101512200123676017014 0ustar taitai#line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; Type-Tiny-0.022/inc/Module/Install/Metadata.pm0000644000175000017500000004327712200123676017171 0ustar taitai#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; Type-Tiny-0.022/inc/Module/Install/AutoManifest.pm0000644000175000017500000000125712200124300020021 0ustar taitai#line 1 use strict; use warnings; package Module::Install::AutoManifest; use Module::Install::Base; BEGIN { our $VERSION = '0.003'; our $ISCORE = 1; our @ISA = qw(Module::Install::Base); } sub auto_manifest { my ($self) = @_; return unless $Module::Install::AUTHOR; die "auto_manifest requested, but no MANIFEST.SKIP exists\n" unless -e "MANIFEST.SKIP"; if (-e "MANIFEST") { unlink('MANIFEST') or die "Can't remove MANIFEST: $!"; } $self->postamble(<<"END"); create_distdir: manifest_clean manifest distclean :: manifest_clean manifest_clean: \t\$(RM_F) MANIFEST END } 1; __END__ #line 48 #line 131 1; # End of Module::Install::AutoManifest Type-Tiny-0.022/inc/Module/Install/TrustMetaYml.pm0000644000175000017500000000161512200123676020051 0ustar taitai#line 1 package Module::Install::TrustMetaYml; use 5.005; use strict; BEGIN { $Module::Install::TrustMetaYml::AUTHORITY = 'cpan:TOBYINK'; $Module::Install::TrustMetaYml::VERSION = '0.003'; } use base qw(Module::Install::Base); sub trust_meta_yml { my ($self, $where) = @_; $where ||= 'META.yml'; $self->perl_version('5.005') unless defined $self->perl_version; $self->include('YAML::Tiny', 0); return $self if $self->is_admin; require YAML::Tiny; my $data = YAML::Tiny::LoadFile($where); $self->perl_version($data->{requires}{perl} || '5.005'); KEY: foreach my $key (qw(requires recommends build_requires)) { next KEY unless ref $data->{$key} eq 'HASH'; my %deps = %{$data->{$key}}; DEP: while (my ($pkg, $ver) = each %deps) { next if $pkg eq 'perl'; $self->$key($pkg, $ver); } } return $self; } *trust_meta_yaml = \&trust_meta_yml; 1; __END__ =encoding utf8 Type-Tiny-0.022/inc/Module/Install.pm0000644000175000017500000003013512200123666015435 0ustar taitai#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. Type-Tiny-0.022/inc/Module/Package/0000755000175000017500000000000012200124456015020 5ustar taitaiType-Tiny-0.022/inc/Module/Package/Dist/0000755000175000017500000000000012200124456015723 5ustar taitaiType-Tiny-0.022/inc/Module/Package/Dist/RDF.pm0000644000175000017500000000204712200123721016671 0ustar taitai#line 1 package Module::Package::Dist::RDF; my $explanation = q< This is the component of Module::Package::RDF which gets bundled with the distribution. >; use 5.005; use strict; BEGIN { $Module::Package::Dist::RDF::AUTHORITY = 'cpan:TOBYINK'; $Module::Package::Dist::RDF::VERSION = '0.014'; @Module::Package::Dist::RDF::ISA = 'Module::Package::Dist'; } sub _main { my ($self) = @_; $self->mi->trust_meta_yml; $self->mi->auto_install; } { package Module::Package::Dist::RDF::standard; use 5.005; use strict; BEGIN { $Module::Package::Dist::RDF::standard::AUTHORITY = 'cpan:TOBYINK'; $Module::Package::Dist::RDF::standard::VERSION = '0.014'; @Module::Package::Dist::RDF::standard::ISA = 'Module::Package::Dist::RDF'; } } { package Module::Package::Dist::RDF::tobyink; use 5.005; use strict; BEGIN { $Module::Package::Dist::RDF::tobyink::AUTHORITY = 'cpan:TOBYINK'; $Module::Package::Dist::RDF::tobyink::VERSION = '0.014'; @Module::Package::Dist::RDF::tobyink::ISA = 'Module::Package::Dist::RDF'; } } 1; Type-Tiny-0.022/COPYRIGHT0000644000175000017500000001233712200124300012754 0ustar taitaiFormat: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: Type-Tiny Upstream-Contact: Toby Inkster Source: https://metacpan.org/release/Type-Tiny Files: examples/benchmark-coercions.pl examples/benchmark-constraints.pl examples/datetime-coercions.pl inc/Module/Install/Contributors.pm lib/Devel/TypeTiny/Perl56Compat.pm lib/Eval/TypeTiny.pm lib/Exporter/TypeTiny.pm lib/Reply/Plugin/TypeTiny.pm lib/Test/TypeTiny.pm lib/Type/Coercion.pm lib/Type/Coercion/Union.pm lib/Type/Exception.pm lib/Type/Exception/Assertion.pm lib/Type/Exception/Compilation.pm lib/Type/Exception/WrongNumberOfParameters.pm lib/Type/Library.pm lib/Type/Params.pm lib/Type/Parser.pm lib/Type/Registry.pm lib/Type/Tiny.pm lib/Type/Tiny/Class.pm lib/Type/Tiny/Duck.pm lib/Type/Tiny/Enum.pm lib/Type/Tiny/Intersection.pm lib/Type/Tiny/Manual.pod lib/Type/Tiny/Manual/Coercions.pod lib/Type/Tiny/Manual/Libraries.pod lib/Type/Tiny/Manual/Params.pod lib/Type/Tiny/Manual/UsingWithMoo.pod lib/Type/Tiny/Manual/UsingWithMoose.pod lib/Type/Tiny/Manual/UsingWithMouse.pod lib/Type/Tiny/Manual/UsingWithOther.pod lib/Type/Tiny/Role.pm lib/Type/Tiny/Union.pm lib/Type/Utils.pm lib/Types/Standard.pm lib/Types/TypeTiny.pm t/00-begin.t t/01-compile.t t/02-api.t t/arithmetic.t t/coercion-automatic.t t/coercion-classy.t t/coercion-frozen.t t/coercion-inlining.t t/coercion-modifiers.t t/coercion-union.t t/coercion.t t/coercions-parameterized.t t/dwim-moose.t t/dwim-mouse.t t/eval-lexicalsubs.t t/eval.t t/exceptions-stack.t t/exceptions.t t/exporter-installer.t t/exporter-roleconflict.t t/exporter.t t/functionparameters.t t/lib/BiggerLib.pm t/lib/DemoLib.pm t/library-assert.t t/library-is.t t/library-to.t t/library-types.t t/match-on-type.t t/moo-coercion.t t/moo-exceptions.t t/moo-inflation.t t/moo.t t/moose-autott.t t/moose-coercion.t t/moose.t t/moosextypes-more.t t/moosextypes.t t/mouse-coercion.t t/mouse.t t/mousextypes.t t/oo-objectaccessor.t t/parameterization.t t/params-badsigs.t t/params-carping.t t/params-coerce.t t/params-methods.t t/params-mixednamed.t t/params-named.t t/params-noninline.t t/params-optional.t t/params-positional.t t/params-slurpy.t t/parser.t t/registry.t t/stdlib-mxtmlb-alike.t t/stdlib-optlist.t t/stdlib-overload.t t/stdlib-strmatch.t t/stdlib-structures.t t/stdlib-tied.t t/stdlib.t t/subquote.t t/syntax.t t/type-class.t t/type-duck.t t/type-enum.t t/type-intersection.t t/type-role.t t/type-union.t t/type.t t/validationclass.t Copyright: This software is copyright (c) 2013 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: CONTRIBUTING CREDITS Changes LICENSE META.ttl Makefile.PL NEWS README examples/benchmark-mkopt.pl examples/benchmark-param-validation.pl meta/changes.pret meta/doap.pret meta/makefile.pret meta/people.pret meta/rights.pret Copyright: Copyright 2013 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: inc/Module/Install.pm inc/Module/Install/Include.pm inc/Module/Install/Metadata.pm Copyright: Copyright 2002 - 2012 Brian Ingerson, Audrey Tang and Adam Kennedy. License: GPL-1.0+ or Artistic-1.0 Files: t/rt85911.t t/rt86004.t Copyright: This software is copyright (c) 2013 by Diab Jerius. License: GPL-1.0+ or Artistic-1.0 Files: inc/Module/Install/TrustMetaYml.pm inc/Module/Package/Dist/RDF.pm Copyright: This software is copyright (c) 2011-2012 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/rt86233.t t/rt86239.t Copyright: This software is copyright (c) 2013 by Vyacheslav Matyukhin. License: GPL-1.0+ or Artistic-1.0 Files: MANIFEST.SKIP Copyright: Copyright 2013 Ingy döt Net. License: GPL-1.0+ or Artistic-1.0 Files: t/oo-classinsideout.t Copyright: This software is copyright (c) 2013 by David Golden, Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: COPYRIGHT Copyright: None License: public-domain Comment: This file! Automatically generated. Files: t/gh1.t Copyright: This software is copyright (c) 2013 by Richard Simões. License: GPL-1.0+ or Artistic-1.0 Files: inc/Try/Tiny.pm Copyright: Copyright 2013 Yuval Kogman. License: GPL-1.0+ or Artistic-1.0 Files: inc/Test/Requires.pm Copyright: Copyright 2013 MATSUNO Tokuhiro. License: GPL-1.0+ or Artistic-1.0 Files: inc/Test/Fatal.pm Copyright: Copyright 2013 Ricardo Signes. License: GPL-1.0+ or Artistic-1.0 Files: .travis.yml Copyright: Unknown License: Unknown Files: inc/YAML/Tiny.pm Copyright: Copyright 2006 - 2012 Adam Kennedy. License: GPL-1.0+ or Artistic-1.0 Files: inc/Module/Install/Makefile.pm Copyright: Copyright 2002, 2003, 2004 Audrey Tang and Brian Ingerson. License: GPL-1.0+ or Artistic-1.0 Files: inc/Module/Install/Base.pm Copyright: Copyright 2003, 2004 by Audrey Tang . License: GPL-1.0+ or Artistic-1.0 Files: inc/Module/Install/Package.pm Copyright: Copyright (c) 2011. Ingy doet Net. License: GPL-1.0+ or Artistic-1.0 License: Artistic-1.0 This software is Copyright (c) 2013 by the copyright holder(s). This is free software, licensed under: The Artistic License 1.0 License: GPL-1.0 This software is Copyright (c) 2013 by the copyright holder(s). This is free software, licensed under: The GNU General Public License, Version 1, February 1989 Type-Tiny-0.022/CONTRIBUTING0000644000175000017500000000531712200123676013332 0ustar taitaiNAME CONTRIBUTING DESCRIPTION If you're reading this document, that means you might be thinking about helping me out with this project. Thanks! Here's some ways you could help out: * Bug reports Found a bug? Great! (Well, not so great I suppose.) The place to report them is . Don't e-mail me about it, as your e-mail is more than likely to get lost amongst the spam. An example script clearly demonstrating the bug (preferably written using Test::More) would be greatly appreciated. * Patches If you've found a bug and written a fix for it, even better! Generally speaking you should check out the latest copy of the code from the source repository rather than using the CPAN distribution. The file META.yml should contain a link to the source repository. If not, then try or submit a bug report. (As far as I'm concerned the lack of a link is a bug.) Many of my distributions are also mirrored at . To submit the patch, do a pull request on GitHub or Bitbucket, or attach a diff file to a bug report. Unless otherwise stated, I'll assume that your contributions are licensed under the same terms as the rest of the project. (If using git, feel free to work in a branch. For Mercurial, I'd prefer bookmarks within the default branch.) * Documentation If there's anything unclear in the documentation, please submit this as a bug report or patch as above. Non-toy example scripts that I can bundle would also be appreciated. * Translation Translations of documentation would be welcome. For translations of error messages and other strings embedded in the code, check with me first. Sometimes the English strings may not in a stable state, so it would be a waste of time translating them. Coding Style I tend to write using something approximating the Allman style, using tabs for indentation and Unix-style line breaks. * * I nominally encode all source files as UTF-8, though in practice most of them use a 7-bit-safe ASCII-compatible subset of UTF-8. AUTHOR Toby Inkster . COPYRIGHT AND LICENCE Copyright (c) 2012-2013 by Toby Inkster. CONTRIBUTING.pod is licensed under the Creative Commons Attribution-ShareAlike 2.0 UK: England & Wales License. To view a copy of this license, visit . Type-Tiny-0.022/NEWS0000644000175000017500000000453712200121174012171 0ustar taitai2013-04-15 Type-Tiny version 0.001 released! - Contains over 2000 lines of code, over 3000 lines of documentation, and over 650 tests. 2013-05-06 Type-Tiny version 0.004 released! - Contains over 3500 lines of code, over 5000 lines of documentation, and over 1000 tests. - Improved manual. - Many improvements to coercions: - can be made immutable - can be added to type libraries as standalone coercions - overload "+" - "deep" coercions - parameterizable coercions - Type::Params is a new module providing ultra-fast parameter checking for subroutines - Exporter::TypeTiny pulls all the weird exporting code from various modules together into one place - Eval::TypeTiny pulls all the weird string evaluation from various modules together into one place - OptList, Bytes and Chars types added to Types::Standard - MkOpt, Encode, Decode, Join and Split coercions added to Types::Standard - Better Mouse support. - Types::TypeTiny::to_TypeTiny is able to built a type constraint from Validation::Class::Simple 2013-05-28 Type-Tiny version 0.006 released! - String error messages replaced with exceptions. - Assertion exceptions have an ->explain method. - Bytes, Chars, Encode and Decode split from Types::Standard to Types::Encodings 2013-06-21 Type-Tiny version 0.008 released! - New types added to Types::Standard: InstanceOf, ConsumerOf, HasMethods, Enum, StrictNum and LaxNum. - New module: Type::Registry. - New module: Type::Parser. - Many bug fixes, large and small. - Much improved documentation, especially Types::Standard and Type::Utils. - Type::Utils now has "match_on_type"/"compile_match_on_type" functions. - Type::Utils no longer exports "extends" function by default. 2013-06-24 Type-Tiny version 0.010 released! - Includes Reply::Plugin::TypeTiny. - Type::API support. - Improved Sub::Quote integration. - Many small bug fixes and optimizations. 2013-06-25 Type-Tiny version 0.012 released! - Better Mouse support. - Can now coerce Type::Tiny objects from coderefs (via to_TypeTiny). 2013-07-16 Type-Tiny version 0.016 released! - Type::Utils::dwim_type() function. 2013-07-23 Type-Tiny version 0.020 released! - Support for Perl 5.6.x. 2013-08-06 Type-Tiny version 0.020 released! - Strict comparison methods in Type::Tiny. - Improved compatibility with Moose attribute native traits. Type-Tiny-0.022/t/0000755000175000017500000000000012200124456011732 5ustar taitaiType-Tiny-0.022/t/functionparameters.t0000644000175000017500000000206712161671331016042 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. =head1 DEPENDENCIES Test is skipped if Function::Parameters 1.0103 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { "Function::Parameters" => "1.0103" }; use Test::Fatal; use Types::Standard -types; use Function::Parameters qw(:strict); fun foo ((Int) $x) { return $x; } is( foo(4), 4, 'foo(4) works', ); like( exception { foo(4.1) }, qr{^In fun foo: parameter 1 \(\$x\): Value "4\.1" did not pass type constraint "Int"}, 'foo(4.1) throws', ); my $info = Function::Parameters::info(\&foo); my ($x) = $info->positional_required; is($x->name, '$x', '$x->name'); ok($x->type == Int, '$x->type'); done_testing; Type-Tiny-0.022/t/type-intersection.t0000644000175000017500000000434112162254757015625 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks intersection type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use BiggerLib qw( :types ); use Type::Utils qw( intersection ); { my $x; sub FooBarAndDoesQuux () { $x ||= intersection(FooBarAndDoesQuux => [FooBar, DoesQuux]) } } isa_ok( FooBarAndDoesQuux, 'Type::Tiny::Intersection', 'FooBarAndDoesQuux', ); isa_ok( FooBarAndDoesQuux->[0], 'Type::Tiny::Class', 'FooBarAndDoesQuux->[0]', ); isa_ok( FooBarAndDoesQuux->[1], 'Type::Tiny::Role', 'FooBarAndDoesQuux->[1]', ); is( FooBarAndDoesQuux."", 'FooBar&DoesQuux', 'stringification good', ); my $something = bless [] => do { package Something; sub DOES { return 1 if $_[1] eq 'Quux'; $_[0]->isa($_[0]); } __PACKAGE__; }; should_fail("Foo::Bar"->new, FooBarAndDoesQuux); should_pass("Foo::Baz"->new, FooBarAndDoesQuux); should_fail($something, FooBarAndDoesQuux); my $something_else = bless [] => do { package Something::Else; sub DOES { return 1 if $_[1] eq 'Else'; $_[0]->isa($_[0]); } __PACKAGE__; }; should_fail($something_else, FooBarAndDoesQuux); should_fail("Foo::Bar", FooBarAndDoesQuux); should_fail("Foo::Baz", FooBarAndDoesQuux); require Types::Standard; my $reftype_array = Types::Standard::Ref["ARRAY"]; { my $x; sub NotherSect () { $x ||= intersection(NotherUnion => [FooBarAndDoesQuux, $reftype_array]) } } is( scalar @{+NotherSect}, 3, "intersections don't get unnecessarily deep", ); note NotherSect->inline_check('$X'); should_pass(bless([], "Foo::Baz"), NotherSect); should_fail(bless({}, "Foo::Baz"), NotherSect); my $SmallEven = SmallInteger & sub { $_ % 2 == 0 }; isa_ok($SmallEven, "Type::Tiny::Intersection"); ok(!$SmallEven->can_be_inlined, "not ($SmallEven)->can_be_inlined"); should_pass(2, $SmallEven); should_fail(20, $SmallEven); should_fail(3, $SmallEven); done_testing; Type-Tiny-0.022/t/eval.t0000644000175000017500000000672212175677664013106 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Tests L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Eval::TypeTiny; my %env = ( '$foo' => do { my $x = "foo"; \$x }, '@bar' => [ "bar" ], '%baz' => { "baz" => "1" }, ); my $source = <<'SRC'; sub { return $foo if $_[0] eq '$foo'; return @bar if $_[0] eq '@bar'; return %baz if $_[0] eq '%baz'; return; } SRC my $closure = eval_closure(source => $source, environment => \%env); is_deeply( [ $closure->('$foo') ], [ 'foo' ], 'closure over scalar', ); is_deeply( [ $closure->('@bar') ], [ 'bar' ], 'closure over array', ); is_deeply( [ $closure->('%baz') ], [ 'baz' => 1 ], 'closure over hash', ); my $external = 40; my $closure2 = eval_closure( source => 'sub { $xxx += 2 }', environment => { '$xxx' => \$external }, alias => 1, ); $closure2->(); is($external, 42, 'closing over variables really really really works!'); { my $destroyed = 0; { package MyIndicator; sub DESTROY { $destroyed++ } } { my $number = bless \(my $foo), "MyIndicator"; $$number = 40; my $closure = eval_closure( source => 'sub { $$xxx += 2 }', environment => { '$xxx' => \$number }, alias => 1, ); $closure->(); is($$number, 42); is($destroyed, 0); } is($destroyed, 1, 'closed over variables disappear on cue'); } { my @store; { package MyTie; use Tie::Scalar (); our @ISA = 'Tie::StdScalar'; sub STORE { my $self = shift; push @store, $_[0]; $self->SUPER::STORE(@_); } sub my_method { 42 } } tie(my($var), 'MyTie'); $var = 1; my $closure = eval_closure( source => 'sub { $xxx = $_[0]; tied($xxx)->my_method }', environment => { '$xxx' => \$var }, alias => 1, ); is($closure->(2), 42, 'can close over tied variables ... AUTOLOAD stuff'); $closure->(3); my $nother_closure = eval_closure( source => 'sub { tied($xxx)->can(@_) }', environment => { '$xxx' => \$var }, alias => 1, ); ok( $nother_closure->('my_method'), '... can'); ok(!$nother_closure->('your_method'), '... !can'); is_deeply( \@store, [ 1 .. 3], '... tie still works', ); { package OtherTie; our @ISA = 'MyTie'; sub my_method { 666 } } tie($var, 'OtherTie'); is($closure->(4), 666, '... can be retied'); untie($var); my $e = exception { $closure->(5) }; like($e, qr{^Can't call method "my_method" on an undefined value}, '... can be untied'); } my $e = exception { eval_closure(source => 'sub { 1 ]') }; isa_ok( $e, 'Type::Exception::Compilation', '$e', ); like( $e, qr{^Failed to compile source because: syntax error}, 'throw exception when code does not compile', ); like( $e->errstr, qr{^syntax error}, '$e->errstr', ); like( $e->code, qr{sub \{ 1 \]}, '$e->code', ); my $c1 = eval_closure(source => 'sub { die("BANG") }', description => 'test1'); my $e1 = exception { $c1->() }; like( $e1, qr{^BANG at test1 line 1}, '"description" option works', ); my $c2 = eval_closure(source => 'sub { die("BANG") }', description => 'test2', line => 222); my $e2 = exception { $c2->() }; like( $e2, qr{^BANG at test2 line 222}, '"line" option works', ); done_testing; Type-Tiny-0.022/t/mouse-coercion.t0000644000175000017500000000432212161671331015054 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check coercions work with L; both mutable and immutable classes. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Mouse 1.00 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Mouse => 1.00 }; use Test::Fatal; { package Local::Class; use Mouse; use BiggerLib -all; ::isa_ok(BigInteger, "Mouse::Meta::TypeConstraint"); has small => (is => "rw", isa => SmallInteger, coerce => 1); has big => (is => "rw", isa => BigInteger, coerce => 1); } my ($e, $o); my $suffix = "mutable class"; for (0..1) { $e = exception { $o = "Local::Class"->new( small => 104, big => 9, ); }; is($e, undef, "no exception on coercion in constructor - $suffix"); is($o && $o->big, 19, "'big' attribute coerces in constructor - $suffix"); is($o && $o->small, 4, "'small' attribute coerces in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => [], big => {}, ); }; like($e, qr{^Attribute \(big\)}, "'big' attribute throws when it cannot coerce in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => {}, big => [], ); }; like($e, qr{^Attribute \(small\)}, "'small' attribute throws when it cannot coerce in constructor - $suffix"); $o = "Local::Class"->new; $e = exception { $o->big([]); $o->small([]); }; is($o && $o->big, 100, "'big' attribute coerces in accessor - $suffix"); is($o && $o->small, 1, "'small' attribute coerces in accessor - $suffix"); $e = exception { $o->big({}) }; like($e, qr{^Attribute \(big\)}, "'big' attribute throws when it cannot coerce in accessor - $suffix"); $e = exception { $o->small({}) }; like($e, qr{^Attribute \(small\)}, "'small' attribute throws when it cannot coerce in accessor - $suffix"); "Local::Class"->meta->make_immutable; $suffix = "im$suffix"; } done_testing; Type-Tiny-0.022/t/exceptions-stack.t0000644000175000017500000000154412161671331015414 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Tests that L is capable of providing stack traces. =head1 DEPENDENCIES Requires L; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); local $Type::Exception::StackTrace; use Test::More; use Test::Fatal; use Test::Requires { "Devel::StackTrace" => 0 }; use Types::Standard slurpy => -types; sub foo { local $Type::Exception::StackTrace = 1; Int->(@_); } my $e = exception { foo(undef) }; is( $e->stack_trace->frame(1)->subroutine, "main::foo", ); done_testing; Type-Tiny-0.022/t/stdlib-mxtmlb-alike.t0000644000175000017500000000335112161671331015773 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test the following types from L which were inspired by L. =over =item C<< InstanceOf >> =item C<< ConsumerOf >> =item C<< HasMethods >> =item C<< Enum >> =back Rather than checking they work directy, we check they are equivalent to known (and well-tested) type constraints generated using L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Type::Utils; sub same_type { my ($a, $b, $msg) = @_; $msg ||= "$a == $b"; @_ = ($a->inline_check('$x'), $b->inline_check('$x'), $msg); goto \&Test::More::is; } same_type( InstanceOf[], Object, ); same_type( InstanceOf["Foo"], class_type(Foo => {class => "Foo"}), ); same_type( InstanceOf["Foo", "Bar"], union [ class_type(Foo => {class => "Foo"}), class_type(Bar => {class => "Bar"}), ], ); same_type( ConsumerOf[], Object, ); same_type( ConsumerOf["Foo"], role_type(Foo => {role => "Foo"}), ); same_type( ConsumerOf["Foo", "Bar"], intersection [ role_type(Foo => {role => "Foo"}), role_type(Bar => {role => "Bar"}), ], ); same_type( HasMethods[], Object, ); same_type( HasMethods["foo"], duck_type(CanFoo => [qw/foo/]), ); same_type( HasMethods["foo", "bar"], duck_type(CanFooBar => [qw/foo bar/]), ); same_type( Enum[], Str, ); same_type( Enum["foo"], enum(Foo => [qw/foo/]), ); same_type( Enum["foo", "bar"], enum(Foo => [qw/foo bar/]), ); done_testing; Type-Tiny-0.022/t/parser.t0000644000175000017500000001520112176272420013421 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks Type::Parser works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Test::Fatal; use Type::Parser qw(_std_eval parse); use Types::Standard qw(-types slurpy); use Type::Utils; sub types_equal { my ($a, $b) = map { ref($_) ? $_ : _std_eval($_) } @_[0, 1]; my ($A, $B) = map { $_->inline_check('$X') } ($a, $b); my $msg = "$_[0] eq $_[1]"; $msg = "$msg - $_[2]" if $_[2]; @_ = ($A, $B, $msg); goto \&Test::More::is; } note "Basics"; types_equal("Int", Int); types_equal("(Int)", Int, "redundant parentheses"); types_equal("((((Int))))", Int, "many redundant parentheses"); note "Class types"; types_equal("DateTime::", InstanceOf["DateTime"]); types_equal("InstanceOf['DateTime']", InstanceOf["DateTime"]); types_equal("Tied[Foo::]", Tied["Foo"]); types_equal("Tied['Foo']", Tied["Foo"]); note "Parameterization"; types_equal("Int[]", Int, "empty parameterization against non-parameterizable type"); types_equal("ArrayRef[]", ArrayRef, "empty parameterization against parameterizable type"); types_equal("ArrayRef[Int]", ArrayRef[Int], "parameterized type"); types_equal("Ref['HASH']", Ref['HASH'], "string parameter (singles)"); types_equal("Ref[\"HASH\"]", Ref['HASH'], "string parameter (doubles)"); types_equal("Ref[q(HASH)]", Ref['HASH'], "string parameter (q)"); types_equal("Ref[qq(HASH)]", Ref['HASH'], "string parameter (qq)"); types_equal("StrMatch[qr{foo}]", StrMatch[qr{foo}], "regexp parameter"); note "Unions"; types_equal("Int|HashRef", Int|HashRef); types_equal("Int|HashRef|ArrayRef", Int|HashRef|ArrayRef); types_equal("ArrayRef[Int|HashRef]", ArrayRef[Int|HashRef], "union as a parameter"); types_equal("ArrayRef[Int|HashRef[Int]]", ArrayRef[Int|HashRef[Int]]); types_equal("ArrayRef[HashRef[Int]|Int]", ArrayRef[HashRef([Int]) | Int]); note "Intersections"; types_equal("Int&Num", Int & Num); types_equal("Int&Num&Defined", Int & Num & Defined); types_equal("ArrayRef[Int]&Defined", (ArrayRef[Int]) & Defined); note "Union + Intersection"; types_equal("Int&Num|ArrayRef", (Int & Num) | ArrayRef); types_equal("(Int&Num)|ArrayRef", (Int & Num) | ArrayRef); types_equal("Int&(Num|ArrayRef)", Int & (Num | ArrayRef)); types_equal("Int&Num|ArrayRef&Ref", intersection([Int, Num]) | intersection([ArrayRef, Ref])); note "Complementary types"; types_equal("~Int", ~Int); types_equal("~ArrayRef[Int]", ArrayRef([Int])->complementary_type); types_equal("~Int|CodeRef", (~Int)|CodeRef); types_equal("~(Int|CodeRef)", ~(Int|CodeRef), 'precedence of "~" versus "|"'); note "Comma"; types_equal("Map[Num,Int]", Map[Num,Int]); types_equal("Map[Int,Num]", Map[Int,Num]); types_equal("Map[Int,Int|ArrayRef[Int]]", Map[Int,Int|ArrayRef[Int]]); types_equal("Map[Int,ArrayRef[Int]|Int]", Map[Int,ArrayRef([Int])|Int]); types_equal("Dict[foo=>Int,bar=>Num]", Dict[foo=>Int,bar=>Num]); types_equal("Dict['foo'=>Int,'bar'=>Num]", Dict[foo=>Int,bar=>Num]); types_equal("Dict['foo',Int,'bar',Num]", Dict[foo=>Int,bar=>Num]); note "Slurpy"; types_equal("Dict[slurpy=>Int,bar=>Num]", Dict[slurpy=>Int,bar=>Num]); types_equal("Tuple[Str, Int, slurpy ArrayRef[Int]]", Tuple[Str, Int, slurpy ArrayRef[Int]]); types_equal("Tuple[Str, Int, slurpy(ArrayRef[Int])]", Tuple[Str, Int, slurpy ArrayRef[Int]]); note "Complexity"; types_equal( "ArrayRef[DateTime::]|HashRef[Int|DateTime::]|CodeRef", ArrayRef([InstanceOf["DateTime"]]) | HashRef([Int|InstanceOf["DateTime"]]) | CodeRef ); types_equal( "ArrayRef [DateTime::] |HashRef[ Int|\tDateTime::]|CodeRef ", ArrayRef([InstanceOf["DateTime"]]) | HashRef([Int|InstanceOf["DateTime"]]) | CodeRef, "gratuitous whitespace", ); note "Bad expressions"; like( exception { _std_eval('%hello') }, qr{^Unexpected token in primary type expression; got '%hello'}, 'weird token' ); like( exception { _std_eval('Str Int') }, qr{^Unexpected tail on type expression: Int}, 'weird stuff 1' ); like( exception { _std_eval('ArrayRef(Int)') }, qr{^Unexpected tail on type expression: .Int.}, 'weird stuff 2' ); note "Tail retention"; my ($ast, $remaining) = parse("ArrayRef [DateTime::] |HashRef[ Int|\tDateTime::]|CodeRef monkey nuts "); is($remaining, " monkey nuts ", "remainder is ok"); note "Parsing edge cases"; is_deeply( scalar parse('Xyzzy[Foo]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Foo' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy[Foo] - parameter is treated as a type constraint' ); is_deeply( scalar parse('Xyzzy["Foo"]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'QUOTELIKE', '"Foo"' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy["Foo"] - parameter is treated as a string' ); is_deeply( scalar parse('Xyzzy[-100]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'STRING', '-100' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy[-100] - parameter is treated as a string' ); is_deeply( scalar parse('Xyzzy[200]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'STRING', '200' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy[200] - parameter is treated as a string' ); is_deeply( scalar parse('Xyzzy[+20.0]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'STRING', '+20.0' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy[+20.0] - parameter is treated as a string' ); done_testing; Type-Tiny-0.022/t/library-assert.t0000644000175000017500000000234712161671331015075 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks that the assertion functions exported by a type library work as expected. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use BiggerLib qw( :assert ); ok assert_String("rats"), "assert_String works (value that should pass)"; like( exception { assert_String([]) }, qr{^is not a string}, "assert_String works (value that should fail)" ); ok BiggerLib::assert_String("rats"), "BiggerLib::assert_String works (value that should pass)"; like( exception { BiggerLib::assert_String([]) }, qr{^is not a string}, "BiggerLib::assert_String works (value that should fail)" ); ok assert_SmallInteger(5), "assert_SmallInteger works (value that should pass)"; like( exception { assert_SmallInteger([]) }, qr{^ARRAY\(\w+\) is too big}, "assert_SmallInteger works (value that should fail)" ); done_testing; Type-Tiny-0.022/t/moo-exceptions.t0000644000175000017500000000335712161671331015105 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Tests L interaction with L. =head1 DEPENDENCIES Requires Moo 1.002001 or above; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::Requires { "Moo" => "1.002001" }; BEGIN { require Method::Generate::Accessor; "Method::Generate::Accessor"->can("_SIGDIE") or plan skip_all => "Method::Generate::Accessor cannot _SIGDIE!!!"; }; { package Goo; use Moo; use Types::Standard qw(Int); has number => (is => "rw", isa => Int); } my $e_constructor = exception { Goo->new(number => "too") }; isa_ok($e_constructor, 'Type::Exception::Assertion', '$e_constructor'); is($e_constructor->attribute_name, 'number', '$e_constructor->attribute_name'); is($e_constructor->attribute_step, 'isa check', '$e_constructor->attribute_step'); is($e_constructor->varname, '$self->{"number"}', '$e_constructor->varname'); is($e_constructor->value, "too", '$e_constructor->value'); is($e_constructor->type, Types::Standard::Int, '$e_constructor->type'); my $e_accessor = exception { Goo->new->number("too") }; isa_ok($e_accessor, 'Type::Exception::Assertion', '$e_accessor'); is($e_accessor->attribute_name, 'number', '$e_accessor->attribute_name'); is($e_accessor->attribute_step, 'isa check', '$e_accessor->attribute_step'); is($e_accessor->value, "too", '$e_accessor->value'); is($e_accessor->type, Types::Standard::Int, '$e_accessor->type'); done_testing; Type-Tiny-0.022/t/type-class.t0000644000175000017500000000303312161671331014207 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks class type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use BiggerLib qw( :types ); isa_ok(FooBar, "Type::Tiny", "FooBar"); isa_ok(FooBar, "Type::Tiny::Class", "FooBar"); isa_ok(FooBaz, "Type::Tiny", "FooBaz"); isa_ok(FooBaz, "Type::Tiny::Class", "FooBaz"); isa_ok(FooBar->new, "Foo::Bar", "FooBar->new"); isa_ok(FooBaz->new, "Foo::Baz", "FooBaz->new"); isa_ok(FooBar->class->new, "Foo::Bar", "FooBar->class->new"); isa_ok(FooBaz->class->new, "Foo::Baz", "FooBaz->class->new"); should_pass("Foo::Bar"->new, FooBar); should_pass("Foo::Baz"->new, FooBar); should_fail("Foo::Bar"->new, FooBaz); should_pass("Foo::Baz"->new, FooBaz); should_fail(undef, FooBar); should_fail(undef, FooBaz); should_fail({}, FooBar); should_fail({}, FooBaz); should_fail(FooBar, FooBar); should_fail(FooBar, FooBaz); should_fail(FooBaz, FooBar); should_fail(FooBaz, FooBaz); should_fail("Foo::Bar", FooBar); should_fail("Foo::Bar", FooBaz); should_fail("Foo::Baz", FooBar); should_fail("Foo::Baz", FooBaz); is( ref(FooBar->new), ref(FooBar->class->new), 'DWIM Type::Tiny::Class::new', ); done_testing; Type-Tiny-0.022/t/params-badsigs.t0000644000175000017500000000203012161671331015014 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check that people doing silly things with Test::Params get =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw( compile ); use Types::Standard qw( Optional Int ArrayRef slurpy ); like( exception { compile(Optional[Int], Int) }, qr{^Non-Optional parameter following Optional parameter}, "Cannot follow an optional parameter with a required parameter", ); like( exception { compile(slurpy ArrayRef[Int], Optional[Int]) }, qr{^Parameter following slurpy parameter}, "Cannot follow a slurpy parameter with anything", ); like( exception { compile(slurpy Int) }, qr{^Slurpy parameter not of type HashRef or ArrayRef}, "Slurpy parameters must be hashrefs or arrayrefs", ); done_testing; Type-Tiny-0.022/t/coercion-inlining.t0000644000175000017500000000247712161671331015544 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks Type::Coercion can be inlined. =head1 DEPENDENCIES Requires JSON::PP 2.27105. Test is skipped if this module is not present. Note that this is bundled with Perl v5.13.11 and above. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { "JSON::PP" => "2.27105" }; use Test::More; use Test::Fatal; { package T; require JSON::PP; use Type::Library -base, -declare => qw/ JsonHash JsonArray /; use Type::Utils; use Types::Standard -types; declare JsonHash, as HashRef; declare JsonArray, as ArrayRef; coerce JsonHash, from Str, 'JSON::PP::decode_json($_)'; coerce ArrayRef, from Str, 'JSON::PP::decode_json($_)'; } my $code = T::ArrayRef->coercion->inline_coercion('$::foo'); our $foo = "[3,2,1]"; is_deeply( eval $code, [3,2,1], 'inlined coercion works', ); $foo = [5,4,3]; is_deeply( eval $code, [5,4,3], 'no coercion necessary', ); $foo = {foo => "bar"}; is_deeply( eval $code, {foo => "bar"}, 'no coercion possible', ); done_testing; Type-Tiny-0.022/t/stdlib.t0000644000175000017500000001062712172321434013411 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks various values against the type constraints from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Types::Standard -all; is(Num->library, "Types::Standard", "->library method"); my $var = 123; should_pass(\$var, ScalarRef); should_pass([], ArrayRef); should_pass(+{}, HashRef); should_pass(sub {0}, CodeRef); should_pass(\*STDOUT, GlobRef); should_pass(\(\"Hello"), Ref); should_pass(\*STDOUT, FileHandle); should_pass(qr{x}, RegexpRef); should_pass(1, Str); should_pass(1, Num); should_pass(1, Int); should_pass(1, Defined); should_pass(1, Value); should_pass(undef, Undef); should_pass(undef, Item); should_pass(undef, Any); should_pass('Type::Tiny', ClassName); should_pass('Type::Library', RoleName); should_pass(undef, Bool); should_pass('', Bool); should_pass(0, Bool); should_pass(1, Bool); should_fail(7, Bool); should_pass(\(\"Hello"), ScalarRef); should_fail('Type::Tiny', RoleName); should_fail([], Str); should_fail([], Num); should_fail([], Int); should_pass("4x4", Str); should_fail("4x4", Num); should_fail("4.2", Int); should_fail(undef, Str); should_fail(undef, Num); should_fail(undef, Int); should_fail(undef, Defined); should_fail(undef, Value); { package Local::Class1; use strict; } { no warnings 'once'; $Local::Class2::VERSION = 0.001; @Local::Class3::ISA = qw(UNIVERSAL); @Local::Dummy1::FOO = qw(UNIVERSAL); } { package Local::Class4; sub XYZ () { 1 } } should_fail(undef, ClassName); should_fail([], ClassName); should_pass("Local::Class$_", ClassName) for 2..4; should_fail("Local::Dummy1", ClassName); should_pass([], ArrayRef[Int]); should_pass([1,2,3], ArrayRef[Int]); should_fail([1.1,2,3], ArrayRef[Int]); should_fail([1,2,3.1], ArrayRef[Int]); should_fail([[]], ArrayRef[Int]); should_pass([[3]], ArrayRef[ArrayRef[Int]]); should_fail([["A"]], ArrayRef[ArrayRef[Int]]); my $deep = ArrayRef[HashRef[ArrayRef[HashRef[Int]]]]; ok($deep->can_be_inlined, "$deep can be inlined"); should_pass([{foo1=>[{bar=>1}]},{foo2=>[{baz=>2}]}], $deep); should_pass([{foo1=>[{bar=>1}]},{foo2=>[]}], $deep); should_fail([{foo1=>[{bar=>1}]},{foo2=>[2]}], $deep); should_pass(undef, Maybe[Int]); should_pass(123, Maybe[Int]); should_fail(1.3, Maybe[Int]); my $i = 1; my $f = 1.1; my $s = "Hello"; should_pass(\$s, ScalarRef[Str]); should_pass(\$f, ScalarRef[Str]); should_pass(\$i, ScalarRef[Str]); should_fail(\$s, ScalarRef[Num]); should_pass(\$f, ScalarRef[Num]); should_pass(\$i, ScalarRef[Num]); should_fail(\$s, ScalarRef[Int]); should_fail(\$f, ScalarRef[Int]); should_pass(\$i, ScalarRef[Int]); should_pass(bless([], "Local::Class4"), Ref["ARRAY"]); should_pass(bless({}, "Local::Class4"), Ref["HASH"]); should_pass([], Ref["ARRAY"]); should_pass({}, Ref["HASH"]); should_fail(bless([], "Local::Class4"), Ref["HASH"]); should_fail(bless({}, "Local::Class4"), Ref["ARRAY"]); should_fail([], Ref["HASH"]); should_fail({}, Ref["ARRAY"]); like( exception { ArrayRef["Int"] }, qr{^Parameter to ArrayRef\[\`a\] expected to be a type constraint; got Int}, qq{ArrayRef["Int"] is not a valid type constraint}, ); like( exception { HashRef[[]] }, qr{^Parameter to HashRef\[\`a\] expected to be a type constraint; got ARRAY}, qq{HashRef[[]] is not a valid type constraint}, ); like( exception { ScalarRef[undef] }, qr{^Parameter to ScalarRef\[\`a\] expected to be a type constraint; got}, qq{ScalarRef[undef] is not a valid type constraint}, ); like( exception { Ref[{}] }, qr{^Parameter to Ref\[\`a\] expected to be string; got HASH}, qq{Ref[{}] is not a valid type constraint}, ); SKIP: { skip "requires Perl 5.8", 3 if $] < 5.008; ok( !!Num->check("Inf") == !Types::Standard::STRICTNUM, "'Inf' passes Num unless Types::Standard::STRICTNUM", ); ok( !!Num->check("-Inf") == !Types::Standard::STRICTNUM, "'-Inf' passes Num unless Types::Standard::STRICTNUM", ); ok( !!Num->check("Nan") == !Types::Standard::STRICTNUM, "'Nan' passes Num unless Types::Standard::STRICTNUM", ); } ok( !!Num->check("0.") == !Types::Standard::STRICTNUM, "'0.' passes Num unless Types::Standard::STRICTNUM", ); done_testing; Type-Tiny-0.022/t/01-compile.t0000644000175000017500000000220412161671331013770 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tiny, Type::Library, etc compile. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use_ok("Eval::TypeTiny"); use_ok("Exporter::TypeTiny"); use_ok("Test::TypeTiny"); use_ok("Type::Coercion"); use_ok("Type::Coercion::Union"); use_ok("Type::Exception"); use_ok("Type::Exception::Assertion"); use_ok("Type::Exception::Compilation"); use_ok("Type::Exception::WrongNumberOfParameters"); use_ok("Type::Library"); use_ok("Types::Standard"); use_ok("Types::TypeTiny"); use_ok("Type::Tiny"); use_ok("Type::Tiny::Class"); use_ok("Type::Tiny::Duck"); use_ok("Type::Tiny::Enum"); use_ok("Type::Tiny::Intersection"); use_ok("Type::Tiny::Role"); use_ok("Type::Tiny::Union"); use_ok("Type::Utils"); use_ok("Type::Params"); BAIL_OUT("Further tests rely on all modules compiling.") unless "Test::Builder"->new->is_passing; done_testing; Type-Tiny-0.022/t/02-api.t0000644000175000017500000000507612161671331013124 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tiny and Type::Coercion provide a Moose/Mouse-compatible API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; my $HAVE_MOOSE = eval { require Moose }; my @MOOSE_WANTS = qw( _actually_compile_type_constraint _collect_all_parents _compile_hand_optimized_type_constraint _compile_subtype _compile_type _compiled_type_constraint _default_message _has_compiled_type_constraint _has_inlined_type_constraint _inline_check _inline_environment _new _package_defined_in _set_constraint assert_coerce assert_valid can_be_inlined check coerce coercion compile_type_constraint constraint create_child_type equals get_message hand_optimized_type_constraint has_coercion has_hand_optimized_type_constraint has_message has_parent inline_environment inlined is_a_type_of is_subtype_of message meta name new parent parents validate ); my $HAVE_MOUSE = eval { require Mouse }; my @MOUSE_WANTS = qw( __is_parameterized _add_type_coercions _as_string _compiled_type_coercion _compiled_type_constraint _identity _unite assert_valid check coerce compile_type_constraint create_child_type get_message has_coercion is_a_type_of message name new parameterize parent type_parameter ); require Type::Tiny; my $type = "Type::Tiny"->new(name => "TestType"); for (@MOOSE_WANTS) { SKIP: { skip "Moose::Meta::TypeConstraint PRIVATE API: '$_'", 1 if /^_/ && !$HAVE_MOOSE; ok($type->can($_), "Moose::Meta::TypeConstraint API: $type->can('$_')"); } } for (@MOUSE_WANTS) { SKIP: { skip "Mouse::Meta::TypeConstraint PRIVATE API: '$_'", 1 if /^_/ && !$HAVE_MOUSE; ok($type->can($_), "Mouse::Meta::TypeConstraint API: $type->can('$_')"); } } my @MOOSE_WANTS_COERCE = qw( _compiled_type_coercion _new add_type_coercions coerce compile_type_coercion has_coercion_for_type meta new type_coercion_map type_constraint ); require Type::Coercion; my $coerce = "Type::Coercion"->new(name => "TestCoercion"); for (@MOOSE_WANTS_COERCE) { SKIP: { skip "Moose::Meta::TypeCoercion PRIVATE API: '$_'", 1 if /^_/ && !$HAVE_MOOSE; ok($coerce->can($_), "Moose::Meta::TypeCoercion API: $coerce->can('$_')"); } } BAIL_OUT("Further tests rely on the Type::Tiny and Type::Coercion APIs.") unless "Test::Builder"->new->is_passing; done_testing; Type-Tiny-0.022/t/gh1.t0000755000175000017500000000152712161671331012613 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test that subtypes of Type::Tiny::Class work. =head1 SEE ALSO L, L. =head1 AUTHOR Richard Simões Ersimoes@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Richard Simões. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; use Type::Utils; use Math::BigFloat; my $pc = declare as class_type({ class => 'Math::BigFloat' }), where { 1 }; my $value = Math::BigFloat->new(0.5); ok $pc->($value); should_pass($value, $pc); should_fail(0.5, $pc); done_testing; Type-Tiny-0.022/t/stdlib-optlist.t0000644000175000017500000000271412161671331015105 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. Checks the standalone C coercion. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard qw( OptList MkOpt ); my $O = OptList; my $OM = OptList + MkOpt; should_pass([], $O); should_pass([[foo=>undef]], $O); should_pass([[foo=>[]]], $O); should_pass([[foo=>{}]], $O); should_pass([], $OM); should_pass([[foo=>undef]], $OM); should_pass([[foo=>[]]], $OM); should_pass([[foo=>{}]], $OM); should_fail([[undef]], $O); should_fail([[[]]], $O); should_fail([[{}]], $O); should_fail([[undef]], $OM); should_fail([[[]]], $OM); should_fail([[{}]], $OM); ok(!$O->has_coercion, "not $O has coercion"); ok($OM->has_coercion, "$OM has coercion"); is_deeply( $OM->coerce(undef), [], '$OM->coerce(undef)', ); is_deeply( $OM->coerce([]), [], '$OM->coerce([])', ); is_deeply( $OM->coerce([foo => {}, bar => "baz"]), [ [foo => {}], [bar => undef], [baz => undef], ], 'simple $OM coercion test', ); is_deeply( $OM->coerce({foo => []}), [ [foo => []], ], 'another simple $OM coercion test', ); done_testing; Type-Tiny-0.022/t/type-role.t0000644000175000017500000000164512161671331014052 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks role type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use BiggerLib qw( :types ); isa_ok(DoesQuux, "Type::Tiny", "DoesQuux"); isa_ok(DoesQuux, "Type::Tiny::Role", "DoesQuux"); should_fail("Foo::Bar"->new, DoesQuux); should_pass("Foo::Baz"->new, DoesQuux); should_fail(undef, DoesQuux); should_fail({}, DoesQuux); should_fail(FooBar, DoesQuux); should_fail(FooBaz, DoesQuux); should_fail(DoesQuux, DoesQuux); should_fail("Quux", DoesQuux); done_testing; Type-Tiny-0.022/t/subquote.t0000644000175000017500000000515412161671331014000 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check type constraints can be made inlinable using L. =head1 DEPENDENCIES Test is skipped if Sub::Quote is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires "Sub::Quote"; use Test::TypeTiny; use Sub::Quote; use Type::Tiny; use Types::Standard qw(Int); my $Type1 = "Type::Tiny"->new( name => "Type1", constraint => quote_sub q{ $_[0] eq q(42) }, ); should_fail(41, $Type1); should_pass(42, $Type1); ok($Type1->can_be_inlined, 'constraint built using quote_sub and $_[0] can be inlined') and note $Type1->inline_check('$value'); my $Type2 = "Type::Tiny"->new( name => "Type2", constraint => quote_sub q{ $_ eq q(42) }, ); should_fail(41, $Type2); should_pass(42, $Type2); ok($Type2->can_be_inlined, 'constraint built using quote_sub and $_[0] can be inlined') and note $Type2->inline_check('$value'); my $Type3 = "Type::Tiny"->new( name => "Type3", constraint => quote_sub q{ my ($n) = @_; $n eq q(42) }, ); should_fail(41, $Type3); should_pass(42, $Type3); ok($Type3->can_be_inlined, 'constraint built using quote_sub and @_ can be inlined') and note $Type3->inline_check('$value'); my $Type4 = "Type::Tiny"->new( name => "Type4", parent => Int, constraint => quote_sub q{ $_[0] >= 42 }, ); should_fail(41, $Type4); should_pass(42, $Type4); should_pass(43, $Type4); should_fail(44.4, $Type4); ok($Type4->can_be_inlined, 'constraint built using quote_sub and parent type can be inlined') and note $Type4->inline_check('$value'); my $Type5 = "Type::Tiny"->new( name => "Type5", parent => Int, constraint => quote_sub q{ $_[0] >= $x }, { '$x' => \42 }, ); should_fail(41, $Type5); should_pass(42, $Type5); should_pass(43, $Type5); should_fail(44.4, $Type5); TODO: { local $TODO = "captures not supported yet"; ok($Type5->can_be_inlined, 'constraint built using quote_sub and captures can be inlined'); }; my $Type6 = "Type::Tiny"->new( name => "Type6", parent => Int->create_child_type(constraint => sub { 999 }), constraint => quote_sub q{ $_[0] >= 42 }, ); should_fail(41, $Type6); should_pass(42, $Type6); should_pass(43, $Type6); should_fail(44.4, $Type6); ok(!$Type6->can_be_inlined, 'constraint built using quote_sub and non-inlinable parent cannot be inlined'); done_testing; Type-Tiny-0.022/t/rt86239.t0000644000175000017500000000230212161671331013162 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Fix: Optional constraints ignored if wrapped in Dict. =head1 SEE ALSO L. =head1 AUTHOR Vyacheslav Matyukhin Emmcleric@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Vyacheslav Matyukhin. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(validate compile); use Types::Standard qw(ArrayRef Dict Optional Str); my $i = 0; sub announce { note sprintf("Test %d ########", ++$i) } sub got { note "got: " . join ", ", explain(@_) } sub f { announce(); got validate( \@_, Optional[Str], ); } is exception { f("foo") }, undef; is exception { f() }, undef; like exception { f(["abc"]) }, qr/type constraint/; sub g { announce(); got validate( \@_, Dict[foo => Optional[Str]], ); } is exception { g({ foo => "foo" }) }, undef; is exception { g({}) }, undef; like exception { g({ foo => ["abc"] }) }, qr/type constraint/; done_testing; Type-Tiny-0.022/t/coercions-parameterized.t0000644000175000017500000000521512173333046016746 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks the C and C parameterized coercions from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use utf8; use Test::More; use Test::Requires { "Encode" => 0 }; use Test::TypeTiny; use Encode; use Types::Standard qw( Str ArrayRef Join Split ); use Type::Utils; my $chars = "Café Paris|Garçon"; my $bytes_utf8 = Encode::encode("utf-8", $chars); my $bytes_western = Encode::encode("iso-8859-1", $chars); is(length($chars), 17, 'length $chars == 17'); is(length($bytes_utf8), 19, 'length $bytes_utf8 == 19'); is(length($bytes_western), 17, 'length $bytes_western == 17'); my $SplitSpace = (ArrayRef[Str]) + (Split[qr/\s/]); my $SplitPipe = (ArrayRef[Str]) + (Split[qr/\|/]); ok($SplitSpace->can_be_inlined, '$SplitSpace can be inlined'); ok($SplitPipe->can_be_inlined, '$SplitPipe can be inlined'); is_deeply( $SplitSpace->coerce($chars), [ "Café", "Paris|Garçon" ], '$SplitSpace->coerce($chars)', ); is_deeply( $SplitSpace->coerce($bytes_utf8), [ map Encode::encode("utf-8", $_), "Café", "Paris|Garçon" ], '$SplitSpace->coerce($bytes_utf8)', ); is_deeply( $SplitSpace->coerce($bytes_western), [ map Encode::encode("iso-8859-1", $_), "Café", "Paris|Garçon" ], '$SplitSpace->coerce($bytes_western)', ); should_pass($SplitSpace->coerce($chars), ArrayRef[Str]); should_pass($SplitSpace->coerce($bytes_utf8), ArrayRef[Str]); should_pass($SplitSpace->coerce($bytes_western), ArrayRef[Str]); is_deeply( my $arr_chars = $SplitPipe->coerce($chars), [ "Café Paris", "Garçon" ], '$SplitPipe->coerce($chars)', ); is_deeply( my $arr_bytes_utf8 = $SplitPipe->coerce($bytes_utf8), [ map Encode::encode("utf-8", $_), "Café Paris", "Garçon" ], '$SplitPipe->coerce($bytes_utf8)', ); is_deeply( my $arr_bytes_western = $SplitPipe->coerce($bytes_western), [ map Encode::encode("iso-8859-1", $_), "Café Paris", "Garçon" ], '$SplitPipe->coerce($bytes_western)', ); my $JoinPipe = Str + Join["|"]; is( $_ = $JoinPipe->coerce($arr_chars), $chars, '$JoinPipe->coerce($arr_chars)', ); should_pass($_, Str); is( $_ = $JoinPipe->coerce($arr_bytes_utf8), $bytes_utf8, '$JoinPipe->coerce($arr_bytes_utf8)', ); should_pass($_, Str); is( $_ = $JoinPipe->coerce($arr_bytes_western), $bytes_western, '$JoinPipe->coerce($arr_bytes_western)', ); should_pass($_, Str); done_testing; Type-Tiny-0.022/t/oo-objectaccessor.t0000644000175000017500000000250212161671331015527 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. =head1 DEPENDENCIES Test is skipped if Object::Accessor 0.30 is not available. =head1 CAVEATS As of Perl 5.17.x, the Object::Accessor module is being de-cored, so will issue deprecation warnings. These can safely be ignored for the purposes of this test case. Object::Accessor from CPAN does not have these warnings. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); # Avoid warnings about core version of Object::Accessor in Perl 5.18 no warnings qw(deprecated); use Test::More; use Test::Requires { "Object::Accessor" => 0.30 }; use Test::Fatal; use Types::Standard "Int"; use Object::Accessor; my $obj = Object::Accessor->new; $obj->mk_accessors( { foo => Int->compiled_check }, ); $obj->foo(12); is($obj->foo, 12, 'write then read on accessor works'); my $e = exception { local $Object::Accessor::FATAL = 1; $obj->foo("Hello"); }; like($e, qr{^'Hello' is an invalid value for 'foo'}, 'exception thrown for bad value'); done_testing; Type-Tiny-0.022/t/moo.t0000644000175000017500000000300212161671331012711 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. Checks values that should pass and should fail; checks error messages. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moo 1.001000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moo => 1.001000 }; use Test::Fatal; { package Local::Class; use Moo; use BiggerLib ":all"; has small => (is => "ro", isa => SmallInteger); has big => (is => "ro", isa => BigInteger); } is( exception { "Local::Class"->new(small => 9, big => 12) }, undef, "some values that should pass their type constraint", ); like( exception { "Local::Class"->new(small => 100) }, qr{^100 is too big}, "direct violation of type constraint", ); like( exception { "Local::Class"->new(small => 5.5) }, qr{^5.5 is too big}, "violation of parent type constraint", ); like( exception { "Local::Class"->new(small => "five point five") }, qr{^five point five is too big}, "violation of grandparent type constraint", ); like( exception { "Local::Class"->new(small => []) }, qr{^ARRAY\(\w+\) is too big}, "violation of great-grandparent type constraint", ); done_testing; Type-Tiny-0.022/t/type-duck.t0000644000175000017500000000201012161671331014022 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks duck type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use BiggerLib qw( :types ); isa_ok(CanFooBar, "Type::Tiny", "CanFooBar"); isa_ok(CanFooBaz, "Type::Tiny::Duck", "CanFooBar"); should_pass("Foo::Bar"->new, CanFooBar); should_fail("Foo::Bar"->new, CanFooBaz); should_pass("Foo::Baz"->new, CanFooBar); should_pass("Foo::Baz"->new, CanFooBaz); should_fail(undef, CanFooBar); should_fail({}, CanFooBar); should_fail(FooBar, CanFooBar); should_fail(FooBaz, CanFooBar); should_fail(CanFooBar, CanFooBar); should_fail("Foo::Bar", CanFooBar); done_testing; Type-Tiny-0.022/t/params-mixednamed.t0000644000175000017500000000177512161671331015532 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L usage with mix of positional and named parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types, "slurpy"; my $chk = compile(ClassName, slurpy Dict[ foo => Int, bar => Str, baz => ArrayRef, ]); is_deeply( [ $chk->("Type::Tiny", foo => 1, bar => "Hello", baz => []) ], [ "Type::Tiny", { foo => 1, bar => "Hello", baz => [] } ] ); is_deeply( [ $chk->("Type::Tiny", bar => "Hello", baz => [], foo => 1) ], [ "Type::Tiny", { foo => 1, bar => "Hello", baz => [] } ] ); like( exception { $chk->("Type::Tiny", foo => 1, bar => "Hello") }, qr{did not pass type constraint "Dict}, ); done_testing; Type-Tiny-0.022/t/params-carping.t0000644000175000017500000000163012161671331015030 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L' interaction with L: use Type::Params compile => { confess => 1 }; =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params compile => { confess => 1 }; use Types::Standard qw(Int); my $check; #line 1 "testsub1.chunk" sub testsub1 { $check ||= compile(Int); [ $check->(@_) ]; } #line 1 "testsub2.chunk" sub testsub2 { testsub1(@_); } #line 52 "params-carping.t" my $e = exception { testsub2(1.1); }; isa_ok($e, 'Type::Exception'); like( $e, qr{^Value "1\.1" did not pass type constraint "Int" \(in \$_\[0\]\)}, ); done_testing; Type-Tiny-0.022/t/type-enum.t0000644000175000017500000000206612175703721014057 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks enum type constraints work. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Type::Utils qw< enum >; use constant FBB => enum(FBB => [qw/foo bar baz/]); isa_ok(FBB, "Type::Tiny", "FBB"); isa_ok(FBB, "Type::Tiny::Enum", "FBB"); should_pass("foo", FBB); should_pass("bar", FBB); should_pass("baz", FBB); should_fail("quux", FBB); should_fail(" foo", FBB); should_fail("foo\n", FBB); should_fail("\nfoo", FBB); should_fail("\nfoo\n", FBB); should_fail("foo|", FBB); should_fail("|foo", FBB); should_fail(undef, FBB); should_fail({}, FBB); should_fail(\$_, FBB) for "foo", "bar", "baz"; is_deeply( [sort @{FBB->values}], [sort qw/foo bar baz/], 'FBB->values works', ); done_testing; Type-Tiny-0.022/t/library-is.t0000644000175000017500000000220712161671331014202 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks that the check functions exported by a type library work as expected. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use BiggerLib qw( :is ); ok is_String("rats"), "is_String works (value that should pass)"; ok !is_String([]), "is_String works (value that should fail)"; ok is_Number(5.5), "is_Number works (value that should pass)"; ok !is_Number("rats"), "is_Number works (value that should fail)"; ok is_Integer(5), "is_Integer works (value that should pass)"; ok !is_Integer(5.5), "is_Integer works (value that should fail)"; ok is_SmallInteger(5), "is_SmallInteger works (value that should pass)"; ok !is_SmallInteger(12), "is_SmallInteger works (value that should fail)"; done_testing; Type-Tiny-0.022/t/lib/0000755000175000017500000000000012200124456012500 5ustar taitaiType-Tiny-0.022/t/lib/DemoLib.pm0000644000175000017500000000143212161671331014356 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Type library used in several test cases. Defines types C, C and C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut package DemoLib; use strict; use warnings; use Scalar::Util "looks_like_number"; use Type::Utils; use base "Type::Library"; declare "String", where { not ref $_ } message { "is not a string" }; declare "Number", as "String", where { looks_like_number $_ }, message { "'$_' doesn't look like a number" }; declare "Integer", as "Number", where { $_ eq int($_) }; 1; Type-Tiny-0.022/t/lib/BiggerLib.pm0000644000175000017500000000346412161671331014700 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Type library used in several test cases. Defines types C, C and C. Defines classes C and C along with correponding C and C class type constraints; defines role C and the C role type constraint. Library extends DemoLib.pm. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut package BiggerLib; use strict; use warnings; use Type::Utils qw(:all); use base "Type::Library"; extends "DemoLib"; extends "Types::Standard"; declare "SmallInteger", as "Integer", where { no warnings; $_ < 10 } message { no warnings; "$_ is too big" }; declare "BigInteger", as "Integer", where { no warnings; $_ >= 10 }; { package Quux; our $VERSION = 1; } role_type "DoesQuux", { role => "Quux" }; { package Foo::Bar; sub new { my $c = shift; bless {@_}, $c } sub foo { 1 } sub bar { 2 } } class_type "FooBar", { class => "Foo::Bar" }; { package Foo::Baz; use base "Foo::Bar"; sub DOES { return 1 if $_[1] eq 'Quux'; $_[0]->isa($_[0]); } sub foo { 3 } sub baz { 4 } } class_type "FooBaz", { class => "Foo::Baz" }; duck_type "CanFooBar", [qw/ foo bar /]; duck_type "CanFooBaz", [qw/ foo baz /]; coerce "SmallInteger", from BigInteger => via { abs($_) % 10 }, from ArrayRef => via { 1 }; coerce "BigInteger", from SmallInteger => via { abs($_) + 10 }, from ArrayRef => via { 100 }; declare_coercion "ArrayRefFromAny", to_type "ArrayRef", from "Any", q { [$_] }; declare_coercion "ArrayRefFromPiped", to_type "ArrayRef", from "Str", q { [split /\\|/] }; 1; Type-Tiny-0.022/t/coercion-union.t0000644000175000017500000000443412161671331015060 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks Type::Coercion::Union works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard -types; use Type::Utils; my $RoundedInteger = declare RoundedInteger => as Int; $RoundedInteger->coercion->add_type_coercions(Num, 'int($_)'); should_pass("4", $RoundedInteger); should_fail("1.1", $RoundedInteger); should_fail("xyz", $RoundedInteger); my $String3 = declare String3 => as StrMatch[qr/^.{3}$/]; $String3->coercion->add_type_coercions(Str, 'substr("$_ ", 0, 3)'); should_pass("xyz", $String3); should_fail("x", $String3); should_fail("wxyz", $String3); my $Union1 = union Union1 => [$RoundedInteger, $String3]; should_pass("3.4", $Union1); should_pass("30", $Union1); should_fail("3.12", $Union1); should_fail("wxyz", $Union1); is( $RoundedInteger->coerce("3.4"), "3", "RoundedInteger coerces from Num", ); is( $RoundedInteger->coerce("xyz"), "xyz", "RoundedInteger does not coerce from Str", ); is( $String3->coerce("30"), "30 ", "String3 coerces from Str", ); my $arr = []; is( $String3->coerce($arr), $arr, "String3 does not coerce from ArrayRef", ); ok( $Union1->has_coercion, "unions automatically have a coercion if their child constraints do", ); note $Union1->coercion->inline_coercion('$X'); ok( union([Str, ArrayRef]), "unions do not automatically have a coercion if their child constraints do not", ); is( $Union1->coerce("4"), "4", "Union1 does not need to coerce an Int", ); is( $Union1->coerce("xyz"), "xyz", "Union1 does not need to coerce a String3", ); is( $Union1->coerce("3.1"), "3.1", "Union1 does not need to coerce a String3, even if it looks like a Num", ); is( $Union1->coerce("abcde"), "abc", "Union1 coerces Str -> String3", ); is( $Union1->coerce("3.123"), "3", "given the choice of two valid coercions, Union1 prefers RoundedInteger because it occurs sooner", ); is( $Union1->coerce($arr), $arr, "Union1 cannot coerce an arrayref", ); done_testing; Type-Tiny-0.022/t/eval-lexicalsubs.t0000644000175000017500000000431612172157467015406 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Tests L with experimental lexical subs. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires 'v5.18'; use Test::Fatal; use Eval::TypeTiny; my $variable; my %env = ( '$foo' => do { my $x = "foo"; \$x }, '@bar' => [ "bar" ], '%baz' => { "baz" => "1" }, '&quux' => sub { $variable }, '&quuux' => sub { $variable + 40 }, ); my $source = <<'SRC'; sub { return $foo if $_[0] eq '$foo'; return @bar if $_[0] eq '@bar'; return %baz if $_[0] eq '%baz'; return quux() if $_[0] eq '&quux'; return quuux if $_[0] eq '&quuux'; return; } SRC my $closure = eval_closure(source => $source, environment => \%env); is_deeply( [ $closure->('$foo') ], [ 'foo' ], 'closure over scalar', ); is_deeply( [ $closure->('@bar') ], [ 'bar' ], 'closure over array', ); is_deeply( [ $closure->('%baz') ], [ 'baz' => 1 ], 'closure over hash', ); is_deeply( [ $closure->('&quux') ], [ undef ], 'closure over lexical sub - undef', ); $variable = 2; is_deeply( [ $closure->('&quux') ], [ 2 ], 'closure over lexical sub - 2', ); is_deeply( [ $closure->('&quuux') ], [ 42 ], 'closure over lexical sub - 42', ); my $e = exception { eval_closure(source => 'sub { 1 ]') }; isa_ok( $e, 'Type::Exception::Compilation', '$e', ); like( $e, qr{^Failed to compile source because: syntax error}, 'throw exception when code does not compile', ); like( $e->errstr, qr{^syntax error}, '$e->errstr', ); like( $e->code, qr{sub \{ 1 \]}, '$e->code', ); my $c1 = eval_closure(source => 'sub { die("BANG") }', description => 'test1'); my $e1 = exception { $c1->() }; like( $e1, qr{^BANG at test1 line 1}, '"description" option works', ); my $c2 = eval_closure(source => 'sub { die("BANG") }', description => 'test2', line => 222); my $e2 = exception { $c2->() }; like( $e2, qr{^BANG at test2 line 222}, '"line" option works', ); done_testing; Type-Tiny-0.022/t/stdlib-overload.t0000644000175000017500000000212312161671331015214 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard qw( Any Item Defined Ref ArrayRef Object Overload ); my $o = bless [] => do { package Local::Class; use overload q[&] => sub { 1 }, fallback => 1; __PACKAGE__; }; should_pass($o, Any); should_pass($o, Item); should_pass($o, Defined); should_pass($o, Ref); should_pass($o, Ref["ARRAY"]); should_pass($o, Object); should_pass($o, Overload); should_pass($o, Overload["&"]); should_fail($o, Ref["HASH"]); should_fail($o, Overload["|"]); should_fail("Local::Class", Overload); should_fail([], Overload); ok_subtype($_, Overload["&"]) for Item, Defined, Ref, Object, Overload; done_testing; Type-Tiny-0.022/t/stdlib-structures.t0000644000175000017500000000704112176136132015631 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks various values against structured types from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard -all, "slurpy"; my $struct1 = Map[Int, Num]; should_pass({1=>111,2=>222}, $struct1); should_pass({1=>1.1,2=>2.2}, $struct1); should_fail({1=>"Str",2=>222}, $struct1); should_fail({1.1=>1,2=>2.2}, $struct1); my $struct2 = Tuple[Int, Num, Optional([Int]), slurpy ArrayRef[Num]]; my $struct3 = Tuple[Int, Num, Optional[Int]]; should_pass([1, 1.1], $struct2); should_pass([1, 1.1, 2], $struct2); should_pass([1, 1.1, 2, 2.2], $struct2); should_pass([1, 1.1, 2, 2.2, 2.3], $struct2); should_pass([1, 1.1, 2, 2.2, 2.3, 2.4], $struct2); should_fail({}, $struct2); should_fail([], $struct2); should_fail([1], $struct2); should_fail([1.1, 1.1], $struct2); should_fail([1, 1.1, 2.1], $struct2); should_fail([1, 1.1, 2.1], $struct2); should_fail([1, 1.1, 2, 2.2, 2.3, 2.4, "xyz"], $struct2); should_fail([1, 1.1, undef], $struct2); should_pass([1, 1.1], $struct3); should_pass([1, 1.1, 2], $struct3); should_fail([1, 1.1, 2, 2.2], $struct3); should_fail([1, 1.1, 2, 2.2, 2.3], $struct3); should_fail([1, 1.1, 2, 2.2, 2.3, 2.4], $struct3); should_fail({}, $struct3); should_fail([], $struct3); should_fail([1], $struct3); should_fail([1.1, 1.1], $struct3); should_fail([1, 1.1, 2.1], $struct3); should_fail([1, 1.1, 2.1], $struct3); should_fail([1, 1.1, 2, 2.2, 2.3, 2.4, "xyz"], $struct3); should_fail([1, 1.1, undef], $struct3); my $struct4 = Dict[ name => Str, age => Int, height => Optional[Num] ]; should_pass({ name => "Bob", age => 40, height => 1.76 }, $struct4); should_pass({ name => "Bob", age => 40 }, $struct4); should_fail({ name => "Bob" }, $struct4); should_fail({ age => 40 }, $struct4); should_fail({ name => "Bob", age => 40.1 }, $struct4); should_fail({ name => "Bob", age => 40, weight => 80.3 }, $struct4); should_fail({ name => "Bob", age => 40, height => 1.76, weight => 80.3 }, $struct4); should_fail({ name => "Bob", age => 40, height => "xyz" }, $struct4); should_fail({ name => "Bob", age => 40, height => undef }, $struct4); should_fail({ name => "Bob", age => undef, height => 1.76 }, $struct4); my $opt1 = Optional[Int]; ok( $opt1->check(), "$opt1 check ()"); ok( $opt1->check(1), "$opt1 check (1)"); TODO: { local $TODO = "`exists \$arr[\$idx]` behaves oddly in all versions of Perl"; ok(!$opt1->check(undef), "$opt1 check (undef)"); }; ok(!$opt1->check('xxx'), "$opt1 check ('xxx')"); my $slurper = Tuple[ArrayRef, slurpy Map[Num, Int]]; should_pass([ [], 1.1 => 1, 2.1 => 2 ], $slurper); should_pass([ [] ], $slurper); should_fail([ [], 1.1 => 1, xxx => 2 ], $slurper); should_fail([ [], 1.1 => 1, 2.1 => undef ], $slurper); my $struct5 = Dict[ i => Maybe[Int], b => Bool ]; should_pass({ i => 42, b => undef }, $struct5); should_pass({ i => 42, b => '' }, $struct5); should_pass({ i => 42, b => 0 }, $struct5); should_pass({ i => 42, b => 1 }, $struct5); should_pass({ i => undef, b => 1 }, $struct5); should_fail({ b => 42, i => 1 }, $struct5); should_fail({ i => 42 }, $struct5); should_fail({ b => 1 }, $struct5); should_fail({ i => 42, b => 1, a => 1 }, $struct5); should_fail({ i => 42, a => 1 }, $struct5); should_fail({ a => 42, b => 1 }, $struct5); done_testing; Type-Tiny-0.022/t/coercion-classy.t0000644000175000017500000000443412161671331015226 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks the C's C method. =head1 DEPENDENCIES Requires Moose 2.00; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use utf8; use Test::More; use Test::Requires { Moose => 2.00 }; use Test::TypeTiny; my ($Address, $Person); BEGIN { package Address; use Moose; use Types::Standard qw( Str ); use Type::Utils; has [qw/ line1 line2 town county postcode country /] => ( is => "ro", isa => Str, ); sub _new_from_array { my $class = shift; my @addr = ref($_[0]) ? @{$_[0]} : @_; $class->new( line1 => $addr[0], line2 => $addr[1], town => $addr[2], county => $addr[3], postcode => $addr[4], country => $addr[5], ); } $Address = class_type { class => __PACKAGE__ }; }; BEGIN { package Person; use Moose; use Types::Standard qw( Str Join Tuple HashRef ); use Type::Utils; has name => ( required => 1, coerce => 1, is => "ro", isa => Str + Join[" "], ); has addr => ( coerce => 1, is => "ro", isa => $Address->plus_constructors( (Tuple[(Str) x 6]) => "_new_from_array", (HashRef) => "new", ), ); sub _new_from_name { my $class = shift; my ($name) = @_; $class->new(name => $name); } $Person = class_type { class => __PACKAGE__ }; }; ok( "Person"->meta->get_attribute("addr")->type_constraint->is_a_type_of($Address), q["Person"->meta->get_attribute("addr")->type_constraint->is_a_type_of($Address)], ); my $me = Person->new( name => ["Toby", "Inkster"], addr => ["Flat 2, 39 Hartington Road", "West Ealing", "LONDON", "", "W13 8QL", "United Kingdom"], ); my $me2 = Person->new( name => "Toby Inkster", addr => Address->new( line1 => "Flat 2, 39 Hartington Road", line2 => "West Ealing", town => "LONDON", county => "", postcode => "W13 8QL", country => "United Kingdom", ), ); is_deeply($me, $me2, 'coercion worked'); done_testing; Type-Tiny-0.022/t/stdlib-tied.t0000644000175000017500000000436512172321267014342 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard qw( Tied HashRef ); use Type::Utils qw( class_type ); my $a = do { package MyTie::Array; require Tie::Array; our @ISA = qw(Tie::StdArray); tie my(@A), __PACKAGE__; \@A; }; my $h = do { package MyTie::Hash; require Tie::Hash; our @ISA = qw(Tie::StdHash); tie my(%H), __PACKAGE__; \%H }; my $S; my $s = do { package MyTie::Scalar; require Tie::Scalar; our @ISA = qw(Tie::StdScalar); tie $S, __PACKAGE__; \$S; }; should_pass($a, Tied); should_pass($h, Tied); should_pass($s, Tied); should_fail($S, Tied); should_pass($a, Tied["MyTie::Array"]); should_fail($h, Tied["MyTie::Array"]); should_fail($s, Tied["MyTie::Array"]); should_fail($a, Tied["MyTie::Hash"]); should_pass($h, Tied["MyTie::Hash"]); should_fail($s, Tied["MyTie::Hash"]); should_fail($a, Tied["MyTie::Scalar"]); should_fail($h, Tied["MyTie::Scalar"]); should_pass($s, Tied["MyTie::Scalar"]); should_pass($a, Tied[ class_type MyTieArray => { class => "MyTie::Array" } ]); should_fail($h, Tied[ class_type MyTieArray => { class => "MyTie::Array" } ]); should_fail($s, Tied[ class_type MyTieArray => { class => "MyTie::Array" } ]); should_fail($a, Tied[ class_type MyTieHash => { class => "MyTie::Hash" } ]); should_pass($h, Tied[ class_type MyTieHash => { class => "MyTie::Hash" } ]); should_fail($s, Tied[ class_type MyTieHash => { class => "MyTie::Hash" } ]); should_fail($a, Tied[ class_type MyTieScalar => { class => "MyTie::Scalar" } ]); should_fail($h, Tied[ class_type MyTieScalar => { class => "MyTie::Scalar" } ]); should_pass($s, Tied[ class_type MyTieScalar => { class => "MyTie::Scalar" } ]); my $intersection = (Tied) & (HashRef); should_pass($h, $intersection); should_fail($a, $intersection); should_fail($s, $intersection); should_fail({foo=>2}, $intersection); done_testing; Type-Tiny-0.022/t/moo-inflation.t0000644000175000017500000000410112161671331014673 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks that type constraints continue to work when a L class is inflated to a L class. Checks that Moo::HandleMoose correctly calls back to Type::Tiny to build Moose type constraints. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moo 1.001000 is not available. Test is redundant if Moose 2.0000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moo => 1.001000 }; use Test::Fatal; { package Local::Class; use Moo; use BiggerLib ":all"; has small => (is => "ro", isa => SmallInteger); has big => (is => "ro", isa => BigInteger); } note explain(\%Moo::HandleMoose::TYPE_MAP); my $state = "Moose is not loaded"; for (0..1) { is( exception { "Local::Class"->new(small => 9, big => 12) }, undef, "some values that should pass their type constraint - $state", ); ok( exception { "Local::Class"->new(small => 100) }, "direct violation of type constraint - $state", ); ok( exception { "Local::Class"->new(small => 5.5) }, "violation of parent type constraint - $state", ); ok( exception { "Local::Class"->new(small => "five point five") }, "violation of grandparent type constraint - $state", ); ok( exception { "Local::Class"->new(small => []) }, "violation of great-grandparent type constraint - $state", ); eval q{ require Moose; Moose->VERSION(2.0000); "Local::Class"->meta->get_attribute("small"); "Local::Class"->meta->get_attribute("big"); $state = "Moose is loaded"; }; } $state eq 'Moose is loaded' ? is( "Local::Class"->meta->get_attribute("small")->type_constraint->name, "SmallInteger", "type constraint metaobject inflates from Moo to Moose", ) : pass("redundant test"); done_testing; Type-Tiny-0.022/t/moosextypes-more.t0000644000175000017500000000326512162071426015471 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE More checks between Type::Tiny and L. This started out as an example of making a parameterized C<< Not[] >> type constraint, but worked out as a nice test case. =head1 DEPENDENCIES MooseX::Types 0.35; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::Types::Moose" => "0.35" }; use Test::TypeTiny; BEGIN { package MooseX::Types::Not; use Type::Library -base; use Types::TypeTiny; __PACKAGE__->add_type({ name => "Not", constraint => sub { !!0 }, inlined => sub { "!!0" }, constraint_generator => sub { Types::TypeTiny::to_TypeTiny(shift)->complementary_type }, }); $INC{"MooseX/Types/Not.pm"} = __FILE__; }; use MooseX::Types::Not qw(Not); use MooseX::Types::Moose qw(Int); isa_ok($_, "Moose::Meta::TypeConstraint", "$_") for Not, Int, Not[Int], Not[Not[Int]]; should_fail(1.1, Int); should_fail(undef, Int); should_fail([], Int); should_pass(2, Int); should_pass(1.1, Not[Int]); should_pass(undef, Not[Int]); should_pass([], Not[Int]); should_fail(2, Not[Int]); should_fail(1.1, Not[Not[Int]]); should_fail(undef, Not[Not[Int]]); should_fail([], Not[Not[Int]]); should_pass(2, Not[Not[Int]]); # 'Not' alone behaves as 'Not[Any]' should_fail(1.1, Not); should_fail(undef, Not); should_fail([], Not); should_fail(2, Not); done_testing; Type-Tiny-0.022/t/params-named.t0000644000175000017500000000227112161671331014473 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L usage with named parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types, "slurpy"; my $chk = compile slurpy Dict[ foo => Int, bar => Str, baz => ArrayRef, ]; is_deeply( [ $chk->(foo => 1, bar => "Hello", baz => []) ], [ { foo => 1, bar => "Hello", baz => [] } ] ); is_deeply( [ $chk->(bar => "Hello", baz => [], foo => 1) ], [ { foo => 1, bar => "Hello", baz => [] } ] ); like( exception { $chk->(foo => 1, bar => "Hello") }, qr{did not pass type constraint "Dict}, ); my $chk2 = compile slurpy Dict[ foo => Int, bar => Str, baz => Optional[ArrayRef], ]; is_deeply( [ $chk2->(foo => 1, bar => "Hello") ], [ { foo => 1, bar => "Hello" } ] ); like( exception { $chk2->(foo => 1, bar => "Hello", zab => []) }, qr{did not pass type constraint "Dict}, ); done_testing; Type-Tiny-0.022/t/dwim-moose.t0000644000175000017500000000317412166031123014203 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks Moose type constraints, and L type constraints are picked up by C from L. =head1 DEPENDENCIES Moose 2.0600 and MooseX::Types 0.35; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "Moose" => "2.0600" }; use Test::Requires { "MooseX::Types" => "0.35" }; use Test::TypeTiny; use Moose; use Moose::Util::TypeConstraints qw(:all); use Type::Utils 0.015 qw(dwim_type); # Creating a type constraint with Moose subtype "Two", as "Int", where { $_ eq 2 }; my $two = dwim_type("Two"); my $twos = dwim_type("ArrayRef[Two]"); isa_ok($two, 'Type::Tiny', '$two'); isa_ok($twos, 'Type::Tiny', '$twos'); should_pass(2, $two); should_fail(3, $two); should_pass([2, 2, 2], $twos); should_fail([2, 3, 2], $twos); # Creating a type constraint with MooseX::Types { package MyTypes; use MooseX::Types -declare => ["Three"]; use MooseX::Types::Moose "Int"; subtype Three, as Int, where { $_ eq 3 }; } # Note that MooseX::Types namespace-prefixes its types. my $three = dwim_type("MyTypes::Three"); my $threes = dwim_type("ArrayRef[MyTypes::Three]"); isa_ok($three, 'Type::Tiny', '$three'); isa_ok($threes, 'Type::Tiny', '$threes'); should_pass(3, $three); should_fail(4, $three); should_pass([3, 3, 3], $threes); should_fail([3, 4, 3], $threes); done_testing; Type-Tiny-0.022/t/exporter.t0000644000175000017500000000441612161671331014001 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Tests L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; require Types::Standard; is( exception { "Types::Standard"->import("Any") }, undef, q {No exception exporting a legitimate function}, ); can_ok(main => "Any"); like( exception { "Types::Standard"->import("kghffubbtfui") }, qr{^Could not find sub 'kghffubbtfui' to export in package 'Types::Standard'}, q {Attempt to export a function which does not exist}, ); like( exception { "Types::Standard"->import("declare") }, qr{^Could not find sub 'declare' to export in package 'Types::Standard'}, q {Attempt to export a function which exists but not in @EXPORT_OK}, ); { my $hash = {}; "Types::Standard"->import({ into => $hash }, qw(-types)); is_deeply( [ sort keys %$hash ], [ sort "Types::Standard"->meta->type_names ], '"-types" shortcut works', ); }; { my $hash = {}; "Types::Standard"->import({ into => $hash }, qw(-coercions)); is_deeply( [ sort keys %$hash ], [ sort "Types::Standard"->meta->coercion_names ], '"-coercions" shortcut works', ); }; { my $hash = {}; "Types::Standard"->import({ into => $hash }, Str => { }); "Types::Standard"->import({ into => $hash }, Str => { -as => "String" }); "Types::Standard"->import({ into => $hash }, -types => { -prefix => "X_" }); "Types::Standard"->import({ into => $hash }, -types => { -suffix => "_Z" }); is($hash->{Str}, $hash->{String}, 'renaming works'); is($hash->{Str}, $hash->{X_Str}, 'prefixes work'); is($hash->{Str}, $hash->{Str_Z}, 'suffixes work'); }; { my $hash = {}; "Types::Standard"->import({ into => $hash }, qw(+Str)); is_deeply( [sort keys %$hash], [sort qw/ assert_Str to_Str is_Str Str /], 'plus notation works for Type::Library', ); }; my $opthash = Exporter::TypeTiny::mkopt_hash([ foo => [], "bar" ]); is_deeply( $opthash, { foo => [], bar => undef }, 'mkopt_hash', ) or diag explain($opthash); done_testing; Type-Tiny-0.022/t/library-types.t0000644000175000017500000000452312161671331014736 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks that the type functions exported by a type library work as expected. =head1 DEPENDENCIES Uses the bundled DemoLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use DemoLib -types; isa_ok String, "Type::Tiny", "String"; isa_ok Number, "Type::Tiny", "Number"; isa_ok Integer, "Type::Tiny", "Integer"; isa_ok DemoLib::String, "Type::Tiny", "DemoLib::String"; isa_ok DemoLib::Number, "Type::Tiny", "DemoLib::Number"; isa_ok DemoLib::Integer, "Type::Tiny", "DemoLib::Integer"; is(String."", "String", "String has correct stringification"); is(Number."", "Number", "Number has correct stringification"); is(Integer."", "Integer", "Integer has correct stringification"); is(DemoLib::String."", "String", "DemoLib::String has correct stringification"); is(DemoLib::Number."", "Number", "DemoLib::Number has correct stringification"); is(DemoLib::Integer."", "Integer", "DemoLib::Integer has correct stringification"); is( exception { Integer->(5) }, undef, "coderef overload (with value that should pass type constraint) does not die", ); is( Integer->(5), 5, "coderef overload returns correct value", ); like( exception { Integer->(5.5) }, qr{^Value "5\.5" did not pass type constraint "Integer"}, "coderef overload (value that should fail type constraint) dies", ); use DemoLib String => { -prefix => "foo", -as => "bar", -suffix => "baz", }; is(foobarbaz->qualified_name, "DemoLib::String", "Sub::Exporter-style export renaming"); ok( Integer eq Integer, 'eq works', ); use Types::Standard qw(ArrayRef Int); my $int = Int; my $arrayref = ArrayRef; my $arrayref_int = ArrayRef[Int]; is_deeply( [ 1, 2, Int, 3, 4 ], [ 1, 2, $int, 3, 4 ], 'type constant in list context', ); is_deeply( [ 1, 2, ArrayRef, 3, 4 ], [ 1, 2, $arrayref, 3, 4 ], 'parameterizable type constant in list context', ); is_deeply( [ 1, 2, ArrayRef[Int], 3, 4 ], [ 1, 2, $arrayref_int, 3, 4 ], 'parameterized type constant in list context', ); done_testing; Type-Tiny-0.022/t/coercion-automatic.t0000644000175000017500000001711712161671331015720 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE If a coercion exists for type C, then Type::Tiny should be able to auto-generate a coercion for type C<< ArrayRef[Foo] >>, etc. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Types::Standard qw( -types slurpy ); use Type::Utils; NONINLINED: { my $Foo = declare Foo => as Int; coerce $Foo, from Num, via { int($_) }; my $ArrayOfFoo = declare ArrayOfFoo => as ArrayRef[$Foo], coercion => 1; ok($ArrayOfFoo->has_coercion, '$ArrayOfFoo has coercion'); my $arr1 = [1..3]; my $arr2 = [1..3, "Hello"]; is( $ArrayOfFoo->coerce($arr1), $arr1, '$ArrayOfFoo does not coerce value that needs no coercion', ); is_deeply( $ArrayOfFoo->coerce([1.1, 2.1, 3.1]), [1, 2, 3], '$ArrayOfFoo does coerce value that can be coerced', ); is( $ArrayOfFoo->coerce($arr2), $arr2, '$ArrayOfFoo does not coerce value that cannot be coerced', ); my $HashOfFoo = HashRef[$Foo]; ok($HashOfFoo->has_coercion, '$HashOfFoo has coercion'); my $hsh1 = {one => 1, two => 2, three => 3}; my $hsh2 = {one => 1, two => 2, three => 3, greeting => "Hello"}; is( $HashOfFoo->coerce($hsh1), $hsh1, '$HashOfFoo does not coerce value that needs no coercion', ); is_deeply( $HashOfFoo->coerce({one => 1.1, two => 2.2, three => 3.3}), {one => 1, two => 2, three => 3}, '$HashOfFoo does coerce value that can be coerced', ); is( $HashOfFoo->coerce($hsh2), $hsh2, '$HashOfFoo does not coerce value that cannot be coerced', ); my $RefOfFoo = ScalarRef[$Foo]; ok($RefOfFoo->has_coercion, '$RefOfFoo has coercion'); my $ref1 = do { my $x = 1; \$x }; my $ref2 = do { my $x = "xxx"; \$x }; is( $RefOfFoo->coerce($ref1), $ref1, '$RefOfFoo does not coerce value that needs no coercion', ); is_deeply( ${ $RefOfFoo->coerce(do { my $x = 1.1; \$x }) }, 1, '$RefOfFoo does coerce value that can be coerced', ); is( $RefOfFoo->coerce($ref2), $ref2, '$RefOfFoo does not coerce value that cannot be coerced', ); }; INLINED: { my $Bar = declare Bar => as Int; coerce $Bar, from Num, q { int($_) }; my $ArrayOfBar = ArrayRef[$Bar]; ok($ArrayOfBar->has_coercion, '$ArrayOfBar has coercion'); ok($ArrayOfBar->coercion->can_be_inlined, '$ArrayOfBar coercion can be inlined'); my $arr1 = [1..3]; my $arr2 = [1..3, "Hello"]; is( $ArrayOfBar->coerce($arr1), $arr1, '$ArrayOfBar does not coerce value that needs no coercion', ); is_deeply( $ArrayOfBar->coerce([1.1, 2.1, 3.1]), [1, 2, 3], '$ArrayOfBar does coerce value that can be coerced', ); is( $ArrayOfBar->coerce($arr2), $arr2, '$ArrayOfBar does not coerce value that cannot be coerced', ); my $HashOfBar = HashRef[$Bar]; ok($HashOfBar->has_coercion, '$HashOfBar has coercion'); ok($HashOfBar->coercion->can_be_inlined, '$HashOfBar coercion can be inlined'); my $hsh1 = {one => 1, two => 2, three => 3}; my $hsh2 = {one => 1, two => 2, three => 3, greeting => "Hello"}; is( $HashOfBar->coerce($hsh1), $hsh1, '$HashOfBar does not coerce value that needs no coercion', ); is_deeply( $HashOfBar->coerce({one => 1.1, two => 2.2, three => 3.3}), {one => 1, two => 2, three => 3}, '$HashOfBar does coerce value that can be coerced', ); is( $HashOfBar->coerce($hsh2), $hsh2, '$HashOfBar does not coerce value that cannot be coerced', ); my $RefOfBar = ScalarRef[$Bar]; ok($RefOfBar->has_coercion, '$RefOfBar has coercion'); ok($RefOfBar->coercion->can_be_inlined, '$RefOfBar coercion can be inlined'); my $ref1 = do { my $x = 1; \$x }; my $ref2 = do { my $x = "xxx"; \$x }; is( $RefOfBar->coerce($ref1), $ref1, '$RefOfBar does not coerce value that needs no coercion', ); is_deeply( ${ $RefOfBar->coerce(do { my $x = 1.1; \$x }) }, 1, '$RefOfBar does coerce value that can be coerced', ); is( $RefOfBar->coerce($ref2), $ref2, '$RefOfBar does not coerce value that cannot be coerced', ); }; MAP: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, q{ length($_) }; my $IntFromNum = declare IntFromNum => as Int; coerce $IntFromNum, from Num, q{ int($_) }; my $IntFromArray = declare IntFromArray => as Int; coerce $IntFromArray, from ArrayRef, via { scalar(@$_) }; my $Map1 = Map[$IntFromNum, $IntFromStr]; ok( $Map1->has_coercion && $Map1->coercion->can_be_inlined, "$Map1 has an inlinable coercion", ); is_deeply( $Map1->coerce({ 1.1 => "Hello", 2.1 => "World", 3.1 => "Hiya" }), { 1 => 5, 2 => 5, 3 => 4 }, "Coercions to $Map1", ); is_deeply( $Map1->coerce({ 1.1 => "Hello", 2.1 => "World", 3.1 => [] }), { 1.1 => "Hello", 2.1 => "World", 3.1 => [] }, "Impossible coercion to $Map1", ); my $m = { 1 => 2 }; is( $Map1->coerce($m), $m, "Unneeded coercion to $Map1", ); my $Map2 = Map[$IntFromNum, $IntFromArray]; ok( $Map2->has_coercion && !$Map2->coercion->can_be_inlined, "$Map2 has a coercion, but it cannot be inlined", ); is_deeply( $Map2->coerce({ 1.1 => [1], 2.1 => [1,2], 3.1 => [] }), { 1 => 1, 2 => 2, 3 => 0 }, "Coercions to $Map2", ); is_deeply( $Map2->coerce({ 1.1 => [1], 2.1 => [1,2], 3.1 => {} }), { 1.1 => [1], 2.1 => [1,2], 3.1 => {} }, "Impossible coercion to $Map2", ); $m = { 1 => 2 }; is( $Map2->coerce($m), $m, "Unneeded coercion to $Map2", ); }; DICT: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, q{ length($_) }; my $IntFromNum = declare IntFromNum => as Int; coerce $IntFromNum, from Num, q{ int($_) }; my $IntFromArray = declare IntFromArray => as Int; coerce $IntFromArray, from ArrayRef, via { scalar(@$_) }; my @a = (a => $IntFromStr, b => $IntFromNum, c => Optional[$IntFromNum]); my $Dict1 = Dict[ a => $IntFromStr, b => $IntFromNum, c => Optional[$IntFromNum] ]; ok( $Dict1->has_coercion && $Dict1->coercion->can_be_inlined, "$Dict1 has an inlinable coercion", ); is_deeply( $Dict1->coerce({ a => "Hello", b => 1.1, c => 2.2 }), { a => 5, b => 1, c => 2 }, "Coercion (A) to $Dict1", ); is_deeply( $Dict1->coerce({ a => "Hello", b => 1 }), { a => 5, b => 1 }, "Coercion (B) to $Dict1", ); is_deeply( $Dict1->coerce({ a => "Hello", b => 1, c => [], d => 1 }), { a => "Hello", b => 1, c => [], d => 1 }, "Coercion (C) to $Dict1 - changed in 0.003_11; the presence of an additional value cancels coercion", ); }; TUPLE: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, q{ length($_) }; my $IntFromNum = declare IntFromNum => as Int; coerce $IntFromNum, from Num, q{ int($_) }; my $IntFromArray = declare IntFromArray => as Int; coerce $IntFromArray, from ArrayRef, via { scalar(@$_) }; my $Tuple1 = Tuple[ $IntFromNum, Optional[$IntFromStr], slurpy ArrayRef[$IntFromNum]]; ok( $Tuple1->has_coercion && $Tuple1->coercion->can_be_inlined, "$Tuple1 has an inlinable coercion", ); is_deeply( $Tuple1->coerce([qw( 1.1 1.1 )]), [1, 3], "Coercion (A) to $Tuple1", ); is_deeply( $Tuple1->coerce([qw( 1.1 1.1 2.2 2.2 33 3.3 )]), [1, 3, 2, 2, 33, 3], "Coercion (B) to $Tuple1", ); my $Tuple2 = Tuple[ $IntFromNum ]; is_deeply( $Tuple2->coerce([qw( 1.1 )]), [ 1 ], "Coercion (A) to $Tuple2", ); is_deeply( $Tuple2->coerce([qw( 1.1 2.2 )]), [ 1.1, 2.2 ], "Coercion (B) to $Tuple2 - changed in 0.003_11; the presence of an additional value cancels coercion", ); }; done_testing; Type-Tiny-0.022/t/rt86233.t0000644000175000017500000000200512161671331013154 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Fix: "Cannot inline type constraint check" error with compile and Dict. =head1 SEE ALSO L. =head1 AUTHOR Vyacheslav Matyukhin Emmcleric@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Vyacheslav Matyukhin. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { package Types; use Type::Library -base, -declare => qw[ Login ]; use Type::Utils; use Types::Standard qw[ Str ]; declare Login, as Str, where { /^\w+$/ }; }; use Type::Params qw[ compile ]; use Types::Standard qw[ Dict ]; my $type = Dict[login => Types::Login]; ok not( $type->can_be_inlined ); ok not( $type->coercion->can_be_inlined ); is(exception { compile($type) }, undef); done_testing; Type-Tiny-0.022/t/exceptions.t0000644000175000017500000001630212172204404014302 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Tests L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); local $Type::Exception::LastError; use Test::More; use Test::Fatal; use Scalar::Util qw(refaddr); use Types::Standard slurpy => -types; my $supernum = Types::Standard::STRICTNUM ? "StrictNum" : "LaxNum"; my $v = []; my $e = exception { Int->create_child_type->assert_valid($v) }; isa_ok($e, "Type::Exception", '$e'); is(refaddr($e), refaddr($Type::Exception::LastError), '$Type::Exception::LastError'); is( $e->message, q{[] did not pass type constraint}, '$e->message is as expected', ); isa_ok($e, "Type::Exception::Assertion", '$e'); cmp_ok( $e->type, '==', Int, '$e->type is as expected', ); is( $e->value, $v, '$e->value is as expected', ); is_deeply( $e->explain, [ '"__ANON__" is a subtype of "Int"', '"Int" is a subtype of "Num"', '"Num" is a subtype of "'.$supernum.'"', '"'.$supernum.'" is a subtype of "Str"', '"Str" is a subtype of "Value"', '[] did not pass type constraint "Value"', '"Value" is defined as: (defined($_) and not ref($_))', ], '$e->explain is as expected', ); is_deeply( (exception { (ArrayRef[Int])->([1, 2, [3]]) })->explain, [ '[1,2,[3]] did not pass type constraint "ArrayRef[Int]"', '"ArrayRef[Int]" constrains each value in the array with "Int"', '"Int" is a subtype of "Num"', '"Num" is a subtype of "'.$supernum.'"', '"'.$supernum.'" is a subtype of "Str"', '"Str" is a subtype of "Value"', '[3] did not pass type constraint "Value" (in $_->[2])', '"Value" is defined as: (defined($_) and not ref($_))', ], 'ArrayRef[Int] deep explanation, given [1, 2, [3]]', ); is_deeply( (exception { (ArrayRef[Int])->({}) })->explain, [ '"ArrayRef[Int]" is a subtype of "ArrayRef"', '{} did not pass type constraint "ArrayRef"', '"ArrayRef" is defined as: (ref($_) eq \'ARRAY\')', ], 'ArrayRef[Int] deep explanation, given {}', ); is_deeply( (exception { (Ref["ARRAY"])->({}) })->explain, [ '{} did not pass type constraint "Ref[ARRAY]"', '"Ref[ARRAY]" constrains reftype($_) to be equal to "ARRAY"', 'reftype($_) is "HASH"', ], 'Ref["ARRAY"] deep explanation, given {}', ); is_deeply( (exception { (HashRef[Maybe[Int]])->({a => undef, b => 42, c => []}) })->explain, [ '{"a" => undef,"b" => 42,"c" => []} did not pass type constraint "HashRef[Maybe[Int]]"', '"HashRef[Maybe[Int]]" constrains each value in the hash with "Maybe[Int]"', '[] did not pass type constraint "Maybe[Int]" (in $_->{"c"})', '[] is defined', '"Maybe[Int]" constrains the value with "Int" if it is defined', '"Int" is a subtype of "Num"', '"Num" is a subtype of "'.$supernum.'"', '"'.$supernum.'" is a subtype of "Str"', '"Str" is a subtype of "Value"', '[] did not pass type constraint "Value" (in $_->{"c"})', '"Value" is defined as: (defined($_) and not ref($_))', ], 'HashRef[Maybe[Int]] deep explanation, given {a => undef, b => 42, c => []}', ); my $dict = Dict[a => Int, b => Optional[ArrayRef[Str]]]; is_deeply( (exception { $dict->({c => 1}) })->explain, [ '{"c" => 1} did not pass type constraint "Dict[a=>Int,b=>Optional[ArrayRef[Str]]]"', '"Dict[a=>Int,b=>Optional[ArrayRef[Str]]]" does not allow key "c" to appear in hash', ], '$dict deep explanation, given {c => 1}', ); is_deeply( (exception { $dict->({b => 1}) })->explain, [ '{"b" => 1} did not pass type constraint "Dict[a=>Int,b=>Optional[ArrayRef[Str]]]"', '"Dict[a=>Int,b=>Optional[ArrayRef[Str]]]" requires key "a" to appear in hash', ], '$dict deep explanation, given {b => 1}', ); is_deeply( (exception { $dict->({a => 1, b => 2}) })->explain, [ '{"a" => 1,"b" => 2} did not pass type constraint "Dict[a=>Int,b=>Optional[ArrayRef[Str]]]"', '"Dict[a=>Int,b=>Optional[ArrayRef[Str]]]" constrains value at key "b" of hash with "Optional[ArrayRef[Str]]"', 'Value "2" did not pass type constraint "Optional[ArrayRef[Str]]" (in $_->{"b"})', '$_->{"b"} exists', '"Optional[ArrayRef[Str]]" constrains $_->{"b"} with "ArrayRef[Str]" if it exists', '"ArrayRef[Str]" is a subtype of "ArrayRef"', '"ArrayRef" is a subtype of "Ref"', 'Value "2" did not pass type constraint "Ref" (in $_->{"b"})', '"Ref" is defined as: (!!ref($_))', ], '$dict deep explanation, given {a => 1, b => 2}', ); TODO: { local $TODO = ($] >= 5.019) ? "Data::Dumper output changed in Perl 5.19??" : undef; is_deeply( (exception { (Map[Int,Num])->({1=>1.1,2.2=>2.3,3.3=>3.4}) })->explain, [ '{1 => "1.1","2.2" => "2.3","3.3" => "3.4"} did not pass type constraint "Map[Int,Num]"', '"Map[Int,Num]" constrains each key in the hash with "Int"', 'Value "2.2" did not pass type constraint "Int" (in key $_->{"2.2"})', '"Int" is defined as: (defined $_ and $_ =~ /\A-?[0-9]+\z/)', ], 'Map[Int,Num] deep explanation, given {1=>1.1,2.2=>2.3,3.3=>3.4}', ); } my $AlwaysFail = Any->create_child_type(constraint => sub { 0 }); is_deeply( (exception { $AlwaysFail->(1) })->explain, [ 'Value "1" did not pass type constraint "__ANON__"', '"__ANON__" is defined as: sub { 0; }', ], '$AlwaysFail explanation, given 1', ); my $SlurpyThing = Tuple[ Num, slurpy Map[Int, ArrayRef] ]; is_deeply( (exception { $SlurpyThing->(1) })->explain, [ '"Tuple[Num,slurpy Map[Int,ArrayRef]]" is a subtype of "Tuple"', '"Tuple" is a subtype of "ArrayRef"', '"ArrayRef" is a subtype of "Ref"', 'Value "1" did not pass type constraint "Ref"', '"Ref" is defined as: (!!ref($_))', ], '$SlurpyThing explanation, given 1', ); TODO: { local $TODO = ($] >= 5.019) ? "Data::Dumper output changed in Perl 5.19??" : undef; is_deeply( (exception { $SlurpyThing->([1.1, 2 => "Hello"]) })->explain, [ '["1.1",2,"Hello"] did not pass type constraint "Tuple[Num,slurpy Map[Int,ArrayRef]]"', 'Array elements from index 1 are slurped into a hashref which is constrained with "Map[Int,ArrayRef]"', '{2 => "Hello"} did not pass type constraint "Map[Int,ArrayRef]" (in $SLURPY)', '"Map[Int,ArrayRef]" constrains each value in the hash with "ArrayRef"', '"ArrayRef" is a subtype of "Ref"', 'Value "Hello" did not pass type constraint "Ref" (in $SLURPY->{"2"})', '"Ref" is defined as: (!!ref($_))', ], '$SlurpyThing explanation, given [1.1, 2 => "Hello"]', ); } my $e_where = exception { #line 1 "thisfile.plx" package Monkey::Nuts; "Type::Exception"->throw(message => "Test"); }; #line 220 "exceptions.t" is_deeply( $e_where->context, { package => "Monkey::Nuts", file => "thisfile.plx", line => 2, }, '$e_where->context', ); is( "$e_where", "Test at thisfile.plx line 2.\n", '"$e_where"', ); BEGIN { package MyTypes; use Type::Library -base, -declare => qw(HttpMethod); use Type::Utils -all; use Types::Standard qw(Enum); declare HttpMethod, as Enum[qw/ HEAD GET POST PUT DELETE OPTIONS PATCH /], message { "$_ is not a HttpMethod" }; }; like( exception { MyTypes::HttpMethod->("FOOL") }, qr{^FOOL is not a HttpMethod}, "correct exception from type with null constraint", ); done_testing; Type-Tiny-0.022/t/validationclass.t0000644000175000017500000000413312161671331015305 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check type constraints L objects can be used as type constraints. =head1 DEPENDENCIES Test is skipped if Validation::Class 7.900017 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { "Validation::Class" => "7.900017" }; use Test::TypeTiny; use Types::TypeTiny qw( to_TypeTiny ); use Validation::Class::Simple; my $type = to_TypeTiny "Validation::Class::Simple"->new( fields => { name => { required => 1, pattern => qr{^\w+(\s\w+)*$}, filters => [qw/trim/] }, email => { required => 1 }, pass => { required => 1 }, pass2 => { required => 1, matches => 'pass' }, }, ); isa_ok($type, "Type::Tiny", 'can create a child type constraint from Validation::Class::Simple'); should_fail('Hello', $type); should_fail({}, $type); should_fail({ name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'bar' }, $type); should_pass({ name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }, $type); should_fail({ name => 'Toby ', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }, $type); my $msg = $type->get_message({ name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'bar' }); like($msg, qr{pass2 does not match pass}, 'correct error message (A)'); my $msg2 = $type->get_message({ name => 'Toby ', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }); like($msg2, qr{name is not formatted properly}, 'correct error message (B)'); ok($type->has_coercion, 'the type has a coercion'); is_deeply( $type->coerce( { name => 'Toby ', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo', monkey => 'nuts' }, ), { name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }, "... which works", ); done_testing; Type-Tiny-0.022/t/00-begin.t0000644000175000017500000000314312174251104013422 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Print some standard diagnostics before beginning testing. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; sub diag_version { my ($module, $version) = @_; $version = eval "require $module; $module->VERSION" unless defined $version; return diag sprintf(' %-30s undef', $module) unless defined $version; my ($major, $rest) = split /\./, $version; return diag sprintf(' %-30s % 4d.%s', $module, $major, $rest); } sub diag_env { require B; require Devel::TypeTiny::Perl56Compat; my $var = shift; return diag sprintf(' $%-30s %s', $var, exists $ENV{$var} ? B::perlstring($ENV{$var}) : "undef"); } while () { chomp; if (/^#\s*(.*)$/ or /^$/) { diag($1 || ""); next; } if (/^\$(.+)$/) { diag_env($1); next; } if (/^perl$/) { diag_version("Perl", $]); next; } diag_version($_) if /\S/; } ok 1; done_testing; __END__ # Required: perl base Encode Scalar::Util Test::More # Optional: Class::InsideOut Devel::LexAlias Devel::StackTrace Function::Parameters Moo Moose Mouse Object::Accessor Role::Tiny Sub::Exporter::Lexical Validation::Class::Simple # Environment: $AUTOMATED_TESTING $NONINTERACTIVE_TESTING $EXTENDED_TESTING $AUTHOR_TESTING $RELEASE_TESTING $PERL_TYPES_STANDARD_STRICTNUM $MOO_XS_DISABLE $MOOSE_ERROR_STYLE $MOUSE_XS $MOUSE_PUREPERL $PERL_ONLY Type-Tiny-0.022/t/coercion-frozen.t0000644000175000017500000000247412161671331015235 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Type::Coercion objects are mutable, unlike Type::Tiny objects. However, they can be frozen, making them immutable. (And Type::Tiny will freeze them occasionally, if it feels it has to.) =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Requires Moose 2.0000 =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { Moose => 2.0000 }; use Test::More; use Test::Fatal; use BiggerLib -types; ok(!BigInteger->coercion->frozen, 'coercions are not initially frozen'); BigInteger->coercion->add_type_coercions(Any, sub { 777 }); ok(!BigInteger->coercion->frozen, 'coercions do not freeze because of adding code'); BigInteger->coercion->moose_coercion; ok(BigInteger->coercion->frozen, 'coercions do freeze when forced inflation to Moose'); my $e = exception { BigInteger->coercion->add_type_coercions(Item, sub { 888 }) }; like($e, qr{Attempt to add coercion code to a Type::Coercion which has been frozen}, 'cannot add code to a frozen coercion'); done_testing; Type-Tiny-0.022/t/moose-autott.t0000644000175000017500000000314312161671331014565 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check that Moose type constraints can be passed into the Type::Tiny API where a Type::Tiny constraint might usually be expected. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moose 2.0000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moose => 2.0000 }; use Test::Fatal; # Example from the manual { package Person; use Moose; use Types::Standard qw( Str Int ); use Type::Utils qw( declare as where inline_as coerce from ); ::isa_ok( Int, 'Moose::Meta::TypeConstraint', 'Int', ); ::isa_ok( Str, 'Moose::Meta::TypeConstraint', 'Str', ); has name => ( is => "ro", isa => Str, ); my $PositiveInt = declare as Int, where { $_ > 0 }, inline_as { "$_ =~ /^0-9]\$/ and $_ > 0" }; coerce $PositiveInt, from Int, q{ abs $_ }; ::isa_ok( $PositiveInt, 'Type::Tiny', '$PositiveInt', ); ::isa_ok( $PositiveInt->parent, 'Type::Tiny', '$PositiveInt->parent', ); has age => ( is => "ro", isa => $PositiveInt, coerce => 1, writer => "_set_age", ); sub get_older { my $self = shift; my ($years) = @_; $PositiveInt->assert_valid($years); $self->_set_age($self->age + $years); } } done_testing; Type-Tiny-0.022/t/stdlib-strmatch.t0000644000175000017500000000333412161671331015233 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard -all, "slurpy"; use Type::Utils; my $DistanceUnit = enum DistanceUnit => [qw/ mm cm m km /]; my $Distance = declare Distance => as StrMatch[ qr{^([0-9]+)\s+(.+)$}, Tuple[Int, $DistanceUnit], ]; should_pass("mm", $DistanceUnit); should_pass("cm", $DistanceUnit); should_pass("m", $DistanceUnit); should_pass("km", $DistanceUnit); should_fail("MM", $DistanceUnit); should_fail("mm ", $DistanceUnit); should_fail(" mm", $DistanceUnit); should_fail("miles", $DistanceUnit); should_pass("5 km", $Distance) or diag($Distance->inline_check('$XXX')); should_pass("5 mm", $Distance); should_fail("4 miles", $Distance); should_fail("5.5 km", $Distance); should_fail([qw/5 km/], $Distance); my $Boolean = declare Boolean => as StrMatch[qr{^(?:true|false|0|1)$}ism]; should_pass("true", $Boolean); should_pass("True", $Boolean); should_pass("TRUE", $Boolean); should_pass("false", $Boolean); should_pass("False", $Boolean); should_pass("FALSE", $Boolean); should_pass("0", $Boolean); should_pass("1", $Boolean); should_fail("True ", $Boolean); should_fail("11", $Boolean); my $SecureUrl = declare SecureUrl => as StrMatch[qr{^https://}]; should_pass("https://www.google.com/", $SecureUrl); should_fail("http://www.google.com/", $SecureUrl); done_testing; Type-Tiny-0.022/t/mouse.t0000644000175000017500000000345012162235645013263 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. Checks values that should pass and should fail; checks error messages. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Mouse 1.00 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Mouse => 1.00 }; use Test::Fatal; { package Local::Class; use Mouse; use BiggerLib -all; has small => (is => "ro", isa => SmallInteger); has big => (is => "ro", isa => BigInteger); } is( exception { "Local::Class"->new(small => 9, big => 12) }, undef, "some values that should pass their type constraint", ); like( exception { "Local::Class"->new(small => 100) }, qr{^Attribute \(small\) does not pass the type constraint}, "direct violation of type constraint", ); like( exception { "Local::Class"->new(small => 5.5) }, qr{^Attribute \(small\) does not pass the type constraint}, "violation of parent type constraint", ); like( exception { "Local::Class"->new(small => "five point five") }, qr{^Attribute \(small\) does not pass the type constraint}, "violation of grandparent type constraint", ); like( exception { "Local::Class"->new(small => []) }, qr{^Attribute \(small\) does not pass the type constraint}, "violation of great-grandparent type constraint", ); use Mouse::Util; ok( Mouse::Util::is_a_type_constraint(BiggerLib::SmallInteger), "Mouse::Util::is_a_type_constraint accepts Type::Tiny type constraints", ); done_testing; Type-Tiny-0.022/t/rt85911.t0000644000175000017500000000217412161671331013165 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L with deep Dict coercion. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; BEGIN { package MyTypes; use Type::Library -base, -declare => qw[ StrList ]; use Type::Utils; use Types::Standard qw[ ArrayRef Str ]; declare StrList, as ArrayRef[Str]; coerce StrList, from Str, via { [$_] }; } use Type::Params qw[ compile ]; use Types::Standard qw[ Dict slurpy Optional ]; sub foo { my $check = compile( slurpy Dict [ foo => MyTypes::StrList ] ); return [ $check->( @_ ) ]; } sub bar { my $check = compile( MyTypes::StrList ); return [ $check->( @_ ) ]; } is_deeply( bar( 'b' ), [ ["b"] ], ); is_deeply( foo( foo => 'a' ), [ { foo=>["a"] } ], ); done_testing; Type-Tiny-0.022/t/params-noninline.t0000644000175000017500000000342112161671331015376 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L with type constraints that cannot be inlined. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard qw(Num ArrayRef); use Type::Utils; my $NumX = declare NumX => as Num, where { $_ != 42 }; my $check; sub nth_root { $check ||= compile( $NumX, $NumX ); [ $check->(@_) ]; } is_deeply( nth_root(1, 2), [ 1, 2 ], '(1, 2)', ); is_deeply( nth_root("1.1", 2), [ "1.1", 2 ], '(1.1, 2)', ); { my $e = exception { nth_root() }; like($e, qr{^Wrong number of parameters; got 0; expected 2}, '()'); } { my $e = exception { nth_root(1) }; like($e, qr{^Wrong number of parameters; got 1; expected 2}, '(1)'); } { my $e = exception { nth_root(undef, 1) }; like($e, qr{^Undef did not pass type constraint "NumX" \(in \$_\[0\]\)}, '(undef, 1)'); } { my $e = exception { nth_root(41, 42) }; like($e, qr{^Value "42" did not pass type constraint "NumX" \(in \$_\[1\]\)}, '(42)'); } my $check2; sub nth_root_coerce { $check2 ||= compile( $NumX->plus_coercions( Num, sub { 21 }, # non-inline ArrayRef, q { scalar(@$_) }, # inline ), $NumX, ); [ $check2->(@_) ]; } is_deeply( nth_root_coerce(42, 11), [21, 11], '(42, 11)' ); is_deeply( nth_root_coerce([1..3], 11), [3, 11], '([1..3], 11)' ); { my $e = exception { nth_root_coerce([1..41], 42) }; like($e, qr{^Value "42" did not pass type constraint "NumX" \(in \$_\[1\]\)}, '([1..41], 42)'); } done_testing; Type-Tiny-0.022/t/dwim-mouse.t0000644000175000017500000000317012166002740014210 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks Mouse type constraints, and L type constraints are picked up by C from L. =head1 DEPENDENCIES Mouse 1.00 and MouseX::Types 0.06; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "Mouse" => "1.00" }; use Test::Requires { "MouseX::Types" => "0.06" }; use Test::TypeTiny; use Mouse; use Mouse::Util::TypeConstraints qw(:all); use Type::Utils 0.015 qw(dwim_type); # Creating a type constraint with Mouse subtype "Two", as "Int", where { $_ eq 2 }; my $two = dwim_type("Two"); my $twos = dwim_type("ArrayRef[Two]"); isa_ok($two, 'Type::Tiny', '$two'); isa_ok($twos, 'Type::Tiny', '$twos'); should_pass(2, $two); should_fail(3, $two); should_pass([2, 2, 2], $twos); should_fail([2, 3, 2], $twos); # Creating a type constraint with MouseX::Types { package MyTypes; use MouseX::Types -declare => ["Three"]; use MouseX::Types::Moose "Int"; subtype Three, as Int, where { $_ eq 3 }; } # Note that MouseX::Types namespace-prefixes its types. my $three = dwim_type("MyTypes::Three"); my $threes = dwim_type("ArrayRef[MyTypes::Three]"); isa_ok($three, 'Type::Tiny', '$three'); isa_ok($threes, 'Type::Tiny', '$threes'); should_pass(3, $three); should_fail(4, $three); should_pass([3, 3, 3], $threes); should_fail([3, 4, 3], $threes); done_testing; Type-Tiny-0.022/t/params-optional.t0000644000175000017500000000232712161671331015236 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L usage with optional parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types; my $chk = compile(Num, Optional[Int], Optional[ArrayRef], Optional[HashRef]); is_deeply( [ $chk->(1.1, 2, [], {}) ], [ 1.1, 2, [], {} ] ); is_deeply( [ $chk->(1.1, 2, []) ], [ 1.1, 2, [] ] ); is_deeply( [ $chk->(1.1, 2) ], [ 1.1, 2 ] ); is_deeply( [ $chk->(1.1) ], [ 1.1 ] ); like( exception { $chk->(1.1, 2, {}) }, qr{^{} did not pass type constraint "Optional\[ArrayRef\]" \(in \$_\[2\]\)}, ); like( exception { $chk->() }, qr{^Wrong number of parameters; got 0; expected 1 to 4}, ); like( exception { $chk->(1 .. 5) }, qr{^Wrong number of parameters; got 5; expected 1 to 4}, ); my $chk2 = compile(1, 0, 0); like( exception { $chk2->() }, qr{^Wrong number of parameters; got 0; expected 1 to 3}, ); done_testing; Type-Tiny-0.022/t/registry.t0000644000175000017500000000402012165404077013775 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks Type::Registry works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Test::Fatal; { package Local::Pkg1; use Type::Registry "t"; t->add_types(-Standard); t->alias_type(Int => "Integer"); ::ok(t->Integer == Types::Standard::Int(), 'alias works'); ::ok(t("Integer") == Types::Standard::Int(), 'alias works via simple_lookup'); ::ok(t("Integer[]") == Types::Standard::Int(), 'alias works via lookup'); } { package Local::Pkg2; use Type::Registry "t"; t->add_types(-Standard => [ -types => { -prefix => 'XYZ_' } ]); ::ok(t->XYZ_Int == Types::Standard::Int(), 'prefix works'); } ok( exception { Local::Pkg2::t->lookup("Integer") }, 'type registries are separate', ); my $r = Type::Registry->for_class("Local::Pkg1"); should_pass([1, 2, 3], $r->lookup("ArrayRef[Integer]")); should_fail([1, 2, 3.14159], $r->lookup("ArrayRef[Integer]")); like( exception { $r->lookup('%foo') }, qr{^Unexpected token in primary type expression; got '\%foo'}, 'type constraint invalid syntax', ); like( exception { $r->lookup('MonkeyNuts') }, qr{^MonkeyNuts is not a known type constraint }, 'type constraint unknown type', ); is( $r->lookup('MonkeyNuts::')->class, 'MonkeyNuts', 'class type', ); use Type::Utils qw(dwim_type role_type class_type); is( dwim_type('MonkeyNuts')->class, 'MonkeyNuts', 'DWIM - class type', ); is( dwim_type('MonkeyNuts', does => 1)->role, 'MonkeyNuts', 'DWIM - role type', ); is( dwim_type('ArrayRef[MonkeyNuts | Foo::]', does => 1)->inline_check('$X'), Types::Standard::ArrayRef()->parameterize(role_type({role=>"MonkeyNuts"}) | class_type({class=>"Foo"}))->inline_check('$X'), 'DWIM - complex type', ); done_testing; Type-Tiny-0.022/t/match-on-type.t0000644000175000017500000000444012161671331014613 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L C and C functions. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Utils qw( match_on_type compile_match_on_type ); use Types::Standard -types; sub to_json; *to_json = compile_match_on_type( HashRef() => sub { my $hash = shift; '{ ' . ( join ", " => map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) } sort keys %$hash ) . ' }'; }, ArrayRef() => sub { my $array = shift; '[ ' . ( join ", " => map { to_json($_) } @$array ) . ' ]'; }, Num() => q {$_}, Str() => q { '"' . $_ . '"' }, Undef() => q {'null'}, => sub { die "$_ is not acceptable json type" }, ); is( to_json({foo => 1, bar => 2, baz => [3 .. 5], quux => undef}), '{ "bar" : 2, "baz" : [ 3, 4, 5 ], "foo" : 1, "quux" : null }', 'to_json using compile_match_on_type works', ); sub to_json_2 { return match_on_type $_[0] => ( HashRef() => sub { my $hash = shift; '{ ' . ( join ", " => map { '"' . $_ . '" : ' . to_json_2( $hash->{$_} ) } sort keys %$hash ) . ' }'; }, ArrayRef() => sub { my $array = shift; '[ ' . ( join ", " => map { to_json_2($_) } @$array ) . ' ]'; }, Num() => q {$_}, Str() => q { '"' . $_ . '"' }, Undef() => q {'null'}, => sub { die "$_ is not acceptable json type" }, ); } is( to_json_2({foo => 1, bar => 2, baz => [3 .. 5], quux => undef}), '{ "bar" : 2, "baz" : [ 3, 4, 5 ], "foo" : 1, "quux" : null }', 'to_json_2 using match_on_type works', ); if ($ENV{EXTENDED_TESTING}) { require Benchmark; my $iters = 5_000; my $standard = Benchmark::timethis( $iters, '::to_json_2({foo => 1, bar => 2, baz => [3 .. 5], quux => undef})', 'standard', 'none', ); diag "match_on_type: " . Benchmark::timestr($standard); my $compiled = Benchmark::timethis( $iters, '::to_json({foo => 1, bar => 2, baz => [3 .. 5], quux => undef})', 'compiled', 'none', ); diag "compile_match_on_type: " . Benchmark::timestr($compiled); } done_testing; Type-Tiny-0.022/t/syntax.t0000644000175000017500000000341612161671331013456 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks that all this Type[Param] syntactic sugar works. In particular, the following three type constraints are expected to be equivalent to each other: use Types::Standard qw( ArrayRef Int Num Str ); use Type::Utils qw( union intersection ); my $type1 = (ArrayRef[Int]) | (ArrayRef[Num & ~Int]) | (ArrayRef[Str & ~Num]); my $type2 = union [ ArrayRef[Int], ArrayRef[Num & ~Int], ArrayRef[Str & ~Num], ]; my $type3 = union([ ArrayRef->parameterize(Int), ArrayRef->parameterize( intersection([ Num, Int->complementary_type, ]), ), ArrayRef->parameterize( intersection([ Str, Num->complementary_type, ]), ), ]); =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Types::Standard qw( ArrayRef Int Num Str ); use Type::Utils qw( union intersection ); my $type1 = (ArrayRef[Int]) | (ArrayRef[Num & ~Int]) | (ArrayRef[Str & ~Num]); my $type2 = union [ ArrayRef[Int], ArrayRef[Num & ~Int], ArrayRef[Str & ~Num], ]; my $type3 = union([ ArrayRef->parameterize(Int), ArrayRef->parameterize( intersection([ Num, Int->complementary_type, ]), ), ArrayRef->parameterize( intersection([ Str, Num->complementary_type, ]), ), ]); ok($type1==$type2, '$type1==$type2'); ok($type1==$type3, '$type1==$type3'); ok($type2==$type3, '$type2==$type3'); done_testing; Type-Tiny-0.022/t/exporter-installer.t0000644000175000017500000000154612161671331015775 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Tests L works with Sub::Exporter plugins. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { "Sub::Exporter::Lexical" => "0.092291" }; use Test::More; use Test::Fatal; { use Sub::Exporter::Lexical qw( lexical_installer ); use Types::Standard { installer => lexical_installer }, qw( ArrayRef ); ArrayRef->( [] ); } ok(!eval q{ ArrayRef->( [] ) }, 'the ArrayRef function was cleaned away'); ok(!__PACKAGE__->can("ArrayRef"), 'ArrayRef does not appear to be a method'); done_testing; Type-Tiny-0.022/t/params-methods.t0000644000175000017500000000332112161671331015047 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L usage for method calls. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; { package Silly::String; use Type::Params qw(Invocant compile); use Types::Standard qw(ClassName Object Str Int); my %chk; sub new { $chk{new} ||= compile(ClassName, Str); my ($class, $str) = $chk{new}->(@_); bless \$str, $class; } sub repeat { $chk{repeat} ||= compile(Object, Int); my ($self, $n) = $chk{repeat}->(@_); $self->get x $n; } sub get { $chk{get} ||= compile(Object); my ($self) = $chk{get}->(@_); $$self; } sub set { $chk{set} ||= compile(Invocant, Str); my ($proto, $str) = $chk{set}->(@_); Object->check($proto) ? ($$proto = $str) : $proto->new($str); } } is( exception { my $o = Silly::String->new("X"); is($o->get, "X"); is($o->repeat(4), "XXXX"); $o->set("Y"); is($o->repeat(4), "YYYY"); my $p = Silly::String->set("Z"); is($p->repeat(4), "ZZZZ"); }, undef, 'clean operation', ); like( exception { Silly::String::new() }, qr{^Wrong number of parameters; got 0; expected 2}, 'exception calling new() with no args', ); like( exception { Silly::String->new() }, qr{^Wrong number of parameters; got 1; expected 2}, 'exception calling ->new() with no args', ); like( exception { Silly::String::set() }, qr{^Wrong number of parameters; got 0; expected 2}, 'exception calling set() with no args', ); done_testing; Type-Tiny-0.022/t/type.t0000644000175000017500000000661212174250771013117 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Type::Tiny; my $Any = "Type::Tiny"->new(name => "Any"); ok(!$Any->is_anon, "Any is not anon"); is($Any->name, "Any", "Any is called Any"); ok($Any->can_be_inlined, 'Any can be inlined'); should_pass($_, $Any) for 1, 1.2, "Hello World", [], {}, undef, \*STDOUT; like( exception { $Any->create_child_type(name => "1") }, qr{^"1" is not a valid type name}, "bad type constraint name", ); my $Int = $Any->create_child_type( constraint => sub { defined($_) and !ref($_) and $_ =~ /^[+-]?[0-9]+$/sm }, ); ok($Int->is_anon, "\$Int is anon"); is($Int->name, "__ANON__", "\$Int is called __ANON__"); ok(!$Int->can_be_inlined, '$Int cannot be inlined'); should_pass($_, $Int) for 1, -1, 0, 100, 10000, 987654; should_fail($_, $Int) for 1.2, "Hello World", [], {}, undef, \*STDOUT; ok_subtype($Any, $Int); ok($Any->is_supertype_of($Int), 'Any is_supertype_of $Int'); ok($Int->is_a_type_of($Any), '$Int is_a_type_of Any'); ok($Int->is_a_type_of($Int), '$Int is_a_type_of $Int'); ok(!$Int->is_subtype_of($Int), 'not $Int is_subtype_of $Int'); my $Below = $Int->create_child_type( name => "Below", constraint_generator => sub { my $param = shift; return sub { $_ < $param }; }, ); ok($Below->is_parameterizable, 'Below is_parameterizable'); ok(!$Below->is_parameterized, 'not Below is_parameterized'); should_pass($_, $Below) for 1, -1, 0, 100, 10000, 987654; should_fail($_, $Below) for 1.2, "Hello World", [], {}, undef, \*STDOUT; my $Below5 = $Below->parameterize(5); ok($Below5->is_anon, '$Below5 is anon'); is($Below5->display_name, 'Below[5]', '... but still has a nice display name'); should_pass($_, $Below5) for 1, -1, 0; should_fail($_, $Below5) for 1.2, "Hello World", [], {}, undef, \*STDOUT, 100, 10000, 987654; ok_subtype($_, $Below5) for $Any, $Int, $Below; ok($Below5->is_parameterized, 'Below[5] is_parameterized'); ok(!$Below->has_parameters, 'has_parameters method works - negative'); ok($Below5->has_parameters, 'has_parameters method works - positive'); is_deeply($Below5->parameters, [5], 'parameters method works'); my $Ref = "Type::Tiny"->new( name => "Ref", constraint => sub { ref($_) }, inlined => sub { "ref($_)" }, ); my $ArrayRef = "Type::Tiny"->new( name => "ArrayRef", parent => $Ref, constraint => sub { ref($_) eq 'ARRAY' }, inlined => sub { undef, "ref($_) eq 'ARRAY'" }, ); is( $ArrayRef->inline_check('$xxx'), q[(((ref($xxx))) && (ref($xxx) eq 'ARRAY'))], 'inlining stuff can return a list', ); use Types::Standard (); { my $subtype_of_Num = Types::Standard::Num->create_child_type; my $subtype_of_Int = Types::Standard::Int->create_child_type; ok( $subtype_of_Int->is_subtype_of( $subtype_of_Num ), 'loose type comparison', ); } { my $subtype_of_Num = Types::Standard::Num->create_child_type; my $subtype_of_Int = Types::Standard::Int->create_child_type; ok( ! $subtype_of_Int->is_strictly_subtype_of( $subtype_of_Num ), 'strict type comparison', ); } done_testing; Type-Tiny-0.022/t/moo-coercion.t0000644000175000017500000000413112161671331014514 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check coercions work with L. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moo 1.001000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moo => 1.001000 }; use Test::Fatal; { package Local::Class; use Moo; use BiggerLib -all; ::isa_ok(BigInteger, "Type::Tiny"); has small => (is => "rw", isa => SmallInteger, coerce => SmallInteger->coercion); has big => (is => "rw", isa => BigInteger, coerce => BigInteger->coercion); } my ($e, $o); my $suffix = "mutable class"; for (0..1) { $e = exception { $o = "Local::Class"->new( small => 104, big => 9, ); }; is($e, undef, "no exception on coercion in constructor - $suffix"); is($o && $o->big, 19, "'big' attribute coerces in constructor - $suffix"); is($o && $o->small, 4, "'small' attribute coerces in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => [], big => {}, ); }; ok($e, "'big' attribute throws when it cannot coerce in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => {}, big => [], ); }; ok($e, "'small' attribute throws when it cannot coerce in constructor - $suffix"); $o = "Local::Class"->new; $e = exception { $o->big([]); $o->small([]); }; is($o && $o->big, 100, "'big' attribute coerces in accessor - $suffix"); is($o && $o->small, 1, "'small' attribute coerces in accessor - $suffix"); $e = exception { $o->big({}) }; ok($e, "'big' attribute throws when it cannot coerce in accessor - $suffix"); $e = exception { $o->small({}) }; ok($e, "'small' attribute throws when it cannot coerce in accessor - $suffix"); "Local::Class"->meta->make_immutable; $suffix = "im$suffix"; } done_testing; Type-Tiny-0.022/t/library-to.t0000644000175000017500000000164212161671331014213 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks that the coercion functions exported by a type library work as expected. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal qw(dies_ok); use BiggerLib qw(:to); is( to_BigInteger(8), 18, 'to_BigInteger converts a small integer OK' ); is( to_BigInteger(17), 17, 'to_BigInteger leaves an existing BigInteger OK' ); is( to_BigInteger(3.14), 3.14, 'to_BigInteger ignores something it cannot coerce' ); dies_ok { to_Str [] } "no coercion for Str - should die"; done_testing; Type-Tiny-0.022/t/coercion.t0000644000175000017500000000630312161671331013727 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks Type::Coercion works. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use BiggerLib -types, -coercions; is( BigInteger->coercion->coerce(2), 12, 'coercion works', ); is( BigInteger->coercion->(2), 12, 'coercion overloads &{}', ); ok( BigInteger->coercion->has_coercion_for_type(ArrayRef), 'BigInteger has_coercion_for_type ArrayRef', ); ok( BigInteger->coercion->has_coercion_for_type(SmallInteger), 'BigInteger has_coercion_for_type SmallInteger', ); ok( !BigInteger->coercion->has_coercion_for_type(HashRef), 'not BigInteger has_coercion_for_type SmallInteger', ); cmp_ok( BigInteger->coercion->has_coercion_for_type(BigInteger), eq => '0 but true', 'BigInteger has_coercion_for_type BigInteger eq "0 but true"' ); my $BiggerInteger = BigInteger->create_child_type( constraint => sub { $_ > 1_000_000 }, ); cmp_ok( BigInteger->coercion->has_coercion_for_type($BiggerInteger), eq => '0 but true', 'BigInteger has_coercion_for_type $BiggerInteger eq "0 but true"' ); ok( BigInteger->coercion->has_coercion_for_value([]), 'BigInteger has_coercion_for_value []', ); ok( BigInteger->coercion->has_coercion_for_value(2), 'BigInteger has_coercion_for_value 2', ); ok( !BigInteger->coercion->has_coercion_for_value({}), 'not BigInteger has_coercion_for_value {}', ); cmp_ok( BigInteger->coercion->has_coercion_for_value(200), eq => '0 but true', 'BigInteger has_coercion_for_value 200 eq "0 but true"' ); is( exception { BigInteger->coerce([]) }, undef, "coerce doesn't throw an exception if it can coerce", ); is( exception { BigInteger->coerce({}) }, undef, "coerce doesn't throw an exception if it can't coerce", ); is( exception { BigInteger->assert_coerce([]) }, undef, "assert_coerce doesn't throw an exception if it can coerce", ); like( exception { BigInteger->assert_coerce({}) }, qr{^\{\} did not pass type constraint "BigInteger"}, "assert_coerce DOES throw an exception if it can't coerce", ); isa_ok( ArrayRefFromAny, 'Type::Coercion', 'ArrayRefFromAny', ); is_deeply( ArrayRefFromAny->coerce(1), [1], 'ArrayRefFromAny coercion works', ); my $sum1 = ArrayRefFromAny + ArrayRefFromPiped; is_deeply( $sum1->coerce("foo|bar"), ["foo|bar"], "Coercion $sum1 prioritizes ArrayRefFromAny", ); my $sum2 = ArrayRefFromPiped + ArrayRefFromAny; is_deeply( $sum2->coerce("foo|bar"), ["foo","bar"], "Coercion $sum2 prioritizes ArrayRefFromPiped", ); my $arr = (ArrayRef) + (ArrayRefFromAny); is_deeply( $arr->coerce("foo|bar"), ["foo|bar"], "Type \$arr coercion works", ); my $sum3 = ($arr) + (ArrayRefFromPiped); is_deeply( $sum3->coerce("foo|bar"), ["foo|bar"], "Type \$sum3 coercion works", ); my $sum4 = (ArrayRefFromPiped) + ($arr); is_deeply( $sum4->coerce("foo|bar"), ["foo","bar"], "Type \$sum4 coercion works", ); done_testing; Type-Tiny-0.022/t/moosextypes.t0000644000175000017500000000301512162311657014525 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Complex checks between Type::Tiny and L. =head1 DEPENDENCIES MooseX::Types 0.35; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::Types::Moose" => "0.35" }; use Test::TypeTiny; use MooseX::Types::Moose -all; use Types::Standard -all => { -prefix => "My" }; my $union1 = Int | MyArrayRef; my $union2 = MyArrayRef | Int; isa_ok($union1, "Moose::Meta::TypeConstraint"); isa_ok($union2, "Moose::Meta::TypeConstraint"); isa_ok($union2, "Type::Tiny"); should_pass([], $union1); should_pass(2, $union1); should_fail({}, $union1); should_pass([], $union2); should_pass(2, $union2); should_fail({}, $union2); my $param1 = MyArrayRef[Int]; my $param2 = ArrayRef[MyInt]; should_pass([1,2,3], $param1); should_pass([], $param1); should_fail({}, $param1); should_fail(["x"], $param1); should_pass([1,2,3], $param2); should_pass([], $param2); should_fail({}, $param2); should_fail(["x"], $param2); my $param_union = MyArrayRef[Int | ArrayRef]; should_pass([], $param_union); should_pass([1,2,3], $param_union); should_pass([[],[]], $param_union); should_pass([11,[]], $param_union); should_pass([[],11], $param_union); should_fail([1.111], $param_union); done_testing; Type-Tiny-0.022/t/oo-classinsideout.t0000644000175000017500000001042312161671331015570 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. =head1 DEPENDENCIES Test is skipped if Class::InsideOut 1.13 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. Based on C<< t/14_accessor_hooks.t >> from the Class::InsideOut test suite, by David Golden. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by David Golden, Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { "Class::InsideOut" => 1.13 }; use Test::More; BEGIN { package Object::HookedTT; use Class::InsideOut ':std'; use Types::Standard -types; # $_ has the first argument in it for convenience public integer => my %integer, { set_hook => Int }; # first argument is also available directly public word => my %word, { set_hook => StrMatch[qr/\A\w+\z/] }; # Changing $_ changes what gets stored my $UC = (StrMatch[qr/\A[A-Z]+\z/])->plus_coercions(Str, q{uc $_}); public uppercase => my %uppercase, { set_hook => sub { $_ = $UC->coercion->($_) }, }; # Full @_ is available, but only first gets stored public list => my %list, { set_hook => sub { $_ = ArrayRef->check($_) ? $_ : [ @_ ] }, get_hook => sub { @$_ }, }; public reverser => my %reverser, { set_hook => sub { $_ = ArrayRef->check($_) ? $_ : [ @_ ] }, get_hook => sub { reverse @$_ } }; public write_only => my %only_only, { get_hook => sub { die "is write-only\n" } }; sub new { register( bless {}, shift ); } }; #--------------------------------------------------------------------------# my $class = "Object::HookedTT"; my $properties = { $class => { integer => "public", uppercase => "public", word => "public", list => "public", reverser => "public", write_only => "public", }, }; my ($o, @got, $got); #--------------------------------------------------------------------------# is_deeply( Class::InsideOut::_properties( $class ), $properties, "$class has/inherited its expected properties", ); ok( ($o = $class->new()) && $o->isa($class), "Creating a $class object", ); #--------------------------------------------------------------------------# eval { $o->integer(3.14) }; my $err = $@; like( $err, '/integer\(\) Value "3.14" did not pass type constraint "Int"/i', "integer(3.14) dies", ); eval { $o->integer(42) }; is( $@, q{}, "integer(42) lives", ); is( $o->integer, 42, "integer() == 42", ); #--------------------------------------------------------------------------# eval { $o->word("^^^^") }; like( $@, '/word\(\) value "\^\^\^\^" did not pass type constraint/i', "word(^^^^) dies", ); eval { $o->word("apple") }; is( $@, q{}, "word(apple) lives", ); is( $o->word, 'apple', "word() eq 'apple'", ); #--------------------------------------------------------------------------# eval { $o->uppercase("banana") }; is( $@, q{}, "uppercase(banana) lives", ); is( $o->uppercase, 'BANANA', "uppercase() eq 'BANANA'", ); #--------------------------------------------------------------------------# # list(@array) eval { $o->list(qw(foo bar bam)) }; is( $@, q{}, "list(qw(foo bar bam)) lives", ); is_deeply( [ $o->list ], [qw(foo bar bam)], "list() gives qw(foo bar bam)", ); # list(\@array) eval { $o->list( [qw(foo bar bam)] ) }; is( $@, q{}, "list( [qw(foo bar bam)] ) lives", ); is_deeply( [ $o->list ], [qw(foo bar bam)], "list() gives qw(foo bar bam)", ); #--------------------------------------------------------------------------# eval { $o->reverser(qw(foo bar bam)) }; is( $@, q{}, "reverser(qw(foo bar bam)) lives", ); # reverser in list context @got = $o->reverser; is_deeply( \@got, [qw(bam bar foo)], "reverser() in list context gives qw(bam bar foo)", ); # reverser in scalar context $got = $o->reverser; is( $got, 'mabraboof', "reverser() in scalar context gives mabraboof", ); #--------------------------------------------------------------------------# eval { $o->write_only( 23 ) }; is( $@, q{}, "write_only lives on write", ); eval { $got = $o->write_only() }; like( $@, '/write_only\(\) is write-only at/i', "write only dies on write (and was caught)", ); done_testing; Type-Tiny-0.022/t/parameterization.t0000644000175000017500000000310012161671331015474 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE There are loads of tests for parameterization in C, C, C, C, C, C, etc. This file includes a handful of other parameterization-related tests that didn't fit anywhere else. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny -all; use Types::Standard -types; my $p1 = ArrayRef[Int]; my $p2 = ArrayRef[Int]; my $p3 = ArrayRef[Int->create_child_type()]; is($p1->{uniq}, $p2->{uniq}, "Avoid duplicating parameterized types"); isnt($p1->{uniq}, $p3->{uniq}, "... except when necessary!"); =pod =begin not_yet_implemented my $p4 = ArrayRef[sub { $_ eq "Bob" }]; my $p5 = ArrayRef[sub { $_ eq "Bob" or die "not Bob" }]; should_pass(["Bob"], $p4); should_pass(["Bob", "Bob"], $p4); should_fail(["Bob", "Bob", "Suzie"], $p4); should_pass(["Bob"], $p5); should_pass(["Bob", "Bob"], $p5); should_fail(["Bob", "Bob", "Suzie"], $p5); is( $p4->parameters->[0]->validate("Suzie"), 'Value "Suzie" did not pass type constraint', 'error message when a coderef returns false', ); like( $p5->parameters->[0]->validate("Suzie"), qr{^not Bob}, 'error message when a coderef dies', ); =end not_yet_implemented =cut done_testing; Type-Tiny-0.022/t/moose-coercion.t0000644000175000017500000000504512161671331015051 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check coercions work with L; both mutable and immutable classes. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moose 2.0000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moose => 2.0000 }; use Test::Fatal; my @warnings; { package Local::Class; use Moose; use BiggerLib -all; ::isa_ok(BigInteger, "Moose::Meta::TypeConstraint"); has small => (is => "rw", isa => SmallInteger, coerce => 1); has big => (is => "rw", isa => BigInteger, coerce => 1); local $SIG{__WARN__} = sub { push @warnings, \@_ }; has big_nc => (is => "rw", isa => BigInteger->no_coercions, coerce => 1); } like( $warnings[0][0], qr{^You cannot coerce an attribute .?big_nc.? unless its type .?\w+.? has a coercion}, "no_coercions and friends available on Moose type constraint objects", ); my ($e, $o); my $suffix = "mutable class"; for (0..1) { $e = exception { $o = "Local::Class"->new( small => 104, big => 9, ); }; is($e, undef, "no exception on coercion in constructor - $suffix"); is($o && $o->big, 19, "'big' attribute coerces in constructor - $suffix"); is($o && $o->small, 4, "'small' attribute coerces in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => [], big => {}, ); }; like($e, qr{^Attribute \(big\)}, "'big' attribute throws when it cannot coerce in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => {}, big => [], ); }; like($e, qr{^Attribute \(small\)}, "'small' attribute throws when it cannot coerce in constructor - $suffix"); $o = "Local::Class"->new; $e = exception { $o->big([]); $o->small([]); }; is($o && $o->big, 100, "'big' attribute coerces in accessor - $suffix"); is($o && $o->small, 1, "'small' attribute coerces in accessor - $suffix"); $e = exception { $o->big({}) }; like($e, qr{^Attribute \(big\)}, "'big' attribute throws when it cannot coerce in accessor - $suffix"); $e = exception { $o->small({}) }; like($e, qr{^Attribute \(small\)}, "'small' attribute throws when it cannot coerce in accessor - $suffix"); "Local::Class"->meta->make_immutable; $suffix = "im$suffix"; } done_testing; Type-Tiny-0.022/t/params-slurpy.t0000644000175000017500000000243412161671331014746 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L usage with slurpy parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types, "slurpy"; my $chk = compile(Str, slurpy HashRef[Int]); is_deeply( [ $chk->("Hello", foo => 1, bar => 2) ], [ "Hello", { foo => 1, bar => 2 } ] ); like( exception { $chk->("Hello", foo => 1, bar => 2.1) }, qr{did not pass type constraint "HashRef\[Int\]" \(in \$SLURPY\)}, ); my $chk2 = compile(Str, slurpy HashRef); is_deeply( [ $chk2->("Hello", foo => 1, bar => 2) ], [ "Hello", { foo => 1, bar => 2 } ] ); like( exception { $chk2->("Hello", foo => 1, "bar") }, qr{^Odd number of elements in HashRef}, ); my $chk3 = compile(Str, slurpy Map); like( exception { $chk3->("Hello", foo => 1, "bar") }, qr{^Odd number of elements in Map}, ); my $chk4 = compile(Str, slurpy Tuple[Str, Int, Str]); is_deeply( [ $chk4->("Hello", foo => 1, "bar") ], [ Hello => [qw/ foo 1 bar /] ], ); done_testing; Type-Tiny-0.022/t/type-union.t0000644000175000017500000000500712162254212014231 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks union type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use BiggerLib qw( :types ); use Type::Utils qw( union class_type ); { my $x; sub FooBarOrDoesQuux () { $x ||= union(FooBarOrDoesQuux => [FooBar, DoesQuux]) } } isa_ok( FooBarOrDoesQuux, 'Type::Tiny::Union', 'FooBarOrDoesQuux', ); isa_ok( FooBarOrDoesQuux->[0], 'Type::Tiny::Class', 'FooBarOrDoesQuux->[0]', ); isa_ok( FooBarOrDoesQuux->[1], 'Type::Tiny::Role', 'FooBarOrDoesQuux->[1]', ); is( FooBarOrDoesQuux."", 'FooBar|DoesQuux', 'stringification good', ); my $something = bless [] => do { package Something; sub DOES { return 1 if $_[1] eq 'Quux'; $_[0]->isa($_[0]); } __PACKAGE__; }; should_pass("Foo::Bar"->new, FooBarOrDoesQuux); should_pass("Foo::Baz"->new, FooBarOrDoesQuux); should_pass($something, FooBarOrDoesQuux); my $something_else = bless [] => do { package Something::Else; sub DOES { return 1 if $_[1] eq 'Else'; $_[0]->isa($_[0]); } __PACKAGE__; }; should_fail($something_else, FooBarOrDoesQuux); should_fail("Foo::Bar", FooBarOrDoesQuux); should_fail("Foo::Baz", FooBarOrDoesQuux); { my $x; sub NotherUnion () { $x ||= union(NotherUnion => [BigInteger, FooBarOrDoesQuux, SmallInteger]) } } is( scalar @{+NotherUnion}, 4, "unions don't get unnecessarily deep", ); { package Local::A } { package Local::B } { package Local::C } { package Local::A::A; our @ISA = qw(Local::A) } { package Local::A::B; our @ISA = qw(Local::A) } { package Local::A::AB; our @ISA = qw(Local::A::A Local::A::B) } { package Local::A::X; our @ISA = qw(Local::A) } my $c1 = union [ class_type({ class => "Local::A::AB" }), class_type({ class => "Local::A::X" }), ]; ok( $c1->parent == class_type({ class => "Local::A" }), "can climb up parents of union type constraints to find best common ancestor", ); my $c2 = union [ class_type({ class => "Local::A" }), class_type({ class => "Local::B" }), class_type({ class => "Local::C" }), ]; ok( $c2->parent == Types::Standard::Object(), "can climb up parents of union type constraints to find best common ancestor (again)", ); done_testing; Type-Tiny-0.022/t/arithmetic.t0000644000175000017500000001126112161671331014256 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Tests overloading of bitwise operators and numeric comparison operators for L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard -all; my $var = 123; should_fail(\$var, ~ScalarRef); should_fail([], ~ArrayRef); should_fail(+{}, ~HashRef); should_fail(sub {0}, ~CodeRef); should_fail(\*STDOUT, ~GlobRef); should_fail(\(\"Hello"), ~Ref); should_fail(\*STDOUT, ~FileHandle); should_fail(qr{x}, ~RegexpRef); should_fail(1, ~Str); should_fail(1, ~Num); should_fail(1, ~Int); should_fail(1, ~Defined); should_fail(1, ~Value); should_fail(undef, ~Undef); should_fail(undef, ~Item); should_fail(undef, ~Any); should_fail('Type::Tiny', ~ClassName); should_fail('Type::Library', ~RoleName); should_fail(undef, ~Bool); should_fail('', ~Bool); should_fail(0, ~Bool); should_fail(1, ~Bool); should_pass(7, ~Bool); should_fail(\(\"Hello"), ~ScalarRef); should_pass('Type::Tiny', ~RoleName); should_pass([], ~Str); should_pass([], ~Num); should_pass([], ~Int); should_fail("4x4", ~Str); should_pass("4x4", ~Num); should_pass("4.2", ~Int); should_pass(undef, ~Str); should_pass(undef, ~Num); should_pass(undef, ~Int); should_pass(undef, ~Defined); should_pass(undef, ~Value); { package Local::Class1; use strict; } { no warnings 'once'; $Local::Class2::VERSION = 0.001; @Local::Class3::ISA = qw(UNIVERSAL); @Local::Dummy1::FOO = qw(UNIVERSAL); } { package Local::Class4; sub XYZ () { 1 } } should_pass(undef, ~ClassName); should_pass([], ~ClassName); should_fail("Local::Class$_", ~ClassName) for 2..4; should_pass("Local::Dummy1", ~ClassName); should_fail([], ~(ArrayRef[Int])); should_fail([1,2,3], ~(ArrayRef[Int])); should_pass([1.1,2,3], ~(ArrayRef[Int])); should_pass([1,2,3.1], ~(ArrayRef[Int])); should_pass([[]], ~(ArrayRef[Int])); should_fail([[3]], ~(ArrayRef[ArrayRef[Int]])); should_pass([["A"]], ~(ArrayRef[ArrayRef[Int]])); should_fail(undef, ~(Maybe[Int])); should_fail(123, ~(Maybe[Int])); should_pass(1.3, ~(Maybe[Int])); my $even = "Type::Tiny"->new( name => "Even", parent => Int, constraint => sub { !(abs($_) % 2) }, ); my $odd = "Type::Tiny"->new( name => "Even", parent => Int, constraint => sub { !!(abs($_) % 2) }, ); my $positive = "Type::Tiny"->new( name => "Positive", parent => Int, constraint => sub { $_ > 0 }, ); my $negative = "Type::Tiny"->new( name => "Negative", parent => Int, constraint => sub { $_ < 0 }, ); should_pass(-2, $even & $negative); should_pass(-1, $odd & $negative); should_pass(0, $even & ~$negative & ~$positive); should_pass(1, $odd & $positive); should_pass(2, $even & $positive); should_pass(3, $even | $odd); should_pass(4, $even | $odd); should_pass(5, $negative | $positive); should_pass(-6, $negative | $positive); should_fail(-3, $even & $negative); should_fail(1, $odd & $negative); should_fail(1, $even & ~$negative & ~$positive); should_fail(2, $odd & $positive); should_fail(1, $even & $positive); should_fail("Str", $even | $odd); should_fail(1.1, $even | $odd); should_fail(0, $negative | $positive); should_fail("Str", $negative | $positive); is( ($even & ~$negative & ~$positive)->display_name, "Even&~Negative&~Positive", "coolio stringification", ); ok(Item > Value, "Item > Value"); ok(Value > Str, "Value > Str"); ok(Str > Num, "Str > Num"); ok(Num > Int, "Num > Int"); ok(Int > $odd, "Int > \$odd"); ok(Item >= Value, "Item >= Value"); ok(Value >= Str, "Value >= Str"); ok(Str >= Num, "Str >= Num"); ok(Num >= Int, "Num >= Int"); ok(Int >= $odd, "Int >= \$odd"); ok(Value() < Item, "Value < Item"); ok(Str() < Value, "Str < Value"); ok(Num() < Str, "Num < Str"); ok(Int() < Num, "Int < Num"); ok($even < Int, "\$even < Int"); ok(Value() <= Item, "Value <= Item"); ok(Str() <= Value, "Str <= Value"); ok(Num() <= Str, "Num <= Str"); ok(Int() <= Num, "Int <= Num"); ok($even <= Int, "\$even < Int"); ok(not(Int > Int), "not(Int > Int)"); ok(not(Int() < Int), "not(Int < Int)"); ok(Int() <= Int, "Int <= Int"); ok(Int >= Int, "Int >= Int"); ok(not((ArrayRef[Int]) > (ArrayRef[Num])), 'not(ArrayRef[Int] > ArrayRef[Num])'); ok(not((ArrayRef[Int]) == (ArrayRef[Num])), 'not(ArrayRef[Int] == ArrayRef[Num])'); ok((ArrayRef[Int]) == (ArrayRef[Int]), 'ArrayRef[Int] == ArrayRef[Int]'); ok(not(ArrayRef == ArrayRef[Int]), 'not(ArrayRef == ArrayRef[Int])'); ok(ArrayRef > ArrayRef[Int], 'ArrayRef > ArrayRef[Int]'); done_testing; Type-Tiny-0.022/t/params-coerce.t0000644000175000017500000000305212161671331014645 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L usage of types with coercions. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types, "slurpy"; use Type::Utils; use Scalar::Util qw(refaddr); my $RoundedInt = declare as Int; coerce $RoundedInt, from Num, q{ int($_) }; my $chk = compile(Int, $RoundedInt, Num); is_deeply( [ $chk->(1, 2, 3.3) ], [ 1, 2, 3.3 ] ); is_deeply( [ $chk->(1, 2.2, 3.3) ], [ 1, 2, 3.3 ] ); like( exception { $chk->(1.1, 2.2, 3.3) }, qr{^Value "1\.1" did not pass type constraint "Int" \(in \$_\[0\]\)}, ); my $chk2 = compile(ArrayRef[$RoundedInt]); is_deeply( [ $chk2->([1, 2, 3]) ], [ [1, 2, 3] ] ); is_deeply( [ $chk2->([1.1, 2.2, 3.3]) ], [ [1, 2, 3] ] ); is_deeply( [ $chk2->([1.1, 2, 3.3]) ], [ [1, 2, 3] ] ); my $arr = [ 1 ]; my $arr2 = [ 1.1 ]; is( refaddr( [$chk2->($arr)]->[0] ), refaddr($arr), 'if value passes type constraint; no need to clone arrayref' ); isnt( refaddr( [$chk2->($arr2)]->[0] ), refaddr($arr2), 'if value fails type constraint; need to clone arrayref' ); my $chk3 = compile($RoundedInt->no_coercions); like( exception { $chk3->(1.1) }, qr{^Value "1\.1" did not pass type constraint "__ANON__" \(in \$_\[0\]\)}, ); done_testing; Type-Tiny-0.022/t/moose.t0000644000175000017500000001306412175713635013263 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. Checks values that should pass and should fail; checks error messages. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moose 2.0000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moose => 2.0000 }; use Test::Fatal; note "The basics"; { package Local::Class; use Moose; use BiggerLib -all; has small => (is => "ro", isa => SmallInteger); has big => (is => "ro", isa => BigInteger); } is( exception { "Local::Class"->new(small => 9, big => 12) }, undef, "some values that should pass their type constraint", ); like( exception { "Local::Class"->new(small => 100) }, qr{^Attribute \(small\) does not pass the type constraint}, "direct violation of type constraint", ); like( exception { "Local::Class"->new(small => 5.5) }, qr{^Attribute \(small\) does not pass the type constraint}, "violation of parent type constraint", ); like( exception { "Local::Class"->new(small => "five point five") }, qr{^Attribute \(small\) does not pass the type constraint}, "violation of grandparent type constraint", ); like( exception { "Local::Class"->new(small => []) }, qr{^Attribute \(small\) does not pass the type constraint}, "violation of great-grandparent type constraint", ); note "Introspection, comparisons, conversions..."; require Types::Standard; ok( Types::Standard::Num->moose_type->equals( Moose::Util::TypeConstraints::find_type_constraint("Num") ), "equivalence between Types::Standard types and core Moose types", ); require Type::Utils; my $classtype = Type::Utils::class_type(LocalClass => { class => "Local::Class" })->moose_type; isa_ok( $classtype, "Moose::Meta::TypeConstraint::Class", '$classtype', ); is( $classtype->class, "Local::Class", "Type::Tiny::Class provides meta information to Moose::Meta::TypeConstraint::Class", ); isa_ok( $classtype->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Class', '$classtype->Types::TypeTiny::to_TypeTiny', ); my $roletype = Type::Utils::role_type(LocalRole => { class => "Local::Role" })->moose_type; isa_ok( $roletype, "Moose::Meta::TypeConstraint", '$roletype', ); ok( !$roletype->isa("Moose::Meta::TypeConstraint::Role"), "NB! Type::Tiny::Role does not inflate to Moose::Meta::TypeConstraint::Role because of differing notions as to what constitutes a role.", ); isa_ok( $roletype->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Role', '$roletype->Types::TypeTiny::to_TypeTiny', ); my $ducktype = Type::Utils::duck_type(Darkwing => [qw/ foo bar baz /])->moose_type; isa_ok( $ducktype, "Moose::Meta::TypeConstraint::DuckType", '$ducktype', ); is_deeply( [sort @{$ducktype->methods}], [sort qw/ foo bar baz /], "Type::Tiny::Duck provides meta information to Moose::Meta::TypeConstraint::DuckType", ); isa_ok( $ducktype->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Duck', '$ducktype->Types::TypeTiny::to_TypeTiny', ); my $enumtype = Type::Utils::enum(MyEnum => [qw/ foo bar baz /])->moose_type; isa_ok( $enumtype, "Moose::Meta::TypeConstraint::Enum", '$classtype', ); is_deeply( [sort @{$enumtype->values}], [sort qw/ foo bar baz /], "Type::Tiny::Enum provides meta information to Moose::Meta::TypeConstraint::Enum", ); isa_ok( $enumtype->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Enum', '$enumtype->Types::TypeTiny::to_TypeTiny', ); my $union = Type::Utils::union(ICU => [$classtype->Types::TypeTiny::to_TypeTiny, $roletype->Types::TypeTiny::to_TypeTiny])->moose_type; isa_ok( $union, "Moose::Meta::TypeConstraint::Union", '$union', ); is_deeply( [sort @{$union->type_constraints}], [sort $classtype, $roletype], "Type::Tiny::Union provides meta information to Moose::Meta::TypeConstraint::Union", ); isa_ok( $union->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Union', '$union->Types::TypeTiny::to_TypeTiny', ); is( [sort @{$union->type_constraints}]->[0]->Types::TypeTiny::to_TypeTiny->{uniq}, $classtype->Types::TypeTiny::to_TypeTiny->{uniq}, '$union->type_constraints->[$i]->Types::TypeTiny::to_TypeTiny provides access to underlying Type::Tiny objects' ); my $intersect = Type::Utils::intersection(Chuck => [$classtype->Types::TypeTiny::to_TypeTiny, $roletype->Types::TypeTiny::to_TypeTiny])->moose_type; isa_ok( $intersect, "Moose::Meta::TypeConstraint", '$intersect', ); isa_ok( $intersect->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Intersection', '$intersect->Types::TypeTiny::to_TypeTiny', ); is( Scalar::Util::refaddr( $intersect->Types::TypeTiny::to_TypeTiny ), Scalar::Util::refaddr( $intersect->Types::TypeTiny::to_TypeTiny->moose_type->Types::TypeTiny::to_TypeTiny->moose_type->Types::TypeTiny::to_TypeTiny ), 'round-tripping between ->moose_type and ->Types::TypeTiny::to_TypeTiny preserves reference address' ); note "Native attribute traits"; { package MyCollection; use Moose; use Types::Standard qw( ArrayRef Object ); has things => ( is => 'ro', isa => ArrayRef[ Object ], traits => [ 'Array' ], handles => { add => 'push' }, ); } my $coll = MyCollection->new(things => []); ok( !exception { $coll->add(bless {}, "Monkey") }, 'pushing ok value', ); like( exception { $coll->add({})}, qr{^A new member value for things does not pass its type constraint because:}, 'pushing not ok value', ); done_testing; Type-Tiny-0.022/t/params-positional.t0000644000175000017500000000251312161671331015567 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L positional parameters, a la the example in the documentation: sub nth_root { state $check = compile( Num, Num ); my ($x, $n) = $check->(@_); return $x ** (1 / $n); } =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard qw(Num); my $check; sub nth_root { $check ||= compile( Num, Num ); [ $check->(@_) ]; } is_deeply( nth_root(1, 2), [ 1, 2 ], '(1, 2)', ); is_deeply( nth_root("1.1", 2), [ "1.1", 2 ], '(1.1, 2)', ); { my $e = exception { nth_root() }; like($e, qr{^Wrong number of parameters; got 0; expected 2}, '(1)'); } { my $e = exception { nth_root(1) }; like($e, qr{^Wrong number of parameters; got 1; expected 2}, '(1)'); } { my $e = exception { nth_root(undef, 1) }; like($e, qr{^Undef did not pass type constraint "Num" \(in \$_\[0\]\)}, '(undef, 1)'); } { my $e = exception { nth_root(1, 2, 3) }; like($e, qr{^Wrong number of parameters; got 3; expected 2}, '(1)'); } done_testing; Type-Tiny-0.022/t/coercion-modifiers.t0000644000175000017500000000374412161671331015714 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Checks C, C and C methods work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal qw(dies_ok); use BiggerLib -types; my $new_type = BigInteger->plus_coercions( HashRef, "999", Undef, sub { 666 }, ); my $arr = []; my $hash = {}; ok( $new_type->coercion->has_coercion_for_type(HashRef), 'has_coercian_for_type - obvious', ); ok( $new_type->coercion->has_coercion_for_type(HashRef[Num]), 'has_coercian_for_type - subtle', ); ok( not($new_type->coercion->has_coercion_for_type(Ref["CODE"])), 'has_coercian_for_type - negative', ); is($new_type->coerce($hash), 999, 'plus_coercions - added coercion'); is($new_type->coerce(undef), 666, 'plus_coercions - added coercion'); is($new_type->coerce(-1), 11, 'plus_coercions - retained coercion'); is($new_type->coerce($arr), 100, 'plus_coercions - retained coercion'); my $newer_type = $new_type->minus_coercions(ArrayRef, Undef); is($newer_type->coerce($hash), 999, 'minus_coercions - retained coercion'); is($newer_type->coerce(undef), undef, 'minus_coercions - removed coercion'); is($newer_type->coerce(-1), 11, 'minus_coercions - retained coercion'); is($newer_type->coerce($arr), $arr, 'minus_coercions - removed coercion'); my $no_coerce = $new_type->no_coercions; dies_ok { $no_coerce->coerce($hash) } 'no_coercions - removed coercion'; dies_ok { $no_coerce->coerce(undef) } 'no_coercions - removed coercion'; dies_ok { $no_coerce->coerce(-1) } 'no_coercions - removed coercion'; dies_ok { $no_coerce->coerce($arr) } 'no_coercions - removed coercion'; done_testing; Type-Tiny-0.022/t/rt86004.t0000644000175000017500000000510712161671331013156 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Test L with more complex Dict coercion. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; BEGIN { package Types; use Type::Library -base, -declare => qw[ StrList ]; use Type::Utils; use Types::Standard qw[ ArrayRef Str ]; declare StrList, as ArrayRef [Str]; coerce StrList, from Str, q { [$_] }; }; use Test::More; use Test::Fatal; use Type::Params qw[ validate compile ]; use Types::Standard -all; sub a { validate( \@_, slurpy Dict [ connect => Optional [Bool], encoding => Optional [Str], hg => Optional [Types::StrList], ] ); } sub b { validate( \@_, slurpy Dict [ connect => Optional [Bool], hg => Optional [Types::StrList], ] ); } sub c { validate( \@_, slurpy Dict [ connect => Optional [Bool], encoding => Optional [Str], hg2 => Optional [Types::StrList->no_coercions->plus_coercions(Types::Standard::Str, sub {[$_]})], ] ); } my $expect = { connect => 1, hg => ['a'], }; my $expect2 = { connect => 1, hg2 => ['a'], }; # 1 { my ( $opts, $e ); $e = exception { ( $opts ) = a( connect => 1, hg => ['a'] ) } and diag $e; is_deeply( $opts, $expect, "StrList ArrayRef" ); } # 2 { my ( $opts, $e ); $e = exception { ( $opts ) = a( connect => 1, hg => 'a' ) } and diag $e; is_deeply( $opts, $expect, "StrList scalar" ); } # 3 { my ( $opts, $e ); $e = exception { ( $opts ) = b( connect => 1, hg => ['a'] ) } and diag $e; is_deeply( $opts, $expect, "StrList ArrayRef" ); } # 4 { my ( $opts, $e ); $e = exception { ( $opts ) = b( connect => 1, hg => 'a' ) } and diag $e; is_deeply( $opts, $expect, "StrList scalar" ); } # 5 { my ( $opts, $e ); $e = exception { ( $opts ) = c( connect => 1, hg2 => ['a'] ) } and diag $e; is_deeply( $opts, $expect2, "StrList ArrayRef - noninline" ); } # 6 { my ( $opts, $e ); $e = exception { ( $opts ) = c( connect => 1, hg2 => 'a' ) } and diag $e; is_deeply( $opts, $expect2, "StrList scalar - noninline" ); } #note compile( # { want_source => 1 }, # slurpy Dict [ # connect => Optional[Bool], # encoding => Optional[Str], # hg => Optional[Types::StrList], # ], #); done_testing; Type-Tiny-0.022/t/mousextypes.t0000644000175000017500000000305212162363505014533 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Complex checks between Type::Tiny and L. =head1 DEPENDENCIES MouseX::Types 0.06; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MouseX::Types" => "0.06" }; use Test::TypeTiny; use MouseX::Types::Moose qw(Int ArrayRef); use Types::Standard -all => { -prefix => "My" }; my $union1 = Int | MyArrayRef; my $union2 = MyArrayRef | Int; isa_ok($union1, "Mouse::Meta::TypeConstraint"); isa_ok($union1, "Mouse::Meta::TypeConstraint"); isa_ok($union2, "Type::Tiny"); should_pass([], $union1); should_pass(2, $union1); should_fail({}, $union1); should_pass([], $union2); should_pass(2, $union2); should_fail({}, $union2); note explain($union2); my $param1 = MyArrayRef[Int]; my $param2 = ArrayRef[MyInt]; should_pass([1,2,3], $param1); should_pass([], $param1); should_fail({}, $param1); should_fail(["x"], $param1); should_pass([1,2,3], $param2); should_pass([], $param2); should_fail({}, $param2); should_fail(["x"], $param2); my $param_union = MyArrayRef[Int | ArrayRef]; should_pass([], $param_union); should_pass([1,2,3], $param_union); should_pass([[],[]], $param_union); should_pass([11,[]], $param_union); should_pass([[],11], $param_union); should_fail([1.111], $param_union); done_testing; Type-Tiny-0.022/t/exporter-roleconflict.t0000644000175000017500000000231012172320012016436 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Tests exporting to two roles; tries to avoid reporting conflicts. =head1 DEPENDENCIES Requires L 5.59 and L 1.000000; test skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 THANKS This test case is based on a script provided by Kevin Dawson. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { "Exporter" => 5.59 }; use Test::Requires { "Role::Tiny" => 1.000000 }; use Test::More; use Test::Fatal; { package Local::Role1; use Role::Tiny; use Types::Standard "Str"; } { package Local::Role2; use Role::Tiny; use Types::Standard "Str"; } my $e = exception { package Local::Class1; use Role::Tiny::With; with qw( Local::Role1 Local::Role2 ); }; is($e, undef, 'no exception when trying to compose two roles that use type constraints'); use Scalar::Util "refaddr"; note refaddr(\&Local::Role1::Str); note refaddr(\&Local::Role2::Str); done_testing; Type-Tiny-0.022/README0000644000175000017500000001204012200123720012335 0ustar taitaiNAME Type::Tiny::Manual - an overview of Type::Tiny SYNOPSIS Type::Tiny is a small class for writing type constraints, inspired by Moose's type constraint API. It has no non-core dependencies, and can be used with Moose, Mouse and Moo (or none of the above). Type::Tiny is bundled with Type::Library a framework for organizing type constraints into collections. Also bundled is Types::Standard, a Moose-inspired library of useful type constraints. Type::Params is also provided, to allow very fast checking and coercion of function and method parameters. SEE ALSO * Libraries - how to build a type library with Type::Tiny, Type::Library and Type::Utils * Coercions - adding coercions to type constraints * Using with Moose - how to use Type::Tiny and Type::Library with Moose * Using with Mouse - how to use Type::Tiny and Type::Library with Mouse * Using with Moo - how to use Type::Tiny and Type::Library with Moo * Using with Other OO Frameworks - how to use Type::Tiny and Type::Library with other OO frameworks * Type::Tiny and friends don't need to be used within an OO framework. See FreeMind::Node for an example that does not. * Processing arguments to subs - coerce and validate arguments to functions and methods. * Other modules using Type::Tiny in interesting ways: Type::Tie, Scalar::Does, Set::Equivalence... DEPENDENCIES Type::Tiny requires at least Perl 5.6.1, though certain Unicode-related features (e.g. non-ASCII type constraint names) may work better in newer versions of Perl. At run-time, Type::Tiny requires the following modules: B, B::Deparse, Data::Dumper, Scalar::Util, Text::Balanced, base, overload, strict and warnings. All of these come bundled with Perl itself. (Prior to Perl 5.8, Scalar::Util and Text::Balanced do not come bundled with Perl and will need installing separately from the CPAN.) Certain features require additional modules. Tying a variable to a type constraint (e.g. "tie my $count, Int") requires Type::Tie; stack traces on exceptions require Devel::StackTrace. The Reply::Plugin::TypeTiny plugin for Reply requires Reply (obviously). Devel::LexAlias may *slightly* increase the speed of some of Type::Tiny's compiled coderefs. The test suite additionally requires Test::More, Test::Fatal and Test::Requires. Test::More comes bundled with Perl, but if you are using a version of Perl older than 5.14, you will need to upgrade to at least Test::More version 0.96. Test::Requires and Test::Fatal (plus Try::Tiny which Test::Fatal depends on) are bundled with Type::Tiny in the "inc" directory, so you do not need to install them separately. Perl 5.6.x support is not well tested; if it proves too burdensome to maintain, it may be dropped in a future release. TYPE::TINY VERSUS X Specio Type::Tiny is similar in aim to Specio. The major differences are * Type::Tiny is "tiny" (Specio will eventually have fewer dependencies than it currently does, but is unlikely to ever have zero); * Specio has a somewhat nicer API (better method names; less duplication), and its API is likely to improve further. Type::Tiny's aims at complete compatibility with current versions of Moose and Mouse, so there is a limit to how much I can deviate from the existing APIs of (Moose|Mouse)::Meta::TypeConstraint. MooseX::Types Type::Tiny libraries expose a similar interface to MooseX::Types libraries. In most cases you should be able to rewrite a MooseX::Types library to use Type::Tiny pretty easily. MooX::Types::MooseLike Type::Tiny is faster and supports coercions. Scalar::Does Scalar::Does is somewhat of a precursor to Type::Tiny, but has now been rewritten to use Type::Tiny internally. It gives you a "does($value, $type)" function that is roughly equivalent to "$type->check($value)" except that $type may be one of a list of pre-defined strings (instead of a Type::Tiny type constraint); or may be a package name in which case it will be assumed to be a role and checked with "$value->DOES($type)". BUGS Please report any bugs to . SUPPORT IRC: support is available through in the *#moose* channel on irc.perl.org . If Type::Tiny discussion there becomes overwhelming (unlikely) then I'll move it to a separate channel. AUTHOR Toby Inkster . COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/0000755000175000017500000000000012200124456012235 5ustar taitaiType-Tiny-0.022/lib/Reply/0000755000175000017500000000000012200124456013330 5ustar taitaiType-Tiny-0.022/lib/Reply/Plugin/0000755000175000017500000000000012200124456014566 5ustar taitaiType-Tiny-0.022/lib/Reply/Plugin/TypeTiny.pm0000644000175000017500000000342612200121217016706 0ustar taitaipackage Reply::Plugin::TypeTiny; use strict; use warnings; BEGIN { $Reply::Plugin::TypeTiny::AUTHORITY = 'cpan:TOBYINK'; $Reply::Plugin::TypeTiny::VERSION = '0.022'; }; use base 'Reply::Plugin'; use Scalar::Util qw(blessed); use Term::ANSIColor; sub mangle_error { my $self = shift; my ($err) = @_; if (blessed $err and $err->isa("Type::Exception::Assertion")) { my $explain = $err->explain; if ($explain) { print color("cyan"); print "Type::Exception::Assertion explain:\n"; $self->_explanation($explain, ""); local $| = 1; print "\n"; print color("reset"); } } return @_; } sub _explanation { my $self = shift; my ($ex, $indent) = @_; for my $line (@$ex) { if (ref($line) eq q(ARRAY)) { print "$indent * Explain:\n"; $self->_explanation($line, "$indent "); } else { print "$indent * $line\n"; } } } 1; __END__ =pod =encoding utf-8 =head1 NAME Reply::Plugin::TypeTiny - improved type constraint exceptions in Reply =head1 DESCRIPTION This is a small plugin to improve error messages in L. Not massively tested. =begin trustme =item mangle_error =end trustme =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Devel/0000755000175000017500000000000012200124456013274 5ustar taitaiType-Tiny-0.022/lib/Devel/TypeTiny/0000755000175000017500000000000012200124456015061 5ustar taitaiType-Tiny-0.022/lib/Devel/TypeTiny/Perl56Compat.pm0000644000175000017500000000277712200121217017645 0ustar taitaipackage Devel::TypeTiny::Perl56Compat; use 5.006; use strict; use warnings; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.022'; #### B doesn't provide perlstring() in 5.6. Monkey patch it. use B (); unless (exists &B::perlstring) { my $d; *B::perlstring = sub { require Data::Dumper; $d ||= 'Data::Dumper'->new([])->Indent(0)->Purity(0)->Pad('')->Useqq(1)->Terse(1)->Freezer('')->Toaster(''); my $perlstring = $d->Values([''.shift])->Dump; ($perlstring =~ /^"/) ? $perlstring : qq["$perlstring"]; }; } push @B::EXPORT_OK, 'perlstring'; #### Done! 5.6; __END__ =pod =encoding utf-8 =for stopwords pragmas =head1 NAME Devel::TypeTiny::Perl56Compat - shims to allow Type::Tiny to run on Perl 5.6.x =head1 DESCRIPTION This is not considered part of Type::Tiny's public API. Currently this module just has one job: it patches L to export a C function, as this was only added in Perl 5.8.0. =head1 BUGS Please report any bugs to L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Types/0000755000175000017500000000000012200124456013341 5ustar taitaiType-Tiny-0.022/lib/Types/TypeTiny.pm0000644000175000017500000002046712200121217015465 0ustar taitaipackage Types::TypeTiny; use strict; use warnings; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.022'; use Scalar::Util qw< blessed >; our @EXPORT_OK = qw( CodeLike StringLike TypeTiny HashLike ArrayLike to_TypeTiny ); my %cache; sub import { # do the shuffle! no warnings "redefine"; our @ISA = qw( Exporter::TypeTiny ); require Exporter::TypeTiny; my $next = \&Exporter::TypeTiny::import; *import = $next; goto $next; } sub meta { return $_[0]; } sub get_type { my $self = shift; my $func = $self->can(@_) or return; my $type = $func->(); return $type if blessed($type) && $type->isa("Type::Tiny"); return; } sub StringLike () { require Type::Tiny; $cache{StringLike} ||= "Type::Tiny"->new( name => "StringLike", constraint => sub { !ref($_ ) or Scalar::Util::blessed($_ ) && overload::Method($_ , q[""]) }, inlined => sub { qq/!ref($_[1]) or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[""])/ }, library => __PACKAGE__, ); } sub HashLike () { require Type::Tiny; $cache{HashLike} ||= "Type::Tiny"->new( name => "HashLike", constraint => sub { ref($_ ) eq q[HASH] or Scalar::Util::blessed($_ ) && overload::Method($_ , q[%{}]) }, inlined => sub { qq/ref($_[1]) eq q[HASH] or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[\%{}])/ }, library => __PACKAGE__, ); } sub ArrayLike () { require Type::Tiny; $cache{ArrayLike} ||= "Type::Tiny"->new( name => "ArrayLike", constraint => sub { ref($_ ) eq q[ARRAY] or Scalar::Util::blessed($_ ) && overload::Method($_ , q[@{}]) }, inlined => sub { qq/ref($_[1]) eq q[ARRAY] or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[\@{}])/ }, library => __PACKAGE__, ); } sub CodeLike () { require Type::Tiny; $cache{CodeLike} ||= "Type::Tiny"->new( name => "CodeLike", constraint => sub { ref($_ ) eq q[CODE] or Scalar::Util::blessed($_ ) && overload::Method($_ , q[&{}]) }, inlined => sub { qq/ref($_[1]) eq q[CODE] or Scalar::Util::blessed($_[1]) && overload::Method($_[1], q[\&{}])/ }, library => __PACKAGE__, ); } sub TypeTiny () { require Type::Tiny; $cache{TypeTiny} ||= "Type::Tiny"->new( name => "TypeTiny", constraint => sub { Scalar::Util::blessed($_ ) && $_ ->isa(q[Type::Tiny]) }, inlined => sub { my $var = $_[1]; "Scalar::Util::blessed($var) && $var\->isa(q[Type::Tiny])" }, library => __PACKAGE__, ); } sub to_TypeTiny { my $t = $_[0]; return $t unless ref $t; return $t if ref($t) =~ /^Type::Tiny\b/; if (my $class = blessed $t) { return $t if $class->isa("Type::Tiny"); goto \&_TypeTinyFromMoose if $class->isa("Moose::Meta::TypeConstraint"); goto \&_TypeTinyFromMoose if $class->isa("MooseX::Types::TypeDecorator"); goto \&_TypeTinyFromValidationClass if $class->isa("Validation::Class::Simple"); goto \&_TypeTinyFromValidationClass if $class->isa("Validation::Class"); goto \&_TypeTinyFromGeneric if $t->can("check") && $t->can("get_message"); # i.e. Type::API::Constraint } goto \&_TypeTinyFromCodeRef if ref($t) eq q(CODE); $t; } sub _TypeTinyFromMoose { my $t = $_[0]; if (ref $t->{"Types::TypeTiny::to_TypeTiny"}) { return $t->{"Types::TypeTiny::to_TypeTiny"}; } if ($t->name ne '__ANON__') { require Types::Standard; my $ts = 'Types::Standard'->get_type($t->name); return $ts if $ts->{_is_core}; } my %opts; $opts{display_name} = $t->name; $opts{constraint} = $t->constraint; $opts{parent} = to_TypeTiny($t->parent) if $t->has_parent; $opts{inlined} = sub { shift; $t->_inline_check(@_) } if $t->can_be_inlined; $opts{message} = sub { $t->get_message($_) } if $t->has_message; $opts{moose_type} = $t; require Type::Tiny; return "Type::Tiny"->new(%opts); } sub _TypeTinyFromValidationClass { my $t = $_[0]; require Type::Tiny; require Types::Standard; my %opts = ( parent => Types::Standard::HashRef(), _validation_class => $t, ); if ($t->VERSION >= "7.900048") { $opts{constraint} = sub { $t->params->clear; $t->params->add(%$_); my $f = $t->filtering; $t->filtering('off'); my $r = eval { $t->validate }; $t->filtering($f || 'pre'); return $r; }; $opts{message} = sub { $t->params->clear; $t->params->add(%$_); my $f = $t->filtering; $t->filtering('off'); my $r = (eval { $t->validate } ? "OK" : $t->errors_to_string); $t->filtering($f || 'pre'); return $r; }; } else # need to use hackish method { $opts{constraint} = sub { $t->params->clear; $t->params->add(%$_); no warnings "redefine"; local *Validation::Class::Directive::Filters::execute_filtering = sub { $_[0] }; eval { $t->validate }; }; $opts{message} = sub { $t->params->clear; $t->params->add(%$_); no warnings "redefine"; local *Validation::Class::Directive::Filters::execute_filtering = sub { $_[0] }; eval { $t->validate } ? "OK" : $t->errors_to_string; }; } my $new = "Type::Tiny"->new(%opts); $new->coercion->add_type_coercions( Types::Standard::HashRef() => sub { my %params = %$_; for my $k (keys %params) { delete $params{$_} unless $t->get_fields($k) }; $t->params->clear; $t->params->add(%params); eval { $t->validate }; $t->get_hash; }, ); return $new; } sub _TypeTinyFromGeneric { my $t = $_[0]; # XXX - handle inlining?? # XXX - handle display_name???? my %opts = ( constraint => sub { $t->check(@_ ? @_ : $_) }, message => sub { $t->get_message(@_ ? @_ : $_) }, ); $opts{display_name} = $t->name if $t->can("name"); $opts{coercion} = sub { $t->coerce(@_ ? @_ : $_) } if $t->can("has_coercion") && $t->has_coercion && $t->can("coerce"); require Type::Tiny; return "Type::Tiny"->new(%opts); } sub _TypeTinyFromCodeRef { my $t = $_[0]; require Type::Tiny; return "Type::Tiny"->new( constraint => sub { return !!eval { $t->($_) }; }, message => sub { local $@; eval { $t->($_); 1 } or do { chomp $@; return $@ if $@ }; return sprintf('%s did not pass type constraint', Type::Tiny::_dd($_)); }, ); } 1; __END__ =pod =encoding utf-8 =head1 NAME Types::TypeTiny - type constraints used internally by Type::Tiny =head1 DESCRIPTION Dogfooding. This isn't a real Type::Library-based type library; that would involve too much circularity. But it exports some type constraint "constants": =head2 Types =over =item C<< StringLike >> =item C<< HashLike >> =item C<< ArrayLike >> =item C<< CodeLike >> =item C<< TypeTiny >> =back =head2 Coercion Functions =over =item C<< to_TypeTiny($constraint) >> Promotes (or "demotes" if you prefer) a Moose::Meta::TypeConstraint object to a Type::Tiny object. Can also handle L objects. Type constraints built from Validation::Class objects deliberately I field filters when they do constraint checking (and go to great lengths to do so); using filters for coercion only. (The behaviour of C if we don't do that is just too weird!) Can also handle any object providing C and C methods. (This includes L objects.) If the object also provides C and C methods, these will be used too. Can also handle coderefs (but not blessed coderefs or objects overloading C<< &{} >>). Coderefs are expected to return true iff C<< $_ >> passes the constraint. If C<< $_ >> fails the type constraint, they may either return false, or die with a helpful error message. =back =head2 Methods These are implemented so that C<< Types::TypeTiny->meta->get_type($foo) >> works, for rough compatibility with a real L type library. =over =item C<< meta >> =item C<< get_type($name) >> =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Types/Standard.pm0000644000175000017500000014221412200121217015433 0ustar taitaipackage Types::Standard; use 5.006001; use strict; use warnings; BEGIN { if ($] < 5.008) { require Devel::TypeTiny::Perl56Compat }; } BEGIN { $Types::Standard::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::VERSION = '0.022'; } use Type::Library -base; our @EXPORT_OK = qw( slurpy ); use Scalar::Util qw( blessed looks_like_number ); use Types::TypeTiny (); sub _is_class_loaded { return !!0 if ref $_[0]; return !!0 if !defined $_[0]; my $stash = do { 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; } sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } no warnings; BEGIN { *STRICTNUM = $ENV{PERL_TYPES_STANDARD_STRICTNUM} ? sub(){!!1} : sub(){!!0} }; my $meta = __PACKAGE__->meta; $meta->add_type({ name => "Any", _is_core => 1, inlined => sub { "!!1" }, }); my $_item = $meta->add_type({ name => "Item", _is_core => 1, inlined => sub { "!!1" }, }); $meta->add_type({ name => "Bool", _is_core => 1, parent => $_item, constraint => sub { !defined $_ or $_ eq q() or $_ eq '0' or $_ eq '1' }, inlined => sub { "!defined $_[1] or $_[1] eq q() or $_[1] eq '0' or $_[1] eq '1'" }, }); my $_undef = $meta->add_type({ name => "Undef", _is_core => 1, parent => $_item, constraint => sub { !defined $_ }, inlined => sub { "!defined($_[1])" }, }); my $_def = $meta->add_type({ name => "Defined", _is_core => 1, parent => $_item, constraint => sub { defined $_ }, inlined => sub { "defined($_[1])" }, }); my $_val = $meta->add_type({ name => "Value", _is_core => 1, parent => $_def, constraint => sub { not ref $_ }, inlined => sub { "defined($_[1]) and not ref($_[1])" }, }); my $_str = $meta->add_type({ name => "Str", _is_core => 1, parent => $_val, constraint => sub { ref(\$_) eq 'SCALAR' or ref(\(my $val = $_)) eq 'SCALAR' }, inlined => sub { "defined($_[1]) and do { ref(\\$_[1]) eq 'SCALAR' or ref(\\(my \$val = $_[1])) eq 'SCALAR' }" }, }); my $_laxnum = $meta->add_type({ name => "LaxNum", parent => $_str, constraint => sub { looks_like_number $_ }, inlined => sub { "!ref($_[1]) && Scalar::Util::looks_like_number($_[1])" }, }); my $_strictnum = $meta->add_type({ name => "StrictNum", parent => $_str, constraint => sub { my $val = $_; ($val =~ /\A[+-]?[0-9]+\z/) || ( $val =~ /\A(?:[+-]?) #matches optional +- in the beginning (?=[0-9]|\.[0-9]) #matches previous +- only if there is something like 3 or .3 [0-9]* #matches 0-9 zero or more times (?:\.[0-9]+)? #matches optional .89 or nothing (?:[Ee](?:[+-]?[0-9]+))? #matches E1 or e1 or e-1 or e+1 etc \z/x ); }, inlined => sub { 'my $val = '.$_[1].';'. Value()->inline_check('$val') .' && ( $val =~ /\A[+-]?[0-9]+\z/ || ' . '$val =~ /\A(?:[+-]?) # matches optional +- in the beginning (?=[0-9]|\.[0-9]) # matches previous +- only if there is something like 3 or .3 [0-9]* # matches 0-9 zero or more times (?:\.[0-9]+)? # matches optional .89 or nothing (?:[Ee](?:[+-]?[0-9]+))? # matches E1 or e1 or e-1 or e+1 etc \z/x ); ' }, }); my $_num = $meta->add_type({ name => "Num", _is_core => 1, parent => (STRICTNUM ? $_strictnum : $_laxnum), }); $meta->add_type({ name => "Int", _is_core => 1, parent => $_num, constraint => sub { /\A-?[0-9]+\z/ }, inlined => sub { "defined $_[1] and $_[1] =~ /\\A-?[0-9]+\\z/" }, }); my $_classn = $meta->add_type({ name => "ClassName", _is_core => 1, parent => $_str, constraint => sub { goto \&_is_class_loaded }, inlined => sub { "Types::Standard::_is_class_loaded($_[1])" }, }); $meta->add_type({ name => "RoleName", parent => $_classn, constraint => sub { not $_->can("new") }, inlined => sub { "Types::Standard::_is_class_loaded($_[1]) and not $_[1]\->can('new')" }, }); my $_ref = $meta->add_type({ name => "Ref", _is_core => 1, parent => $_def, constraint => sub { ref $_ }, inlined => sub { "!!ref($_[1])" }, constraint_generator => sub { my $reftype = shift; Types::TypeTiny::StringLike->check($reftype) or _croak("Parameter to Ref[`a] expected to be string; got $reftype"); $reftype = "$reftype"; return sub { ref($_[0]) and Scalar::Util::reftype($_[0]) eq $reftype; } }, inline_generator => sub { my $reftype = shift; return sub { my $v = $_[1]; "ref($v) and Scalar::Util::reftype($v) eq q($reftype)"; }; }, deep_explanation => sub { require B; my ($type, $value, $varname) = @_; my $param = $type->parameters->[0]; return if $type->check($value); my $reftype = Scalar::Util::reftype($value); return [ sprintf('"%s" constrains reftype(%s) to be equal to %s', $type, $varname, B::perlstring($param)), sprintf('reftype(%s) is %s', $varname, defined($reftype) ? B::perlstring($reftype) : "undef"), ]; }, }); $meta->add_type({ name => "CodeRef", _is_core => 1, parent => $_ref, constraint => sub { ref $_ eq "CODE" }, inlined => sub { "ref($_[1]) eq 'CODE'" }, }); $meta->add_type({ name => "RegexpRef", _is_core => 1, parent => $_ref, constraint => sub { ref $_ eq "Regexp" }, inlined => sub { "ref($_[1]) eq 'Regexp'" }, }); $meta->add_type({ name => "GlobRef", _is_core => 1, parent => $_ref, constraint => sub { ref $_ eq "GLOB" }, inlined => sub { "ref($_[1]) eq 'GLOB'" }, }); $meta->add_type({ name => "FileHandle", _is_core => 1, parent => $_ref, constraint => sub { (ref($_) eq "GLOB" && Scalar::Util::openhandle($_)) or (blessed($_) && $_->isa("IO::Handle")) }, inlined => sub { "(ref($_[1]) eq \"GLOB\" && Scalar::Util::openhandle($_[1])) ". "or (Scalar::Util::blessed($_[1]) && $_[1]\->isa(\"IO::Handle\"))" }, }); my $_arr = $meta->add_type({ name => "ArrayRef", _is_core => 1, parent => $_ref, constraint => sub { ref $_ eq "ARRAY" }, inlined => sub { "ref($_[1]) eq 'ARRAY'" }, constraint_generator => sub { my $param = Types::TypeTiny::to_TypeTiny(shift); Types::TypeTiny::TypeTiny->check($param) or _croak("Parameter to ArrayRef[`a] expected to be a type constraint; got $param"); return sub { my $array = shift; $param->check($_) || return for @$array; return !!1; }; }, inline_generator => sub { my $param = shift; return unless $param->can_be_inlined; my $param_check = $param->inline_check('$i'); return sub { my $v = $_[1]; "ref($v) eq 'ARRAY' and do { " . "my \$ok = 1; " . "for my \$i (\@{$v}) { " . "\$ok = 0 && last unless $param_check " . "}; " . "\$ok " ."}" }; }, deep_explanation => sub { my ($type, $value, $varname) = @_; my $param = $type->parameters->[0]; for my $i (0 .. $#$value) { my $item = $value->[$i]; next if $param->check($item); require Type::Exception::Assertion; return [ sprintf('"%s" constrains each value in the array with "%s"', $type, $param), @{ "Type::Exception::Assertion"->_explain( $param, $item, sprintf('%s->[%d]', $varname, $i), ) }, ] } return; }, }); my $_hash = $meta->add_type({ name => "HashRef", _is_core => 1, parent => $_ref, constraint => sub { ref $_ eq "HASH" }, inlined => sub { "ref($_[1]) eq 'HASH'" }, constraint_generator => sub { my $param = Types::TypeTiny::to_TypeTiny(shift); Types::TypeTiny::TypeTiny->check($param) or _croak("Parameter to HashRef[`a] expected to be a type constraint; got $param"); return sub { my $hash = shift; $param->check($_) || return for values %$hash; return !!1; }; }, inline_generator => sub { my $param = shift; return unless $param->can_be_inlined; my $param_check = $param->inline_check('$i'); return sub { my $v = $_[1]; "ref($v) eq 'HASH' and do { " . "my \$ok = 1; " . "for my \$i (values \%{$v}) { " . "\$ok = 0 && last unless $param_check " . "}; " . "\$ok " ."}" }; }, deep_explanation => sub { require B; my ($type, $value, $varname) = @_; my $param = $type->parameters->[0]; for my $k (sort keys %$value) { my $item = $value->{$k}; next if $param->check($item); require Type::Exception::Assertion; return [ sprintf('"%s" constrains each value in the hash with "%s"', $type, $param), @{ "Type::Exception::Assertion"->_explain( $param, $item, sprintf('%s->{%s}', $varname, B::perlstring($k)), ) } ]; } return; }, }); $meta->add_type({ name => "ScalarRef", _is_core => 1, parent => $_ref, constraint => sub { ref $_ eq "SCALAR" or ref $_ eq "REF" }, inlined => sub { "ref($_[1]) eq 'SCALAR' or ref($_[1]) eq 'REF'" }, constraint_generator => sub { my $param = Types::TypeTiny::to_TypeTiny(shift); Types::TypeTiny::TypeTiny->check($param) or _croak("Parameter to ScalarRef[`a] expected to be a type constraint; got $param"); return sub { my $ref = shift; $param->check($$ref) || return; return !!1; }; }, inline_generator => sub { my $param = shift; return unless $param->can_be_inlined; return sub { my $v = $_[1]; my $param_check = $param->inline_check("\${$v}"); "(ref($v) eq 'SCALAR' or ref($v) eq 'REF') and $param_check"; }; }, deep_explanation => sub { my ($type, $value, $varname) = @_; my $param = $type->parameters->[0]; for my $item ($$value) { next if $param->check($item); require Type::Exception::Assertion; return [ sprintf('"%s" constrains the referenced scalar value with "%s"', $type, $param), @{ "Type::Exception::Assertion"->_explain( $param, $item, sprintf('${%s}', $varname), ) } ]; } return; }, }); my $_obj = $meta->add_type({ name => "Object", _is_core => 1, parent => $_ref, constraint => sub { blessed $_ }, inlined => sub { "Scalar::Util::blessed($_[1])" }, }); $meta->add_type({ name => "Maybe", _is_core => 1, parent => $_item, constraint_generator => sub { my $param = Types::TypeTiny::to_TypeTiny(shift); Types::TypeTiny::TypeTiny->check($param) or _croak("Parameter to Maybe[`a] expected to be a type constraint; got $param"); return sub { my $value = shift; return !!1 unless defined $value; return $param->check($value); }; }, inline_generator => sub { my $param = shift; return unless $param->can_be_inlined; return sub { my $v = $_[1]; my $param_check = $param->inline_check($v); "!defined($v) or $param_check"; }; }, deep_explanation => sub { my ($type, $value, $varname) = @_; my $param = $type->parameters->[0]; return [ sprintf('%s is defined', Type::Tiny::_dd($value)), sprintf('"%s" constrains the value with "%s" if it is defined', $type, $param), @{ "Type::Exception::Assertion"->_explain( $param, $value, $varname, ) } ]; }, }); $meta->add_type({ name => "Map", parent => $_hash, constraint_generator => sub { my ($keys, $values) = map Types::TypeTiny::to_TypeTiny($_), @_; Types::TypeTiny::TypeTiny->check($keys) or _croak("First parameter to Map[`k,`v] expected to be a type constraint; got $keys"); Types::TypeTiny::TypeTiny->check($values) or _croak("Second parameter to Map[`k,`v] expected to be a type constraint; got $values"); return sub { my $hash = shift; $keys->check($_) || return for keys %$hash; $values->check($_) || return for values %$hash; return !!1; }; }, inline_generator => sub { my ($k, $v) = @_; return unless $k->can_be_inlined && $v->can_be_inlined; my $k_check = $k->inline_check('$k'); my $v_check = $v->inline_check('$v'); return sub { my $h = $_[1]; "ref($h) eq 'HASH' and do { " . "my \$ok = 1; " . "for my \$v (values \%{$h}) { " . "\$ok = 0 && last unless $v_check " . "}; " . "for my \$k (keys \%{$h}) { " . "\$ok = 0 && last unless $k_check " . "}; " . "\$ok " ."}" }; }, deep_explanation => sub { require B; my ($type, $value, $varname) = @_; my ($kparam, $vparam) = @{ $type->parameters }; for my $k (sort keys %$value) { unless ($kparam->check($k)) { require Type::Exception::Assertion; return [ sprintf('"%s" constrains each key in the hash with "%s"', $type, $kparam), @{ "Type::Exception::Assertion"->_explain( $kparam, $k, sprintf('key %s->{%s}', $varname, B::perlstring($k)), ) } ]; } unless ($vparam->check($value->{$k})) { require Type::Exception::Assertion; return [ sprintf('"%s" constrains each value in the hash with "%s"', $type, $vparam), @{ "Type::Exception::Assertion"->_explain( $vparam, $value->{$k}, sprintf('%s->{%s}', $varname, B::perlstring($k)), ) } ]; } } return; }, }); $meta->add_type({ name => "Optional", parent => $_item, constraint_generator => sub { my $param = Types::TypeTiny::to_TypeTiny(shift); Types::TypeTiny::TypeTiny->check($param) or _croak("Parameter to Optional[`a] expected to be a type constraint; got $param"); sub { exists($_[0]) ? $param->check($_[0]) : !!1 } }, inline_generator => sub { my $param = shift; return unless $param->can_be_inlined; return sub { my $v = $_[1]; my $param_check = $param->inline_check($v); "!exists($v) or $param_check"; }; }, deep_explanation => sub { my ($type, $value, $varname) = @_; my $param = $type->parameters->[0]; return [ sprintf('%s exists', $varname), sprintf('"%s" constrains %s with "%s" if it exists', $type, $varname, $param), @{ "Type::Exception::Assertion"->_explain( $param, $value, $varname, ) } ]; }, }); sub slurpy { my $t = shift; wantarray ? (+{ slurpy => $t }, @_) : +{ slurpy => $t }; } $meta->add_type({ name => "Tuple", parent => $_arr, name_generator => sub { my ($s, @a) = @_; sprintf('%s[%s]', $s, join q[,], map { ref($_) eq "HASH" ? sprintf("slurpy %s", $_->{slurpy}) : $_ } @a); }, constraint_generator => sub { my @constraints = @_; my $slurpy; if (exists $constraints[-1] and ref $constraints[-1] eq "HASH") { $slurpy = Types::TypeTiny::to_TypeTiny(pop(@constraints)->{slurpy}); Types::TypeTiny::TypeTiny->check($slurpy) or _croak("Slurpy parameter to Tuple[...] expected to be a type constraint; got $slurpy"); } @constraints = map Types::TypeTiny::to_TypeTiny($_), @constraints; for (@constraints) { Types::TypeTiny::TypeTiny->check($_) or _croak("Parameters to Tuple[...] expected to be type constraints; got $_"); } return sub { my $value = $_[0]; if ($#constraints < $#$value) { defined($slurpy) && $slurpy->check( $slurpy->is_a_type_of(HashRef()) ? +{@$value[$#constraints+1 .. $#$value]} : +[@$value[$#constraints+1 .. $#$value]] ) or return; } for my $i (0 .. $#constraints) { $constraints[$i]->check(exists $value->[$i] ? $value->[$i] : ()) or return; } return !!1; }; }, inline_generator => sub { my @constraints = @_; my $slurpy; if (exists $constraints[-1] and ref $constraints[-1] eq "HASH") { $slurpy = pop(@constraints)->{slurpy}; } return if grep { not $_->can_be_inlined } @constraints; return if defined $slurpy && !$slurpy->can_be_inlined; my $tmpl = defined($slurpy) && $slurpy->is_a_type_of(HashRef()) ? "do { my \$tmp = +{\@{%s}[%d..\$#{%s}]}; %s }" : "do { my \$tmp = +[\@{%s}[%d..\$#{%s}]]; %s }"; return sub { my $v = $_[1]; join " and ", "ref($v) eq 'ARRAY'", ($slurpy ? sprintf($tmpl, $v, $#constraints+1, $v, $slurpy->inline_check('$tmp')) : sprintf("\@{$v} <= %d", scalar @constraints) ), map { $constraints[$_]->inline_check("$v\->[$_]") } 0 .. $#constraints; }; }, deep_explanation => sub { my ($type, $value, $varname) = @_; my @constraints = @{ $type->parameters }; my $slurpy; if (exists $constraints[-1] and ref $constraints[-1] eq "HASH") { $slurpy = Types::TypeTiny::to_TypeTiny(pop(@constraints)->{slurpy}); } @constraints = map Types::TypeTiny::to_TypeTiny($_), @constraints; if ($#constraints < $#$value and not $slurpy) { return [ sprintf('"%s" expects at most %d values in the array', $type, $#constraints), sprintf('%d values found; too many', $#$value), ]; } for my $i (0 .. $#constraints) { next if $constraints[$i]->is_strictly_a_type_of( Optional() ) && $i > $#$value; next if $constraints[$i]->check($value->[$i]); return [ sprintf('"%s" constrains value at index %d of array with "%s"', $type, $i, $constraints[$i]), @{ "Type::Exception::Assertion"->_explain( $constraints[$i], $value->[$i], sprintf('%s->[%s]', $varname, $i), ) } ]; } if (defined($slurpy)) { my $tmp = $slurpy->is_a_type_of(HashRef()) ? +{@$value[$#constraints+1 .. $#$value]} : +[@$value[$#constraints+1 .. $#$value]]; $slurpy->check($tmp) or return [ sprintf( 'Array elements from index %d are slurped into a %s which is constrained with "%s"', $#constraints+1, $slurpy->is_a_type_of(HashRef()) ? 'hashref' : 'arrayref', $slurpy, ), @{ "Type::Exception::Assertion"->_explain( $slurpy, $tmp, '$SLURPY', ) }, ]; } return; }, }); $meta->add_type({ name => "Dict", parent => $_hash, name_generator => sub { my ($s, %a) = @_; sprintf('%s[%s]', $s, join q[,], map sprintf("%s=>%s", $_, $a{$_}), sort keys %a); }, constraint_generator => sub { my %constraints = @_; while (my ($k, $v) = each %constraints) { $constraints{$k} = Types::TypeTiny::to_TypeTiny($v); Types::TypeTiny::TypeTiny->check($v) or _croak("Parameter to Dict[`a] for key '$k' expected to be a type constraint; got $v"); } return sub { my $value = $_[0]; exists($constraints{$_}) || return for sort keys %$value; for (sort keys %constraints) { my $c = $constraints{$_}; return unless exists($value->{$_}) || $c->is_strictly_a_type_of(Optional()); return unless $c->check( exists $value->{$_} ? $value->{$_} : () ); } return !!1; }; }, inline_generator => sub { # We can only inline a parameterized Dict if all the # constraints inside can be inlined. my %constraints = @_; for my $c (values %constraints) { next if $c->can_be_inlined; return; } my $regexp = join "|", map quotemeta, sort keys %constraints; return sub { require B; my $h = $_[1]; join " and ", "ref($h) eq 'HASH'", "not(grep !/^($regexp)\$/, keys \%{$h})", ( map { my $k = B::perlstring($_); $constraints{$_}->is_strictly_a_type_of( Optional() ) ? $constraints{$_}->inline_check("$h\->{$k}") : ( "exists($h\->{$k})", $constraints{$_}->inline_check("$h\->{$k}") ) } sort keys %constraints ), } }, deep_explanation => sub { require B; my ($type, $value, $varname) = @_; my %constraints = @{ $type->parameters }; for my $k (sort keys %$value) { return [ sprintf('"%s" does not allow key %s to appear in hash', $type, B::perlstring($k)) ] unless exists $constraints{$k}; } for my $k (sort keys %constraints) { next if $constraints{$k}->parent == Optional() && !exists $value->{$k}; next if $constraints{$k}->check($value->{$k}); return [ sprintf('"%s" requires key %s to appear in hash', $type, B::perlstring($k)) ] unless exists $value->{$k}; return [ sprintf('"%s" constrains value at key %s of hash with "%s"', $type, B::perlstring($k), $constraints{$k}), @{ "Type::Exception::Assertion"->_explain( $constraints{$k}, $value->{$k}, sprintf('%s->{%s}', $varname, B::perlstring($k)), ) } ]; } return; }, }); use overload (); $meta->add_type({ name => "Overload", parent => $_obj, constraint => sub { overload::Overloaded($_) }, inlined => sub { "Scalar::Util::blessed($_[1]) and overload::Overloaded($_[1])" }, constraint_generator => sub { my @operations = map { Types::TypeTiny::StringLike->check($_) ? "$_" : _croak("Parameters to Overload[`a] expected to be a strings; got $_"); } @_; return sub { my $value = shift; for my $op (@operations) { return unless overload::Method($value, $op); } return !!1; } }, inline_generator => sub { my @operations = @_; return sub { my $v = $_[1]; join " and ", "Scalar::Util::blessed($v)", map "overload::Method($v, q[$_])", @operations; }; }, }); our %_StrMatch; $meta->add_type({ name => "StrMatch", parent => $_str, constraint_generator => sub { my ($regexp, $checker) = @_; ref($regexp) eq 'Regexp' or _croak("First parameter to StrMatch[`a] expected to be a Regexp; got $regexp"); if (@_ > 1) { $checker = Types::TypeTiny::to_TypeTiny($checker); Types::TypeTiny::TypeTiny->check($checker) or _croak("Second parameter to StrMatch[`a] expected to be a type constraint; got $checker") } $checker ? sub { my $value = shift; return if ref($value); my @m = ($value =~ $regexp); $checker->check(\@m); } : sub { my $value = shift; !ref($value) and $value =~ $regexp; } ; }, inline_generator => sub { require B; my ($regexp, $checker) = @_; my $regexp_string = "$regexp"; $_StrMatch{$regexp_string} = $regexp; if ($checker) { return unless $checker->can_be_inlined; return sub { my $v = $_[1]; sprintf "!ref($v) and do { my \$m = [$v =~ \$Types::Standard::_StrMatch{%s}]; %s }", B::perlstring($regexp_string), $checker->inline_check('$m'), ; }; } else { return sub { my $v = $_[1]; sprintf "!ref($v) and $v =~ \$Types::Standard::_StrMatch{%s}", B::perlstring($regexp_string), ; }; } }, }); $meta->add_type({ name => "OptList", parent => $_arr->parameterize($_arr), constraint => sub { for my $inner (@$_) { return unless @$inner == 2; return unless is_Str($inner->[0]); } return !!1; }, inlined => sub { my ($self, $var) = @_; my $Str_check = __PACKAGE__->meta->get_type("Str")->inline_check('$inner->[0]'); my @code = 'do { my $ok = 1; '; push @code, sprintf('for my $inner (@{%s}) { no warnings; ', $var); push @code, '($ok=0) && last unless @$inner == 2; '; push @code, sprintf('($ok=0) && last unless (%s); ', $Str_check); push @code, '} '; push @code, '$ok }'; my $r = sprintf( '%s and %s', $self->parent->inline_check($var), join(q( ), @code), ); }, }); $meta->add_type({ name => "Tied", parent => $_ref, constraint => sub { !!tied(Scalar::Util::reftype($_) eq 'HASH' ? %{$_} : Scalar::Util::reftype($_) eq 'ARRAY' ? @{$_} : ${$_}) }, inlined => sub { my ($self, $var) = @_; $self->parent->inline_check($var) . " and !!tied(Scalar::Util::reftype($var) eq 'HASH' ? \%{$var} : Scalar::Util::reftype($var) eq 'ARRAY' ? \@{$var} : \${$var})" }, name_generator => sub { my $self = shift; my $param = Types::TypeTiny::to_TypeTiny(shift); unless (Types::TypeTiny::TypeTiny->check($param)) { Types::TypeTiny::StringLike->check($param) or _croak("Parameter to Tied[`a] expected to be a class name; got $param"); require B; return sprintf("%s[%s]", $self, B::perlstring($param)); } return sprintf("%s[%s]", $self, $param); }, constraint_generator => sub { my $param = Types::TypeTiny::to_TypeTiny(shift); unless (Types::TypeTiny::TypeTiny->check($param)) { Types::TypeTiny::StringLike->check($param) or _croak("Parameter to Tied[`a] expected to be a class name; got $param"); require Type::Tiny::Class; $param = "Type::Tiny::Class"->new(class => "$param"); } my $check = $param->compiled_check; return sub { $check->(tied(Scalar::Util::reftype($_) eq 'HASH' ? %{$_} : Scalar::Util::reftype($_) eq 'ARRAY' ? @{$_} : ${$_})); }; }, inline_generator => sub { my $param = Types::TypeTiny::to_TypeTiny(shift); unless (Types::TypeTiny::TypeTiny->check($param)) { Types::TypeTiny::StringLike->check($param) or _croak("Parameter to Tied[`a] expected to be a class name; got $param"); require Type::Tiny::Class; $param = "Type::Tiny::Class"->new(class => "$param"); } return unless $param->can_be_inlined; return sub { require B; my $var = $_[1]; sprintf( "%s and do { my \$TIED = tied(Scalar::Util::reftype($var) eq 'HASH' ? \%{$var} : Scalar::Util::reftype($var) eq 'ARRAY' ? \@{$var} : \${$var}); %s }", Ref()->inline_check($var), $param->inline_check('$TIED') ); }; }, }); $meta->add_type({ name => "InstanceOf", parent => $_obj, constraint_generator => sub { require Type::Tiny::Class; my @classes = map { Types::TypeTiny::TypeTiny->check($_) ? $_ : "Type::Tiny::Class"->new(class => $_, display_name => sprintf('InstanceOf[%s]', B::perlstring($_))) } @_; return $classes[0] if @classes == 1; require B; require Type::Tiny::Union; return "Type::Tiny::Union"->new( type_constraints => \@classes, display_name => sprintf('InstanceOf[%s]', join q[,], map B::perlstring($_->class), @classes), ); }, }); $meta->add_type({ name => "ConsumerOf", parent => $_obj, constraint_generator => sub { require B; require Type::Tiny::Role; my @roles = map { Types::TypeTiny::TypeTiny->check($_) ? $_ : "Type::Tiny::Role"->new(role => $_, display_name => sprintf('ConsumerOf[%s]', B::perlstring($_))) } @_; return $roles[0] if @roles == 1; require Type::Tiny::Intersection; return "Type::Tiny::Intersection"->new( type_constraints => \@roles, display_name => sprintf('ConsumerOf[%s]', join q[,], map B::perlstring($_->role), @roles), ); }, }); $meta->add_type({ name => "HasMethods", parent => $_obj, constraint_generator => sub { require B; require Type::Tiny::Duck; return "Type::Tiny::Duck"->new( methods => \@_, display_name => sprintf('HasMethods[%s]', join q[,], map B::perlstring($_), @_), ); }, }); $meta->add_type({ name => "Enum", parent => $_str, constraint_generator => sub { require B; require Type::Tiny::Enum; return "Type::Tiny::Enum"->new( values => \@_, display_name => sprintf('Enum[%s]', join q[,], map B::perlstring($_), @_), ); }, }); $meta->add_coercion({ name => "MkOpt", type_constraint => $meta->get_type("OptList"), type_coercion_map => [ $_arr, q{ Exporter::TypeTiny::mkopt($_) }, $_hash, q{ Exporter::TypeTiny::mkopt($_) }, $_undef, q{ [] }, ], }); $meta->add_coercion({ name => "Join", type_constraint => $_str, coercion_generator => sub { my ($self, $target, $sep) = @_; Types::TypeTiny::StringLike->check($sep) or _croak("Parameter to Join[`a] expected to be a string; got $sep"); require B; $sep = B::perlstring($sep); return (ArrayRef(), qq{ join($sep, \@\$_) }); }, }); $meta->add_coercion({ name => "Split", type_constraint => $_arr, coercion_generator => sub { my ($self, $target, $re) = @_; ref($re) eq q(Regexp) or _croak("Parameter to Split[`a] expected to be a regular expresssion; got $re"); my $regexp_string = "$re"; $regexp_string =~ s/\\\//\\\\\//g; # toothpicks return (Str(), qq{ [split /$regexp_string/, \$_] }); }, }); #### Deep coercion stuff... sub Stringable (&) { package #private Types::Standard::_Stringable; use overload q[""] => sub { $_[0]{text} ||= $_[0]{code}->() }, fallback => 1; bless +{ code => $_[0] }; } my $lib = "Types::Standard"->meta; $lib->get_type("ArrayRef")->{coercion_generator} = sub { my ($parent, $child, $param) = @_; return unless $param->has_coercion; my $coercable_item = $param->coercion->_source_type_union; my $C = "Type::Coercion"->new(type_constraint => $child); if ($param->coercion->can_be_inlined and $coercable_item->can_be_inlined) { $C->add_type_coercions($parent => Stringable { my @code; push @code, 'do { my ($orig, $return_orig, @new) = ($_, 0);'; push @code, 'for (@$orig) {'; push @code, sprintf('$return_orig++ && last unless (%s);', $coercable_item->inline_check('$_')); push @code, sprintf('push @new, (%s);', $param->coercion->inline_coercion('$_')); push @code, '}'; push @code, '$return_orig ? $orig : \\@new'; push @code, '}'; "@code"; }); } else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my @new; for my $item (@$value) { return $value unless $coercable_item->check($item); push @new, $param->coerce($item); } return \@new; }, ); } return $C; }; $lib->get_type("HashRef")->{coercion_generator} = sub { my ($parent, $child, $param) = @_; return unless $param->has_coercion; my $coercable_item = $param->coercion->_source_type_union; my $C = "Type::Coercion"->new(type_constraint => $child); if ($param->coercion->can_be_inlined and $coercable_item->can_be_inlined) { $C->add_type_coercions($parent => Stringable { my @code; push @code, 'do { my ($orig, $return_orig, %new) = ($_, 0);'; push @code, 'for (keys %$orig) {'; push @code, sprintf('$return_orig++ && last unless (%s);', $coercable_item->inline_check('$orig->{$_}')); push @code, sprintf('$new{$_} = (%s);', $param->coercion->inline_coercion('$orig->{$_}')); push @code, '}'; push @code, '$return_orig ? $orig : \\%new'; push @code, '}'; "@code"; }); } else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my %new; for my $k (keys %$value) { return $value unless $coercable_item->check($value->{$k}); $new{$k} = $param->coerce($value->{$k}); } return \%new; }, ); } return $C; }; $lib->get_type("ScalarRef")->{coercion_generator} = sub { my ($parent, $child, $param) = @_; return unless $param->has_coercion; my $coercable_item = $param->coercion->_source_type_union; my $C = "Type::Coercion"->new(type_constraint => $child); if ($param->coercion->can_be_inlined and $coercable_item->can_be_inlined) { $C->add_type_coercions($parent => Stringable { my @code; push @code, 'do { my ($orig, $return_orig, $new) = ($_, 0);'; push @code, 'for ($$orig) {'; push @code, sprintf('$return_orig++ && last unless (%s);', $coercable_item->inline_check('$_')); push @code, sprintf('$new = (%s);', $param->coercion->inline_coercion('$_')); push @code, '}'; push @code, '$return_orig ? $orig : \\$new'; push @code, '}'; "@code"; }); } else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my $new; for my $item ($$value) { return $value unless $coercable_item->check($item); $new = $param->coerce($item); } return \$new; }, ); } return $C; }; $lib->get_type("Map")->{coercion_generator} = sub { my ($parent, $child, $kparam, $vparam) = @_; return unless $kparam->has_coercion || $vparam->has_coercion; my $kcoercable_item = $kparam->has_coercion ? $kparam->coercion->_source_type_union : $kparam; my $vcoercable_item = $vparam->has_coercion ? $vparam->coercion->_source_type_union : $vparam; my $C = "Type::Coercion"->new(type_constraint => $child); if ((!$kparam->has_coercion or $kparam->coercion->can_be_inlined) and (!$vparam->has_coercion or $vparam->coercion->can_be_inlined) and $kcoercable_item->can_be_inlined and $vcoercable_item->can_be_inlined) { $C->add_type_coercions($parent => Stringable { my @code; push @code, 'do { my ($orig, $return_orig, %new) = ($_, 0);'; push @code, 'for (keys %$orig) {'; push @code, sprintf('$return_orig++ && last unless (%s);', $kcoercable_item->inline_check('$_')); push @code, sprintf('$return_orig++ && last unless (%s);', $vcoercable_item->inline_check('$orig->{$_}')); push @code, sprintf('$new{(%s)} = (%s);', $kparam->has_coercion ? $kparam->coercion->inline_coercion('$_') : '$_', $vparam->has_coercion ? $vparam->coercion->inline_coercion('$orig->{$_}') : '$orig->{$_}', ); push @code, '}'; push @code, '$return_orig ? $orig : \\%new'; push @code, '}'; "@code"; }); } else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my %new; for my $k (keys %$value) { return $value unless $kcoercable_item->check($k) && $vcoercable_item->check($value->{$k}); $new{$kparam->has_coercion ? $kparam->coerce($k) : $k} = $vparam->has_coercion ? $vparam->coerce($value->{$k}) : $value->{$k}; } return \%new; }, ); } return $C; }; # XXX - also Maybe[`a]? # XXX - does not seem quite right $lib->get_type("Optional")->{coercion_generator} = sub { my ($parent, $child, $param) = @_; return unless $param->has_coercion; return $param->coercion; }; my $label_counter = 0; our ($keycheck_counter, @KEYCHECK) = -1; $lib->get_type("Dict")->{coercion_generator} = sub { my ($parent, $child, %dict) = @_; my $C = "Type::Coercion"->new(type_constraint => $child); my $all_inlinable = 1; for my $tc (values %dict) { $all_inlinable = 0 if !$tc->can_be_inlined; $all_inlinable = 0 if $tc->has_coercion && !$tc->coercion->can_be_inlined; last if!$all_inlinable; } if ($all_inlinable) { $C->add_type_coercions($parent => Stringable { require B; my $keycheck = join "|", map quotemeta, sort { length($b) <=> length($a) or $a cmp $b } keys %dict; $keycheck = $KEYCHECK[++$keycheck_counter] = qr{^($keycheck)$}ms; # regexp for legal keys my $label = sprintf("LABEL%d", ++$label_counter); my @code; push @code, 'do { my ($orig, $return_orig, %tmp, %new) = ($_, 0);'; push @code, "$label: {"; push @code, sprintf('($_ =~ $%s::KEYCHECK[%d])||(($return_orig = 1), last %s) for sort keys %%$orig;', __PACKAGE__, $keycheck_counter, $label); for my $k (keys %dict) { my $ct = $dict{$k}; my $ct_coerce = $ct->has_coercion; my $ct_optional = $ct->is_a_type_of(Types::Standard::Optional()); my $K = B::perlstring($k); push @code, "if (exists \$orig->{$K}) {" if $ct_optional; if ($ct_coerce) { push @code, sprintf('%%tmp = (); $tmp{x} = %s;', $ct->coercion->inline_coercion("\$orig->{$K}")); push @code, sprintf( # $ct_optional # ? 'if (%s) { $new{%s}=$tmp{x} }' # : 'if (%s) { $new{%s}=$tmp{x} } else { $return_orig = 1; last %s }', $ct->inline_check('$tmp{x}'), $K, $label, ); } else { push @code, sprintf( # $ct_optional # ? 'if (%s) { $new{%s}=$orig->{%s} }' # : 'if (%s) { $new{%s}=$orig->{%s} } else { $return_orig = 1; last %s }', $ct->inline_check("\$orig->{$K}"), $K, $K, $label, ); } push @code, '}' if $ct_optional; } push @code, '}'; push @code, '$return_orig ? $orig : \\%new'; push @code, '}'; #warn "CODE:: @code"; "@code"; }); } else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my %new; for my $k (keys %$value) { return $value unless exists $dict{$k}; } for my $k (keys %dict) { my $ct = $dict{$k}; my @accept; if (exists $value->{$k} and $ct->check($value->{$k})) { @accept = $value->{$k}; } elsif (exists $value->{$k} and $ct->has_coercion) { my $x = $ct->coerce($value->{$k}); @accept = $x if $ct->check($x); } elsif (exists $value->{$k}) { return $value; } if (@accept) { $new{$k} = $accept[0]; } elsif (not $ct->is_a_type_of(Types::Standard::Optional())) { return $value; } } return \%new; }, ); } return $C; }; $lib->get_type("Tuple")->{coercion_generator} = sub { my ($parent, $child, @tuple) = @_; my $C = "Type::Coercion"->new(type_constraint => $child); my $slurpy; if (exists $tuple[-1] and ref $tuple[-1] eq "HASH") { $slurpy = pop(@tuple)->{slurpy}; } my $all_inlinable = 1; for my $tc (@tuple, ($slurpy ? $slurpy : ())) { $all_inlinable = 0 if !$tc->can_be_inlined; $all_inlinable = 0 if $tc->has_coercion && !$tc->coercion->can_be_inlined; last if!$all_inlinable; } if ($all_inlinable) { $C->add_type_coercions($parent => Stringable { my $label = sprintf("LABEL%d", ++$label_counter); my @code; push @code, 'do { my ($orig, $return_orig, @tmp, @new) = ($_, 0);'; push @code, "$label: {"; push @code, sprintf('(($return_orig = 1), last %s) if @$orig > %d;', $label, scalar @tuple) unless $slurpy; for my $i (0 .. $#tuple) { my $ct = $tuple[$i]; my $ct_coerce = $ct->has_coercion; my $ct_optional = $ct->is_a_type_of(Types::Standard::Optional()); if ($ct_coerce) { push @code, sprintf('@tmp = (); $tmp[0] = %s;', $ct->coercion->inline_coercion("\$orig->[$i]")); push @code, sprintf( $ct_optional ? 'if (%s) { $new[%d]=$tmp[0] }' : 'if (%s) { $new[%d]=$tmp[0] } else { $return_orig = 1; last %s }', $ct->inline_check('$tmp[0]'), $i, $label, ); } else { push @code, sprintf( $ct_optional ? 'if (%s) { $new[%d]=$orig->[%s] }' : 'if (%s) { $new[%d]=$orig->[%s] } else { $return_orig = 1; last %s }', $ct->inline_check("\$orig->[$i]"), $i, $i, $label, ); } } if ($slurpy) { my $size = @tuple; push @code, sprintf('if (@$orig > %d) {', $size); push @code, sprintf('my $tail = [ @{$orig}[%d .. $#$orig] ];', $size); push @code, $slurpy->has_coercion ? sprintf('$tail = %s;', $slurpy->coercion->inline_coercion('$tail')) : q(); push @code, sprintf( '(%s) ? push(@new, @$tail) : ($return_orig++);', $slurpy->inline_check('$tail'), ); push @code, '}'; } push @code, '}'; push @code, '$return_orig ? $orig : \\@new'; push @code, '}'; "@code"; }); } else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; if (!$slurpy and @$value > @tuple) { return $value; } my @new; for my $i (0 .. $#tuple) { my $ct = $tuple[$i]; my @accept; if (exists $value->[$i] and $ct->check($value->[$i])) { @accept = $value->[$i]; } elsif (exists $value->[$i] and $ct->has_coercion) { my $x = $ct->coerce($value->[$i]); @accept = $x if $ct->check($x); } else { return $value; } if (@accept) { $new[$i] = $accept[0]; } elsif (not $ct->is_a_type_of(Types::Standard::Optional())) { return $value; } } if ($slurpy and @$value > @tuple) { my $tmp = $slurpy->has_coercion ? $slurpy->coerce([ @{$value}[@tuple .. $#$value] ]) : [ @{$value}[@tuple .. $#$value] ]; $slurpy->check($tmp) ? push(@new, @$tmp) : return($value); } return \@new; }, ); }; return $C; }; 1; __END__ =pod =for stopwords booleans vstrings typeglobs =encoding utf-8 =for stopwords datetimes =head1 NAME Types::Standard - bundled set of built-in types for Type::Tiny =head1 DESCRIPTION L bundles a few types which seem to be useful. =head2 Moose-like The following types are similar to those described in L. =over =item C<< Any >> Absolutely any value passes this type constraint (even undef). =item C<< Item >> Essentially the same as C. All other type constraints in this library inherit directly or indirectly from C. =item C<< Bool >> Values that are reasonable booleans. Accepts 1, 0, the empty string and undef. =item C<< Maybe[`a] >> Given another type constraint, also accepts undef. For example, C<< Maybe[Int] >> accepts all integers plus undef. =item C<< Undef >> Only undef passes this type constraint. =item C<< Defined >> Only undef fails this type constraint. =item C<< Value >> Any defined, non-reference value. =item C<< Str >> Any string. (The only difference between C and C is that the former accepts typeglobs and vstrings.) =item C<< Num >> See C and C below. =item C<< Int >> An integer; that is a string of digits 0 to 9, optionally prefixed with a hyphen-minus character. =item C<< ClassName >> The name of a loaded package. The package must have C<< @ISA >> or C<< $VERSION >> defined, or must define at least one sub to be considered a loaded package. =item C<< RoleName >> Like C<< ClassName >>, but the package must I define a method called C. This is subtly different from Moose's type constraint of the same name; let me know if this causes you any problems. (I can't promise I'll change anything though.) =item C<< Ref[`a] >> Any defined reference value, including blessed objects. Unlike Moose, C is a parameterized type, allowing Scalar::Util::reftype checks, a la Ref["HASH"] # hashrefs, including blessed hashrefs =item C<< ScalarRef[`a] >> A value where C<< ref($value) eq "SCALAR" or ref($value) eq "REF" >>. If parameterized, the referred value must pass the additional constraint. For example, C<< ScalarRef[Int] >> must be a reference to a scalar which holds an integer value. =item C<< ArrayRef[`a] >> A value where C<< ref($value) eq "ARRAY" >>. If parameterized, the elements of the array must pass the additional constraint. For example, C<< ArrayRef[Num] >> must be a reference to an array of numbers. =item C<< HashRef[`a] >> A value where C<< ref($value) eq "HASH" >>. If parameterized, the values of the hash must pass the additional constraint. For example, C<< HashRef[Num] >> must be a reference to an hash where the values are numbers. The hash keys are not constrained, but Perl limits them to strings; see C below if you need to further constrain the hash values. =item C<< CodeRef >> A value where C<< ref($value) eq "CODE" >>. =item C<< RegexpRef >> A value where C<< ref($value) eq "Regexp" >>. =item C<< GlobRef >> A value where C<< ref($value) eq "GLOB" >>. =item C<< FileHandle >> A file handle. =item C<< Object >> A blessed object. (This also accepts regexp refs.) =back =head2 Structured OK, so I stole some ideas from L. =over =item C<< Map[`k, `v] >> Similar to C but parameterized with type constraints for both the key and value. The constraint for keys would typically be a subtype of C. =item C<< Tuple[...] >> Subtype of C, accepting an list of type constraints for each slot in the array. C<< Tuple[Int, HashRef] >> would match C<< [1, {}] >> but not C<< [{}, 1] >>. =item C<< Dict[...] >> Subtype of C, accepting an list of type constraints for each slot in the hash. For example C<< Dict[name => Str, id => Int] >> allows C<< { name => "Bob", id => 42 } >>. =item C<< Optional[`a] >> Used in conjunction with C and C to specify slots that are optional and may be omitted (but not necessarily set to an explicit undef). C<< Dict[name => Str, id => Optional[Int]] >> allows C<< { name => "Bob" } >> but not C<< { name => "Bob", id => "BOB" } >>. =back This module also exports a C function, which can be used as follows: my $type = Tuple[Str, slurpy ArrayRef[Int]]; $type->( ["Hello"] ); # ok $type->( ["Hello", 1, 2, 3] ); # ok $type->( ["Hello", [1, 2, 3]] ); # not ok =begin trustme =item slurpy =end trustme =head2 Objects OK, so I stole some ideas from L. =over =item C<< InstanceOf[`a] >> Shortcut for a union of L constraints. C<< InstanceOf["Foo", "Bar"] >> allows objects blessed into the C or C classes, or subclasses of those. Given no parameters, just equivalent to C. =item C<< ConsumerOf[`a] >> Shortcut for an intersection of L constraints. C<< ConsumerOf["Foo", "Bar"] >> allows objects where C<< $o->DOES("Foo") >> and C<< $o->DOES("Bar") >> both return true. Given no parameters, just equivalent to C. =item C<< HasMethods[`a] >> Shortcut for a L constraint. C<< HasMethods["foo", "bar"] >> allows objects where C<< $o->can("foo") >> and C<< $o->can("bar") >> both return true. Given no parameters, just equivalent to C. =back =head2 More There are a few other types exported by this function: =over =item C<< Overload[`a] >> With no parameters, checks that the value is an overloaded object. Can be given one or more string parameters, which are specific operations to check are overloaded. For example, the following checks for objects which overload addition and subtraction. Overload["+", "-"] =item C<< Tied[`a] >> A reference to a tied scalar, array or hash. Can be parameterized with a type constraint which will be applied to the object returned by the C<< tied() >> function. As a convenience, can also be parameterized with a string, which will be inflated to a L. use Types::Standard qw(Tied); use Type::Utils qw(class_type); my $My_Package = class_type { class => "My::Package" }; tie my %h, "My::Package"; \%h ~~ Tied; # true \%h ~~ Tied[ $My_Package ]; # true \%h ~~ Tied["My::Package"]; # true tie my $s, "Other::Package"; \$s ~~ Tied; # true $s ~~ Tied; # false !! If you need to check that something is specifically a reference to a tied hash, use an intersection: use Types::Standard qw( Tied HashRef ); my $TiedHash = (Tied) & (HashRef); tie my %h, "My::Package"; tie my $s, "Other::Package"; \%h ~~ $TiedHash; # true \$s ~~ $TiedHash; # false =item C<< StrMatch[`a] >> A string that matches a regular expression: declare "Distance", as StrMatch[ qr{^([0-9]+)\s*(mm|cm|m|km)$} ]; You can optionally provide a type constraint for the array of subexpressions: declare "Distance", as StrMatch[ qr{^([0-9]+)\s*(.+)$}, Tuple[ Int, enum(DistanceUnit => [qw/ mm cm m km /]), ], ]; =item C<< Enum[`a] >> As per MooX::Types::MooseLike::Base: has size => (is => "ro", isa => Enum[qw( S M L XL XXL )]); =item C<< OptList >> An arrayref of arrayrefs in the style of L output. =item C<< LaxNum >>, C<< StrictNum >> In Moose 2.09, the C type constraint implementation was changed from being a wrapper around L's C function to a stricter regexp (which disallows things like "-Inf" and "Nan"). Types::Standard provides I implementations. C is measurably faster. The C type constraint is currently an alias for C unless you set the C environment variable to true before loading Types::Standard, in which case it becomes an alias for C. The constant C<< Types::Standard::STRICTNUM >> can be used to check if C is being strict. Most people should probably use C or C. Don't explicitly use C unless you specifically need an attribute which will accept things like "Inf". =back =head2 Coercions None of the types in this type library have any coercions by default. However some standalone coercions may be exported. These can be combined with type constraints using the C<< + >> operator. =over =item C<< MkOpt >> A coercion from C, C or C to C. Example usage in a Moose attribute: use Types::Standard qw( OptList MkOpt ); has options => ( is => "ro", isa => OptList + MkOpt, coerce => 1, ); =item C<< Split[`a] >> Split a string on a regexp. use Types::Standard qw( ArrayRef Str Split ); has name => ( is => "ro", isa => (ArrayRef[Str]) + (Split[qr/\s/]), coerce => 1, ); =item C<< Join[`a] >> Join an array of strings with a delimiter. use Types::Standard qw( Str Join ); my $FileLines = Str + Join["\n"]; has file_contents => ( is => "ro", isa => $FileLines, coerce => 1, ); =back =head2 Constants =over =item C<< Types::Standard::STRICTNUM >> Indicates whether C is an alias for C. (It is usually an alias for C.) =back =begin private =item Stringable =end private =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L, L. L, L, L. L provides some type constraints based on XML Schema's data types; this includes constraints for ISO8601-formatted datetimes, integer ranges (e.g. C<< PositiveInteger[maxInclusive=>10] >> and so on. L provides C and C type constraints that were formerly found in Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Test/0000755000175000017500000000000012200124456013154 5ustar taitaiType-Tiny-0.022/lib/Test/TypeTiny.pm0000644000175000017500000001077612200121217015302 0ustar taitaipackage Test::TypeTiny; use strict; use warnings; use Test::More qw(); use Scalar::Util qw(blessed); use Types::TypeTiny qw(to_TypeTiny); use base qw(Exporter::TypeTiny); BEGIN { *EXTENDED_TESTING = $ENV{EXTENDED_TESTING} ? sub(){!!1} : sub(){!!0}; }; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.022'; our @EXPORT = qw( should_pass should_fail ok_subtype ); our @EXPORT_OK = qw( EXTENDED_TESTING ); sub _mk_message { require Type::Tiny; my ($template, $value) = @_; sprintf($template, Type::Tiny::_dd($value)); } sub ok_subtype { my ($type, @s) = @_; @_ = ( not(scalar grep !$_->is_subtype_of($type), @s), sprintf("%s subtype: %s", $type, join q[, ], @s), ); goto \&Test::More::ok; } eval(EXTENDED_TESTING ? <<'SLOW' : <<'FAST'); sub should_pass { my ($value, $type, $message) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; $type = to_TypeTiny($type) unless blessed($type) && $type->can("check"); my $strictures = $type->can("_strict_check"); my $test = "Test::Builder"->new->child( $message || _mk_message("%s passes type constraint $type", $value), ); $test->plan(tests => ($strictures ? 2 : 1)); $test->ok(!!$type->check($value), '->check'); $test->ok(!!$type->_strict_check($value), '->_strict_check') if $strictures; $test->finalize; return $test->is_passing; } sub should_fail { my ($value, $type, $message) = @_; $type = to_TypeTiny($type) unless blessed($type) && $type->can("check"); local $Test::Builder::Level = $Test::Builder::Level + 1; my $strictures = $type->can("_strict_check"); my $test = "Test::Builder"->new->child( $message || _mk_message("%s fails type constraint $type", $value), ); $test->plan(tests => ($strictures ? 2 : 1)); $test->ok(!$type->check($value), '->check'); $test->ok(!$type->_strict_check($value), '->_strict_check') if $strictures; $test->finalize; return $test->is_passing; } SLOW sub should_pass { my ($value, $type, $message) = @_; $type = to_TypeTiny($type) unless blessed($type) && $type->can("check"); @_ = ( !!$type->check($value), $message || _mk_message("%s passes type constraint $type", $value), ); goto \&Test::More::ok; } sub should_fail { my ($value, $type, $message) = @_; $type = to_TypeTiny($type) unless blessed($type) && $type->can("check"); @_ = ( !$type->check($value), $message || _mk_message("%s fails type constraint $type", $value), ); goto \&Test::More::ok; } FAST 1; __END__ =pod =encoding utf-8 =head1 NAME Test::TypeTiny - useful functions for testing the efficacy of type constraints =head1 SYNOPSIS use strict; use warnings; use Test::More; use Test::TypeTiny; use Types::Mine qw(Integer); should_pass(1, Integer); should_pass(-1, Integer); should_pass(0, Integer); should_fail(2.5, Integer); ok_subtype(Number, Integer); done_testing; =head1 DESCRIPTION L provides a few handy functions for testing type constraints. =head2 Functions =over =item C<< should_pass($value, $type, $test_name) >> =item C<< should_pass($value, $type) >> Test that passes iff C<< $value >> passes C<< $type->check >>. =item C<< should_fail($value, $type, $test_name) >> =item C<< should_fail($value, $type) >> Test that passes iff C<< $value >> fails C<< $type->check >>. =item C<< ok_subtype($type, @subtypes) >> Test that passes iff all C<< @subtypes >> are subtypes of C<< $type >>. =item C<< EXTENDED_TESTING >> Exportable boolean constant. =back =head1 ENVIRONMENT If the C environment variable is set to true, this module will promote each C or C test into a subtest block and test the type constraint in both an inlined and non-inlined manner. This variable must be set at compile time (i.e. before this module is loaded). =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. For an alternative to C, see L which will happily accept a Type::Tiny type constraint instead of a MooseX::Types one. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/0000755000175000017500000000000012200124456013156 5ustar taitaiType-Tiny-0.022/lib/Type/Exception.pm0000644000175000017500000001205412200121217015444 0ustar taitaipackage Type::Exception; use 5.006001; use strict; use warnings; BEGIN { $Type::Exception::AUTHORITY = 'cpan:TOBYINK'; $Type::Exception::VERSION = '0.022'; } use overload q[""] => sub { $_[0]->to_string }, fallback => 1, ; our %CarpInternal; $CarpInternal{$_}++ for qw( Eval::TypeTiny Exporter::TypeTiny Test::TypeTiny Type::Coercion Type::Coercion::Union Type::Exception Type::Library Type::Params Type::Registry Types::Standard Types::Standard::_Stringable Types::TypeTiny Type::Tiny Type::Tiny::Class Type::Tiny::Duck Type::Tiny::Enum Type::Tiny::Intersection Type::Tiny::Role Type::Tiny::Union Type::Utils ); sub new { my $class = shift; my %params = (@_==1) ? %{$_[0]} : @_; return bless \%params, $class; } sub throw { my $class = shift; my ($level, @caller, %ctxt) = 0; while ( (defined scalar caller($level) and $CarpInternal{scalar caller($level)}) or ( (caller($level))[0] =~ /^Eval::TypeTiny::/ ) ) { $level++ }; if ( ((caller($level - 1))[1]||"") =~ /^parameter validation for '(.+?)'$/ ) { my ($pkg, $func) = ($1 =~ m{^(.+)::(\w+)$}); $level++ if caller($level) eq ($pkg||""); } @ctxt{qw/ package file line /} = caller($level); my $stack = undef; if (our $StackTrace) { require Devel::StackTrace; $stack = "Devel::StackTrace"->new( ignore_package => [ keys %CarpInternal ], ); } die( our $LastError = $class->new( context => \%ctxt, stack_trace => $stack, @_, ) ); } sub message { $_[0]{message} ||= $_[0]->_build_message }; sub context { $_[0]{context} }; sub stack_trace { $_[0]{stack_trace} }; sub to_string { my $e = shift; my $c = $e->context; my $m = $e->message; $m =~ /\n\z/s ? $m : $c ? sprintf("%s at %s line %d.\n", $m, $c->{file}, $c->{line}) : sprintf("%s\n", $m); } sub _build_message { return 'An exception has occurred'; } sub croak { my ($fmt, @args) = @_; @_ = ( __PACKAGE__, message => sprintf($fmt, @args), ); goto \&throw; } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Exception - exceptions for Type::Tiny and friends =head1 SYNOPSIS use Data::Dumper; use Try::Tiny; use Types::Standard qw(Str); try { Str->assert_valid(undef); } catch { my $exception = shift; warn "Encountered Error: $exception"; warn Dumper($exception->explain) if $exception->isa("Type::Exception::Assertion"); }; =head1 DESCRIPTION When Type::Tiny and its related modules encounter an error, they throw an exception object. These exception objects inherit from Type::Exception. =head2 Constructors =over =item C<< new(%attributes) >> Moose-style constructor function. =item C<< throw(%attributes) >> Constructs an exception and passes it to C. Automatically populates C and C if appropriate. =back =head2 Attributes =over =item C The error message. =item C Hashref containing the package, file and line that generated the error. =item C A more complete stack trace. This feature requires L; use the C<< $StackTrace >> package variable to switch it on. =back =head2 Methods =over =item C Returns the message, followed by the context if it is set. =back =head2 Functions =over =item C<< Type::Exception::croak($format, @args) >> Functional-style shortcut to C method. Takes an C-style format string and optional arguments to construct the C. =back =head2 Overloading =over =item * Stringification is overloaded to call C. =back =head2 Package Variables =over =item C<< %Type::Tiny::CarpInternal >> Serves a similar purpose to C<< %Carp::CarpInternal >>. =item C<< $Type::Tiny::StackTrace >> Boolean to toggle stack trace generation. =item C<< $Type::Tiny::LastError >> A reference to the last exception object thrown. =back =head1 CAVEATS Although Type::Exception objects are thrown for errors produced by Type::Tiny, that doesn't mean every time you use Type::Tiny you'll get Type::Exceptions whenever you want. For example, if you use a Type::Tiny type constraint in a Moose attribute, Moose will not call the constraint's C method (which throws an exception). Instead it will call C and C (which do not), and will C an error message of its own. (The C<< $LastError >> package variable may save your bacon.) =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Params.pm0000644000175000017500000003530512200121217014735 0ustar taitaipackage Type::Params; use 5.006001; use strict; use warnings; BEGIN { if ($] < 5.008) { require Devel::TypeTiny::Perl56Compat }; } BEGIN { $Type::Params::AUTHORITY = 'cpan:TOBYINK'; $Type::Params::VERSION = '0.022'; } use B qw(perlstring); use Eval::TypeTiny; use Scalar::Util qw(refaddr); use Type::Exception; use Type::Exception::Assertion; use Type::Exception::WrongNumberOfParameters; use Type::Tiny::Union; use Types::Standard -types; use Types::TypeTiny qw(to_TypeTiny); use base qw< Exporter::TypeTiny >; our @EXPORT = qw( compile ); our @EXPORT_OK = qw( validate Invocant ); BEGIN { my $Invocant = 'Type::Tiny::Union'->new( name => 'Invocant', type_constraints => [Object, ClassName], ); sub Invocant () { $Invocant }; }; #sub _exporter_expand_sub #{ # my $class = shift; # my ($name, $value, $globals, $permitted) = @_; # $permitted ||= $class->_exporter_permitted_regexp($globals); # # my %opts; # if ($name eq 'compile' and keys %opts) # { # return compile => sub { unshift @_, \%opts; goto \&compile }; # } # elsif ($name eq 'validate' and keys %opts) # { # my %compiled; # return validate => sub { # my $arr = shift; # ($compiled{ join ":", map($_->{uniq}||"\@$_->{slurpy}", @_) } ||= compile({ caller_level => 1, %opts }, @_)) # ->(@$arr); # }; # } # # return $class->SUPER::_exporter_expand_sub(@_); #} sub _mkslurpy { my ($name, $type, $tc, $i) = @_; $type eq '@' ? sprintf( '%s = [ @_[%d..$#_] ];', $name, $i, ) : sprintf( '%s = (($#_-%d)%%2)==0 ? "Type::Exception::WrongNumberOfParameters"->throw(message => "Odd number of elements in %s") : +{ @_[%d..$#_] };', $name, $i, $tc, $i, $i, ); } sub compile { my (@code, %env); @code = 'my (@R, %tmp, $tmp);'; push @code, '#placeholder'; # $code[1] my %options = (ref($_[0]) eq "HASH" && !$_[0]{slurpy}) ? %{+shift} : (); my $arg = -1; my $saw_slurpy = 0; my $min_args = 0; my $max_args = 0; my $saw_opt = 0; while (@_) { ++$arg; my $constraint = shift; my $is_optional; my $is_slurpy; my $varname; if (Bool->check($constraint)) { $constraint = $constraint ? Any : Optional[Any]; } if (HashRef->check($constraint)) { $constraint = to_TypeTiny($constraint->{slurpy}); push @code, $constraint->is_a_type_of(Dict) ? _mkslurpy('$_', '%', $constraint => $arg) : $constraint->is_a_type_of(Map) ? _mkslurpy('$_', '%', $constraint => $arg) : $constraint->is_a_type_of(Tuple) ? _mkslurpy('$_', '@', $constraint => $arg) : $constraint->is_a_type_of(HashRef) ? _mkslurpy('$_', '%', $constraint => $arg) : $constraint->is_a_type_of(ArrayRef) ? _mkslurpy('$_', '@', $constraint => $arg) : Type::Exception::croak("Slurpy parameter not of type HashRef or ArrayRef"); $varname = '$_'; $is_slurpy++; $saw_slurpy++; } else { Type::Exception::croak("Parameter following slurpy parameter") if $saw_slurpy; $is_optional = grep $_->{uniq} == Optional->{uniq}, $constraint->parents; if ($is_optional) { push @code, sprintf 'return @R if $#_ < %d;', $arg; $saw_opt++; $max_args++; } else { Type::Exception::croak("Non-Optional parameter following Optional parameter") if $saw_opt; $min_args++; $max_args++; } $varname = sprintf '$_[%d]', $arg; } if ($constraint->has_coercion and $constraint->coercion->can_be_inlined) { push @code, sprintf( '$tmp%s = %s;', ($is_optional ? '{x}' : ''), $constraint->coercion->inline_coercion($varname) ); $varname = '$tmp'.($is_optional ? '{x}' : ''); } elsif ($constraint->has_coercion) { $env{'@coerce'}[$arg] = $constraint->coercion->compiled_coercion; push @code, sprintf( '$tmp%s = $coerce[%d]->(%s);', ($is_optional ? '{x}' : ''), $arg, $varname, ); $varname = '$tmp'.($is_optional ? '{x}' : ''); } if ($constraint->can_be_inlined) { push @code, sprintf( '(%s) or Type::Tiny::_failed_check(%d, %s, %s, varname => %s);', $constraint->inline_check($varname), $constraint->{uniq}, perlstring($constraint), $varname, $is_slurpy ? 'q{$SLURPY}' : sprintf('q{$_[%d]}', $arg), ); } else { $env{'@check'}[$arg] = $constraint->compiled_check; push @code, sprintf( '%s or Type::Tiny::_failed_check(%d, %s, %s, varname => %s);', sprintf(sprintf '$check[%d]->(%s)', $arg, $varname), $constraint->{uniq}, perlstring($constraint), $varname, $is_slurpy ? 'q{$SLURPY}' : sprintf('q{$_[%d]}', $arg), ); } push @code, sprintf 'push @R, %s;', $varname; } if ($min_args == $max_args and not $saw_slurpy) { $code[1] = sprintf( '"Type::Exception::WrongNumberOfParameters"->throw(got => scalar(@_), minimum => %d, maximum => %d) if @_ != %d;', $min_args, $max_args, $min_args, ); } elsif ($min_args < $max_args and not $saw_slurpy) { $code[1] = sprintf( '"Type::Exception::WrongNumberOfParameters"->throw(got => scalar(@_), minimum => %d, maximum => %d) if @_ < %d || @_ > %d;', $min_args, $max_args, $min_args, $max_args, ); } elsif ($min_args and $saw_slurpy) { $code[1] = sprintf( '"Type::Exception::WrongNumberOfParameters"->throw(got => scalar(@_), minimum => %d) if @_ < %d;', $min_args, $min_args, ); } push @code, '@R;'; my $source = "sub { no warnings; ".join("\n", @code)." };"; return $source if $options{want_source}; return eval_closure( source => $source, description => sprintf("parameter validation for '%s'", [caller(1+($options{caller_level}||0))]->[3] || '__ANON__'), environment => \%env, ); } my %compiled; sub validate { my $arr = shift; my $sub = $compiled{ join ":", map($_->{uniq}||"\@$_->{slurpy}", @_) } ||= compile({ caller_level => 1 }, @_); @_ = @$arr; goto $sub; } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Params - Params::Validate-like parameter validation using Type::Tiny type constraints and coercions =head1 SYNOPSIS use v5.10; use strict; use warnings; use Type::Params qw( compile ); use Types::Standard qw( slurpy Str ArrayRef Num ); sub deposit_monies { state $check = compile( Str, Str, slurpy ArrayRef[Num] ); my ($sort_code, $account_number, $monies) = $check->(@_); my $account = Local::BankAccount->new($sort_code, $account_number); $account->deposit($_) for @$monies; } deposit_monies("12-34-56", "11223344", 1.2, 3, 99.99); =head1 DESCRIPTION Type::Params uses L constraints to validate the parameters to a sub. It takes the slightly unorthodox approach of separating validation into two stages: =over =item 1. Compiling the parameter specification into a coderef; then =item 2. Using the coderef to validate parameters. =back The first stage is slow (it might take a couple of milliseconds), but you only need to do it the first time the sub is called. The second stage is fast; according to my benchmarks faster even than the XS version of L. If you're using a modern version of Perl, you can use the C keyword which was a feature added to Perl in 5.10. If you're stuck on Perl 5.8, the example from the SYNOPSIS could be rewritten as: my $deposit_monies_check; sub deposit_monies { $deposit_monies_check ||= compile( Str, Str, slurpy ArrayRef[Num] ); my ($sort_code, $account_number, $monies) = $check->(@_); ...; } Not quite as neat, but not awful either. There's a shortcut reducing it to one step: use Type::Params qw( validate ); sub deposit_monies { my ($sort_code, $account_number, $monies) = validate( \@_, Str, Str, slurpy ArrayRef[Num] ); ...; } Type::Params has a few tricks up its sleeve to make sure performance doesn't suffer too much with the shortcut, but it's never going to be as fast as the two stage compile/execute. =begin trustme Dude, these functions are documented! =item compile =item validate =item Invocant =end trustme =head1 COOKBOOK =head2 Positional Parameters sub nth_root { state $check = compile( Num, Num ); my ($x, $n) = $check->(@_); return $x ** (1 / $n); } =head2 Method Calls Type::Params exports an additional keyword C on request. This is a type constraint accepting blessed objects and also class names. use Types::Standard qw( ClassName Object Str Int ); use Type::Params qw( compile Invocant ); # a class method sub new_from_json { state $check = compile( ClassName, Str ); my ($class, $json) = $check->(@_); $class->new( from_json($json) ); } # an object method sub dump { state $check = compile( Object, Int ); my ($self, $limit) = $check->(@_); local $Data::Dumper::Maxdepth = $limit; print Data::Dumper::Dumper($self); } # can be called as either and object or class method sub run { state $check = compile( Invocant ); my ($proto) = $check->(@_); my $self = ref($proto) ? $proto : $default_instance; $self->_run; } =head2 Optional Parameters use Types::Standard qw( Object Optional Int ); sub dump { state $check = compile( Object, Optional[Int] ); my ($self, $limit) = $check->(@_); $limit //= 0; local $Data::Dumper::Maxdepth = $limit; print Data::Dumper::Dumper($self); } $obj->dump(1); # ok $obj->dump(); # ok $obj->dump(undef); # dies =head2 Slurpy Parameters use Types::Standard qw( slurpy ClassName HashRef ); sub new { state $check = compile( ClassName, slurpy HashRef ); my ($class, $ref) = $check->(@_); bless $ref => $class; } __PACKAGE__->new(foo => 1, bar => 2); The following types from L can be made slurpy: C, C, C, C, C. Hash-like types will die if an odd number of elements are slurped in. A check may only have one slurpy parameter, and it must be the last parameter. =head2 Named Parameters Just use a slurpy C: use Types::Standard qw( slurpy Dict Ref Optional Int ); sub dump { state $check = compile( slurpy Dict[ var => Ref, limit => Optional[Int], ], ); my ($arg) = $check->(@_); local $Data::Dumper::Maxdepth = $arg->{limit}; print Data::Dumper::Dumper($arg->{var}); } dump(var => $foo, limit => 1); # ok dump(var => $foo); # ok dump(limit => 1); # dies =head2 Mixed Positional and Named Parameters use Types::Standard qw( slurpy Dict Ref Optional Int ); sub my_print { state $check = compile( Str, slurpy Dict[ colour => Optional[Str], size => Optional[Int], ], ); my ($string, $arg) = $check->(@_); } my_print("Hello World", colour => "blue"); =head2 Coercions Coercions will automatically be applied for I type constraints that have a coercion associated. use Type::Utils; use Types::Standard qw( Int Num ); my $RoundedInt = declare as Int; coerce $RoundedInt, from Num, q{ int($_) }; sub set_age { state $check = compile( Object, $RoundedInt ); my ($self, $age) = $check->(@_); $self->{age} = $age; } $obj->set_age(32.5); # ok; coerced to "32". Coercions carry over into structured types such as C automatically: sub delete_articles { state $check = compile( Object, slurpy ArrayRef[$RoundedInt] ); my ($db, $articles) = $check->(@_); $db->select_article($_)->delete for @$articles; } # delete articles 1, 2 and 3 delete_articles($my_db, 1.1, 2.2, 3.3); If type C has coercions from C and C and you want to B coercion, then use: state $check = compile( Foo->no_coercions ); Or if you just want to prevent coercion from C, use: state $check = compile( Foo->minus_coercions(Str) ); Or maybe add an extra coercion: state $check = compile( Foo->plus_coercions(Int, q{ Foo->new_from_number($_) }), ); Note that the coercion is specified as a string of Perl code. This is usually the fastest way to do it, but a coderef is also accepted. Either way, the value to be coerced is C<< $_ >>. =head1 COMPARISON WITH PARAMS::VALIDATE L is not really a drop-in replacement for L; the API differs far too much to claim that. Yet it performs a similar task, so it makes sense to compare them. =over =item * Type::Params will tend to be faster if you've got a sub which is called repeatedly, but may be a little slower than Params::Validate for subs that are only called a few times. This is because it does a bunch of work the first time your sub is called to make subsequent calls a lot faster. =item * Type::Params is mostly geared towards positional parameters, while Params::Validate seems to be primarily aimed at named parameters. (Though either works for either.) Params::Validate doesn't appear to have a particularly natural way of validating a mix of positional and named parameters. =item * Type::Utils allows you to coerce parameters. For example, if you expect a L object, you could coerce it from a string. =item * Params::Validate allows you to supply defaults for missing parameters; Type::Params does not, but you may be able to use coercion from Undef. =item * If you are primarily writing object-oriented code, using Moose or similar, and you are using Type::Tiny type constraints for your attributes, then using Type::Params allows you to use the same constraints for method calls. =item * Type::Params comes bundled with Types::Standard, which provides a much richer vocabulary of types than the type validation constants that come with Params::Validate. For example, Types::Standard provides constraints like C<< ArrayRef[Int] >> (an arrayref of integers), while the closest from Params::Validate is C<< ARRAYREF >>, which you'd need to supplement with additional callbacks if you wanted to check that the arrayref contained integers. Whatsmore, Type::Params doesn't just work with Types::Standard, but also any other Type::Tiny type constraints. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Tiny/0000755000175000017500000000000012200124456014101 5ustar taitaiType-Tiny-0.022/lib/Type/Tiny/Manual.pod0000644000175000017500000001244212174252321016030 0ustar taitai=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual - an overview of Type::Tiny =head1 SYNOPSIS L is a small class for writing type constraints, inspired by L's type constraint API. It has no non-core dependencies, and can be used with L, L and L (or none of the above). Type::Tiny is bundled with L a framework for organizing type constraints into collections. Also bundled is L, a Moose-inspired library of useful type constraints. L is also provided, to allow very fast checking and coercion of function and method parameters. =head1 SEE ALSO =over =item * L - how to build a type library with Type::Tiny, Type::Library and Type::Utils =item * L - adding coercions to type constraints =item * L - how to use Type::Tiny and Type::Library with Moose =item * L - how to use Type::Tiny and Type::Library with Mouse =item * L - how to use Type::Tiny and Type::Library with Moo =item * L - how to use Type::Tiny and Type::Library with other OO frameworks =item * Type::Tiny and friends don't need to be used within an OO framework. See L for an example that does not. =item * L - coerce and validate arguments to functions and methods. =item * Other modules using Type::Tiny in interesting ways: L, L, L... =back =head1 DEPENDENCIES Type::Tiny requires at least Perl 5.6.1, though certain Unicode-related features (e.g. non-ASCII type constraint names) may work better in newer versions of Perl. At run-time, Type::Tiny requires the following modules: L, L, L, L, L, L, L, L and L. All of these come bundled with Perl itself. (Prior to Perl 5.8, L and L do not come bundled with Perl and will need installing separately from the CPAN.) Certain features require additional modules. Tying a variable to a type constraint (e.g. C<< tie my $count, Int >>) requires L; stack traces on exceptions require L. The L plugin for L requires L (obviously). L may I increase the speed of some of Type::Tiny's compiled coderefs. The test suite additionally requires L, L and L. Test::More comes bundled with Perl, but if you are using a version of Perl older than 5.14, you will need to upgrade to at least Test::More version 0.96. Test::Requires and Test::Fatal (plus Try::Tiny which Test::Fatal depends on) are bundled with Type::Tiny in the C directory, so you do not need to install them separately. Perl 5.6.x support is not well tested; if it proves too burdensome to maintain, it may be dropped in a future release. =head1 TYPE::TINY VERSUS X =head2 Specio Type::Tiny is similar in aim to L. The major differences are =over =item * Type::Tiny is "tiny" (Specio will eventually have fewer dependencies than it currently does, but is unlikely to ever have zero); =item * Specio has a somewhat nicer API (better method names; less duplication), and its API is likely to improve further. Type::Tiny's aims at complete compatibility with current versions of Moose and Mouse, so there is a limit to how much I can deviate from the existing APIs of (Moose|Mouse)::Meta::TypeConstraint. =back =head2 MooseX::Types Type::Tiny libraries expose a similar interface to L libraries. In most cases you should be able to rewrite a L library to use Type::Tiny pretty easily. =head2 MooX::Types::MooseLike Type::Tiny is faster and supports coercions. =head2 Scalar::Does L is somewhat of a precursor to Type::Tiny, but has now been rewritten to use Type::Tiny internally. It gives you a C<< does($value, $type) >> function that is roughly equivalent to C<< $type->check($value) >> except that C<< $type >> may be one of a list of pre-defined strings (instead of a Type::Tiny type constraint); or may be a package name in which case it will be assumed to be a role and checked with C<< $value->DOES($type) >>. =head1 BUGS Please report any bugs to L. =head1 SUPPORT B<< IRC: >> support is available through in the I<< #moose >> channel on L. If Type::Tiny discussion there becomes overwhelming (unlikely) then I'll move it to a separate channel. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Type-Tiny-0.022/lib/Type/Tiny/Enum.pm0000644000175000017500000000657412200121217015347 0ustar taitaipackage Type::Tiny::Enum; use 5.006001; use strict; use warnings; BEGIN { $Type::Tiny::Enum::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Enum::VERSION = '0.022'; } sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } use overload q[@{}] => 'values'; use base "Type::Tiny"; sub new { my $proto = shift; my %opts = @_; _croak "Enum type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent}; _croak "Enum type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Enum type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply list of values" unless exists $opts{values}; my %tmp = map { $_ => 1 } @{ ref $opts{values} eq "ARRAY" ? $opts{values} : [$opts{values}] }; $opts{values} = [sort keys %tmp]; return $proto->SUPER::new(%opts); } sub values { $_[0]{values} } sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } sub _build_display_name { my $self = shift; sprintf("Enum[%s]", join q[,], @$self); } sub _build_constraint { my $self = shift; my $regexp = join "|", map quotemeta, @$self; return sub { defined and m{\A(?:$regexp)\z} }; } sub can_be_inlined { !!1; } sub inline_check { my $self = shift; my $regexp = join "|", map quotemeta, @$self; $_[0] eq '$_' ? "(defined and m{\\A(?:$regexp)\\z})" : "(defined($_[0]) and $_[0] =~ m{\\A(?:$regexp)\\z})"; } sub _instantiate_moose_type { my $self = shift; my %opts = @_; delete $opts{parent}; delete $opts{constraint}; delete $opts{inlined}; require Moose::Meta::TypeConstraint::Enum; return "Moose::Meta::TypeConstraint::Enum"->new(%opts, values => $self->values); } sub has_parent { !!1; } sub parent { require Types::Standard; Types::Standard::Str(); } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Enum - string enum type constraints =head1 DESCRIPTION Enum type constraints. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C Arrayref of allowable value strings. Non-string values (e.g. objects with overloading) will be stringified in the constructor. =item C Unlike Type::Tiny, you should generally I pass a constraint to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you should generally I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is always Types::Standard::Str, and cannot be passed to the constructor. =back =head2 Overloading =over =item * Arrayrefification calls C. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Tiny/Manual/0000755000175000017500000000000012200124456015316 5ustar taitaiType-Tiny-0.022/lib/Type/Tiny/Manual/Coercions.pod0000644000175000017500000001555512171054767017777 0ustar taitai=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::Coercions - adding coercions to type constraints =head1 DESCRIPTION B<< Stop! Don't do it! >> OK, it's fairly common practice in L/L code to define coercions for type constraints. For example, suppose we have a type constraint: class_type PathTiny, { class => "Path::Tiny" }; We may wish to define a coercion (i.e. a convertion routine) to handle strings, and convert them into Path::Tiny objects: coerce PathTiny, from Str, via { "Path::Tiny"->new($_) }; However, there are good reasons to avoid this practice. It ties the coercion routine to the type constraint. Any people wishing to use your C type constraint need to buy in to your idea of how they should be coerced from C. With L this is unlikely to be controversial, however consider: coerce ArrayRef, from Str, via { [split /\n/] }; In one part of the application (dealing with parsing log files for instance), this could be legitimate. But another part (dealing with logins perhaps) might prefer to split on colons. Another (dealing with web services) might attempt to parse the string as a JSON array. If all these coercions have attached themselves to the C type constraint, coercing a string becomes a complicated proposition! In a large application where coercions are defined across many different files, the application can start to suffer from "spooky action at a distance". In the interests of Moose-compatibility, L and L do allow you to define coercions this way, but they also provide an alternative that you should consider: C. =head2 plus_coercions L offers a method C which constructs a new anonymous type constraint, but with additional coercions. In our earlier example, we'd define the C type constraint as before: class_type PathTiny, { class => "Path::Tiny" }; But then not define any coercions for it. Later, when using the type constraint, we can add coercions: my $ConfigFileType = PathTiny->plus_coercions( Str, sub { "Path::Tiny"->new($_) }, Undef, sub { "Path::Tiny"->new("/etc/myapp/default.conf") }, ); has config_file => ( is => "ro", isa => $ConfigFileType, coerce => 1, ); Where the C constraint is used in another part of the code, it will not see these coercions, because they were added to the new anonymous type constraint, not to the C constraint itself! =head2 Aside: Optimizing Coercions Stepping away from the flow of this article, I'll point out that the following also works, using strings of Perl code instead of coderefs. It allows Type::Coercion to do a little optimization and run faster: my $ConfigFileType = PathTiny->plus_coercions( Str, q{ "Path::Tiny"->new($_) }, Undef, q{ "Path::Tiny"->new("/etc/myapp/default.conf") }, ); Now, where were we...? =head2 Named Coercions A type library may define a named set of coercions to a particular type. For example, let's define that coercion from C to C: declare_coercion "LinesFromStr", to_type ArrayRef, from Str, q{ [split /\n/] }; Now we can import that coercion using a name, and it makes our code look a little cleaner: use Types::Standard qw(ArrayRef); use MyApp::Types qw(LinesFromStr); has lines => ( is => "ro", isa => ArrayRef->plus_coercions(LinesFromStr), coerce => 1, ); =head2 Overloading L and L overload the C<< + >> operator to add coercions. So you may use: isa => PathTiny + PathTinyFromStr, However, beware precedence. The following is parsed as a function call with an argument preceded by a unary plus: isa => ArrayRef + LinesFromStr, # ArrayRef( +LinesFromStr ) When things can be parameterized, it's generally a good idea to wrap them in parentheses to disambiguate: isa => (ArrayRef) + LinesFromStr, =head2 Parameterized Coercions Parameterized type constraints are familiar from Moose. For example, an arrayref of integers: ArrayRef[Int] L supports parameterized named coercions too. For example, the following type constraint has a coercion from strings that splits them into lines: use Types::Standard qw( ArrayRef Split ); my $ArrayOfLines = (ArrayRef) + Split[ qr{\n} ]; The implementation of this feature is considered experimental, and the API for building parameterized coercions is likely to change. However, the feature itself, and its surface syntax (the square brackets) is likely to stay. So beware building your own parameterizable coercions, but don't be shy about using the ones in Types::Standard. =head2 plus_fallback_coercions, minus_coercions and no_coercions Getting back to the C method, there are some other methods that perform coercion maths. C is the same as C but the added coercions have a lower priority than any existing coercions. C can be given a list of type constraints that we wish to ignore coercions for. Imagine our C constraint already has a coercion from C, then the following creates a new anonymous type constraint without that coercion: PathTiny->minus_coercions(Str) C gives us a new type anonymous constraint without any of its parents coercions. This is useful as a way to create a blank slate for a subsequent C: PathTiny->no_coercions->plus_coercions(...) =head2 plus_constructors The C method defined in L is sugar for C. The following two are the same: PathTiny->plus_coercions(Str, q{ Path::Tiny->new($_) }) PathTiny->plus_constructors(Str, "new"); =head2 "Deep" Coercions Certain parameterized type constraints can automatically acquire coercions if their parameters have coercions. For example: ArrayRef[ Int->plus_coercions(Num, q{int($_)}) ] ... does what you mean! The parameterized type constraints that do this magic include the following ones from L: =over =item * C =item * C =item * C =item * C =item * C =item * C =item * C =back =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Type-Tiny-0.022/lib/Type/Tiny/Manual/UsingWithOther.pod0000644000175000017500000001061412171054767020765 0ustar taitai=pod =encoding utf-8 =for stopwords inlinable =head1 NAME Type::Tiny::Manual::UsingWithOther - how to use Type::Tiny and Type::Library with other OO frameworks =head1 DESCRIPTION =head2 Class::InsideOut You want L 1.13 or above, which has support for blessed and overloaded objects (including Type::Tiny type constraints) for the C and C options. { package Person; use Class::InsideOut qw( public ); use Types::Standard qw( Str Int ); use Type::Utils qw( declare as where inline_as coerce from ); public name => my %_name, { set_hook => Str, }; my $PositiveInt = declare as Int, where { $_ > 0 }, inline_as { "$_ =~ /^[0-9]\$/ and $_ > 0" }; coerce $PositiveInt, from Int, q{ abs $_ }; public age => my %_age, { set_hook => sub { $_ = $PositiveInt->assert_coerce($_) }, }; sub get_older { my $self = shift; my ($years) = @_; $PositiveInt->assert_valid($years); $self->_set_age($self->age + $years); } } I probably need to make coercions a little prettier. B<< See also: >> C<< t/25_accessor_hooks_typetiny.t >> and C<< t/Object/HookedTT.pm >> in the Class::InsideOut test suite. =head2 Params::Check and Object::Accessor The Params::Check C<< allow() >> function, the C option for the Params::Check C<< check() >> function, and the input validation mechanism for Object::Accessor all work in the same way, which is basically a limited pure-Perl implementation of the smart match operator. While this doesn't directly support Type::Tiny constraints, it does support coderefs. You can use Type::Tiny's C method to obtain a suitable coderef. B<< L example: >> my $tmpl = { name => { allow => Str->compiled_check }, age => { allow => Int->compiled_check }, }; check($tmpl, { name => "Bob", age => 32 }) or die Params::Check::last_error(); B<< L example: >> my $obj = Object::Accessor->new; $obj->mk_accessors( { name => Str->compiled_check }, { age => Int->compiled_check }, ); Caveat: Object::Accessor doesn't die when a value fails to meet its type constraint; instead it outputs a warning to STDERR. This behaviour can be changed by setting C<< $Object::Accessor::FATAL = 1 >>. =head2 Validation::Class You want L 7.900017 or above. The C function from L can be used to create a Type::Tiny type constraint from a Validation::Class::Simple object (and probably from Validation::Class, but this is untested). use Types::TypeTiny qw( to_TypeTiny ); use Validation::Class::Simple; my $type = to_TypeTiny Validation::Class::Simple->new( fields => { name => { required => 1, pattern => qr{^\w+(\s\w+)*$}, filters => ["trim", "strip"], }, email => { required => 1, email => 1 }, pass => { required => 1, min_length => 6 }, }, ); # true $type->check({ name => "Toby Inkster", email => "tobyink@cpan.org", pass => "foobar", }); # false $type->check({ name => "Toby Inkster ", # trailing whitespace email => "tobyink@cpan.org", pass => "foobar", }); # coercion from HashRef uses the filters defined above my $fixed = $type->coerce({ name => "Toby Inkster ", # trailing whitespace email => "tobyink@cpan.org", pass => "foobar", }); # true $type->check($fixed); Type constraints built with Validation::Class are not inlinable, so won't be as fast as C from L, but the filters are a pretty useful feature. (Note that filters are explicitly I for type constraint checking, and only come into play for coercion.) =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Type-Tiny-0.022/lib/Type/Tiny/Manual/Params.pod0000644000175000017500000001012312171054767017260 0ustar taitai=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::Params - coerce and validate arguments to functions and methods =head1 DESCRIPTION There is a module called L available to wrap up type coercion and constraint checks into a single, simple and fast check. If you care about speed, and your sub signatures are fairly simple, then this is the way to go... use feature qw( state ); use Types::Standard qw( Str ); use Type::Utils; use Type::Params qw( compile ); my $Invocant = class_type { class => __PACKAGE__ }; sub set_name { state $check = compile($Invocant, Str); my ($self, $name) = $check->(@_); ...; } See the COOKBOOK section of L for further information. =head2 The Somewhat More Manual Way... In general, Type::Params should be sufficient to cover most needs, and will probably run faster than almost anything you could cook up yourself. However, sometimes you need to deal with unusual function signatures that it does not support. For example, imagine function C<< format_string >> takes an optional hashref of formatting instructions, followed by a required string. You might expect to be able to handle it like this: sub format_string { state $check = compile(Optional[HashRef], Str); my ($instructions, $string) = $check->(@_); ...; } However, this won't work, as Type::Params expects required parameters to always precede optional ones. So there are times you need to handle parameters more manually. In these cases, bear in mind that for any type constraint object you have several useful checking methods available: Str->check($var) # returns a boolean is_Str($var) # ditto Str->($var) # returns $var or dies assert_Str($var) # ditto Here's how you might handle the C function: sub format_string { my $instructions; $instructions = shift if HashRef->check($_[0]); my $string = Str->(shift); ...; } Alternatively, you could manipulate @_ before passing it to the compiled check: sub format_string { state $check = compile(HashRef, Str); my ($instructions, $str) = $check->(@_==1 ? ({}, @_) : @_); ...; } =head2 Signatures Don't you wish your subs could look like this? sub set_name (Object $self, Str $name) { $self->{name} = $name; } Well; here are a few solutions for sub signatures that work with L... =head3 Attribute::Contract You want Attribute::Contract 0.03 or above. use Attribute::Contract -types => [qw/Object Str/]; sub set_name :ContractRequires(Object, Str) { my ($self, $name) = @_; $self->{name} = $name; } Attribute::Contract also includes support for type checking of the returned value. =head3 Function::Parameters The following should work from L 1.0101: use Function::Parameters qw(:strict); use Types::Standard; fun set_name ((Object) $self, (Str) $name) { $self->{name} = $name; } # or... method set_name ((Str) $name) { $self->{name} = $name; } In Function::Parameters 1.0101 and 1.0102, L was required to be loaded for this to work (even though it's not actually being used for type checks). Since Function::Parameters 1.0103, Moose is no longer required. Note the parentheses around the type names are required, because without parentheses, Function::Parameters will use Moose type constraints: method set_name (Str $name) # Moose type constraint { $self->{name} = $name; } =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Type-Tiny-0.022/lib/Type/Tiny/Manual/UsingWithMoose.pod0000644000175000017500000000644212171054767020772 0ustar taitai=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithMoose - how to use Type::Tiny and Type::Library with Moose =head1 SYNOPSIS { package Person; use Moose; use Types::Standard qw( Str Int ); use Type::Utils qw( declare as where inline_as coerce from ); has name => ( is => "ro", isa => Str, ); my $PositiveInt = declare as Int, where { $_ > 0 }, inline_as { "$_ =~ /^[0-9]\$/ and $_ > 0" }; coerce $PositiveInt, from Int, q{ abs $_ }; has age => ( is => "ro", isa => $PositiveInt, coerce => 1, writer => "_set_age", ); sub get_older { my $self = shift; my ($years) = @_; $PositiveInt->assert_valid($years); $self->_set_age($self->age + $years); } } =head1 DESCRIPTION L type constraints have an API almost identical to that of L. It is also able to build a Moose::Meta::TypeConstraint constraint from a Type::Tiny constraint, and will do so automatically when needed. When Moose.pm is loaded, Type::Tiny will use Perl's C feature to proxy method calls through to the Moose::Meta::TypeConstraint object. In short, you can use a Type::Tiny object pretty much anywhere you'd use a Moose::Meta::TypeConstraint and you are unlikely to notice the difference. =head2 Per-Attribute Coercions Type::Tiny offers convenience methods to alter the list of coercions associated with a type constraint. Let's imagine we wish to allow our C attribute to be coerced from an arrayref of strings. has name => ( is => "ro", isa => Str->plus_coercions( ArrayRef[Str], sub { join " ", @{$_} }, ), coerce => 1, ); This coercion will apply to the C attribute only; other attributes using the C type constraint will be unaffected. See the documentation for C, C and C in L. =head2 Optimization The usual advice for optimizing type constraints applies: use type constraints which can be inlined whenever possible. Defining coercions as strings rather than coderefs won't give you as much of a boost with Moose as it does with Moo, because Moose doesn't inline coercion code. However, it should still improve performance somewhat because it allows L to do some internal inlining. =head1 SEE ALSO For examples using Type::Tiny with L see the SYNOPSIS sections of L and L, and the files C<< moose.t >>, C<< moose-coercion.t >> and C<< moo-inflation.t >> in the Type-Tiny L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Type-Tiny-0.022/lib/Type/Tiny/Manual/Libraries.pod0000644000175000017500000002527612172163705017762 0ustar taitai=pod =for stopwords smush smushed =encoding utf-8 =head1 NAME Type::Tiny::Manual::Libraries - how to build a type library with Type::Tiny, Type::Library and Type::Utils =head1 SYNOPSIS A type library is a collection of type constraints, optionally with coercions. The following is an example type library: package Types::Datetime; use Type::Library -base, -declare => qw( Datetime DatetimeHash EpochHash ); use Type::Utils -all; use Types::Standard -types; class_type Datetime, { class => "DateTime" }; declare DatetimeHash, as Dict[ year => Int, month => Optional[ Int ], day => Optional[ Int ], hour => Optional[ Int ], minute => Optional[ Int ], second => Optional[ Int ], nanosecond => Optional[ Int ], time_zone => Optional[ Str ], ]; declare EpochHash, as Dict[ epoch => Int ]; coerce Datetime, from Int, via { "DateTime"->from_epoch(epoch => $_) }, from Undef, via { "DateTime"->now }, from DatetimeHash, via { "DateTime"->new(%$_) }, from EpochHash, via { "DateTime"->from_epoch(%$_) }; 1; =head1 DESCRIPTION Here's a line by line description of what's going on in the type library. package Types::Datetime; Type libraries are packages. It is recommended that re-usable type libraries be given a name in the C<< Types::* >> namespace. For application-specific type libraries, assuming your application's namespace is C<< MyApp::* >> then name the type library C<< MyApp::Types >>, or if more than one is needed, use the C<< MyApp::Types::* >> namespace. use Type::Library -base, -declare => qw( Datetime DatetimeHash EpochHash ); The C<< -base >> part is used to establish inheritance. It makes C a child class of C. Declaring the types we're going to define ahead of their definition allows us to use them as barewords later on. (Note that in code which I our type library, the types will always be available as barewords. The declaration above just allows us to use them within the library itself.) use Type::Utils -all; Imports some utility functions from L. These will be useful for defining our types and the relationships between them. use Types::Standard -types; Here we import a standard set of type constraints from L. There is no need to do this, but it's often helpful to have a base set of types which we can define our own in terms of. Note that although we've imported the types to be able to use in our library, we haven't I the types to our library. We've imported C, but other people won't be able to re-import C from our library. If you actually want your library to I another library, do this instead: BEGIN { extends "Types::AnotherLibrary" }; (Note: if your code breaks here when you upgrade from version 0.006 or below, saying that the 'extends' keyword has not been declared, just add '-all' after use Type::Utils.) OK, now we're ready to declare a few types. class_type Datetime, { class => "DateTime" }; This creates a type constraint named "Datetime" which is all objects blessed into the L package. Because this type constraint is not anonymous (it has a name), it will be automagically installed into the type library. The next two statements declare two further types constraints, using type constraints from the Types::Standard library. Let's look at C in more detail. This is a hashref with one key called "epoch" and a value which is an integer. declare EpochHash, as Dict[ epoch => Int ]; C inherits from the C type defined in Types::Standard. It equally could have been defined as: declare EpochHash, as HashRef[Int], where { scalar(keys(%$_))==1 and exists $_->{epoch} }; Or even: declare EpochHash, where { ref($_) eq "HASH" and scalar(keys(%$_))==1 and exists $_->{epoch} }; Lastly we set up coercions. It's best to define all your types before you define any coercions. coerce Datetime, from Int, via { "DateTime"->from_epoch(epoch => $_) }, from Undef, via { "DateTime"->now }, from DatetimeHash, via { "DateTime"->new(%$_) }, from EpochHash, via { "DateTime"->from_epoch(%$_) }; These are simply coderefs that will be fired when you want a Datetime, but are given something else. For more information on coercions, see L. =head1 ADVANCED TOPICS =head2 Messages It is sometimes nice to be able to emit a more useful error message than the standard: Value "Foo" did not pass type constraint "Bar" It is possible to define custom error messages for types. declare MediumInteger, as Integer, where { $_ >= 10 and $_ < 20 }, message { return Integer->get_message($_) if !Integer->check($_); return "$_ is too small!" if $_ < 10; return "$_ is so very, very big!"; }; =head2 Inlining If your type constraint can be inlined, this can not only speed up Type::Tiny's own checks and coercions, it may also allow your type constraint to be inlined into generated methods such as Moose attribute accessors. All of the constraints from C can be inlined, as can enum, class_type, role_type and duck_type constraints. Union and intersection constraints can be inlined if their sub-constraints can be. So if you can define your own types purely in terms of these types, you automatically get inlining: declare HashLike, as union [ Ref["HASH"], Overload["&{}"], ]; However, sometimes these base types are not powerful enough and you'll need to write a constraint coderef: declare NonEmptyHash, as HashLike, where { scalar values %$_ }; ... and you've suddenly sacrificed a lot of speed. Inlining to the rescue! You can define an inlining coderef which will be passed two parameters: the constraint itself and a variable name as a string. For example, the variable name might be C<< '$_' >> or C<< '$_[0]' >>. Your coderef should return a Perl expression string, interpolating that variable name. declare NonEmptyHash, as HashLike, where { scalar values %$_ }, inline_as { my ($constraint, $varname) = @_; return sprintf( '%s and scalar values %%{%s}', $constraint->parent->inline_check($varname), $varname, ); }; The Perl expression could be inlined within a function or a C clause or potentially anywhere, so it really must be an expression, not a statement. It should not C or C and probably shouldn't C. (If you need loops and so on, you can output a C block.) Note that if you're subtyping an existing type constraint, your C block is also responsible for checking the parent type's constraint. This can be done quite easily, as shown in the example above. Note that defining a type constraint in terms of a constraint coderef and an inlining coderef can be a little repetitive. L provides an alternative that reduces repetition (though the inlined code might not be as compact/good/fast). declare NonEmptyHash, as HashLike, constraint => quote_sub q{ scalar values %$_ }; Aside: it's been pointed out that "might not be as fast" above is a bit hand-wavy. When Type::Tiny does inlining from Sub::Quote coderefs, it needs to inline all the ancestor type constraints, and smush them together with C<< && >>. This may result in duplicate checks. For example, if 'MyArray' inherits from 'MyRef' which inherits from 'MyDef', the inlined code might end up as: defined($_) # check MyDef && ref($_) # check MyRef && ref($_) eq 'ARRAY' # check MyArray When just the last check would have been sufficient. A custom C allows you finer control over how the type constraint is inlined. =head2 Parameterized Constraints Parameterized type constraints are those that can generate simple child type constraints by passing parameters to their C method. For example, ArrayRef in Types::Standard: use Types::Standard; my $ArrayRef = Types::Standard::ArrayRef; my $Int = Types::Standard::Int; my $ArrayRef_of_Ints = $ArrayRef->parameterize($Int); Type libraries provide some convenient sugar for this: use Types::Standard qw( ArrayRef Int ); my $ArrayRef_of_Ints = ArrayRef[Int]; Unlike L which has separate meta classes for parameterizable, parameterized and non-parameterizable type constraints, L handles all that in one. To create a parameterizable type constraint, you'll need to pass an extra named parameter to C. Let's imagine that we want to make our earlier C constraint accept a parameter telling it the minimum size of the hash. For example C<< NonEmptyHash[4] >> would need to contain at least four key-value pairs. Here's how you'd do it: declare NonEmptyHash, as HashLike, where { scalar values %$_ }, inline_as { my ($constraint, $varname) = @_; return sprintf( '%s and scalar values %%{%s}', $constraint->parent->inline_check($varname), $varname, ); }, # Generate a new "where" coderef... constraint_generator => sub { my ($minimum) = @_; die "parameter must be positive" unless int($minimum) > 0; return sub { scalar(values(%$_)) >= int($minimum); }; }, # Generate a new "inline_as" coderef... inline_generator => sub { my ($minimum) = @_; return sub { my ($constraint, $varname) = @_; return sprintf( '%s and scalar(values(%%{%s})) >= %d', $constraint->parent->inline_check($varname), $varname, $minimum, ); }; }; =head1 SEE ALSO Some type libraries on CPAN: =over =item * L =item * L =item * L =item * L =item * L =item * L / L =item * L =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Type-Tiny-0.022/lib/Type/Tiny/Manual/UsingWithMouse.pod0000644000175000017500000000613112171054767020773 0ustar taitai=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithMouse - how to use Type::Tiny and Type::Library with Mouse =head1 SYNOPSIS { package Person; use Mouse; use Types::Standard qw( Str Int ); use Type::Utils qw( declare as where inline_as coerce from ); has name => ( is => "ro", isa => Str, ); my $PositiveInt = declare as Int, where { $_ > 0 }, inline_as { "$_ =~ /^[0-9]\$/ and $_ > 0" }; coerce $PositiveInt, from Int, q{ abs $_ }; has age => ( is => "ro", isa => $PositiveInt, coerce => 1, writer => "_set_age", ); sub get_older { my $self = shift; my ($years) = @_; $PositiveInt->assert_valid($years); $self->_set_age($self->age + $years); } } =head1 STATUS L support in Type::Tiny was somewhat of an afterthought. It should work, but is not anywhere near as well-tested as L or L support. =head1 DESCRIPTION L type constraints have an API almost identical to that of L. As a result, you can use a Type::Tiny object pretty much anywhere you'd use a Mouse::Meta::TypeConstraint and you are unlikely to notice the difference. (And Mouse is unlikely to notice the difference too!) =head2 Per-Attribute Coercions Type::Tiny offers convenience methods to alter the list of coercions associated with a type constraint. Let's imagine we wish to allow our C attribute to be coerced from an arrayref of strings. has name => ( is => "ro", isa => Str->plus_coercions( ArrayRef[Str], sub { join " ", @{$_} }, ), coerce => 1, ); This coercion will apply to the C attribute only; other attributes using the C type constraint will be unaffected. See the documentation for C, C and C in L. =head2 Optimization Mouse's built-in type constraints are implemented using XS and are stupidly fast. Using Type::Tiny type constraints I be significantly slower. However, Type::Tiny constraints should not be significantly slower (and may even be faster) than non-built-in Mouse type constraints. =head1 SEE ALSO For examples using Type::Tiny with L see the SYNOPSIS sections of L and L, and the files C<< mouse.t >> and C<< mouse-coercion.t >> in the Type-Tiny L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Type-Tiny-0.022/lib/Type/Tiny/Manual/UsingWithMoo.pod0000644000175000017500000000557412171054767020447 0ustar taitai=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithMoo - how to use Type::Tiny and Type::Library with Moo =head1 SYNOPSIS { package Person; use Moo; use Types::Standard qw( Str Int ); use Type::Utils qw( declare as where inline_as coerce from ); has name => ( is => "ro", isa => Str, ); my $PositiveInt = declare as Int, where { $_ > 0 }, inline_as { "$_ =~ /^[0-9]\$/ and $_ > 0" }; coerce $PositiveInt, from Int, q{ abs $_ }; has age => ( is => "rwp", isa => $PositiveInt, coerce => $PositiveInt->coercion, ); sub get_older { my $self = shift; my ($years) = @_; $PositiveInt->assert_valid($years); $self->_set_age($self->age + $years); } } =head1 DESCRIPTION Type::Tiny is tested with L 1.001000 and above. Type::Tiny overloads C<< &{} >>. Moo supports using objects that overload C<< &{} >> as C constraints, so Type::Tiny objects can directly be used in C. Moo doesn't support C<< coerce => 1 >> but requires a coderef as a coercion. However, again it supports using objects that overload C<< &{} >>, which Type::Coercion does, allowing C<< coerce => $Type->coercion >> to work. Type::Tiny hooks into Moo's HandleMoose interface to ensure that type constraints get inflated to Moose type constraints if and when Moo inflates your class to a full Moose class. =head2 Optimization The usual advice for optimizing type constraints applies: use type constraints which can be inlined whenever possible, and define coercions as strings rather than coderefs. Upgrading to Moo 1.002000 or above should provide a slight increase in speed for type constraints, as it allows them to be inlined into accessors and constructors. If creating your own type constraints using C<< Type::Tiny->new >>, then consider using L to quote the coderef; this allows you to take advantage of inlining without having to write your own inlining routines. =head1 SEE ALSO For examples using Type::Tiny with L see the SYNOPSIS sections of L and L, and the files C<< moo.t >> and C<< moo-coercion.t >> and C<< moo-inflation.t >> in the Type-Tiny L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Type-Tiny-0.022/lib/Type/Tiny/Class.pm0000644000175000017500000001407712200121217015505 0ustar taitaipackage Type::Tiny::Class; use 5.006001; use strict; use warnings; BEGIN { if ($] < 5.008) { require Devel::TypeTiny::Perl56Compat }; } BEGIN { $Type::Tiny::Class::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Class::VERSION = '0.022'; } use Scalar::Util qw< blessed >; sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } use base "Type::Tiny"; sub new { my $proto = shift; return $proto->class->new(@_) if blessed $proto; # DWIM my %opts = @_; _croak "Class type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent}; _croak "Class type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Class type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply class name" unless exists $opts{class}; return $proto->SUPER::new(%opts); } sub class { $_[0]{class} } sub inlined { $_[0]{inlined} ||= $_[0]->_build_inlined } sub has_inlined { !!1 } sub _build_constraint { my $self = shift; my $class = $self->class; return sub { blessed($_) and $_->isa($class) }; } sub _build_inlined { my $self = shift; my $class = $self->class; sub { my $var = $_[1]; qq{Scalar::Util::blessed($var) and $var->isa(q[$class])}; }; } sub _build_default_message { my $self = shift; my $c = $self->class; return sub { sprintf 'value "%s" did not pass type constraint (not isa %s)', $_[0], $c } if $self->is_anon; my $name = "$self"; return sub { sprintf 'value "%s" did not pass type constraint "%s" (not isa %s)', $_[0], $name, $c }; } sub _instantiate_moose_type { my $self = shift; my %opts = @_; delete $opts{parent}; delete $opts{constraint}; delete $opts{inlined}; require Moose::Meta::TypeConstraint::Class; return "Moose::Meta::TypeConstraint::Class"->new(%opts, class => $self->class); } sub plus_constructors { my $self = shift; unless (@_) { require Types::Standard; push @_, Types::Standard::HashRef(), "new"; } require B; require Types::TypeTiny; my $class = B::perlstring($self->class); my @r; while (@_) { my $source = shift; Types::TypeTiny::TypeTiny->check($source) or _croak "Expected type constraint; got $source"; my $constructor = shift; Types::TypeTiny::StringLike->check($constructor) or _croak "Expected string; got $constructor"; push @r, $source, sprintf('%s->%s($_)', $class, $constructor); } return $self->plus_coercions(\@r); } sub has_parent { !!1; } sub parent { $_[0]{parent} ||= $_[0]->_build_parent; } sub _build_parent { my $self = shift; my $class = $self->class; my @isa = grep $class->isa($_), do { no strict "refs"; no warnings; @{"$class\::ISA"} }; if (@isa == 0) { require Types::Standard; return Types::Standard::Object(); } if (@isa == 1) { return ref($self)->new(class => $isa[0]) } require Type::Tiny::Intersection; "Type::Tiny::Intersection"->new( type_constraints => [ map ref($self)->new(class => $_), @isa ], ); } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Class - type constraints based on the "isa" method =head1 DESCRIPTION Type constraints of the general form C<< { $_->isa("Some::Class") } >>. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Constructor =over =item C When the constructor is called on an I of Type::Tiny::Class, it passes the call through to the constructor of the class for the constraint. So for example: my $type = Type::Tiny::Class->new(class => "Foo::Bar"); my $obj = $type->new(hello => "World"); say ref($obj); # prints "Foo::Bar" This little bit of DWIM was borrowed from L, but Type::Tiny doesn't take the idea quite as far. =back =head2 Attributes =over =item C The class for the constraint. =item C Unlike Type::Tiny, you should generally I pass a constraint to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you should generally I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is automatically calculated, and cannot be passed to the constructor. =back =head2 Methods =over =item C<< plus_constructors($source, $method_name) >> Much like C but adds coercions that go via a constructor. (In fact, this is implemented as a wrapper for C.) Example: package MyApp::Minion; use Moose; extends "MyApp::Person"; use Types::Standard qw( HashRef Str ); use Type::Utils qw( class_type ); my $Person = class_type({ class => "MyApp::Person" }); has boss => ( is => "ro", isa => $Person->plus_constructors( HashRef, "new", Str, "_new_from_name", ), coerce => 1, ); package main; MyApp::Minion->new( ..., boss => "Bob", ## via MyApp::Person->_new_from_name ); MyApp::Minion->new( ..., boss => { name => "Bob" }, ## via MyApp::Person->new ); Because coercing C via constructor is a common desire, if you call C with no arguments at all, this is the default. $classtype->plus_constructors(Types::Standard::HashRef, "new") $classtype->plus_constructors() ## identical to above This is handy for Moose/Mouse/Moo-based classes. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Tiny/Union.pm0000644000175000017500000000775412200121217015534 0ustar taitaipackage Type::Tiny::Union; use 5.006001; use strict; use warnings; BEGIN { $Type::Tiny::Union::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Union::VERSION = '0.022'; } use Scalar::Util qw< blessed >; use Types::TypeTiny (); sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } use overload q[@{}] => sub { $_[0]{type_constraints} ||= [] }; use base "Type::Tiny"; sub new { my $proto = shift; my %opts = @_; _croak "Union type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent}; _croak "Union type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Union type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply list of type constraints" unless exists $opts{type_constraints}; $opts{type_constraints} = [ map { $_->isa(__PACKAGE__) ? @$_ : $_ } map Types::TypeTiny::to_TypeTiny($_), @{ ref $opts{type_constraints} eq "ARRAY" ? $opts{type_constraints} : [$opts{type_constraints}] } ]; my $self = $proto->SUPER::new(%opts); $self->coercion if grep $_->has_coercion, @$self; return $self; } sub type_constraints { $_[0]{type_constraints} } sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } sub _build_display_name { my $self = shift; join q[|], @$self; } sub _build_coercion { require Type::Coercion::Union; my $self = shift; return "Type::Coercion::Union"->new(type_constraint => $self); } sub _build_constraint { my @tcs = @{+shift}; return sub { my $val = $_; $_->check($val) && return !!1 for @tcs; return; } } sub can_be_inlined { my $self = shift; not grep !$_->can_be_inlined, @$self; } sub inline_check { my $self = shift; sprintf '(%s)', join " or ", map $_->inline_check($_[0]), @$self; } sub _instantiate_moose_type { my $self = shift; my %opts = @_; delete $opts{parent}; delete $opts{constraint}; delete $opts{inlined}; my @tc = map $_->moose_type, @{$self->type_constraints}; require Moose::Meta::TypeConstraint::Union; return "Moose::Meta::TypeConstraint::Union"->new(%opts, type_constraints => \@tc); } sub has_parent { defined(shift->parent); } sub parent { $_[0]{parent} ||= $_[0]->_build_parent; } sub _build_parent { my $self = shift; my ($first, @rest) = @$self; for my $parent ($first, $first->parents) { return $parent unless grep !$_->is_a_type_of($parent), @rest; } return; } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Union - union type constraints =head1 DESCRIPTION Union type constraints. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C Arrayref of type constraints. When passed to the constructor, if any of the type constraints in the union is itself a union type constraint, this is "exploded" into the new union. =item C Unlike Type::Tiny, you should generally I pass a constraint to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you should generally I pass an inlining coderef to the constructor. Instead rely on the default. =item C Will typically be a L. =back =head2 Overloading =over =item * Arrayrefification calls C. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Tiny/Intersection.pm0000644000175000017500000000700512200121217017077 0ustar taitaipackage Type::Tiny::Intersection; use 5.006001; use strict; use warnings; BEGIN { $Type::Tiny::Intersection::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Intersection::VERSION = '0.022'; } use Scalar::Util qw< blessed >; use Types::TypeTiny (); sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } use overload q[@{}] => sub { $_[0]{type_constraints} ||= [] }; use base "Type::Tiny"; sub new { my $proto = shift; my %opts = @_; _croak "Intersection type constraints cannot have a parent constraint" if exists $opts{parent}; _croak "Intersection type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Intersection type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply list of type constraints" unless exists $opts{type_constraints}; $opts{type_constraints} = [ map { $_->isa(__PACKAGE__) ? @$_ : $_ } map Types::TypeTiny::to_TypeTiny($_), @{ ref $opts{type_constraints} eq "ARRAY" ? $opts{type_constraints} : [$opts{type_constraints}] } ]; return $proto->SUPER::new(%opts); } sub type_constraints { $_[0]{type_constraints} } sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } sub _build_display_name { my $self = shift; join q[&], @$self; } sub _build_constraint { my @tcs = @{+shift}; return sub { my $val = $_; $_->check($val) || return for @tcs; return !!1; } } sub can_be_inlined { my $self = shift; not grep !$_->can_be_inlined, @$self; } sub inline_check { my $self = shift; sprintf '(%s)', join " and ", map $_->inline_check($_[0]), @$self; } sub has_parent { !!@{ $_[0]{type_constraints} }; } sub parent { $_[0]{type_constraints}[0]; } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Intersection - intersection type constraints =head1 DESCRIPTION Intersection type constraints. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C Arrayref of type constraints. When passed to the constructor, if any of the type constraints in the intersection is itself an intersection type constraint, this is "exploded" into the new intersection. =item C Unlike Type::Tiny, you should generally I pass a constraint to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you should generally I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is automatically calculated, and cannot be passed to the constructor. (Technically any of the types in the intersection could be treated as a parent type; we choose the first arbitrarily.) =back =head2 Overloading =over =item * Arrayrefification calls C. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Tiny/Duck.pm0000644000175000017500000000657612200121217015333 0ustar taitaipackage Type::Tiny::Duck; use 5.006001; use strict; use warnings; BEGIN { $Type::Tiny::Duck::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Duck::VERSION = '0.022'; } use Scalar::Util qw< blessed >; sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } use base "Type::Tiny"; sub new { my $proto = shift; my %opts = @_; _croak "Duck type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent}; _croak "Duck type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Duck type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply list of methods" unless exists $opts{methods}; $opts{methods} = [$opts{methods}] unless ref $opts{methods}; return $proto->SUPER::new(%opts); } sub methods { $_[0]{methods} } sub inlined { $_[0]{inlined} ||= $_[0]->_build_inlined } sub has_inlined { !!1 } sub _build_constraint { my $self = shift; my @methods = @{$self->methods}; return sub { blessed($_[0]) and not grep(!$_[0]->can($_), @methods) }; } sub _build_inlined { my $self = shift; my @methods = @{$self->methods}; sub { my $var = $_[1]; local $" = q{ }; qq{ Scalar::Util::blessed($var) and not grep(!$var->can(\$_), qw/@methods/) }; }; } sub _build_default_message { my $self = shift; return sub { sprintf 'value "%s" did not pass type constraint', $_[0] } if $self->is_anon; my $name = "$self"; return sub { sprintf 'value "%s" did not pass type constraint "%s"', $_[0], $name }; } sub _instantiate_moose_type { my $self = shift; my %opts = @_; delete $opts{parent}; delete $opts{constraint}; delete $opts{inlined}; require Moose::Meta::TypeConstraint::DuckType; return "Moose::Meta::TypeConstraint::DuckType"->new(%opts, methods => $self->methods); } sub has_parent { !!1; } sub parent { require Types::Standard; Types::Standard::Object(); } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Duck - type constraints based on the "can" method =head1 DESCRIPTION Type constraints of the general form C<< { $_->can("method") } >>. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C An arrayref of method names. =item C Unlike Type::Tiny, you should generally I pass a constraint to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you should generally I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is always Types::Standard::Object, and cannot be passed to the constructor. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Tiny/Role.pm0000644000175000017500000000653212200121217015336 0ustar taitaipackage Type::Tiny::Role; use 5.006001; use strict; use warnings; BEGIN { $Type::Tiny::Role::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Role::VERSION = '0.022'; } use Scalar::Util qw< blessed weaken >; sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } use base "Type::Tiny"; my %cache; sub new { my $proto = shift; my %opts = @_; _croak "Role type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent}; _croak "Role type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Role type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply role name" unless exists $opts{role}; return $proto->SUPER::new(%opts); } sub role { $_[0]{role} } sub inlined { $_[0]{inlined} ||= $_[0]->_build_inlined } sub has_inlined { !!1 } sub _build_constraint { my $self = shift; my $role = $self->role; return sub { blessed($_) and do { my $method = $_->can('DOES')||$_->can('isa'); $_->$method($role) } }; } sub _build_inlined { my $self = shift; my $role = $self->role; sub { my $var = $_[1]; qq{Scalar::Util::blessed($var) and do { my \$method = $var->can('DOES')||$var->can('isa'); $var->\$method(q[$role]) }}; }; } sub _build_default_message { my $self = shift; my $c = $self->role; return sub { sprintf 'value "%s" did not pass type constraint (not DOES %s)', $_[0], $c } if $self->is_anon; my $name = "$self"; return sub { sprintf 'value "%s" did not pass type constraint "%s" (not DOES %s)', $_[0], $name, $c }; } sub has_parent { !!1; } sub parent { require Types::Standard; Types::Standard::Object(); } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Role - type constraints based on the "DOES" method =head1 DESCRIPTION Type constraints of the general form C<< { $_->DOES("Some::Role") } >>. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C The role for the constraint. Note that this package doesn't subscribe to any particular flavour of roles (L, L, L, L, etc). It simply trusts the object's C method (see L). =item C Unlike Type::Tiny, you should generally I pass a constraint to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you should generally I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is always Types::Standard::Object, and cannot be passed to the constructor. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Registry.pm0000644000175000017500000001553612200121217015326 0ustar taitaipackage Type::Registry; use 5.006001; use strict; use warnings; BEGIN { $Type::Registry::AUTHORITY = 'cpan:TOBYINK'; $Type::Registry::VERSION = '0.022'; } use Exporter::TypeTiny qw( mkopt _croak ); use Scalar::Util qw( refaddr ); use Type::Parser qw( eval_type ); use Types::TypeTiny qw( ArrayLike ); use base "Exporter::TypeTiny"; our @EXPORT_OK = qw(t); sub _exporter_expand_sub { my $class = shift; my ($name, $value, $globals, $permitted) = @_; if ($name eq "t") { my $caller = $globals->{into}; my $reg = $class->for_class( ref($caller) ? sprintf('HASH(0x%08X)', refaddr($caller)) : $caller ); return t => sub (;$) { @_ ? $reg->lookup(@_) : $reg }; } return $class->SUPER::_exporter_expand_sub(@_); } sub new { my $class = shift; ref($class) and _croak("Not an object method"); bless {}, $class; } { my %registries; sub for_class { my $class = shift; my ($for) = @_; $registries{$for} ||= $class->new; } sub for_me { my $class = shift; my $for = caller; $registries{$for} ||= $class->new; } } sub add_types { my $self = shift; my $opts = mkopt(\@_); for my $opt (@$opts) { my ($lib, $types) = @_; $types ||= [qw/-types/]; $lib =~ s/^-/Types::/; eval "require $lib"; $lib->isa("Type::Library") || $lib eq 'Types::TypeTiny' or _croak("%s is not a type library", $lib); ArrayLike->check($types) or _croak("Expected arrayref following '%s'; got %s", $lib, $types); my %hash; $lib->import({into => \%hash}, @$types); for my $key (sort keys %hash) { exists($self->{$key}) and _croak("Duplicate type name: %s", $key); $self->{$key} = $hash{$key}->(); } } $self; } sub alias_type { my $self = shift; my ($old, @new) = @_; $self->{$_} = $self->{$old} for @new; $self; } sub simple_lookup { my $self = shift; my ($tc) = @_; $tc =~ s/(^\s+|\s+$)//g; if (exists $self->{$tc}) { return $self->{$tc}; } return; } sub lookup { my $self = shift; $self->simple_lookup(@_) or eval_type($_[0], $self); } sub AUTOLOAD { my $self = shift; my ($method) = (our $AUTOLOAD =~ /(\w+)$/); my $type = $self->simple_lookup($method); return $type if $type; _croak(q[Can't locate object method "%s" via package "%s"], $method, ref($self)); } # Prevent AUTOLOAD being called for DESTROY! sub DESTROY { return; } 1; __END__ =pod =encoding utf-8 =for stopwords optlist =head1 NAME Type::Registry - a glorified hashref for looking up type constraints =head1 SYNOPSIS package Foo::Bar; use Type::Registry; my $reg = "Type::Registry"->for_me; # a registry for Foo::Bar # Register all types from Types::Standard $reg->add_types(-Standard); # Register just one type from Types::XSD $reg->add_types(-XSD => ["NonNegativeInteger"]); # Register all types from MyApp::Types $reg->add_types("MyApp::Types"); # Create a type alias $reg->alias_type("NonNegativeInteger" => "Count"); # Look up a type constraint my $type = $reg->lookup("ArrayRef[Count]"); $type->check([1, 2, 3.14159]); # croaks Alternatively: package Foo::Bar; use Type::Registry qw( t ); # Register all types from Types::Standard t->add_types(-Standard); # Register just one type from Types::XSD t->add_types(-XSD => ["NonNegativeInteger"]); # Register all types from MyApp::Types t->add_types("MyApp::Types"); # Create a type alias t->alias_type("NonNegativeInteger" => "Count"); # Look up a type constraint my $type = t("ArrayRef[Count]"); $type->check([1, 2, 3.14159]); # croaks =head1 STATUS Type::Registry (and L) is currently a pretty isolated part of this distribution. It seems like something that would be useful, but it's not heavily integrated with everything else. In particular, if you do: use Type::Registry qw(t); use Types::Standard -types; Then the C, C, etc keywords imported from L will work fine, but C<< t->lookup("Str") >> and C<< t->lookup("Num") >> will fail, because importing types from a library does not automatically add them to your registry. Clearly some kind of integration is desirable between Type::Registry and L, but exactly what form that will take is still to be decided. So if you decide to use Type::Registry, be aware of its somewhat experimental status. It's not likely to disappear completely, but there may be changes ahead. =head1 DESCRIPTION A type registry is basically just a hashref mapping type names to type constraint objects. =head2 Constructors =over =item C<< new >> Create a new glorified hashref. =item C<< for_class($class) >> Create or return the existing glorified hashref associated with the given class. =item C<< for_me >> Create or return the existing glorified hashref associated with the caller. =back =head2 Methods =over =item C<< add_types(@libraries) >> The libraries list is treated as an "optlist" (a la L). Strings are the names of type libraries; if the first character is a hyphen, it is expanded to the "Types::" prefix. If followed by an arrayref, this is the list of types to import from that library. Otherwise, imports all types from the library. use Type::Registry qw(t); t->add_types(-Standard); # OR: t->add_types("Types::Standard"); t->add_types( -TypeTiny => ['HashLike'], -Standard => ['HashRef' => { -as => 'RealHash' }], ); =item C<< alias_type($oldname, $newname) >> Create an alias for an existing type. =item C<< simple_lookup($name) >> Look up a type in the registry by name. Returns undef if not found. =item C<< lookup($name) >> Look up by name, with a DSL. t->lookup("Int|ArrayRef[Int]") The DSL can be summed up as: X type from this registry My::Lib::X type from a type library ~X complementary type X | Y union X & Y intersection X[...] parameterized type slurpy X slurpy type Foo::Bar:: class type Croaks if not found. =item C<< AUTOLOAD >> Overloaded to call C. $registry->Str; # like $registry->lookup("Str") =back =head2 Functions =over =item C<< t >> This class can export a function C<< t >> which acts like C<< "Type::Registry"->for_class($importing_class) >>. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Coercion.pm0000644000175000017500000004351712200121217015257 0ustar taitaipackage Type::Coercion; use 5.006001; use strict; use warnings; BEGIN { $Type::Coercion::AUTHORITY = 'cpan:TOBYINK'; $Type::Coercion::VERSION = '0.022'; } use Eval::TypeTiny qw<>; use Scalar::Util qw< blessed >; use Types::TypeTiny qw<>; sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } use overload q("") => sub { caller =~ m{^(Moo::HandleMoose|Sub::Quote)} ? overload::StrVal($_[0]) : $_[0]->display_name }, q(bool) => sub { 1 }, q(&{}) => "_overload_coderef", q(+) => sub { __PACKAGE__->add(@_) }, fallback => 1, ; BEGIN { require Type::Tiny; overload->import(q(~~) => sub { $_[0]->has_coercion_for_value($_[1]) }) if Type::Tiny::SUPPORT_SMARTMATCH(); } sub _overload_coderef { my $self = shift; if ("Sub::Quote"->can("quote_sub") && $self->can_be_inlined) { $self->{_overload_coderef} = Sub::Quote::quote_sub($self->inline_coercion('$_[0]')) if !$self->{_overload_coderef} || !$self->{_sub_quoted}++; } else { $self->{_overload_coderef} ||= sub { $self->coerce(@_) }; } $self->{_overload_coderef}; } sub new { my $class = shift; my %params = (@_==1) ? %{$_[0]} : @_; $params{name} = '__ANON__' unless exists($params{name}); my $C = delete($params{type_coercion_map}) || []; my $F = delete($params{frozen}); my $self = bless \%params, $class; $self->add_type_coercions(@$C) if @$C; Scalar::Util::weaken($self->{type_constraint}); # break ref cycle $self->{frozen} = $F if $F; unless ($self->is_anon) { # First try a fast ASCII-only expression, but fall back to Unicode $self->name =~ /^[A-Z][A-Za-z0-9_]+$/sm or eval q( use 5.008; $self->name =~ /^\p{Lu}[\p{L}0-9_]+$/sm ) or _croak '"%s" is not a valid coercion name', $self->name; } return $self; } sub name { $_[0]{name} } sub display_name { $_[0]{display_name} ||= $_[0]->_build_display_name } sub library { $_[0]{library} } sub type_constraint { $_[0]{type_constraint} } sub type_coercion_map { $_[0]{type_coercion_map} ||= [] } sub moose_coercion { $_[0]{moose_coercion} ||= $_[0]->_build_moose_coercion } sub compiled_coercion { $_[0]{compiled_coercion} ||= $_[0]->_build_compiled_coercion } sub frozen { $_[0]{frozen} ||= 0 } sub coercion_generator { $_[0]{coercion_generator} } sub parameters { $_[0]{parameters} } sub has_library { exists $_[0]{library} } sub has_type_constraint { defined $_[0]{type_constraint} } # sic sub has_coercion_generator { exists $_[0]{coercion_generator} } sub has_parameters { exists $_[0]{parameters} } sub add { my $class = shift; my ($x, $y, $swap) = @_; Types::TypeTiny::TypeTiny->check($x) and return $x->plus_fallback_coercions($y); Types::TypeTiny::TypeTiny->check($y) and return $y->plus_coercions($x); _croak "Attempt to add $class to something that is not a $class" unless blessed($x) && blessed($y) && $x->isa($class) && $y->isa($class); ($y, $x) = ($x, $y) if $swap; my %opts; if ($x->has_type_constraint and $y->has_type_constraint and $x->type_constraint == $y->type_constraint) { $opts{type_constraint} = $x->type_constraint; } elsif ($x->has_type_constraint and $y->has_type_constraint) { # require Type::Tiny::Union; # $opts{type_constraint} = "Type::Tiny::Union"->new( # type_constraints => [ $x->type_constraint, $y->type_constraint ], # ); } $opts{display_name} ||= "$x+$y"; delete $opts{display_name} if $opts{display_name} eq '__ANON__+__ANON__'; my $new = $class->new(%opts); $new->add_type_coercions( @{$x->type_coercion_map} ); $new->add_type_coercions( @{$y->type_coercion_map} ); return $new; } sub _build_display_name { shift->name; } sub qualified_name { my $self = shift; if ($self->has_library and not $self->is_anon) { return sprintf("%s::%s", $self->library, $self->name); } return $self->name; } sub is_anon { my $self = shift; $self->name eq "__ANON__"; } sub _clear_compiled_coercion { delete $_[0]{_overload_coderef}; delete $_[0]{compiled_coercion}; } sub freeze { $_[0]{frozen} = 1; $_[0] } sub coerce { my $self = shift; return $self->compiled_coercion->(@_); } sub assert_coerce { my $self = shift; my $r = $self->coerce(@_); $self->type_constraint->assert_valid($r) if $self->has_type_constraint; return $r; } sub has_coercion_for_type { my $self = shift; my $type = Types::TypeTiny::to_TypeTiny($_[0]); return "0 but true" if $self->has_type_constraint && $type->is_a_type_of($self->type_constraint); my $c = $self->type_coercion_map; for (my $i = 0; $i <= $#$c; $i += 2) { return !!1 if $type->is_a_type_of($c->[$i]); } return; } sub has_coercion_for_value { my $self = shift; local $_ = $_[0]; return "0 but true" if $self->has_type_constraint && $self->type_constraint->check(@_); my $c = $self->type_coercion_map; for (my $i = 0; $i <= $#$c; $i += 2) { return !!1 if $c->[$i]->check(@_); } return; } sub add_type_coercions { my $self = shift; my @args = @_; _croak "Attempt to add coercion code to a Type::Coercion which has been frozen" if $self->frozen; while (@args) { my $type = Types::TypeTiny::to_TypeTiny(shift @args); my $coercion = shift @args; _croak "Types must be blessed Type::Tiny objects" unless Types::TypeTiny::TypeTiny->check($type); _croak "Coercions must be code references or strings" unless Types::TypeTiny::StringLike->check($coercion) || Types::TypeTiny::CodeLike->check($coercion); push @{$self->type_coercion_map}, $type, $coercion; } $self->_clear_compiled_coercion; return $self; } sub _build_compiled_coercion { my $self = shift; my @mishmash = @{$self->type_coercion_map}; return sub { $_[0] } unless @mishmash; if ($self->can_be_inlined) { return Eval::TypeTiny::eval_closure( source => sprintf('sub ($) { %s }', $self->inline_coercion('$_[0]')), description => sprintf("compiled coercion '%s'", $self), ); } # These arrays will be closed over. my (@types, @codes); while (@mishmash) { push @types, shift @mishmash; push @codes, shift @mishmash; } if ($self->has_type_constraint) { unshift @types, $self->type_constraint; unshift @codes, undef; } my @sub; for my $i (0..$#types) { push @sub, $types[$i]->can_be_inlined ? sprintf('if (%s)', $types[$i]->inline_check('$_[0]')) : sprintf('if ($checks[%d]->(@_))', $i); push @sub, !defined($codes[$i]) ? sprintf(' { return $_[0] }') : Types::TypeTiny::StringLike->check($codes[$i]) ? sprintf(' { local $_ = $_[0]; return( %s ) }', $codes[$i]) : sprintf(' { local $_ = $_[0]; return $codes[%d]->(@_) }', $i); } push @sub, 'return $_[0];'; return Eval::TypeTiny::eval_closure( source => sprintf('sub ($) { %s }', join qq[\n], @sub), description => sprintf("compiled coercion '%s'", $self), environment => { '@checks' => [ map $_->compiled_check, @types ], '@codes' => \@codes, }, ); } sub can_be_inlined { my $self = shift; return if $self->has_type_constraint && !$self->type_constraint->can_be_inlined; my @mishmash = @{$self->type_coercion_map}; while (@mishmash) { my ($type, $converter) = splice(@mishmash, 0, 2); return unless $type->can_be_inlined; return unless Types::TypeTiny::StringLike->check($converter); } return !!1; } sub _source_type_union { my $self = shift; my @r; push @r, $self->type_constraint if $self->has_type_constraint; my @mishmash = @{$self->type_coercion_map}; while (@mishmash) { my ($type) = splice(@mishmash, 0, 2); push @r, $type; } require Type::Tiny::Union; return "Type::Tiny::Union"->new(type_constraints => \@r, tmp => 1); } sub inline_coercion { my $self = shift; my $varname = $_[0]; _croak "This coercion cannot be inlined" unless $self->can_be_inlined; my @mishmash = @{$self->type_coercion_map}; return "($varname)" unless @mishmash; my (@types, @codes); while (@mishmash) { push @types, shift @mishmash; push @codes, shift @mishmash; } if ($self->has_type_constraint) { unshift @types, $self->type_constraint; unshift @codes, undef; } my @sub; for my $i (0..$#types) { push @sub, sprintf('(%s) ?', $types[$i]->inline_check($varname)); push @sub, (defined($codes[$i]) && ($varname eq '$_')) ? sprintf('scalar(%s) :', $codes[$i]) : defined($codes[$i]) ? sprintf('do { local $_ = %s; scalar(%s) } :', $varname, $codes[$i]) : sprintf('%s :', $varname); } push @sub, "$varname"; "@sub"; } sub _build_moose_coercion { my $self = shift; my %options = (); $options{type_coercion_map} = [ $self->freeze->_codelike_type_coercion_map('moose_type') ]; $options{type_constraint} = $self->type_constraint if $self->has_type_constraint; require Moose::Meta::TypeCoercion; my $r = "Moose::Meta::TypeCoercion"->new(%options); return $r; } sub _codelike_type_coercion_map { my $self = shift; my $modifier = $_[0]; my @orig = @{ $self->type_coercion_map }; my @new; while (@orig) { my ($type, $converter) = splice(@orig, 0, 2); push @new, $modifier ? $type->$modifier : $type; if (Types::TypeTiny::CodeLike->check($converter)) { push @new, $converter; } else { Eval::TypeTiny::eval_closure( source => sprintf('sub { local $_ = $_[0]; %s }', $converter), description => sprintf("temporary compiled converter from '%s'", $type), ); } } return @new; } sub is_parameterizable { shift->has_coercion_generator; } sub is_parameterized { shift->has_parameters; } sub parameterize { my $self = shift; return $self unless @_; $self->is_parameterizable or _croak "Constraint '%s' does not accept parameters", "$self"; @_ = map Types::TypeTiny::to_TypeTiny($_), @_; return ref($self)->new( type_constraint => $self->type_constraint, type_coercion_map => [ $self->coercion_generator->($self, $self->type_constraint, @_) ], parameters => \@_, frozen => 1, ); } sub isa { my $self = shift; if ($INC{"Moose.pm"} and blessed($self) and $_[0] eq 'Moose::Meta::TypeCoercion') { return !!1; } if ($INC{"Moose.pm"} and blessed($self) and $_[0] =~ /^Moose/ and my $r = $self->moose_coercion->isa(@_)) { return $r; } $self->SUPER::isa(@_); } sub can { my $self = shift; my $can = $self->SUPER::can(@_); return $can if $can; if ($INC{"Moose.pm"} and blessed($self) and my $method = $self->moose_coercion->can(@_)) { return sub { $method->(shift->moose_coercion, @_) }; } return; } sub AUTOLOAD { my $self = shift; my ($m) = (our $AUTOLOAD =~ /::(\w+)$/); return if $m eq 'DESTROY'; if ($INC{"Moose.pm"} and blessed($self) and my $method = $self->moose_coercion->can($m)) { return $method->($self->moose_coercion, @_); } _croak q[Can't locate object method "%s" via package "%s"], $m, ref($self)||$self; } # Private Moose method, but Moo uses this... sub _compiled_type_coercion { my $self = shift; if (@_) { my $thing = $_[0]; if (blessed($thing) and $thing->isa("Type::Coercion")) { $self->add_type_coercions(@{$thing->type_coercion_map}); } elsif (Types::TypeTiny::CodeLike->check($thing)) { require Types::Standard; $self->add_type_coercions(Types::Standard::Any(), $thing); } } $self->compiled_coercion; } *compile_type_coercion = \&compiled_coercion; sub meta { _croak("Not really a Moose::Meta::TypeCoercion. Sorry!") } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Coercion - a set of coercions to a particular target type constraint =head1 DESCRIPTION =head2 Constructors =over =item C<< new(%attributes) >> Moose-style constructor function. =item C<< add($c1, $c2) >> Create a Type::Coercion from two existing Type::Coercion objects. =back =head2 Attributes =over =item C A name for the coercion. These need to conform to certain naming rules (they must begin with an uppercase letter and continue using only letters, digits 0-9 and underscores). Optional; if not supplied will be an anonymous coercion. =item C A name to display for the coercion when stringified. These don't have to conform to any naming rules. Optional; a default name will be calculated from the C. =item C The package name of the type library this coercion is associated with. Optional. Informational only: setting this attribute does not install the coercion into the package. =item C Weak reference to the target type constraint (i.e. the type constraint which the output of coercion coderefs is expected to conform to). =item C Arrayref of source-type/code pairs. Don't set this in the constructor; use the C method instead. =item C<< compiled_coercion >> Coderef to coerce a value (C<< $_[0] >>). The general point of this attribute is that you should not set it, and rely on the lazily-built default. Type::Coerce will usually generate a pretty fast coderef, inlining all type constraint checks, etc. =item C A L object equivalent to this one. Don't set this manually; rely on the default built one. =item C Boolean; default false. A frozen coercion cannot have C called upon it. =back =head2 Methods =over =item C, C Predicate methods. =item C Returns true iff the coercion does not have a C. =item C<< qualified_name >> For non-anonymous coercions that have a library, returns a qualified C<< "Library::Type" >> sort of name. Otherwise, returns the same as C. =item C<< add_type_coercions($type1, $code1, ...) >> Takes one or more pairs of L constraints and coercion code, creating an ordered list of source types and coercion codes. Coercion codes can be expressed as either a string of Perl code (this includes objects which overload stringification), or a coderef (or object that overloads coderefification). In either case, the value to be coerced is C<< $_ >>. =item C<< coerce($value) >> Coerce the value to the target type. Returns the coerced value, or the original value if no coercion was possible. =item C<< assert_coerce($value) >> Coerce the value to the target type, and throw an exception if the result does not validate against the target type constraint. Returns the coerced value. =item C<< has_coercion_for_type($source_type) >> Returns true iff this coercion has a coercion from the source type. Returns the special string C<< "0 but true" >> if no coercion should actually be necessary for this type. (For example, if a coercion coerces to a theoretical "Number" type, there is probably no coercion necessary for values that already conform to the "Integer" type.) =item C<< has_coercion_for_value($value) >> Returns true iff the value could be coerced by this coercion. Returns the special string C<< "0 but true" >> if no coercion would be actually be necessary for this value (due to it already meeting the target type constraint). =item C<< can_be_inlined >> Returns true iff the coercion can be inlined. =item C<< inline_coercion($varname) >> Much like C from L. =item C<< freeze >> Set C to true. There is no C. Called automatically by L sometimes. =item C<< isa($class) >>, C<< can($method) >>, C<< AUTOLOAD(@args) >> If Moose is loaded, then the combination of these methods is used to mock a Moose::Meta::TypeCoercion. =back The following methods are used for parameterized coercions, but are not fully documented because they may change in the near future: =over =item C<< coercion_generator >> =item C<< has_coercion_generator >> =item C<< has_parameters >> =item C<< is_parameterizable >> =item C<< is_parameterized >> =item C<< parameterize(@params) >> =item C<< parameters >> =back The following methods exist for Moose/Mouse compatibility, but do not do anything useful. =over =item C<< compile_type_coercion >> =item C<< meta >> =back =head2 Overloading =over =item * Boolification is overloaded to always return true. =item * Coderefification is overloaded to call C. =item * On Perl 5.10.1 and above, smart match is overloaded to call C. =item * Addition is overloaded to call C. =back =head1 DIAGNOSTICS =over =item B<< Attempt to add coercion code to a Type::Coercion which has been frozen >> Type::Tiny type constraints are designed as immutable objects. Once you've created a constraint, rather than modifying it you generally create child constraints to do what you need. Type::Coercion objects, on the other hand, are mutable. Coercion routines can be added at any time during the object's lifetime. Sometimes Type::Tiny needs to freeze a Type::Coercion object to prevent this. In L and L code this is likely to happen as soon as you use a type constraint in an attribute. Workarounds: =over =item * Define as many of your coercions as possible within type libraries, not within the code that uses the type libraries. The type library will be evaluated relatively early, likely before there is any reason to freeze a coercion. =item * If you do need to add coercions to a type within application code outside the type library, instead create a subtype and add coercions to that. The C method provided by L should make this simple. =back =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L, L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Exception/0000755000175000017500000000000012200124456015114 5ustar taitaiType-Tiny-0.022/lib/Type/Exception/WrongNumberOfParameters.pm0000644000175000017500000000457712200121217022235 0ustar taitaipackage Type::Exception::WrongNumberOfParameters; use 5.006001; use strict; use warnings; BEGIN { $Type::Exception::WrongNumberOfParameters::AUTHORITY = 'cpan:TOBYINK'; $Type::Exception::WrongNumberOfParameters::VERSION = '0.022'; } use base "Type::Exception"; sub minimum { $_[0]{minimum} }; sub maximum { $_[0]{maximum} }; sub got { $_[0]{got} }; sub has_minimum { exists $_[0]{minimum} }; sub has_maximum { exists $_[0]{maximum} }; sub _build_message { my $e = shift; if ($e->has_minimum and $e->has_maximum and $e->minimum == $e->maximum) { return sprintf( "Wrong number of parameters; got %d; expected %d", $e->got, $e->minimum, ); } elsif ($e->has_minimum and $e->has_maximum and $e->minimum < $e->maximum) { return sprintf( "Wrong number of parameters; got %d; expected %d to %d", $e->got, $e->minimum, $e->maximum, ); } elsif ($e->has_minimum) { return sprintf( "Wrong number of parameters; got %d; expected at least %d", $e->got, $e->minimum, ); } else { return sprintf( "Wrong number of parameters; got %d", $e->got, ); } } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Exception::WrongNumberOfParameters - exception for Type::Params =head1 DESCRIPTION Thrown when a Type::Params compiled check is called with the wrong number of parameters. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C The minimum expected number of parameters. =item C The maximum expected number of parameters. =item C The number of parameters actually passed to the compiled check. =back =head2 Methods =over =item C, C Predicate methods. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Exception/Assertion.pm0000644000175000017500000001223312200121217017412 0ustar taitaipackage Type::Exception::Assertion; use 5.006001; use strict; use warnings; BEGIN { if ($] < 5.008) { require Devel::TypeTiny::Perl56Compat }; } BEGIN { $Type::Exception::Assertion::AUTHORITY = 'cpan:TOBYINK'; $Type::Exception::Assertion::VERSION = '0.022'; } use base "Type::Exception"; sub type { $_[0]{type} }; sub value { $_[0]{value} }; sub varname { $_[0]{varname} ||= '$_' }; sub attribute_step { $_[0]{attribute_step} }; sub attribute_name { $_[0]{attribute_name} }; sub has_type { defined $_[0]{type} }; # sic sub has_attribute_step { exists $_[0]{attribute_step} }; sub has_attribute_name { exists $_[0]{attribute_name} }; sub new { my $class = shift; my $self = $class->SUPER::new(@_); if (ref $Method::Generate::Accessor::CurrentAttribute) { require B; my %d = %{$Method::Generate::Accessor::CurrentAttribute}; $self->{attribute_name} = $d{name} if defined $d{name}; $self->{attribute_step} = $d{step} if defined $d{step}; $self->{varname} = sprintf '$self->{%s}', B::perlstring($d{init_arg}) if defined $d{init_arg}; } return $self; } sub message { my $e = shift; $e->varname eq '$_' ? $e->SUPER::message : sprintf('%s (in %s)', $e->SUPER::message, $e->varname); } sub _build_message { my $e = shift; $e->has_type ? sprintf('%s did not pass type constraint "%s"', Type::Tiny::_dd($e->value), $e->type) : sprintf('%s did not pass type constraint', Type::Tiny::_dd($e->value)) } sub explain { my $e = shift; return [] unless $e->has_type; $e->_explain($e->type); } sub _explain { my $e = shift; my ($type, $value, $varname) = @_; $value = $e->value if @_ < 2; $varname = ref($e) ? $e->varname : '$_' if @_ < 3; return unless ref $type; return if $type->check($value); if ($type->has_parent) { my $parent = $e->_explain($type->parent, $value, $varname); return [ sprintf('"%s" is a subtype of "%s"', $type, $type->parent), @$parent, ] if $parent; } if ($type->is_parameterized and $type->parent->has_deep_explanation) { my $deep = $type->parent->deep_explanation->($type, $value, $varname); return [ sprintf('%s did not pass type constraint "%s"%s', Type::Tiny::_dd($value), $type, $e->_displayvar($varname)), @$deep, ] if $deep; } return [ sprintf('%s did not pass type constraint "%s"%s', Type::Tiny::_dd($value), $type, $e->_displayvar($varname)), sprintf('"%s" is defined as: %s', $type, $e->_codefor($type)), ]; } sub _displayvar { require Type::Tiny; shift; my ($varname) = @_; return '' if $varname eq q{$_}; return sprintf(' (in %s)', $varname); } my $b; sub _codefor { shift; my $type = $_[0]; return $type->inline_check('$_') if $type->can_be_inlined; $b ||= do { require B::Deparse; my $tmp = "B::Deparse"->new; $tmp->ambient_pragmas(strict => "all", warnings => "all") if $tmp->can('ambient_pragmas'); $tmp; }; my $code = $b->coderef2text($type->constraint); $code =~ s/\s+/ /g; return "sub $code"; } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Exception::Assertion - exception when a value fails a type constraint =head1 DESCRIPTION This exception is thrown when a value fails a type constraint assertion. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C The type constraint that was checked against. Weakened links are involved, so this may end up being C. =item C The value that was tested. =item C The name of the variable that was checked, if known. Defaults to C<< '$_' >>. =item C If this exception was thrown as the result of an isa check or a failed coercion for a Moo attribute, then this will tell you which attribute (if your Moo is new enough). (Hopefully one day this will support other OO frameworks.) =item C If this exception was thrown as the result of an isa check or a failed coercion for a Moo attribute, then this will contain either C<< "isa check" >> or C<< "coercion" >> to indicate which went wrong (if your Moo is new enough). (Hopefully one day this will support other OO frameworks.) =back =head2 Methods =over =item C, C, C Predicate methods. =item C Overridden to add C to the message if defined. =item C Attempts to explain why the value did not pass the type constraint. Returns an arrayref of strings providing step-by-step reasoning; or returns undef if no explanation is possible. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Exception/Compilation.pm0000644000175000017500000000325412200121217017724 0ustar taitaipackage Type::Exception::Compilation; use 5.006001; use strict; use warnings; BEGIN { $Type::Exception::Compilation::AUTHORITY = 'cpan:TOBYINK'; $Type::Exception::Compilation::VERSION = '0.022'; } use base "Type::Exception"; sub code { $_[0]{code} }; sub environment { $_[0]{environment} ||= {} }; sub errstr { $_[0]{errstr} }; sub _build_message { my $self = shift; sprintf("Failed to compile source because: %s", $self->errstr); } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Exception::Compilation - exception for Eval::TypeTiny =head1 DESCRIPTION Thrown when compiling a closure fails. Common causes are problems with inlined type constraints, and syntax errors when coercions are given as strings of Perl code. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C The Perl source code being compiled. =item C Hashref of variables being closed over. =item C Error message from Perl compiler. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Parser.pm0000644000175000017500000003255212200121217014747 0ustar taitaipackage Type::Parser; use strict; use warnings; sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.022'; # Token types # sub TYPE () { "TYPE" }; sub QUOTELIKE () { "QUOTELIKE" }; sub STRING () { "STRING" }; sub CLASS () { "CLASS" }; sub L_BRACKET () { "L_BRACKET" }; sub R_BRACKET () { "R_BRACKET" }; sub COMMA () { "COMMA" }; sub SLURPY () { "SLURPY" }; sub UNION () { "UNION" }; sub INTERSECT () { "INTERSECT" }; sub NOT () { "NOT" }; sub L_PAREN () { "L_PAREN" }; sub R_PAREN () { "R_PAREN" }; sub MYSTERY () { "MYSTERY" }; our @EXPORT_OK = qw( eval_type _std_eval parse ); use base "Exporter::TypeTiny"; Evaluate: { sub parse { my $str = $_[0]; my $parser = "Type::Parser::AstBuilder"->new(input => $str); $parser->build; wantarray ? ($parser->ast, $parser->remainder) : $parser->ast; } sub extract_type { my ($str, $reg) = @_; my ($parsed, $tail) = parse($str); wantarray ? (_eval_type($parsed, $reg), $tail) : _eval_type($parsed, $reg); } sub eval_type { my ($str, $reg) = @_; my ($parsed, $tail) = parse($str); _croak("Unexpected tail on type expression: $tail") if $tail =~ /\S/sm; return _eval_type($parsed, $reg); } my $std; sub _std_eval { require Type::Registry; unless ($std) { $std = "Type::Registry"->new; $std->add_types(-Standard); } eval_type($_[0], $std); } sub _eval_type { my ($node, $reg) = @_; $node = _simplify_expression($node); if ($node->{type} eq "list") { return map _eval_type($_, $reg), @{$node->{list}}; } if ($node->{type} eq "union") { require Type::Tiny::Union; return "Type::Tiny::Union"->new( type_constraints => [ map _eval_type($_, $reg), @{$node->{union}} ], ); } if ($node->{type} eq "intersect") { require Type::Tiny::Intersection; return "Type::Tiny::Intersection"->new( type_constraints => [ map _eval_type($_, $reg), @{$node->{intersect}} ], ); } if ($node->{type} eq "slurpy") { return +{ slurpy => _eval_type($node->{of}, $reg) }; } if ($node->{type} eq "complement") { return _eval_type($node->{of}, $reg)->complementary_type; } if ($node->{type} eq "parameterized") { return _eval_type($node->{base}, $reg) unless $node->{params}; return _eval_type($node->{base}, $reg)->parameterize(_eval_type($node->{params}, $reg)); } if ($node->{type} eq "primary" and $node->{token}->type eq CLASS) { my $class = substr($node->{token}->spelling, 0, length($node->{token}->spelling) - 2); require Type::Tiny::Class; return "Type::Tiny::Class"->new(class => $class); } if ($node->{type} eq "primary" and $node->{token}->type eq QUOTELIKE) { return eval($node->{token}->spelling); #ARGH } if ($node->{type} eq "primary" and $node->{token}->type eq STRING) { return $node->{token}->spelling; } if ($node->{type} eq "primary" and $node->{token}->type eq TYPE) { my $t = $node->{token}->spelling; my $r; if ($t =~ /^(.+)::(\w+)$/) { require Types::TypeTiny; my $library = $1; $t = $2; eval "require $library;"; $r = $library->isa('MooseX::Types::Base') ? Types::TypeTiny::to_TypeTiny( $library->has_type($t) ? $library->can($t)->() : () ) : $library->can("get_type") ? $library->get_type($t) : $reg->simple_lookup("$library\::$t", 1); } else { $r = $reg->simple_lookup($t, 1); } $r or _croak("%s is not a known type constraint", $node->{token}->spelling); return $r; } } sub _simplify_expression { my $expr = shift; if ($expr->{type} eq "expression" and $expr->{op}[0] eq COMMA) { return _simplify("list", COMMA, $expr); } if ($expr->{type} eq "expression" and $expr->{op}[0] eq UNION) { return _simplify("union", UNION, $expr); } if ($expr->{type} eq "expression" and $expr->{op}[0] eq INTERSECT) { return _simplify("intersect", INTERSECT, $expr); } return $expr; } sub _simplify { my $type = shift; my $op = shift; my @list; for my $expr ($_[0]{lhs}, $_[0]{rhs}) { if ($expr->{type} eq "expression" and $expr->{op}[0] eq $op) { my $simple = _simplify($type, $op, $expr); push @list, @{ $simple->{$type} }; } else { push @list, $expr; } } return { type => $type, $type => \@list }; } } { package # hide from CPAN Type::Parser::AstBuilder; sub new { my $class = shift; bless { @_ }, $class; } my %precedence = ( Type::Parser::COMMA() , 1 , Type::Parser::UNION() , 2 , Type::Parser::INTERSECT() , 3 , Type::Parser::NOT() , 4 , ); sub _parse_primary { my $self = shift; my $tokens = $self->{tokens}; $tokens->assert_not_empty; if ($tokens->peek(0)->type eq Type::Parser::NOT) { $tokens->eat(Type::Parser::NOT); $tokens->assert_not_empty; return { type => "complement", of => $self->_parse_primary, }; } if ($tokens->peek(0)->type eq Type::Parser::SLURPY) { $tokens->eat(Type::Parser::SLURPY); $tokens->assert_not_empty; return { type => "slurpy", of => $self->_parse_primary, }; } if ($tokens->peek(0)->type eq Type::Parser::L_PAREN) { $tokens->eat(Type::Parser::L_PAREN); my $r = $self->_parse_expression; $tokens->eat(Type::Parser::R_PAREN); return $r; } if ($tokens->peek(1) and $tokens->peek(0)->type eq Type::Parser::TYPE and $tokens->peek(1)->type eq Type::Parser::L_BRACKET) { my $base = { type => "primary", token => $tokens->eat(Type::Parser::TYPE) }; $tokens->eat(Type::Parser::L_BRACKET); $tokens->assert_not_empty; my $params = undef; if ($tokens->peek(0)->type eq Type::Parser::R_BRACKET) { $tokens->eat(Type::Parser::R_BRACKET); } else { $params = $self->_parse_expression; $params = { type => "list", list => [$params] } unless $params->{type} eq "list"; $tokens->eat(Type::Parser::R_BRACKET); } return { type => "parameterized", base => $base, params => $params, }; } my $type = $tokens->peek(0)->type; if ($type eq Type::Parser::TYPE or $type eq Type::Parser::QUOTELIKE or $type eq Type::Parser::STRING or $type eq Type::Parser::CLASS) { return { type => "primary", token => $tokens->eat }; } Type::Parser::_croak("Unexpected token in primary type expression; got '%s'", $tokens->peek(0)->spelling); } sub _parse_expression_1 { my $self = shift; my $tokens = $self->{tokens}; my ($lhs, $min_p) = @_; while (!$tokens->empty and exists $precedence{$tokens->peek(0)->type} and $precedence{$tokens->peek(0)->type} >= $min_p) { my $op = $tokens->eat; my $rhs = $self->_parse_primary; while (!$tokens->empty and exists $precedence{$tokens->peek(0)->type} and $precedence{$tokens->peek(0)->type} > $precedence{$op->type}) { my $lookahead = $tokens->peek(0); $rhs = $self->_parse_expression_1($rhs, $precedence{$lookahead->type}); } $lhs = { type => "expression", op => $op, lhs => $lhs, rhs => $rhs, }; } return $lhs; } sub _parse_expression { my $self = shift; my $tokens = $self->{tokens}; return $self->_parse_expression_1($self->_parse_primary, 0); } sub build { my $self = shift; $self->{tokens} = "Type::Parser::TokenStream"->new(remaining => $self->{input}); $self->{ast} = $self->_parse_expression; } sub ast { $_[0]{ast}; } sub remainder { $_[0]{tokens}->remainder; } } { package # hide from CPAN Type::Parser::Token; sub type { $_[0][0] } sub spelling { $_[0][1] } } { package # hide from CPAN Type::Parser::TokenStream; use Scalar::Util qw(looks_like_number); use Text::Balanced qw(extract_quotelike); sub new { my $class = shift; bless { stack => [], done => [], @_ }, $class; } sub peek { my $self = shift; my $ahead = $_[0]; while ($self->_stack_size <= $ahead and length $self->{remaining}) { $self->_stack_extend; } my @tokens = grep ref, @{ $self->{stack} }; return $tokens[$ahead]; } sub empty { my $self = shift; not $self->peek(0); } sub eat { my $self = shift; $self->_stack_extend unless $self->_stack_size; my $r; while (defined(my $item = shift @{$self->{stack}})) { push @{ $self->{done} }, $item; if (ref $item) { $r = $item; last; } } if (@_ and $_[0] ne $r->type) { unshift @{$self->{stack}}, pop @{$self->{done}}; Type::Parser::_croak("Expected $_[0]; got ".$r->type); } return $r; } sub assert_not_empty { my $self = shift; Type::Parser::_croak("Expected token; got empty string") if $self->empty; } sub _stack_size { my $self = shift; scalar grep ref, @{ $self->{stack} }; } sub _stack_extend { my $self = shift; push @{ $self->{stack} }, $self->_read_token; my ($space) = ($self->{remaining} =~ m/^([\s\n\r]*)/sm); return unless length $space; push @{ $self->{stack} }, $space; substr($self->{remaining}, 0, length $space) = ""; } sub remainder { my $self = shift; return join "", map { ref($_) ? $_->spelling : $_ } (@{$self->{stack}}, $self->{remaining}) } my %punctuation = ( '[' => bless([ Type::Parser::L_BRACKET, "[" ], "Type::Parser::Token"), ']' => bless([ Type::Parser::R_BRACKET, "]" ], "Type::Parser::Token"), '(' => bless([ Type::Parser::L_PAREN, "[" ], "Type::Parser::Token"), ')' => bless([ Type::Parser::R_PAREN, "]" ], "Type::Parser::Token"), ',' => bless([ Type::Parser::COMMA, "," ], "Type::Parser::Token"), '=>' => bless([ Type::Parser::COMMA, "=>" ], "Type::Parser::Token"), 'slurpy' => bless([ Type::Parser::SLURPY, "slurpy" ], "Type::Parser::Token"), '|' => bless([ Type::Parser::UNION, "|" ], "Type::Parser::Token"), '&' => bless([ Type::Parser::INTERSECT, "&" ], "Type::Parser::Token"), '~' => bless([ Type::Parser::NOT, "~" ], "Type::Parser::Token"), ); sub _read_token { my $self = shift; return if $self->{remaining} eq ""; # Punctuation # if ($self->{remaining} =~ /^( => | [()\]\[|&~,] )/xsm) { my $spelling = $1; substr($self->{remaining}, 0, length $spelling) = ""; return $punctuation{$spelling}; } if (my $quotelike = extract_quotelike $self->{remaining}) { return bless([ Type::Parser::QUOTELIKE, $quotelike ], "Type::Parser::Token"),; } if ($self->{remaining} =~ /^([+-]?[\w:.+]+)/sm) { my $spelling = $1; substr($self->{remaining}, 0, length $spelling) = ""; if ($spelling =~ /::$/sm) { return bless([ Type::Parser::CLASS, $spelling ], "Type::Parser::Token"),; } elsif (looks_like_number($spelling)) { return bless([ Type::Parser::STRING, $spelling ], "Type::Parser::Token"),; } elsif ($self->{remaining} =~ /^\s*=>/sm) # peek ahead { return bless([ Type::Parser::STRING, $spelling ], "Type::Parser::Token"),; } elsif ($spelling eq "slurpy") { return $punctuation{$spelling}; } return bless([ Type::Parser::TYPE, $spelling ], "Type::Parser::Token"); } my $rest = $self->{remaining}; $self->{remaining} = ""; return bless([ Type::Parser::MYSTERY, $rest ], "Type::Parser::Token"); } } 1; __END__ =pod =encoding utf-8 =for stopwords non-whitespace =head1 NAME Type::Parser - parse type constraint strings =head1 SYNOPSIS use v5.10; use strict; use warnings; use Type::Parser qw( eval_type ); use Type::Registry; my $reg = Type::Registry->for_me; $reg->add_types("Types::Standard"); my $type = eval_type("Int | ArrayRef[Int]", $reg); $type->check(10); # true $type->check([1..4]); # true $type->check({foo=>1}); # false =head1 DESCRIPTION Generally speaking, you probably don't want to be using this module directly. Instead use the C<< lookup >> method from L which wraps it. =head2 Functions =over =item C<< parse($string) >> Parse the type constraint string into something like an AST. If called in list context, also returns any "tail" found on the original string. =item C<< extract_type($string, $registry) >> Compile a type constraint string into a L object. If called in list context, also returns any "tail" found on the original string. =item C<< eval_type($string, $registry) >> Compile a type constraint string into a L object. Throws an error if the "tail" contains any non-whitespace character. =back =head2 Constants The following constants correspond to values returned by C<< $token->type >>. =over =item C<< TYPE >> =item C<< QUOTELIKE >> =item C<< STRING >> =item C<< CLASS >> =item C<< L_BRACKET >> =item C<< R_BRACKET >> =item C<< COMMA >> =item C<< SLURPY >> =item C<< UNION >> =item C<< INTERSECT >> =item C<< NOT >> =item C<< L_PAREN >> =item C<< R_PAREN >> =item C<< MYSTERY >> =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Library.pm0000644000175000017500000003101112200121217015104 0ustar taitaipackage Type::Library; use 5.006001; use strict; use warnings; BEGIN { $Type::Library::AUTHORITY = 'cpan:TOBYINK'; $Type::Library::VERSION = '0.022'; } use Eval::TypeTiny qw< eval_closure >; use Scalar::Util qw< blessed >; use Type::Tiny; use Types::TypeTiny qw< TypeTiny to_TypeTiny >; use base qw< Exporter::TypeTiny >; BEGIN { *NICE_PROTOTYPES = ($] >= 5.014) ? sub () { !!1 } : sub () { !!0 } }; sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } { my $got_subname; sub _subname ($$) { $got_subname = 1 && goto \&Sub::Name::subname if $got_subname || eval "require Sub::Name"; return $_[1]; } } sub _exporter_validate_opts { my $class = shift; no strict "refs"; my $into = $_[0]{into}; push @{"$into\::ISA"}, $class if $_[0]{base}; return $class->SUPER::_exporter_validate_opts(@_); } sub _exporter_expand_tag { my $class = shift; my ($name, $value, $globals) = @_; $name eq 'types' and return map [ "$_" => $value ], $class->type_names; $name eq 'is' and return map [ "is_$_" => $value ], $class->type_names; $name eq 'assert' and return map [ "assert_$_" => $value ], $class->type_names; $name eq 'to' and return map [ "to_$_" => $value ], $class->type_names; $name eq 'coercions' and return map [ "$_" => $value ], $class->coercion_names; if ($name eq 'all') { no strict "refs"; return ( map( [ "+$_" => $value ], $class->type_names, ), map( [ $_ => $value ], $class->coercion_names, @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"}, ), ); } return $class->SUPER::_exporter_expand_tag(@_); } sub _mksub { my $class = shift; my ($type, $post_method) = @_; $post_method ||= q(); my $source = $type->is_parameterizable ? sprintf( q{ sub (%s) { my $params; $params = shift if ref($_[0]) eq q(ARRAY); my $t = $params ? $type->parameterize(@$params) : $type; @_ && wantarray ? return($t%s, @_) : return $t%s; } }, NICE_PROTOTYPES ? q(;$) : q(;@), $post_method, $post_method, ) : sprintf( q{ sub () { $type%s if $] } }, $post_method, ); return _subname( $type->qualified_name, eval_closure( source => $source, description => sprintf("exportable function '%s'", $type), environment => {'$type' => \$type}, ), ); } sub _exporter_permitted_regexp { my $class = shift; my $inherited = $class->SUPER::_exporter_permitted_regexp(@_); my $types = join "|", map quotemeta, sort { length($b) <=> length($a) or $a cmp $b } $class->type_names; my $coercions = join "|", map quotemeta, sort { length($b) <=> length($a) or $a cmp $b } $class->coercion_names; qr{^(?: $inherited | (?: (?:is_|to_|assert_)? (?:$types) ) | (?:$coercions) )$}xms; } sub _exporter_expand_sub { my $class = shift; my ($name, $value, $globals) = @_; if ($name =~ /^\+(.+)/ and $class->has_type($1)) { my $type = $1; my $value2 = +{%{$value||{}}}; return map $class->_exporter_expand_sub($_, $value2, $globals), $type, "is_$type", "assert_$type", "to_$type"; } if (my $type = $class->get_type($name)) { my $post_method = q(); $post_method = '->mouse_type' if $globals->{mouse}; $post_method = '->moose_type' if $globals->{moose}; return ($name => $class->_mksub($type, $post_method)) if $post_method; } return $class->SUPER::_exporter_expand_sub(@_); } #sub _exporter_install_sub #{ # my $class = shift; # my ($name, $value, $globals, $sym) = @_; # # warn sprintf( # 'Exporter %s exporting %s with prototype %s', # $class, # $name, # prototype($sym), # ); # # $class->SUPER::_exporter_install_sub(@_); #} sub _exporter_fail { my $class = shift; my ($name, $value, $globals) = @_; my $into = $globals->{into} or _croak("Parameter 'into' not supplied"); if ($globals->{declare}) { my $declared = sub (;$) { my $params; $params = shift if ref($_[0]) eq "ARRAY"; my $type = $into->get_type($name); unless ($type) { _croak "Cannot parameterize a non-existant type" if $params; $type = $name; } my $t = $params ? $type->parameterize(@$params) : $type; @_ && wantarray ? return($t, @_) : return $t; }; return( $name, _subname( "$class\::$name", NICE_PROTOTYPES ? sub (;$) { goto $declared } : sub (;@) { goto $declared }, ), ); } return $class->SUPER::_exporter_fail(@_); } sub meta { no strict "refs"; no warnings "once"; return $_[0] if blessed $_[0]; ${"$_[0]\::META"} ||= bless {}, $_[0]; } sub add_type { my $meta = shift->meta; my $class = blessed($meta); my $type = ref($_[0]) =~ /^Type::Tiny\b/ ? $_[0] : blessed($_[0]) ? to_TypeTiny($_[0]) : ref($_[0]) eq q(HASH) ? "Type::Tiny"->new(library => $class, %{$_[0]}) : "Type::Tiny"->new(library => $class, @_); my $name = $type->{name}; $meta->{types} ||= {}; _croak 'Type %s already exists in this library', $name if $meta->has_type($name); _croak 'Type %s conflicts with coercion of same name', $name if $meta->has_coercion($name); _croak 'Cannot add anonymous type to a library' if $type->is_anon; $meta->{types}{$name} = $type; no strict "refs"; no warnings "redefine", "prototype"; # There is an inlined coercion available, but don't use that because # additional coercions can be added *after* the type has been installed # into the library. # # XXX: maybe we can use it if the coercion is frozen??? # *{"$class\::$name"} = $class->_mksub($type); *{"$class\::is_$name"} = _subname "is_" .$type->qualified_name, $type->compiled_check; *{"$class\::to_$name"} = _subname "to_" .$type->qualified_name, sub ($) { $type->coerce($_[0]) }; *{"$class\::assert_$name"} = _subname "assert_".$type->qualified_name, $type->_overload_coderef; return $type; } sub get_type { my $meta = shift->meta; $meta->{types}{$_[0]}; } sub has_type { my $meta = shift->meta; exists $meta->{types}{$_[0]}; } sub type_names { my $meta = shift->meta; keys %{ $meta->{types} }; } sub add_coercion { require Type::Coercion; my $meta = shift->meta; my $c = blessed($_[0]) ? $_[0] : "Type::Coercion"->new(@_); my $name = $c->name; $meta->{coercions} ||= {}; _croak 'Coercion %s already exists in this library', $name if $meta->has_coercion($name); _croak 'Coercion %s conflicts with type of same name', $name if $meta->has_type($name); _croak 'Cannot add anonymous type to a library' if $c->is_anon; $meta->{coercions}{$name} = $c; no strict "refs"; no warnings "redefine", "prototype"; my $class = blessed($meta); *{"$class\::$name"} = $class->_mksub($c); return $c; } sub get_coercion { my $meta = shift->meta; $meta->{coercions}{$_[0]}; } sub has_coercion { my $meta = shift->meta; exists $meta->{coercions}{$_[0]}; } sub coercion_names { my $meta = shift->meta; keys %{ $meta->{coercions} }; } 1; __END__ =pod =encoding utf-8 =for stopwords Moo(se)-compatible MooseX::Types-like =head1 NAME Type::Library - tiny, yet Moo(se)-compatible type libraries =head1 SYNOPSIS package Types::Mine { use Scalar::Util qw(looks_like_number); use Type::Library -base; use Type::Tiny; my $NUM = "Type::Tiny"->new( name => "Number", constraint => sub { looks_like_number($_) }, message => sub { "$_ ain't a number" }, ); __PACKAGE__->meta->add_type($NUM); } package Ermintrude { use Moo; use Types::Mine qw(Number); has favourite_number => (is => "ro", isa => Number); } package Bullwinkle { use Moose; use Types::Mine qw(Number); has favourite_number => (is => "ro", isa => Number); } package Maisy { use Mouse; use Types::Mine qw(Number); has favourite_number => (is => "ro", isa => Number); } =head1 DESCRIPTION L is a tiny class for creating MooseX::Types-like type libraries which are compatible with Moo, Moose and Mouse. If you're reading this because you want to create a type library, then you're probably better off reading L. =head2 Methods A type library is a singleton class. Use the C method to get a blessed object which other methods can get called on. For example: Types::Mine->meta->add_type($foo); =begin trustme =item meta =end trustme =over =item C<< add_type($type) >> or C<< add_type(%opts) >> Add a type to the library. If C<< %opts >> is given, then this method calls C<< Type::Tiny->new(%opts) >> first, and adds the resultant type. Adding a type named "Foo" to the library will automatically define four functions in the library's namespace: =over =item C<< Foo >> Returns the Type::Tiny object. =item C<< is_Foo($value) >> Returns true iff $value passes the type constraint. =item C<< assert_Foo($value) >> Returns $value iff $value passes the type constraint. Dies otherwise. =item C<< to_Foo($value) >> Coerces the value to the type. =back =item C<< get_type($name) >> Gets the C object corresponding to the name. =item C<< has_type($name) >> Boolean; returns true if the type exists in the library. =item C<< type_names >> List all types defined by the library. =item C<< add_coercion($c) >> or C<< add_coercion(%opts) >> Add a standalone coercion to the library. If C<< %opts >> is given, then this method calls C<< Type::Coercion->new(%opts) >> first, and adds the resultant coercion. Adding a coercion named "FooFromBar" to the library will automatically define a function in the library's namespace: =over =item C<< FooFromBar >> Returns the Type::Coercion object. =back =item C<< get_coercion($name) >> Gets the C object corresponding to the name. =item C<< has_coercion($name) >> Boolean; returns true if the coercion exists in the library. =item C<< coercion_names >> List all standalone coercions defined by the library. =item C<< import(@args) >> Type::Library-based libraries are exporters. =back =head2 Constants =over =item C<< NICE_PROTOTYPES >> If this is true, then Type::Library will give parameterizable type constraints slightly the nicer prototype of C<< (;$) >> instead of the default C<< (;@) >>. This allows constructs like: ArrayRef[Int] | HashRef[Int] ... to "just work". Sadly, this constant is false on Perl < 5.14, and expressions like the above need lots of parentheses to do what you mean. =back =head2 Export Type libraries are exporters. For the purposes of the following examples, assume that the C library defines types C and C. # Exports nothing. # use Types::Mine; # Exports a function "String" which is a constant returning # the String type constraint. # use Types::Mine qw( String ); # Exports both String and Number as above. # use Types::Mine qw( String Number ); # Same. # use Types::Mine qw( :types ); # Exports a sub "is_String" so that "is_String($foo)" is equivalent # to "String->check($foo)". # use Types::Mine qw( is_String ); # Exports "is_String" and "is_Number". # use Types::Mine qw( :is ); # Exports a sub "assert_String" so that "assert_String($foo)" is # equivalent to "String->assert_return($foo)". # use Types::Mine qw( assert_String ); # Exports "assert_String" and "assert_Number". # use Types::Mine qw( :assert ); # Exports a sub "to_String" so that "to_String($foo)" is equivalent # to "String->coerce($foo)". # use Types::Mine qw( to_String ); # Exports "to_String" and "to_Number". # use Types::Mine qw( :to ); # Exports "String", "is_String", "assert_String" and "coerce_String". # use Types::Mine qw( +String ); # Exports everything. # use Types::Mine qw( :all ); Type libraries automatically inherit from L; see the documentation of that module for tips and tricks importing from libraries. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L, L. L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Coercion/0000755000175000017500000000000012200124456014717 5ustar taitaiType-Tiny-0.022/lib/Type/Coercion/Union.pm0000644000175000017500000000366512200121217016347 0ustar taitaipackage Type::Coercion::Union; use 5.006001; use strict; use warnings; BEGIN { $Type::Coercion::Union::AUTHORITY = 'cpan:TOBYINK'; $Type::Coercion::Union::VERSION = '0.022'; } use Scalar::Util qw< blessed >; use Types::TypeTiny (); sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } use base "Type::Coercion"; sub type_coercion_map { my $self = shift; Types::TypeTiny::TypeTiny->assert_valid(my $type = $self->type_constraint); $type->isa('Type::Tiny::Union') or _croak "Type::Coercion::Union must be used in conjunction with Type::Tiny::Union"; my @c; for my $tc (@$type) { next unless $tc->has_coercion; push @c, @{$tc->coercion->type_coercion_map}; } return \@c; } sub add_type_coercions { my $self = shift; _croak "Adding coercions to Type::Coercion::Union not currently supported" if @_; } # sub _build_moose_coercion ??? 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Coercion::Union - a set of coercions to a union type constraint =head1 DESCRIPTION This package inherits from L; see that for most documentation. The major differences are that C always throws an exception, and the C is automatically populated from the child constraints of the union type constraint. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Tiny.pm0000644000175000017500000011153112200123436014436 0ustar taitaipackage Type::Tiny; use 5.006001; use strict; use warnings; BEGIN { if ($] < 5.008) { require Devel::TypeTiny::Perl56Compat }; } BEGIN { $Type::Tiny::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::VERSION = '0.022'; } use Eval::TypeTiny (); use Scalar::Util qw( blessed weaken refaddr isweak ); use Types::TypeTiny (); sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } sub _swap { $_[2] ? @_[1,0] : @_[0,1] } BEGIN { ($] > 5.010001) ? eval q{ sub SUPPORT_SMARTMATCH () { !!0 } } : eval q{ sub SUPPORT_SMARTMATCH () { !!1 } } } use overload q("") => sub { caller =~ m{^(Moo::HandleMoose|Sub::Quote)} ? overload::StrVal($_[0]) : $_[0]->display_name }, q(bool) => sub { 1 }, q(&{}) => "_overload_coderef", q(+) => sub { $_[2] ? $_[1]->plus_coercions($_[0]) : $_[0]->plus_fallback_coercions($_[1]) }, q(|) => sub { my @tc = _swap @_; require Type::Tiny::Union; "Type::Tiny::Union"->new(type_constraints => \@tc) }, q(&) => sub { my @tc = _swap @_; require Type::Tiny::Intersection; "Type::Tiny::Intersection"->new(type_constraints => \@tc) }, q(~) => sub { shift->complementary_type }, q(==) => sub { $_[0]->equals($_[1]) }, q(<) => sub { my $m = $_[0]->can('is_subtype_of'); $m->(_swap @_) }, q(>) => sub { my $m = $_[0]->can('is_subtype_of'); $m->(reverse _swap @_) }, q(<=) => sub { my $m = $_[0]->can('is_a_type_of'); $m->(_swap @_) }, q(>=) => sub { my $m = $_[0]->can('is_a_type_of'); $m->(reverse _swap @_) }, q(eq) => sub { $_[2] ? ("$_[1]" eq "$_[0]") : ("$_[0]" eq "$_[1]") }, q(cmp) => sub { $_[2] ? ("$_[1]" cmp "$_[0]") : ("$_[0]" cmp "$_[1]") }, fallback => 1, ; BEGIN { overload->import(q(~~) => sub { $_[0]->check($_[1]) }) if Type::Tiny::SUPPORT_SMARTMATCH; } sub _overload_coderef { my $self = shift; $self->message unless exists $self->{message}; # if ($self->has_parent && $self->_is_null_constraint) # { # $self->{_overload_coderef} ||= $self->parent->_overload_coderef; # } # els if ($self->{_default_message} && "Sub::Quote"->can("quote_sub") && $self->can_be_inlined) { $self->{_overload_coderef} = Sub::Quote::quote_sub($self->inline_assert('$_[0]')) if !$self->{_overload_coderef} || !$self->{_sub_quoted}++; } else { $self->{_overload_coderef} ||= sub { $self->assert_return(@_) }; } $self->{_overload_coderef}; } our %ALL_TYPES; my $QFS; my $uniq = 1; sub new { my $class = shift; my %params = (@_==1) ? %{$_[0]} : @_; if (exists $params{parent}) { $params{parent} = ref($params{parent}) =~ /^Type::Tiny\b/ ? $params{parent} : Types::TypeTiny::to_TypeTiny($params{parent}); _croak "Parent must be an instance of %s", __PACKAGE__ unless blessed($params{parent}) && $params{parent}->isa(__PACKAGE__); } $params{name} = "__ANON__" unless exists $params{name}; $params{uniq} = $uniq++; if ($params{name} ne "__ANON__") { # First try a fast ASCII-only expression, but fall back to Unicode $params{name} =~ /^[A-Z][A-Za-z0-9_]+$/sm or eval q( use 5.008; $params{name} =~ /^\p{Lu}[\p{L}0-9_]+$/sm ) or _croak '"%s" is not a valid type name', $params{name}; } if (exists $params{coercion} and !ref $params{coercion} and $params{coercion}) { $params{parent}->has_coercion or _croak "coercion => 1 requires type to have a direct parent with a coercion"; $params{coercion} = $params{parent}->coercion; } if (!exists $params{inlined} and exists $params{constraint} and ( !exists $params{parent} or $params{parent}->can_be_inlined ) and $QFS ||= "Sub::Quote"->can("quoted_from_sub")) { my (undef, $perlstring, $captures) = @{ $QFS->($params{constraint}) || [] }; $params{inlined} = sub { my ($self, $var) = @_; my $code = Sub::Quote::inlinify( $var eq q($_) ? $perlstring : "local \$_ = $var; $perlstring", $var, ); $code = sprintf('%s and %s', $self->parent->inline_check($var), $code) if $self->has_parent; return $code; } if $perlstring && !$captures; } my $self = bless \%params, $class; unless ($params{tmp}) { $Moo::HandleMoose::TYPE_MAP{overload::StrVal($self)} = sub { $self } if $self->has_library && !$self->is_anon; $ALL_TYPES{ $self->{uniq} } = $self; weaken($ALL_TYPES{ $self->{uniq} }); } $self->{type_constraints} ||= undef; return $self; } sub _clone { my $self = shift; my %opts; $opts{$_} = $self->{$_} for qw< name display_name message >; $self->create_child_type(%opts); } sub _dd { require B; my $value = @_ ? $_[0] : $_; !defined $value ? 'Undef' : !ref $value ? sprintf('Value %s', B::perlstring($value)) : do { require Data::Dumper; local $Data::Dumper::Indent = 0; local $Data::Dumper::Useqq = 1; local $Data::Dumper::Terse = 1; local $Data::Dumper::Sortkeys = 1; local $Data::Dumper::Maxdepth = 2; Data::Dumper::Dumper($value) } } sub _loose_to_TypeTiny { map +( ref($_) ? Types::TypeTiny::to_TypeTiny($_) : do { require Type::Utils; Type::Utils::dwim_type($_) } ), @_; } sub name { $_[0]{name} } sub display_name { $_[0]{display_name} ||= $_[0]->_build_display_name } sub parent { $_[0]{parent} } sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } sub compiled_check { $_[0]{compiled_type_constraint} ||= $_[0]->_build_compiled_check } sub coercion { $_[0]{coercion} ||= $_[0]->_build_coercion } sub message { $_[0]{message} } sub library { $_[0]{library} } sub inlined { $_[0]{inlined} } sub constraint_generator { $_[0]{constraint_generator} } sub inline_generator { $_[0]{inline_generator} } sub name_generator { $_[0]{name_generator} ||= $_[0]->_build_name_generator } sub coercion_generator { $_[0]{coercion_generator} } sub parameters { $_[0]{parameters} } sub moose_type { $_[0]{moose_type} ||= $_[0]->_build_moose_type } sub mouse_type { $_[0]{mouse_type} ||= $_[0]->_build_mouse_type } sub deep_explanation { $_[0]{deep_explanation} } sub has_parent { exists $_[0]{parent} } sub has_library { exists $_[0]{library} } sub has_coercion { exists $_[0]{coercion} and !!@{ $_[0]{coercion}->type_coercion_map } } sub has_inlined { exists $_[0]{inlined} } sub has_constraint_generator { exists $_[0]{constraint_generator} } sub has_inline_generator { exists $_[0]{inline_generator} } sub has_coercion_generator { exists $_[0]{coercion_generator} } sub has_parameters { exists $_[0]{parameters} } sub has_message { exists $_[0]{message} } sub has_deep_explanation { exists $_[0]{deep_explanation} } sub _default_message { $_[0]{_default_message} ||= $_[0]->_build_default_message } sub _assert_coercion { my $self = shift; _croak "No coercion for this type constraint" unless $self->has_coercion && @{$self->coercion->type_coercion_map}; return $self->coercion; } my $null_constraint = sub { !!1 }; sub _build_display_name { shift->name; } sub _build_constraint { return $null_constraint; } sub _is_null_constraint { shift->constraint == $null_constraint; } sub _build_coercion { require Type::Coercion; my $self = shift; my %opts = (type_constraint => $self); $opts{display_name} = "to_$self" unless $self->is_anon; return "Type::Coercion"->new(%opts); } sub _build_default_message { my $self = shift; return sub { sprintf '%s did not pass type constraint', _dd($_[0]) } if "$self" eq "__ANON__"; my $name = "$self"; return sub { sprintf '%s did not pass type constraint "%s"', _dd($_[0]), $name }; } sub _build_name_generator { my $self = shift; return sub { my ($s, @a) = @_; sprintf('%s[%s]', $s, join q[,], @a); }; } sub _build_compiled_check { my $self = shift; if ($self->_is_null_constraint and $self->has_parent) { return $self->parent->compiled_check; } if ($INC{'Mouse/Util.pm'} and Mouse::Util::MOUSE_XS()) { require Mouse::Util::TypeConstraints; if ($self->{_is_core}) { my $xs = "Mouse::Util::TypeConstraints"->can($self->name); return $xs if $xs; } elsif ($self->is_parameterized and $self->has_parent and $self->parent->{_is_core} and $self->parent->name =~ /^(ArrayRef|HashRef|Maybe)$/) { my $xs = "Mouse::Util::TypeConstraints"->can("_parameterize_".$self->parent->name."_for"); return $xs->($self->parameters->[0]) if $xs; } } return Eval::TypeTiny::eval_closure( source => sprintf('sub ($) { %s }', $self->inline_check('$_[0]')), description => sprintf("compiled check '%s'", $self), ) if $self->can_be_inlined; my @constraints; push @constraints, $self->parent->compiled_check if $self->has_parent; push @constraints, $self->constraint if !$self->_is_null_constraint; return $null_constraint unless @constraints; return sub ($) { local $_ = $_[0]; for my $c (@constraints) { return unless $c->(@_); } return !!1; }; } sub equals { my ($self, $other) = _loose_to_TypeTiny(@_); return unless blessed($self) && $self->isa("Type::Tiny"); return unless blessed($other) && $other->isa("Type::Tiny"); return !!1 if refaddr($self) == refaddr($other); return !!1 if $self->has_parent && $self->_is_null_constraint && $self->parent==$other; return !!1 if $other->has_parent && $other->_is_null_constraint && $other->parent==$self; return !!1 if refaddr($self->compiled_check) == refaddr($other->compiled_check); return $self->qualified_name eq $other->qualified_name if $self->has_library && !$self->is_anon && $other->has_library && !$other->is_anon; return $self->inline_check('$x') eq $other->inline_check('$x') if $self->can_be_inlined && $other->can_be_inlined; return; } sub is_subtype_of { my ($self, $other) = _loose_to_TypeTiny(@_); return unless blessed($self) && $self->isa("Type::Tiny"); return unless blessed($other) && $other->isa("Type::Tiny"); # my $this = $self; # while (my $parent = $this->parent) # { # return !!1 if $parent->equals($other); # $this = $parent; # } # return; return unless $self->has_parent; $self->parent->equals($other) or $self->parent->is_subtype_of($other); } sub is_supertype_of { my ($self, $other) = _loose_to_TypeTiny(@_); return unless blessed($self) && $self->isa("Type::Tiny"); return unless blessed($other) && $other->isa("Type::Tiny"); $other->is_subtype_of($self); } sub is_a_type_of { my ($self, $other) = _loose_to_TypeTiny(@_); return unless blessed($self) && $self->isa("Type::Tiny"); return unless blessed($other) && $other->isa("Type::Tiny"); $self->equals($other) or $self->is_subtype_of($other); } sub strictly_equals { my ($self, $other) = _loose_to_TypeTiny(@_); return unless blessed($self) && $self->isa("Type::Tiny"); return unless blessed($other) && $other->isa("Type::Tiny"); $self->{uniq} == $other->{uniq}; } sub is_strictly_subtype_of { my ($self, $other) = _loose_to_TypeTiny(@_); return unless blessed($self) && $self->isa("Type::Tiny"); return unless blessed($other) && $other->isa("Type::Tiny"); # my $this = $self; # while (my $parent = $this->parent) # { # return !!1 if $parent->strictly_equals($other); # $this = $parent; # } # return; return unless $self->has_parent; $self->parent->strictly_equals($other) or $self->parent->is_strictly_subtype_of($other); } sub is_strictly_supertype_of { my ($self, $other) = _loose_to_TypeTiny(@_); return unless blessed($self) && $self->isa("Type::Tiny"); return unless blessed($other) && $other->isa("Type::Tiny"); $other->is_strictly_subtype_of($self); } sub is_strictly_a_type_of { my ($self, $other) = _loose_to_TypeTiny(@_); return unless blessed($self) && $self->isa("Type::Tiny"); return unless blessed($other) && $other->isa("Type::Tiny"); $self->strictly_equals($other) or $self->is_strictly_subtype_of($other); } sub qualified_name { my $self = shift; (exists $self->{library} and $self->name ne "__ANON__") ? "$self->{library}::$self->{name}" : $self->{name}; } sub is_anon { my $self = shift; $self->name eq "__ANON__"; } sub parents { my $self = shift; return unless $self->has_parent; return ($self->parent, $self->parent->parents); } sub check { my $self = shift; ($self->{compiled_type_constraint} ||= $self->_build_compiled_check)->(@_); } sub _strict_check { my $self = shift; local $_ = $_[0]; my @constraints = reverse map { $_->constraint } grep { not $_->_is_null_constraint } ($self, $self->parents); for my $c (@constraints) { return unless $c->(@_); } return !!1; } sub get_message { my $self = shift; local $_ = $_[0]; $self->has_message ? $self->message->(@_) : $self->_default_message->(@_); } sub validate { my $self = shift; return undef if ($self->{compiled_type_constraint} ||= $self->_build_compiled_check)->(@_); local $_ = $_[0]; return $self->get_message(@_); } sub assert_valid { my $self = shift; return !!1 if ($self->{compiled_type_constraint} ||= $self->_build_compiled_check)->(@_); local $_ = $_[0]; $self->_failed_check("$self", $_); } sub assert_return { my $self = shift; return $_[0] if ($self->{compiled_type_constraint} ||= $self->_build_compiled_check)->(@_); local $_ = $_[0]; $self->_failed_check("$self", $_); } sub can_be_inlined { my $self = shift; return $self->parent->can_be_inlined if $self->has_parent && $self->_is_null_constraint; return !!1 if !$self->has_parent && $self->_is_null_constraint; return $self->has_inlined; } sub inline_check { my $self = shift; _croak 'Cannot inline type constraint check for "%s"', $self unless $self->can_be_inlined; return $self->parent->inline_check(@_) if $self->has_parent && $self->_is_null_constraint; return '(!!1)' if !$self->has_parent && $self->_is_null_constraint; local $_ = $_[0]; my @r = $self->inlined->($self, @_); if (@r and not defined $r[0]) { _croak 'Inlining type constraint check for "%s" returned undef!', $self unless $self->has_parent; $r[0] = $self->parent->inline_check(@_); } my $r = join " && " => map { /[;{}]/ ? "do { $_ }" : "($_)" } @r; return @r==1 ? $r : "($r)"; } sub inline_assert { require B; my $self = shift; my $varname = $_[0]; my $code = sprintf( q[do { no warnings "void"; %s ? %s : Type::Tiny::_failed_check(%d, %s, %s) };], $self->inline_check(@_), $varname, $self->{uniq}, B::perlstring("$self"), $varname, ); return $code; } sub _failed_check { require Type::Exception::Assertion; my ($self, $name, $value, %attrs) = @_; $self = $ALL_TYPES{$self} unless ref $self; my $exception_class = delete($attrs{exception_class}) || "Type::Exception::Assertion"; if ($self) { $exception_class->throw( message => $self->get_message($value), type => $self, value => $value, %attrs, ); } else { $exception_class->throw( message => sprintf('%s did not pass type constraint "%s"', _dd($value), $name), value => $value, %attrs, ); } } sub coerce { my $self = shift; $self->_assert_coercion->coerce(@_); } sub assert_coerce { my $self = shift; $self->_assert_coercion->assert_coerce(@_); } sub is_parameterizable { shift->has_constraint_generator; } sub is_parameterized { shift->has_parameters; } my %param_cache; sub parameterize { my $self = shift; return $self unless @_; $self->is_parameterizable or _croak "Type '%s' does not accept parameters", "$self"; @_ = map Types::TypeTiny::to_TypeTiny($_), @_; # Generate a key for caching parameterized type constraints, # but only if all the parameters are strings or type constraints. my $key; if ( not grep(ref($_) && !Types::TypeTiny::TypeTiny->check($_), @_) ) { require B; $key = join ":", map(Types::TypeTiny::TypeTiny->check($_) ? $_->{uniq} : B::perlstring($_), $self, @_); } return $param_cache{$key} if defined $key && defined $param_cache{$key}; local $Type::Tiny::parameterize_type = $self; local $_ = $_[0]; my $P; my $constraint = $self->constraint_generator->(@_); if (Types::TypeTiny::TypeTiny->check($constraint)) { $P = $constraint; } else { my %options = ( constraint => $constraint, display_name => $self->name_generator->($self, @_), parameters => [@_], ); $options{inlined} = $self->inline_generator->(@_) if $self->has_inline_generator; exists $options{$_} && !defined $options{$_} && delete $options{$_} for keys %options; $P = $self->create_child_type(%options); my $coercion; $coercion = $self->coercion_generator->($self, $P, @_) if $self->has_coercion_generator; $P->coercion->add_type_coercions( @{$coercion->type_coercion_map} ) if $coercion; } if (defined $key) { $param_cache{$key} = $P; weaken($param_cache{$key}); } return $P; } sub child_type_class { __PACKAGE__; } sub create_child_type { my $self = shift; return $self->child_type_class->new(parent => $self, @_); } sub complementary_type { my $self = shift; my $r = ($self->{complementary_type} ||= $self->_build_complementary_type); weaken($self->{complementary_type}) unless isweak($self->{complementary_type}); return $r; } sub _build_complementary_type { my $self = shift; my %opts = ( constraint => sub { not $self->check($_) }, display_name => sprintf("~%s", $self), ); $opts{display_name} =~ s/^\~{2}//; $opts{inlined} = sub { shift; "not(".$self->inline_check(@_).")" } if $self->can_be_inlined; return "Type::Tiny"->new(%opts); } sub _instantiate_moose_type { my $self = shift; my %opts = @_; require Moose::Meta::TypeConstraint; return "Moose::Meta::TypeConstraint"->new(%opts); } sub _build_moose_type { my $self = shift; my $r; if ($self->{_is_core}) { require Moose::Util::TypeConstraints; $r = Moose::Util::TypeConstraints::find_type_constraint($self->name); $r->{"Types::TypeTiny::to_TypeTiny"} = $self; Scalar::Util::weaken($r->{"Types::TypeTiny::to_TypeTiny"}); } else { my %opts; $opts{name} = $self->qualified_name if $self->has_library && !$self->is_anon; $opts{parent} = $self->parent->moose_type if $self->has_parent; $opts{constraint} = $self->constraint unless $self->_is_null_constraint; $opts{message} = $self->message if $self->has_message; $opts{inlined} = $self->inlined if $self->has_inlined; $r = $self->_instantiate_moose_type(%opts); $r->{"Types::TypeTiny::to_TypeTiny"} = $self; Scalar::Util::weaken($r->{"Types::TypeTiny::to_TypeTiny"}); $self->{moose_type} = $r; # prevent recursion $r->coercion($self->coercion->moose_coercion) if $self->has_coercion; } return $r; } sub _build_mouse_type { my $self = shift; my %options; $options{name} = $self->qualified_name if $self->has_library && !$self->is_anon; $options{parent} = $self->parent->mouse_type if $self->has_parent; $options{constraint} = $self->constraint unless $self->_is_null_constraint; $options{message} = $self->message if $self->has_message; require Mouse::Meta::TypeConstraint; my $r = "Mouse::Meta::TypeConstraint"->new(%options); $self->{mouse_type} = $r; # prevent recursion $r->_add_type_coercions( $self->coercion->freeze->_codelike_type_coercion_map('mouse_type') ) if $self->has_coercion; return $r; } sub plus_coercions { my $self = shift; my @more = (@_==1 && blessed($_[0]) && $_[0]->can('type_coercion_map')) ? @{ $_[0]->type_coercion_map } : (@_==1 && ref $_[0]) ? @{$_[0]} : @_; my $new = $self->_clone; $new->coercion->add_type_coercions( @more, @{$self->coercion->type_coercion_map}, ); return $new; } sub plus_fallback_coercions { my $self = shift; my @more = (@_==1 && blessed($_[0]) && $_[0]->can('type_coercion_map')) ? @{ $_[0]->type_coercion_map } : (@_==1 && ref $_[0]) ? @{$_[0]} : @_; my $new = $self->_clone; $new->coercion->add_type_coercions( @{$self->coercion->type_coercion_map}, @more, ); return $new; } sub minus_coercions { my $self = shift; my @not = (@_==1 && blessed($_[0]) && $_[0]->can('type_coercion_map')) ? grep(blessed($_)&&$_->isa("Type::Tiny"), @{ $_[0]->type_coercion_map }) : (@_==1 && ref $_[0]) ? @{$_[0]} : @_; my @keep; my $c = $self->coercion->type_coercion_map; for (my $i = 0; $i <= $#$c; $i += 2) { my $keep_this = 1; NOT: for my $n (@not) { if ($c->[$i] == $n) { $keep_this = 0; last NOT; } } push @keep, $c->[$i], $c->[$i+1] if $keep_this; } my $new = $self->_clone; $new->coercion->add_type_coercions(@keep); return $new; } sub no_coercions { shift->_clone; } sub isa { my $self = shift; if ($INC{"Moose.pm"} and ref($self)) { return !!1 if $_[0] eq 'Moose::Meta::TypeConstraint'; return $self->is_parameterized if $_[0] eq 'Moose::Meta::TypeConstraint::Parameterized'; return $self->is_parameterizable if $_[0] eq 'Moose::Meta::TypeConstraint::Parameterizable'; } if ($INC{"Moose.pm"} and ref($self) and $_[0] =~ /^Moose/ and my $r = $self->moose_type->isa(@_)) { return $r; } if ($INC{"Mouse.pm"} and ref($self) and $_[0] eq 'Mouse::Meta::TypeConstraint') { return !!1; } $self->SUPER::isa(@_); } sub can { my $self = shift; return !!0 if $_[0] eq 'type_parameter' && blessed($_[0]) && $_[0]->has_parameters; my $can = $self->SUPER::can(@_); return $can if $can; if ($INC{"Moose.pm"} and ref($self) and my $method = $self->moose_type->can(@_)) { return sub { $method->(shift->moose_type, @_) }; } return; } sub AUTOLOAD { my $self = shift; my ($m) = (our $AUTOLOAD =~ /::(\w+)$/); return if $m eq 'DESTROY'; if ($INC{"Moose.pm"} and ref($self) and my $method = $self->moose_type->can($m)) { return $method->($self->moose_type, @_); } _croak q[Can't locate object method "%s" via package "%s"], $m, ref($self)||$self; } sub DOES { my $self = shift; return !!1 if ref($self) && $_[0] =~ m{^ Type::API::Constraint (?: ::Coercible | ::Inlinable )? $}x; return !!1 if !ref($self) && $_[0] eq 'Type::API::Constraint::Constructor'; "UNIVERSAL"->can("DOES") ? $self->SUPER::DOES(@_) : $self->isa(@_); } # fill out Moose-compatible API sub inline_environment { +{} } sub _inline_check { shift->inline_check(@_) } sub _compiled_type_constraint { shift->compiled_check(@_) } sub meta { _croak("Not really a Moose::Meta::TypeConstraint. Sorry!") } sub compile_type_constraint { shift->compiled_check } sub _actually_compile_type_constraint { shift->_build_compiled_check } sub hand_optimized_type_constraint { shift->{hand_optimized_type_constraint} } sub has_hand_optimized_type_constraint { exists(shift->{hand_optimized_type_constraint}) } sub type_parameter { my @p = @{ shift->parameters || [] }; @p==1 ? $p[0] : @p } # some stuff for Mouse-compatible API sub __is_parameterized { shift->is_parameterized(@_) } sub _add_type_coercions { shift->coercion->add_type_coercions(@_) }; sub _as_string { shift->qualified_name(@_) } sub _compiled_type_coercion { shift->coercion->compiled_coercion(@_) }; sub _identity { refaddr(shift) }; sub _unite { require Type::Tiny::Union; "Type::Tiny::Union"->new(type_constraints => \@_) }; # Hooks for Type::Tie sub TIESCALAR { require Type::Tie; unshift @_, 'Type::Tie::SCALAR'; goto \&Type::Tie::SCALAR::TIESCALAR }; sub TIEARRAY { require Type::Tie; unshift @_, 'Type::Tie::ARRAY'; goto \&Type::Tie::SCALAR::TIEARRAY }; sub TIEHASH { require Type::Tie; unshift @_, 'Type::Tie::HASH'; goto \&Type::Tie::SCALAR::TIEHASH }; 1; __END__ =pod =encoding utf-8 =for stopwords Moo(se)-compatible MooseX MouseX MooX Moose-compat =head1 NAME Type::Tiny - tiny, yet Moo(se)-compatible type constraint =head1 SYNOPSIS use Scalar::Util qw(looks_like_number); use Type::Tiny; my $NUM = "Type::Tiny"->new( name => "Number", constraint => sub { looks_like_number($_) }, message => sub { "$_ ain't a number" }, ); package Ermintrude { use Moo; has favourite_number => (is => "ro", isa => $NUM); } package Bullwinkle { use Moose; has favourite_number => (is => "ro", isa => $NUM); } package Maisy { use Mouse; has favourite_number => (is => "ro", isa => $NUM); } =head1 DESCRIPTION L is a tiny class for creating Moose-like type constraint objects which are compatible with Moo, Moose and Mouse. Maybe now we won't need to have separate MooseX, MouseX and MooX versions of everything? We can but hope... This documents the internals of L. L is a better starting place if you're new. =head2 Constructor =over =item C<< new(%attributes) >> Moose-style constructor function. =back =head2 Attributes =over =item C<< name >> The name of the type constraint. These need to conform to certain naming rules (they must begin with an uppercase letter and continue using only letters, digits 0-9 and underscores). Optional; if not supplied will be an anonymous type constraint. =item C<< display_name >> A name to display for the type constraint when stringified. These don't have to conform to any naming rules. Optional; a default name will be calculated from the C. =item C<< parent >> Optional attribute; parent type constraint. For example, an "Integer" type constraint might have a parent "Number". If provided, must be a Type::Tiny object. =item C<< constraint >> Coderef to validate a value (C<< $_ >>) against the type constraint. The coderef will not be called unless the value is known to pass any parent type constraint. Defaults to C<< sub { 1 } >> - i.e. a coderef that passes all values. =item C<< compiled_check >> Coderef to validate a value (C<< $_[0] >>) against the type constraint. This coderef is expected to also handle all validation for the parent type constraints. The general point of this attribute is that you should not set it, and rely on the lazily-built default. Type::Tiny will usually generate a pretty fast coderef. =item C<< message >> Coderef that returns an error message when C<< $_ >> does not validate against the type constraint. Optional (there's a vaguely sensible default.) =item C<< inlined >> A coderef which returns a string of Perl code suitable for inlining this type. Optional. If C (above) is a coderef generated via L, then Type::Tiny I be able to automatically generate C for you. =item C<< library >> The package name of the type library this type is associated with. Optional. Informational only: setting this attribute does not install the type into the package. =item C<< coercion >> A L object associated with this type. Generally speaking this attribute should not be passed to the constructor; you should rely on the default lazily-built coercion object. You may pass C<< coercion => 1 >> to the constructor to inherit coercions from the constraint's parent. (This requires the parent constraint to have a coercion.) =item C<< complementary_type >> A complementary type for this type. For example, the complementary type for an integer type would be all things that are not integers, including floating point numbers, but also alphabetic strings, arrayrefs, filehandles, etc. Generally speaking this attribute should not be passed to the constructor; you should rely on the default lazily-built complementary type. =item C<< moose_type >>, C<< mouse_type >> Objects equivalent to this type constraint, but as a L or L. Generally speaking this attribute should not be passed to the constructor; you should rely on the default lazily-built objects. It should rarely be necessary to obtain a L object from L because the L object itself should be usable pretty much anywhere a L is expected. =back The following additional attributes are used for parameterizable (e.g. C) and parameterized (e.g. C<< ArrayRef[Int] >>) type constraints. Unlike Moose, these aren't handled by separate subclasses. =over =item C<< parameters >> In parameterized types, returns an arrayref of the parameters. =item C<< name_generator >> A coderef which generates a new display_name based on parameters. Optional; the default is reasonable. =item C<< constraint_generator >> Coderef that generates a new constraint coderef based on parameters. Optional; providing a generator makes this type into a parameterizable type constraint. =item C<< inline_generator >> A coderef which generates a new inlining coderef based on parameters. =item C<< coercion_generator >> A coderef which generates a new L object based on parameters. =item C<< deep_explanation >> This API is not finalized. Coderef used by L to peek inside parameterized types and figure out why a value doesn't pass the constraint. =back =head2 Methods =over =item C, C, C, C, C, C, C, C, C Predicate methods. =item C Predicate method with a little extra DWIM. Returns false if the coercion is a no-op. =item C<< is_anon >> Returns true iff the type constraint does not have a C. =item C<< is_parameterized >>, C<< is_parameterizable >> Indicates whether a type has been parameterized (e.g. C<< ArrayRef[Int] >>) or could potentially be (e.g. C<< ArrayRef >>). =item C<< qualified_name >> For non-anonymous type constraints that have a library, returns a qualified C<< "Library::Type" >> sort of name. Otherwise, returns the same as C. =item C<< parents >> Returns a list of all this type constraint's ancestor constraints. For example, if called on the C type constraint would return the list C<< (Value, Defined, Item, Any) >>. B<< Due to a historical misunderstanding, this differs from the Moose implementation of the C method. In Moose, C only returns the immediate parent type constraints, and because type constraints only have one immediate parent, this is effectively an alias for C. The extension module L is the only place where multiple type constraints are returned; and they are returned as an arrayref in violation of the base class' documentation. I'm keeping my behaviour as it seems more useful. >> =item C<< equals($other) >>, C<< is_subtype_of($other) >>, C<< is_supertype_of($other) >>, C<< is_a_type_of($other) >> Compare two types. See L for what these all mean. (OK, Moose doesn't define C, but you get the idea, right?) Note that these have a slightly DWIM side to them. If you create two L objects which test the same class, they're considered equal. And: my $subtype_of_Num = Types::Standard::Num->create_child_type; my $subtype_of_Int = Types::Standard::Int->create_child_type; $subtype_of_Int->is_subtype_of( $subtype_of_Num ); # true =item C<< strictly_equals($other) >>, C<< is_strictly_subtype_of($other) >>, C<< is_strictly_supertype_of($other) >>, C<< is_strictly_a_type_of($other) >> Stricter versions of the type comparison functions. These only care about explicit inheritance via C. my $subtype_of_Num = Types::Standard::Num->create_child_type; my $subtype_of_Int = Types::Standard::Int->create_child_type; $subtype_of_Int->is_strictly_subtype_of( $subtype_of_Num ); # false =item C<< check($value) >> Returns true iff the value passes the type constraint. =item C<< validate($value) >> Returns the error message for the value; returns an explicit undef if the value passes the type constraint. =item C<< assert_valid($value) >> Like C<< check($value) >> but dies if the value does not pass the type constraint. Yes, that's three very similar methods. Blame L whose API I'm attempting to emulate. :-) =item C<< assert_return($value) >> Like C<< assert_valid($value) >> but returns the value if it passes the type constraint. This seems a more useful behaviour than C<< assert_valid($value) >>. I would have just changed C<< assert_valid($value) >> to do this, except that there are edge cases where it could break Moose compatibility. =item C<< get_message($value) >> Returns the error message for the value; even if the value passes the type constraint. =item C<< coerce($value) >> Attempt to coerce C<< $value >> to this type. =item C<< assert_coerce($value) >> Attempt to coerce C<< $value >> to this type. Throws an exception if this is not possible. =item C<< can_be_inlined >> Returns boolean indicating if this type can be inlined. =item C<< inline_check($varname) >> Creates a type constraint check for a particular variable as a string of Perl code. For example: print( Types::Standard::Num->inline_check('$foo') ); prints the following output: (!ref($foo) && Scalar::Util::looks_like_number($foo)) For Moose-compat, there is an alias C<< _inline_check >> for this method. =item C<< inline_assert($varname) >> Much like C but outputs a statement of the form: die ... unless ...; Note that if this type has a custom error message, the inlined code will I this custom message!! =item C<< parameterize(@parameters) >> Creates a new parameterized type; throws an exception if called on a non-parameterizable type. =item C<< create_child_type(%attributes) >> Construct a new Type::Tiny object with this object as its parent. =item C<< child_type_class >> The class that create_child_type will construct. =item C<< plus_coercions($type1, $code1, ...) >> Shorthand for creating a new child type constraint with the same coercions as this one, but then adding some extra coercions (at a higher priority than the existing ones). =item C<< plus_fallback_coercions($type1, $code1, ...) >> Like C, but added at a lower priority. =item C<< minus_coercions($type1, ...) >> Shorthand for creating a new child type constraint with fewer type coercions. =item C<< no_coercions >> Shorthand for creating a new child type constraint with no coercions at all. =item C<< isa($class) >>, C<< can($method) >>, C<< AUTOLOAD(@args) >> If Moose is loaded, then the combination of these methods is used to mock a Moose::Meta::TypeConstraint. If Mouse is loaded, then C mocks Mouse::Meta::TypeConstraint. =item C<< DOES($role) >> Overridden to advertise support for various roles. See also L, etc. =item C<< TIESCALAR >>, C<< TIEARRAY >>, C<< TIEHASH >> These are provided as hooks that wrap L. (Type::Tie is distributed separately, and can be used with non-Type::Tiny type constraints too.) They allow the following to work: use Types::Standard qw(Int); tie my @list, Int; push @list, 123, 456; # ok push @list, "Hello"; # dies =back The following methods exist for Moose/Mouse compatibility, but do not do anything useful. =over =item C<< compile_type_constraint >> =item C<< hand_optimized_type_constraint >> =item C<< has_hand_optimized_type_constraint >> =item C<< inline_environment >> =item C<< meta >> =item C<< type_parameter >> =back =head2 Overloading =over =item * Stringification is overloaded to return the qualified name. =item * Boolification is overloaded to always return true. =item * Coderefification is overloaded to call C. =item * On Perl 5.10.1 and above, smart match is overloaded to call C. =item * The C<< == >> operator is overloaded to call C. =item * The C<< < >> and C<< > >> operators are overloaded to call C and C. =item * The C<< ~ >> operator is overloaded to call C. =item * The C<< | >> operator is overloaded to build a union of two type constraints. See L. =item * The C<< & >> operator is overloaded to build the intersection of two type constraints. See L. =item * The C<< + >> operator is overloaded to call C or C as appropriate. =back =head2 Constants =over =item C<< Type::Tiny::SUPPORT_SMARTMATCH >> Indicates whether the smart match overload is supported on your version of Perl. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. L, L, L, L. L, L, L, L, L, L. L, L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 THANKS Thanks to Matt S Trout for advice on L integration. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Type/Utils.pm0000644000175000017500000005175012200121217014614 0ustar taitaipackage Type::Utils; use 5.006001; use strict; use warnings; BEGIN { $Type::Utils::AUTHORITY = 'cpan:TOBYINK'; $Type::Utils::VERSION = '0.022'; } sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } use Scalar::Util qw< blessed >; use Type::Library; use Type::Tiny; use Types::TypeTiny qw< TypeTiny to_TypeTiny HashLike StringLike CodeLike >; our @EXPORT = qw< declare as where message inline_as class_type role_type duck_type union intersection enum coerce from via declare_coercion to_type >; our @EXPORT_OK = ( @EXPORT, qw< extends type subtype match_on_type compile_match_on_type dwim_type >, ); use base qw< Exporter::TypeTiny >; sub extends { _croak "Not a type library" unless caller->isa("Type::Library"); my $caller = caller->meta; foreach my $lib (@_) { eval "require $lib" or _croak "Could not load library '$lib': $@"; $caller->add_type($lib->get_type($_)) for $lib->meta->type_names; } } sub declare { my %opts; if (@_ % 2 == 0) { %opts = @_; } else { (my($name), %opts) = @_; _croak "Cannot provide two names for type" if exists $opts{name}; $opts{name} = $name; } my $caller = caller($opts{_caller_level} || 0); $opts{library} = $caller; if (defined $opts{parent}) { $opts{parent} = to_TypeTiny($opts{parent}); unless (TypeTiny->check($opts{parent})) { $caller->isa("Type::Library") or _croak("Parent type cannot be a %s", ref($opts{parent})||'non-reference scalar'); $opts{parent} = $caller->meta->get_type($opts{parent}) or _croak("Could not find parent type"); } } my $type; if (defined $opts{parent}) { $type = delete($opts{parent})->create_child_type(%opts); } else { my $bless = delete($opts{bless}) || "Type::Tiny"; eval "require $bless"; $type = $bless->new(%opts); } if ($caller->isa("Type::Library")) { $caller->meta->add_type($type) unless $type->is_anon; } return $type; } *subtype = \&declare; *type = \&declare; sub as (@) { parent => @_; } sub where (&;@) { constraint => @_; } sub message (&;@) { message => @_; } sub inline_as (&;@) { inlined => @_; } sub class_type { my $name = ref($_[0]) ? undef : shift; my %opts = %{ +shift }; if (defined $name) { $opts{name} = $name unless exists $opts{name}; $opts{class} = $name unless exists $opts{class}; } $opts{bless} = "Type::Tiny::Class"; { no warnings "numeric"; $opts{_caller_level}++ } declare(%opts); } sub role_type { my $name = ref($_[0]) ? undef : shift; my %opts = %{ +shift }; if (defined $name) { $opts{name} = $name unless exists $opts{name}; $opts{role} = $name unless exists $opts{role}; } $opts{bless} = "Type::Tiny::Role"; { no warnings "numeric"; $opts{_caller_level}++ } declare(%opts); } sub duck_type { my $name = ref($_[0]) ? undef : shift; my @methods = @{ +shift }; my %opts; $opts{name} = $name if defined $name; $opts{methods} = \@methods; $opts{bless} = "Type::Tiny::Duck"; { no warnings "numeric"; $opts{_caller_level}++ } declare(%opts); } sub enum { my $name = ref($_[0]) ? undef : shift; my @values = @{ +shift }; my %opts; $opts{name} = $name if defined $name; $opts{values} = \@values; $opts{bless} = "Type::Tiny::Enum"; { no warnings "numeric"; $opts{_caller_level}++ } declare(%opts); } sub union { my $name = ref($_[0]) ? undef : shift; my @tcs = @{ +shift }; my %opts; $opts{name} = $name if defined $name; $opts{type_constraints} = \@tcs; $opts{bless} = "Type::Tiny::Union"; { no warnings "numeric"; $opts{_caller_level}++ } declare(%opts); } sub intersection { my $name = ref($_[0]) ? undef : shift; my @tcs = @{ +shift }; my %opts; $opts{name} = $name if defined $name; $opts{type_constraints} = \@tcs; $opts{bless} = "Type::Tiny::Intersection"; { no warnings "numeric"; $opts{_caller_level}++ } declare(%opts); } sub declare_coercion { my %opts; $opts{name} = shift if !ref($_[0]); while (HashLike->check($_[0]) and not TypeTiny->check($_[0])) { %opts = (%opts, %{+shift}); } my $caller = caller($opts{_caller_level} || 0); $opts{library} = $caller; my $bless = delete($opts{bless}) || "Type::Coercion"; eval "require $bless"; my $c = $bless->new(%opts); my @C; if ($caller->isa("Type::Library")) { my $meta = $caller->meta; $meta->add_coercion($c) unless $c->is_anon; while (@_) { push @C, map { ref($_) ? to_TypeTiny($_) : $meta->get_type($_)||$_ } shift; push @C, shift; } } $c->add_type_coercions(@C); return $c->freeze; } sub coerce { if ((scalar caller)->isa("Type::Library")) { my $meta = (scalar caller)->meta; my ($type) = map { ref($_) ? to_TypeTiny($_) : $meta->get_type($_)||$_ } shift; my @opts; while (@_) { push @opts, map { ref($_) ? to_TypeTiny($_) : $meta->get_type($_)||$_ } shift; push @opts, shift; } return $type->coercion->add_type_coercions(@opts); } my ($type, @opts) = @_; $type = to_TypeTiny($type); return $type->coercion->add_type_coercions(@opts); } sub from (@) { return @_; } sub to_type (@) { my $type = shift; unless (TypeTiny->check($type)) { caller->isa("Type::Library") or _croak "Target type cannot be a string"; $type = caller->meta->get_type($type) or _croak "Could not find target type"; } return +{ type_constraint => $type }, @_; } sub via (&;@) { return @_; } sub match_on_type { my $value = shift; while (@_) { my ($type, $code); if (@_ == 1) { require Types::Standard; ($type, $code) = (Types::Standard::Any(), shift); } else { ($type, $code) = splice(@_, 0, 2); TypeTiny->($type); } $type->check($value) or next; if (StringLike->check($code)) { local $_ = $value; if (wantarray) { my @r = eval "$code"; die $@ if $@; return @r; } if (defined wantarray) { my $r = eval "$code"; die $@ if $@; return $r; } eval "$code"; die $@ if $@; return; } else { CodeLike->($code); local $_ = $value; return $code->($value); } } _croak("No cases matched for %s", Type::Tiny::_dd($value)); } sub compile_match_on_type { my @code = 'sub { local $_ = $_[0]; '; my @checks; my @actions; my $els = ''; while (@_) { my ($type, $code); if (@_ == 1) { require Types::Standard; ($type, $code) = (Types::Standard::Any(), shift); } else { ($type, $code) = splice(@_, 0, 2); TypeTiny->($type); } if ($type->can_be_inlined) { push @code, sprintf('%sif (%s)', $els, $type->inline_check('$_')); } else { push @checks, $type; push @code, sprintf('%sif ($checks[%d]->check($_))', $els, $#checks); } $els = 'els'; if (StringLike->check($code)) { push @code, sprintf(' { %s }', $code); } else { CodeLike->($code); push @actions, $code; push @code, sprintf(' { $actions[%d]->(@_) }', $#actions); } } push @code, 'else', ' { Type::Util::_croak("No cases matched for %s", Type::Tiny::_dd($_[0])) }'; push @code, '}'; # /sub require Eval::TypeTiny; return Eval::TypeTiny::eval_closure( source => \@code, environment => { '@actions' => \@actions, '@checks' => \@checks, }, ); } { package #hide Type::Registry::DWIM; our @ISA = qw(Type::Registry); sub simple_lookup { my $self = shift; my $r; # If the lookup is chained to a class, then the class' own # type registry gets first refusal. # if (defined $self->{"~~chained"}) { my $chained = "Type::Registry"->for_class($self->{"~~chained"}); $r = eval { $chained->simple_lookup(@_) } unless $self == $chained; return $r if defined $r; } # Fall back to types in Types::Standard. require Types::Standard; return 'Types::Standard'->get_type($_[0]) if 'Types::Standard'->has_type($_[0]); # Only continue any further if we've been called from Type::Parser. return unless $_[1]; # If Moose is loaded... if ($INC{'Moose.pm'}) { require Moose::Util::TypeConstraints; require Types::TypeTiny; $r = Moose::Util::TypeConstraints::find_type_constraint($_[0]); return Types::TypeTiny::to_TypeTiny($r) if defined $r; } # If Mouse is loaded... if ($INC{'Mouse.pm'}) { require Mouse::Util::TypeConstraints; require Types::TypeTiny; $r = Mouse::Util::TypeConstraints::find_type_constraint($_[0]); return Types::TypeTiny::to_TypeTiny($r) if defined $r; } return unless $_[0] =~ /^\s*(\w+(::\w+)*)\s*$/sm; return unless defined $self->{"~~assume"}; # Lastly, if it looks like a class/role name, assume it's # supposed to be a class/role type. # if ($self->{"~~assume"} eq "Type::Tiny::Class") { require Type::Tiny::Class; return "Type::Tiny::Class"->new(class => $_[0]); } if ($self->{"~~assume"} eq "Type::Tiny::Role") { require Type::Tiny::Role; return "Type::Tiny::Role"->new(role => $_[0]); } die; } } our $dwimmer; sub dwim_type { my ($string, %opts) = @_; $opts{for} = caller unless defined $opts{for}; $dwimmer ||= do { require Type::Registry; 'Type::Registry::DWIM'->new; }; local $dwimmer->{'~~chained'} = $opts{for}; local $dwimmer->{'~~assume'} = $opts{does} ? 'Type::Tiny::Role' : 'Type::Tiny::Class'; $dwimmer->lookup($string); } 1; __END__ =pod =encoding utf-8 =for stopwords smush smushed =head1 NAME Type::Utils - utility functions to make defining and using type constraints a little easier =head1 SYNOPSIS package Types::Mine; use Type::Library -base; use Type::Utils -all; BEGIN { extends "Types::Standard" }; declare "AllCaps", as "Str", where { uc($_) eq $_ }, inline_as { my $varname = $_[1]; "uc($varname) eq $varname" }; coerce "AllCaps", from "Str", via { uc($_) }; =head1 DESCRIPTION This module provides utility functions to make defining and using type constraints a little easier. =head2 Type declaration functions Many of the following are similar to the similarly named functions described in L. =over =item C<< declare $name, %options >> =item C<< declare %options >> Declare a named or anonymous type constraint. Use C and C to specify the parent type (if any) and (possibly) refine its definition. declare EvenInt, as Int, where { $_ % 2 == 0 }; my $EvenInt = declare as Int, where { $_ % 2 == 0 }; B<< NOTE: >> If the caller package inherits from L then any non-anonymous types declared in the package will be automatically installed into the library. Hidden gem: if you're inheriting from a type constraint that includes some coercions, you can include C<< coerce => 1 >> in the C<< %options >> hash to inherit the coercions. =item C<< subtype $name, %options >> =item C<< subtype %options >> Declare a named or anonymous type constraint which is descended from an existing type constraint. Use C and C to specify the parent type and refine its definition. Actually, you should use C instead; this is just an alias. This function is not exported by default. =item C<< type $name, %options >> =item C<< type %options >> Declare a named or anonymous type constraint which is not descended from an existing type constraint. Use C to provide a coderef that constrains values. Actually, you should use C instead; this is just an alias. This function is not exported by default. =item C<< as $parent >> Used with C to specify a parent type constraint: declare EvenInt, as Int, where { $_ % 2 == 0 }; =item C<< where { BLOCK } >> Used with C to provide the constraint coderef: declare EvenInt, as Int, where { $_ % 2 == 0 }; The coderef operates on C<< $_ >>, which is the value being tested. =item C<< message { BLOCK } >> Generate a custom error message when a value fails validation. declare EvenInt, as Int, where { $_ % 2 == 0 }, message { Int->validate($_) or "$_ is not divisible by two"; }; Without a custom message, the messages generated by Type::Tiny are along the lines of I<< Value "33" did not pass type constraint "EvenInt" >>, which is usually reasonable. =item C<< inline_as { BLOCK } >> Generate a string of Perl code that can be used to inline the type check into other functions. If your type check is being used within a L or L constructor or accessor methods, or used by L, this can lead to significant performance improvements. declare EvenInt, as Int, where { $_ % 2 == 0 }, inline_as { my ($constraint, $varname) = @_; my $perlcode = $constraint->parent->inline_check($varname) . "&& ($varname % 2 == 0)"; return $perlcode; }; warn EvenInt->inline_check('$xxx'); # demonstration B your C block can return a list, in which case these will be smushed together with "&&". The first item on the list may be undef, in which case the undef will be replaced by the inlined parent type constraint. (And will throw an exception if there is no parent.) declare EvenInt, as Int, where { $_ % 2 == 0 }, inline_as { return (undef, "($_ % 2 == 0)"); }; Returning a list like this is considered experimental, is not tested very much, and I offer no guarantees that it will necessarily work with Moose/Mouse/Moo. =item C<< class_type $name, { class => $package, %options } >> =item C<< class_type { class => $package, %options } >> Shortcut for declaring a L type constraint. =item C<< role_type $name, { role => $package, %options } >> =item C<< role_type { role => $package, %options } >> Shortcut for declaring a L type constraint. =item C<< duck_type $name, \@methods >> =item C<< duck_type \@methods >> Shortcut for declaring a L type constraint. =item C<< union $name, \@constraints >> =item C<< union \@constraints >> Shortcut for declaring a L type constraint. =item C<< enum $name, \@values >> =item C<< enum \@values >> Shortcut for declaring a L type constraint. =item C<< intersection $name, \@constraints >> =item C<< intersection \@constraints >> Shortcut for declaring a L type constraint. =back =head2 Coercion declaration functions Many of the following are similar to the similarly named functions described in L. =over =item C<< coerce $target, @coercions >> Add coercions to the target type constraint. The list of coercions is a list of type constraint, conversion code pairs. Conversion code can be either a string of Perl code or a coderef; in either case the value to be converted is C<< $_ >>. =item C<< from $source >> Sugar to specify a type constraint in a list of coercions: coerce EvenInt, from Int, via { $_ * 2 }; # As a coderef... coerce EvenInt, from Int, q { $_ * 2 }; # or as a string! =item C<< via { BLOCK } >> Sugar to specify a coderef in a list of coercions. =item C<< declare_coercion $name, \%opts, $type1, $code1, ... >> =item C<< declare_coercion \%opts, $type1, $code1, ... >> Declares a coercion that is not explicitly attached to any type in the library. For example: declare_coercion "ArrayRefFromAny", from "Any", via { [$_] }; This coercion will be exportable from the library as a L object, but the ArrayRef type exported by the library won't automatically use it. Coercions declared this way are immutable (frozen). =item C<< to_type $type >> Used with C to declare the target type constraint for a coercion, but still without explicitly attaching the coercion to the type constraint: declare_coercion "ArrayRefFromAny", to_type "ArrayRef", from "Any", via { [$_] }; You should pretty much always use this when declaring an unattached coercion because it's exceedingly useful for a type coercion to know what it will coerce to - this allows it to skip coercion when no coercion is needed (e.g. avoiding coercing C<< [] >> to C<< [ [] ] >>) and allows C to work properly. =back =head2 Type library management =over =item C<< extends @libraries >> Indicates that this type library extends other type libraries, importing their type constraints. Should usually be executed in a C<< BEGIN >> block. This is not exported by default because it's not fun to export it to Moo, Moose or Mouse classes! C<< use Type::Utils -all >> can be used to import it into your type library. =back =head2 Other =over =item C<< match_on_type $value => ($type => \&action, ..., \&default?) >> Something like a C/C or C/C construct. Dispatches along different code paths depending on the type of the incoming value. Example blatantly stolen from the Moose documentation: sub to_json { my $value = shift; return match_on_type $value => ( HashRef() => sub { my $hash = shift; '{ ' . ( join ", " => map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) } sort keys %$hash ) . ' }'; }, ArrayRef() => sub { my $array = shift; '[ '.( join ", " => map { to_json($_) } @$array ).' ]'; }, Num() => q {$_}, Str() => q { '"' . $_ . '"' }, Undef() => q {'null'}, => sub { die "$_ is not acceptable json type" }, ); } Note that unlike Moose, code can be specified as a string instead of a coderef. (e.g. for C, C and C above.) For improved performance, try C. This function is not exported by default. =item C<< my $coderef = compile_match_on_type($type => \&action, ..., \&default?) >> Compile a C block into a coderef. The following JSON converter is about two orders of magnitude faster than the previous example: sub to_json; *to_json = compile_match_on_type( HashRef() => sub { my $hash = shift; '{ ' . ( join ", " => map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) } sort keys %$hash ) . ' }'; }, ArrayRef() => sub { my $array = shift; '[ '.( join ", " => map { to_json($_) } @$array ).' ]'; }, Num() => q {$_}, Str() => q { '"' . $_ . '"' }, Undef() => q {'null'}, => sub { die "$_ is not acceptable json type" }, ); Remember to store the coderef somewhere fairly permanent so that you don't compile it over and over. C variables (in Perl >= 5.10) are good for this. (Same sort of idea as L.) This function is not exported by default. =item C<< dwim_type($string, %options) >> Given a string like "ArrayRef[Int|CodeRef]", turns it into a type constraint object, hopefully doing what you mean. It uses the syntax of L. Firstly the L for the caller package is consulted; if that doesn't have a match, L is consulted for type constraint names; and if there's still no match, then if a type constraint looks like a class name, a new L object is created for it. Somewhere along the way, it also checks Moose/Mouse's type constraint registries if they are loaded. You can specify an alternative for the caller using the C option. If you'd rather create a L object, set the C option to true. # An arrayref of objects, each of which must do role Foo. my $type = dwim_type("ArrayRef[Foo]", does => 1); Type::Registry->for_me->add_types("-Standard"); Type::Registry->for_me->alias_type("Int" => "Foo"); # An arrayref of integers. my $type = dwim_type("ArrayRef[Foo]", does => 1); While it's probably better overall to use the proper L interface for resolving type constraint strings, this function often does what you want. It should never die if it fails to find a type constraint (but may die if the type constraint string is syntactically malformed), preferring to return undef. This function is not exported by default. =back =head1 EXPORT By default, all of the functions documented above are exported, except C and C (prefer C instead), C, C, and C/C. This module uses L; see the documentation of that module for tips and tricks importing from Type::Utils. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L, L. L, L, L, L, L. L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Eval/0000755000175000017500000000000012200124456013124 5ustar taitaiType-Tiny-0.022/lib/Eval/TypeTiny.pm0000644000175000017500000001750212200121217015244 0ustar taitaipackage Eval::TypeTiny; use strict; BEGIN { *HAS_LEXICAL_SUBS = ($] >= 5.018) ? sub(){!!1} : sub(){!!0}; }; { my $hlv; sub HAS_LEXICAL_VARS () { $hlv = !! eval { require Devel::LexAlias } unless defined $hlv; return $hlv; } } sub _clean_eval { local $@; local $SIG{__DIE__}; my $r = eval $_[0]; my $e = $@; return ($r, $e); } our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.022'; our @EXPORT = qw( eval_closure ); our @EXPORT_OK = qw( HAS_LEXICAL_SUBS HAS_LEXICAL_VARS ); sub import { # do the shuffle! no warnings "redefine"; our @ISA = qw( Exporter::TypeTiny ); require Exporter::TypeTiny; my $next = \&Exporter::TypeTiny::import; *import = $next; goto $next; } use warnings; my $sandbox = 0; sub eval_closure { $sandbox++; my (%args) = @_; my $src = ref $args{source} eq "ARRAY" ? join("\n", @{$args{source}}) : $args{source}; $args{alias} = 0 unless defined $args{alias}; $args{line} = 1 unless defined $args{line}; $args{description} =~ s/[^\w .:-\[\]\(\)\{\}\']//g if defined $args{description}; $src = qq{#line $args{line} "$args{description}"\n$src} if defined $args{description} && !($^P & 0x10); $args{environment} ||= {}; # for my $k (sort keys %{$args{environment}}) # { # next if $k =~ /^\$/ && ref($args{environment}{$k}) =~ /^(SCALAR|REF)$/; # next if $k =~ /^\@/ && ref($args{environment}{$k}) eq q(ARRAY); # next if $k =~ /^\%/ && ref($args{environment}{$k}) eq q(HASH); # # require Type::Exception; # Type::Exception::croak("Expected a variable name and ref; got %s => %s", $k, $args{environment}{$k}); # } my $alias = exists($args{alias}) ? $args{alias} : 0; my @keys = sort keys %{$args{environment}}; my $i = 0; my $source = join "\n" => ( "package Eval::TypeTiny::Sandbox$sandbox;", "sub {", map(_make_lexical_assignment($_, $i++, $alias), @keys), $src, "}", ); _manufacture_ties() if $alias && !HAS_LEXICAL_VARS; my ($compiler, $e) = _clean_eval($source); if ($e) { chomp $e; require Type::Exception::Compilation; "Type::Exception::Compilation"->throw( code => (ref $args{source} eq "ARRAY" ? join("\n", @{$args{source}}) : $args{source}), errstr => $e, environment => $args{environment}, ); } my $code = $compiler->(@{$args{environment}}{@keys}); if ($alias && HAS_LEXICAL_VARS) { Devel::LexAlias::lexalias($code, $_, $args{environment}{$_}) for grep !/^\&/, @keys; } return $code; } my $tmp; sub _make_lexical_assignment { my ($key, $index, $alias) = @_; my $name = substr($key, 1); if (HAS_LEXICAL_SUBS and $key =~ /^\&/) { $tmp++; my $tmpname = '$__LEXICAL_SUB__'.$tmp; return "no warnings 'experimental::lexical_subs';". "use feature 'lexical_subs';". "my $tmpname = \$_[$index];". "my sub $name { goto $tmpname };"; } if (!$alias) { my $sigil = substr($key, 0, 1); return "my $key = $sigil\{ \$_[$index] };"; } elsif (HAS_LEXICAL_VARS) { return "my $key;"; } else { my $tieclass = { '@' => 'Eval::TypeTiny::_TieArray', '%' => 'Eval::TypeTiny::_TieHash', '$' => 'Eval::TypeTiny::_TieScalar', }->{ substr($key, 0, 1) }; return sprintf( 'tie(my(%s), "%s", $_[%d]);', $key, $tieclass, $index, ); } } { my $tie; sub _manufacture_ties { $tie ||= eval <<'FALLBACK'; } } no warnings qw(void once uninitialized numeric); { package # Eval::TypeTiny::_TieArray; require Tie::Array; our @ISA = qw( Tie::StdArray ); sub TIEARRAY { my $class = shift; bless $_[0] => $class; } sub AUTOLOAD { my $self = shift; my ($method) = (our $AUTOLOAD =~ /(\w+)$/); defined tied(@$self) and return tied(@$self)->$method(@_); require Carp; Carp::croak(qq[Can't call method "$method" on an undefined value]); } sub can { my $self = shift; my $code = $self->SUPER::can(@_) || (defined tied(@$self) and tied(@$self)->can(@_)); return $code; } use overload q[bool] => sub { !! tied @{$_[0]} }, q[""] => sub { '' . tied @{$_[0]} }, q[0+] => sub { 0 + tied @{$_[0]} }, fallback => 1, ; } { package # Eval::TypeTiny::_TieHash; require Tie::Hash; our @ISA = qw( Tie::StdHash ); sub TIEHASH { my $class = shift; bless $_[0] => $class; } sub AUTOLOAD { my $self = shift; my ($method) = (our $AUTOLOAD =~ /(\w+)$/); defined tied(%$self) and return tied(%$self)->$method(@_); require Carp; Carp::croak(qq[Can't call method "$method" on an undefined value]); } sub can { my $self = shift; my $code = $self->SUPER::can(@_) || (defined tied(%$self) and tied(%$self)->can(@_)); return $code; } use overload q[bool] => sub { !! tied %{$_[0]} }, q[""] => sub { '' . tied %{$_[0]} }, q[0+] => sub { 0 + tied %{$_[0]} }, fallback => 1, ; } { package # Eval::TypeTiny::_TieScalar; require Tie::Scalar; our @ISA = qw( Tie::StdScalar ); sub TIESCALAR { my $class = shift; bless $_[0] => $class; } sub AUTOLOAD { my $self = shift; my ($method) = (our $AUTOLOAD =~ /(\w+)$/); defined tied($$self) and return tied($$self)->$method(@_); require Carp; Carp::croak(qq[Can't call method "$method" on an undefined value]); } sub can { my $self = shift; my $code = $self->SUPER::can(@_) || (defined tied($$self) and tied($$self)->can(@_)); return $code; } use overload q[bool] => sub { !! tied ${$_[0]} }, q[""] => sub { '' . tied ${$_[0]} }, q[0+] => sub { 0 + tied ${$_[0]} }, fallback => 1, ; } 1; FALLBACK 1; __END__ =pod =encoding utf-8 =for stopwords pragmas =head1 NAME Eval::TypeTiny - utility to evaluate a string of Perl code in a clean environment =head1 DESCRIPTION This is not considered part of Type::Tiny's public API. =head2 Functions This module exports one function, which works much like the similarly named function from L: =over =item C<< eval_closure(source => $source, environment => \%env, %opt) >> =back =head2 Constants The following constants may be exported, but are not by default. =over =item C<< HAS_LEXICAL_SUBS >> Boolean indicating whether Eval::TypeTiny has support for lexical subs. (This feature requires Perl 5.18.) =item C<< HAS_LEXICAL_VARS >> Don't worry; closing over lexical variables in the closures is always supported! However, if this constant is true, it means that L is available, which makes them slightly faster than the fallback solution which uses tied variables. (This only makes any difference when the C<< alias => 1 >> option is used.) =back =head1 EVALUATION ENVIRONMENT The evaluation is performed in the presence of L, but the absence of L. (This is different to L which enables warnings for compiled closures.) The L pragma is not active in the evaluation environment, so the following will not work: use feature qw(say); use Eval::TypeTiny qw(eval_closure); my $say_all = eval_closure( source => 'sub { say for @_ }', ); $say_all->("Hello", "World"); The L pragma does not "carry over" into the stringy eval. It is of course possible to import pragmas into the evaluated string as part of the string itself: use Eval::TypeTiny qw(eval_closure); my $say_all = eval_closure( source => 'sub { use feature qw(say); say for @_ }', ); $say_all->("Hello", "World"); =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/lib/Exporter/0000755000175000017500000000000012200124456014045 5ustar taitaiType-Tiny-0.022/lib/Exporter/TypeTiny.pm0000644000175000017500000002705612200121217016172 0ustar taitaipackage Exporter::TypeTiny; use 5.006001; use strict; use warnings; no warnings qw(void once uninitialized numeric redefine); our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '0.022'; our @EXPORT_OK = qw< mkopt mkopt_hash _croak >; sub _croak ($;@) { require Type::Exception; goto \&Type::Exception::croak } sub import { my $class = shift; my $global_opts = +{ @_ && ref($_[0]) eq q(HASH) ? %{+shift} : () }; my @args = do { no strict qw(refs); @_ ? @_ : @{"$class\::EXPORT"} }; my $opts = mkopt(\@args); $global_opts->{into} = caller unless exists $global_opts->{into}; my @want; while (@$opts) { my $opt = shift @{$opts}; my ($name, $value) = @$opt; $name =~ /^[:-](.+)$/ ? push(@$opts, $class->_exporter_expand_tag($1, $value, $global_opts)) : push(@want, $opt); } $class->_exporter_validate_opts($global_opts); my $permitted = $class->_exporter_permitted_regexp($global_opts); for my $wanted (@want) { my %symbols = $class->_exporter_expand_sub(@$wanted, $global_opts, $permitted); $class->_exporter_install_sub($_, $wanted->[1], $global_opts, $symbols{$_}) for keys %symbols; } } # Called once per import, passed the "global" import options. Expected to # validate the import options and carp or croak if there are problems. Can # also take the opportunity to do other stuff if needed. # sub _exporter_validate_opts { 1; } # Given a tag name, looks it up in %EXPORT_TAGS and returns the list of # associated functions. The default implementation magically handles tags # "all" and "default". The default implementation interprets any undefined # tags as being global options. # sub _exporter_expand_tag { no strict qw(refs); my $class = shift; my ($name, $value, $globals) = @_; my $tags = \%{"$class\::EXPORT_TAGS"}; return map [$_ => $value], @{$tags->{$name}} if exists $tags->{$name}; return map [$_ => $value], @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"} if $name eq 'all'; return map [$_ => $value], @{"$class\::EXPORT"} if $name eq 'default'; $globals->{$name} = $value || 1; return; } # Helper for _exporter_expand_sub. Returns a regexp matching all subs in # the exporter package which are available for export. # sub _exporter_permitted_regexp { no strict qw(refs); my $class = shift; my $re = join "|", map quotemeta, sort { length($b) <=> length($a) or $a cmp $b } @{"$class\::EXPORT"}, @{"$class\::EXPORT_OK"}; qr{^(?:$re)$}ms; } # Given a sub name, returns a hash of subs to install (usually just one sub). # Keys are sub names, values are coderefs. # sub _exporter_expand_sub { my $class = shift; my ($name, $value, $globals, $permitted) = @_; $permitted ||= $class->_exporter_permitted_regexp($globals); no strict qw(refs); exists &{"$class\::$name"} && $name =~ $permitted ? ($name => \&{"$class\::$name"}) : $class->_exporter_fail(@_); } # Called by _exporter_expand_sub if it is unable to generate a key-value # pair for a sub. # sub _exporter_fail { my $class = shift; my ($name, $value, $globals) = @_; _croak("Could not find sub '$name' to export in package '$class'"); } # Actually performs the installation of the sub into the target package. This # also handles renaming the sub. # sub _exporter_install_sub { my $class = shift; my ($name, $value, $globals, $sym) = @_; my $into = $globals->{into}; my $installer = $globals->{installer} || $globals->{exporter}; $name = $value->{-as} || $name; unless (ref($name) eq q(SCALAR)) { my ($prefix) = grep defined, $value->{-prefix}, $globals->{prefix}, q(); my ($suffix) = grep defined, $value->{-suffix}, $globals->{suffix}, q(); $name = "$prefix$name$suffix"; } return $installer->($globals, [$name, $sym]) if $installer; return ($$name = $sym) if ref($name) eq q(SCALAR); return ($into->{$name} = $sym) if ref($into) eq q(HASH); require B; for (grep ref, $into->can($name)) { my $stash = B::svref_2object($_)->STASH; next unless $stash->can("NAME"); $stash->NAME eq $into and _croak("Refusing to overwrite local sub '$name' with export from $class"); } no strict qw(refs); *{"$into\::$name"} = $sym; } sub mkopt { my $in = shift or return []; my @out; $in = [map(($_ => ref($in->{$_}) ? $in->{$_} : ()), sort keys %$in)] if ref($in) eq q(HASH); for (my $i = 0; $i < @$in; $i++) { my $k = $in->[$i]; my $v; ($i == $#$in) ? ($v = undef) : !defined($in->[$i+1]) ? (++$i, ($v = undef)) : !ref($in->[$i+1]) ? ($v = undef) : ($v = $in->[++$i]); push @out, [ $k => $v ]; } \@out; } sub mkopt_hash { my $in = shift or return; my %out = map +($_->[0] => $_->[1]), @{ mkopt($in) }; \%out; } 1; __END__ =pod =encoding utf-8 =head1 NAME Exporter::TypeTiny - a small exporter used internally by Type::Library and friends =head1 SYNOPSIS package MyUtils; use base "Exporter::TypeTiny"; our @EXPORT = qw(frobnicate); sub frobnicate { my $n = shift; ... } 1; package MyScript; use MyUtils "frobnicate" => { -as => "frob" }; print frob(42); exit; =head1 DESCRIPTION Exporter::TypeTiny supports many of Sub::Exporter's external-facing features including renaming imported functions with the C<< -as >>, C<< -prefix >> and C<< -suffix >> options; explicit destinations with the C<< into >> option; and alternative installers with the C<< installler >> option. But it's written in only about 40% as many lines of code and with zero non-core dependencies. Its internal-facing interface is closer to Exporter.pm, with configuration done through the C<< @EXPORT >>, C<< @EXPORT_OK >> and C<< %EXPORT_TAGS >> package variables. Although generators are not an explicit part of the interface, Exporter::TypeTiny performs most of its internal duties (including resolution of tag names to function names, resolution of function names to coderefs, and installation of coderefs into the target package) as method calls, which means they can be overridden to provide interesting behaviour, including an equivalent to Sub::Exporter's generators. (Type::Library does this.) These methods are not currently documented, and are still subject to change. =head2 Utility Functions These are really for internal use, but can be exported if you need them. =over =item C<< mkopt(\@array) >> Similar to C from L. It doesn't support all the fancy options that Data::OptList does (C, C, C and C) but runs about 50% faster. =item C<< mkopt_hash(\@array) >> Similar to C from L. See also C. =back =head1 TIPS AND TRICKS For the purposes of this discussion we'll assume we have a module called C<< MyUtils >> which exports one function, C<< frobnicate >>. C<< MyUtils >> inherits from Exporter::TypeTiny. Many of these tricks may seem familiar from L. That is intentional. Exporter::TypeTiny doesn't attempt to provide every feature of Sub::Exporter, but where it does it usually uses a fairly similar API. =head2 Basic importing # import "frobnicate" function use MyUtils "frobnicate"; # import all functions that MyUtils offers use MyUtils -all; =head2 Renaming imported functions # call it "frob" use MyUtils "frobnicate" => { -as => "frob" }; # call it "my_frobnicate" use MyUtils "frobnicate" => { -prefix => "my_" }; # call it "frobnicate_util" use MyUtils "frobnicate" => { -suffix => "_util" }; # import it twice with two different names use MyUtils "frobnicate" => { -as => "frob" }, "frobnicate" => { -as => "frbnct" }; =head2 Lexical subs { use Sub::Exporter::Lexical lexical_installer => { -as => "lex" }; use MyUtils { installer => lex }, "frobnicate"; frobnicate(...); # ok } frobnicate(...); # not ok =head2 Import functions into another package use MyUtils { into => "OtherPkg" }, "frobnicate"; OtherPkg::frobincate(...); =head2 Import functions into a scalar my $func; use MyUtils "frobnicate" => { -as => \$func }; $func->(...); =head2 Import functions into a hash OK, Sub::Exporter doesn't do this... my %funcs; use MyUtils { into => \%funcs }, "frobnicate"; $funcs{frobnicate}->(...); =head1 HISTORY B<< Why >> bundle an exporter with Type-Tiny? Well, it wasn't always that way. L had a bunch of custom exporting code which poked coderefs into its caller's stash. It needed this so that it could switch between exporting Moose, Mouse and Moo-compatible objects on request. Meanwhile L, L and L each used the venerable L. However, this meant they were unable to use the features like L-style function renaming which I'd built into Type::Library: ## import "Str" but rename it to "String". use Types::Standard "Str" => { -as => "String" }; And so I decided to factor out code that could be shared by all Type-Tiny's exporters into a single place. =head1 OBLIGATORY EXPORTER COMPARISON Exporting is unlikely to be your application's performance bottleneck, but nonetheless here are some comparisons. B<< Comparative sizes according to L: >> Exporter 217.1Kb Sub::Exporter::Progressive 263.2Kb Exporter::TypeTiny 267.7Kb Exporter + Exporter::Heavy 281.5Kb Exporter::Renaming 406.2Kb Sub::Exporter 701.0Kb B<< Performance exporting a single sub: >> Rate SubExp ExpTT SubExpProg ExpPM SubExp 2489/s -- -56% -85% -88% ExpTT 5635/s 126% -- -67% -72% SubExpProg 16905/s 579% 200% -- -16% ExpPM 20097/s 707% 257% 19% -- (Exporter::Renaming globally changes the behaviour of Exporter.pm, so could not be included in the same benchmarks.) B<< (Non-Core) Depenendencies: >> Exporter -1 Exporter::Renaming 0 Exporter::TypeTiny 0 Sub::Exporter::Progressive 0 Sub::Exporter 3 B<< Features: >> ExpPM ExpTT SubExp SubExpProg Can export code symbols............. Yes Yes Yes Yes Can export non-code symbols......... Yes Groups/tags......................... Yes Yes Yes Yes Config avoids package variables..... Yes Allows renaming of subs............. Yes Yes Maybe Install code into scalar refs....... Yes Yes Maybe Can be passed an "into" parameter... Yes Yes Maybe Can be passed an "installer" sub.... Yes Yes Maybe Supports generators................. Yes Yes Sane API for generators............. Yes (Certain Sub::Exporter::Progressive features are only available if Sub::Exporter is installed.) =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. 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 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Type-Tiny-0.022/MANIFEST0000644000175000017500000000630512200124456012624 0ustar taitai.travis.yml Changes CONTRIBUTING COPYRIGHT CREDITS examples/benchmark-coercions.pl examples/benchmark-constraints.pl examples/benchmark-mkopt.pl examples/benchmark-param-validation.pl examples/datetime-coercions.pl inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/AutoManifest.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Contributors.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Package.pm inc/Module/Install/TrustMetaYml.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm inc/Module/Package.pm inc/Module/Package/Dist/RDF.pm inc/Test/Fatal.pm inc/Test/Requires.pm inc/Try/Tiny.pm inc/YAML/Tiny.pm lib/Devel/TypeTiny/Perl56Compat.pm lib/Eval/TypeTiny.pm lib/Exporter/TypeTiny.pm lib/Reply/Plugin/TypeTiny.pm lib/Test/TypeTiny.pm lib/Type/Coercion.pm lib/Type/Coercion/Union.pm lib/Type/Exception.pm lib/Type/Exception/Assertion.pm lib/Type/Exception/Compilation.pm lib/Type/Exception/WrongNumberOfParameters.pm lib/Type/Library.pm lib/Type/Params.pm lib/Type/Parser.pm lib/Type/Registry.pm lib/Type/Tiny.pm lib/Type/Tiny/Class.pm lib/Type/Tiny/Duck.pm lib/Type/Tiny/Enum.pm lib/Type/Tiny/Intersection.pm lib/Type/Tiny/Manual.pod lib/Type/Tiny/Manual/Coercions.pod lib/Type/Tiny/Manual/Libraries.pod lib/Type/Tiny/Manual/Params.pod lib/Type/Tiny/Manual/UsingWithMoo.pod lib/Type/Tiny/Manual/UsingWithMoose.pod lib/Type/Tiny/Manual/UsingWithMouse.pod lib/Type/Tiny/Manual/UsingWithOther.pod lib/Type/Tiny/Role.pm lib/Type/Tiny/Union.pm lib/Type/Utils.pm lib/Types/Standard.pm lib/Types/TypeTiny.pm LICENSE Makefile.PL MANIFEST This list of files META.ttl META.yml meta/changes.pret meta/doap.pret meta/makefile.pret meta/people.pret meta/rights.pret NEWS README t/00-begin.t t/01-compile.t t/02-api.t t/arithmetic.t t/coercion-automatic.t t/coercion-classy.t t/coercion-frozen.t t/coercion-inlining.t t/coercion-modifiers.t t/coercion-union.t t/coercion.t t/coercions-parameterized.t t/dwim-moose.t t/dwim-mouse.t t/eval-lexicalsubs.t t/eval.t t/exceptions-stack.t t/exceptions.t t/exporter-installer.t t/exporter-roleconflict.t t/exporter.t t/functionparameters.t t/gh1.t t/lib/BiggerLib.pm t/lib/DemoLib.pm t/library-assert.t t/library-is.t t/library-to.t t/library-types.t t/match-on-type.t t/moo-coercion.t t/moo-exceptions.t t/moo-inflation.t t/moo.t t/moose-autott.t t/moose-coercion.t t/moose.t t/moosextypes-more.t t/moosextypes.t t/mouse-coercion.t t/mouse.t t/mousextypes.t t/oo-classinsideout.t t/oo-objectaccessor.t t/parameterization.t t/params-badsigs.t t/params-carping.t t/params-coerce.t t/params-methods.t t/params-mixednamed.t t/params-named.t t/params-noninline.t t/params-optional.t t/params-positional.t t/params-slurpy.t t/parser.t t/registry.t t/rt85911.t t/rt86004.t t/rt86233.t t/rt86239.t t/stdlib-mxtmlb-alike.t t/stdlib-optlist.t t/stdlib-overload.t t/stdlib-strmatch.t t/stdlib-structures.t t/stdlib-tied.t t/stdlib.t t/subquote.t t/syntax.t t/type-class.t t/type-duck.t t/type-enum.t t/type-intersection.t t/type-role.t t/type-union.t t/type.t t/validationclass.t SIGNATURE Public-key signature (added by MakeMaker) Type-Tiny-0.022/SIGNATURE0000664000175000017500000002534512200124457012767 0ustar taitaiThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.70. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 ffba79617e0a3973b8e686262c11356c9660fc80 .travis.yml SHA1 294505f858f11dd062e9916e3f50d88210a9ef54 CONTRIBUTING SHA1 bef297ee5236d761d9cb68e283a4e46af6057285 COPYRIGHT SHA1 f1dbbc496bf3ab651b44c834b43f9f880e13d9b7 CREDITS SHA1 24ab0fa2489b8afe742c06ed42090612b19a0de0 Changes SHA1 937d452c5c4069f4cda9ffaf45a33f1eb5f060e8 LICENSE SHA1 ff865bface7d4548699bc2dc91291216765e9316 MANIFEST SHA1 fc0d20d0790f44560dd80b5ce5f33b87e483556e META.ttl SHA1 eff3a49416969cf671e73c86e9e240f9c1c5378e META.yml SHA1 92d74e2c94dac26021eb4606db5548807e84c418 Makefile.PL SHA1 ffd86c343718880b63e03237fd8d16ffc8dba1ac NEWS SHA1 69e368bdcde72aa0ec41288a72e86aef94b5dc08 README SHA1 899a0efab4b5096bb91eb6c95cd8b3cdd9c40f6c examples/benchmark-coercions.pl SHA1 797286fcd93ea65440ba512e1b4076017e655020 examples/benchmark-constraints.pl SHA1 c6127806b4b8c68d728e6c51e345e46c7a2b56f7 examples/benchmark-mkopt.pl SHA1 296d9518cf196b817afe3d33089b9127e95f5dde examples/benchmark-param-validation.pl SHA1 1ec446214f4926f76b14c1d7f098a6d977829229 examples/datetime-coercions.pl SHA1 06c410f05488c1612ed66b06d3a86b2580581e4a inc/Module/AutoInstall.pm SHA1 8a924add836b60fb23b25c8506d45945e02f42f4 inc/Module/Install.pm SHA1 61ab1dd37e33ddbe155907ce51df8a3e56ac8bbf inc/Module/Install/AutoInstall.pm SHA1 c04f94f91fa97b9f8cfb5a36071098ab0e6c78e3 inc/Module/Install/AutoManifest.pm SHA1 2d0fad3bf255f8c1e7e1e34eafccc4f595603ddc inc/Module/Install/Base.pm SHA1 f0e01fff7d73cd145fbf22331579918d4628ddb0 inc/Module/Install/Can.pm SHA1 9e4cc10c7f138a3f2c60d9ee1f34261f0d8c5aae inc/Module/Install/Contributors.pm SHA1 7328966e4fda0c8451a6d3850704da0b84ac1540 inc/Module/Install/Fetch.pm SHA1 66d3d335a03492583a3be121a7d888f63f08412c inc/Module/Install/Include.pm SHA1 b62ca5e2d58fa66766ccf4d64574f9e1a2250b34 inc/Module/Install/Makefile.pm SHA1 1aa925be410bb3bfcd84a16985921f66073cc1d2 inc/Module/Install/Metadata.pm SHA1 3b9281ddf7dd6d6f5de0a9642c69333023193c80 inc/Module/Install/Package.pm SHA1 41f76ff6b39368a65da86377e43b34bacc2fb0eb inc/Module/Install/TrustMetaYml.pm SHA1 e4196994fa75e98bdfa2be0bdeeffef66de88171 inc/Module/Install/Win32.pm SHA1 c3a6d0d5b84feb3280622e9599e86247d58b0d18 inc/Module/Install/WriteAll.pm SHA1 26d58a041cd6b3d21db98b32e8fd1841aae21204 inc/Module/Package.pm SHA1 685e964c05a5f29d416f263c35589a10cb7296e1 inc/Module/Package/Dist/RDF.pm SHA1 85872fcf275a7868f858ca6ccc0e15cdaff8f8ac inc/Test/Fatal.pm SHA1 95d4da14025622f3a45f5e9b75b7b6860148f415 inc/Test/Requires.pm SHA1 75dd349355aff420c46d9e37802e39712b6309c2 inc/Try/Tiny.pm SHA1 feb933cefe2e3762e8322bd6071a2499f3440da1 inc/YAML/Tiny.pm SHA1 54941624182ddfe3180a8f3316da8a229baf6072 lib/Devel/TypeTiny/Perl56Compat.pm SHA1 267fbaa3cfbbe337d76020238be782cc68c81670 lib/Eval/TypeTiny.pm SHA1 c492915063750cd7d6ea073c08d5b13eb8a8dcfd lib/Exporter/TypeTiny.pm SHA1 9639a968fc78f8b22c9fce64a208688ba4d52b3b lib/Reply/Plugin/TypeTiny.pm SHA1 d6942a91d6e091f3a091c6b4901c0de5fe06e5d8 lib/Test/TypeTiny.pm SHA1 f4fe74dd4196259e5c7501d2f9011606d69f2a0b lib/Type/Coercion.pm SHA1 5fa708890cd0ab595880481884bb8759aa4a726e lib/Type/Coercion/Union.pm SHA1 ea81d8d1b5ea2794912820c999f038a3a8bd3856 lib/Type/Exception.pm SHA1 b0c4b9b8b2e590bebcd12d9d8fc446045726ce5e lib/Type/Exception/Assertion.pm SHA1 55a61fcc46296d70838cd80fdc93ee5fbc1ac0ba lib/Type/Exception/Compilation.pm SHA1 67eadd43720fbacaa1e9af80886b66243827f6b0 lib/Type/Exception/WrongNumberOfParameters.pm SHA1 81bee1209776601540bb6a1e2914c45df7f389da lib/Type/Library.pm SHA1 0a8095653a776b734fca4a5a32ec525f547b1174 lib/Type/Params.pm SHA1 cd63df344d08f9f4133ad3b9d916eacfb7637f15 lib/Type/Parser.pm SHA1 fdad8928ba6d010f64829d89512e672d458f53e5 lib/Type/Registry.pm SHA1 a47ff9d8e650ef6694dd8e4ed415a90ee679f791 lib/Type/Tiny.pm SHA1 ed560ffaebb2e3ac37ef5bfd3d966da7c9805df8 lib/Type/Tiny/Class.pm SHA1 6b92e1282099198e708ef5d978c5b2259ac7619a lib/Type/Tiny/Duck.pm SHA1 7e4df91f51a01956a9211e4f2693555475170820 lib/Type/Tiny/Enum.pm SHA1 cff928ee4709e52cae530c50c3d160f4d8d7e8af lib/Type/Tiny/Intersection.pm SHA1 02d90523154ca83a0610adccfc66fee81b4e3365 lib/Type/Tiny/Manual.pod SHA1 b5c8ce3095a92013e27cea222bc3c9e35815ddb3 lib/Type/Tiny/Manual/Coercions.pod SHA1 7be726547105a9f6b8f24540834b3503a464eb12 lib/Type/Tiny/Manual/Libraries.pod SHA1 53641c4d3db9cce3de405141286a87e2691b749b lib/Type/Tiny/Manual/Params.pod SHA1 a5d063f03a668b29a64725efa3e2d0b1b29ffda1 lib/Type/Tiny/Manual/UsingWithMoo.pod SHA1 196f1a0139e81d34d3d0411dbbe0239c87006927 lib/Type/Tiny/Manual/UsingWithMoose.pod SHA1 11989313f5c5e341e9a8adf84c56e19e0c3ecb8e lib/Type/Tiny/Manual/UsingWithMouse.pod SHA1 6f275259876e125860b5c547b42f1aa43422096a lib/Type/Tiny/Manual/UsingWithOther.pod SHA1 060c81e54d19bc1941fafb8045d1bff579ad1ae7 lib/Type/Tiny/Role.pm SHA1 13cb88021ad99b1b5b62915d09a14e113f06a3f6 lib/Type/Tiny/Union.pm SHA1 2b307767115803d89f656d8907b20a817708d6ef lib/Type/Utils.pm SHA1 aa247c56dd6c3eef1b874d5d9a59565ff8ad93a4 lib/Types/Standard.pm SHA1 7c996aa007bb3a3980511c405527419be23dd8a0 lib/Types/TypeTiny.pm SHA1 ee1c51b2b005e8db6d45812c4c9fde497433e57d meta/changes.pret SHA1 44c50e98f08e14dbcf92f35026920a99d2f4acd2 meta/doap.pret SHA1 6f6df6a5db8d8093f7178cdb6864f286eb5952ff meta/makefile.pret SHA1 39e654d17e476daa474202b52c1713c124e091c0 meta/people.pret SHA1 d80a09a14b667c262e84dbbe5b167afe6eaebdb5 meta/rights.pret SHA1 6b3b58df8a4f99ee06882e9640adb1ce0c2abfe4 t/00-begin.t SHA1 94adc437f57a739b0e83322a681948b0350375d2 t/01-compile.t SHA1 13f4ba0963c2f7529c1973eb3d1952ccee5e3bc7 t/02-api.t SHA1 96a85724daff6e8f04b7194d05e4ab751c13c856 t/arithmetic.t SHA1 69a172f825442dff28b130004b425c3108f3ca05 t/coercion-automatic.t SHA1 8aff7cfecfa7d95bb31aefa01dd52e87f25ecc0b t/coercion-classy.t SHA1 71c02f97765e0d8ac445ddffb53d0d27188d4b95 t/coercion-frozen.t SHA1 88643d5052a8678ec045c4792bf50b4c1627d5a8 t/coercion-inlining.t SHA1 e009266d6abb401d4ebd853d1812e4f29bfb5bb5 t/coercion-modifiers.t SHA1 6a6f29d9b738a422371a3245f1f7332a4ec7c81f t/coercion-union.t SHA1 59c777aeccef6db13a587f3d408bd722af122302 t/coercion.t SHA1 c96eaba352991fe833f8609dacd84881deb75ad1 t/coercions-parameterized.t SHA1 e61079de2bf1ad968d8dab422e3291c2a921aa83 t/dwim-moose.t SHA1 ba1a538edaf3af2e452590a6fab9e6196b02393a t/dwim-mouse.t SHA1 0bd29d2bb9fa197303047f5f91d35c0f3541dbb9 t/eval-lexicalsubs.t SHA1 c388bdc2e0596d66ec72504df93c1ea930a875d5 t/eval.t SHA1 6a2d4d4765b5fa1e922553be42d0a29022a8d385 t/exceptions-stack.t SHA1 2e996a04c2d8f9d92553f0ed2ba5ef6da8041de5 t/exceptions.t SHA1 cf873059221cedf6bec478b403a1ceb262e7a2e0 t/exporter-installer.t SHA1 58dadf52ac4fdf26befdd9c17ccfff9a5af1b179 t/exporter-roleconflict.t SHA1 f9a415937b8a5cbed43fca50433f3bd44f702453 t/exporter.t SHA1 cc7ece50931da50d76068f01d370a8559aca9b55 t/functionparameters.t SHA1 bf2a36374dbfda69102dc39e69ea908d1e8d859a t/gh1.t SHA1 461438f584eee9e10b0414e2aad9d8f6cc016084 t/lib/BiggerLib.pm SHA1 a2396d638af3b1374b9dee7a4a34c385f859ff3c t/lib/DemoLib.pm SHA1 295e3f8e6205a3f584ffb4a8826167f86286bf42 t/library-assert.t SHA1 9c14c53670c85f8f88ab136ec0b0513a5994da29 t/library-is.t SHA1 27f4599180fac64dac30abee029a74f3801fd389 t/library-to.t SHA1 c991cffc795cacc145692b09a9ca6e33cb145e3c t/library-types.t SHA1 13fa57e5f8c8dda9de852f12c27cfe5940cfaa61 t/match-on-type.t SHA1 7fce17a74ccc1abcd8a38d6730a001829848f19e t/moo-coercion.t SHA1 32714b93d0d84193956ad99246f7bde115f007f1 t/moo-exceptions.t SHA1 61fbc072aeb574d2d48301a8c5c29d45bf7f12d5 t/moo-inflation.t SHA1 5710b6b747b566f5a5c05e19c3491bbb082138c5 t/moo.t SHA1 3d81b49b24608421267274c902385768680dfdf0 t/moose-autott.t SHA1 cea80a416f24a01aaddb7337ec096657878fff23 t/moose-coercion.t SHA1 41ef9de6d02119876be6a8bae94c68b5244dd7a2 t/moose.t SHA1 7c4c9b3c5eb992bae511507b8a85d24cf9efbfa7 t/moosextypes-more.t SHA1 54a3df5177606258517e6c81879d8ff74968e174 t/moosextypes.t SHA1 214e2b1132c58a9312205698586c6785b89cce82 t/mouse-coercion.t SHA1 180fd0e8b3ba8d836776a9c7a30243a16e460cf3 t/mouse.t SHA1 d550c0d4900f96984cccbc01c4aef357b1d08420 t/mousextypes.t SHA1 6c9540d0454e3348fa7960c6fbd170ed965360f7 t/oo-classinsideout.t SHA1 78d2cc0e3edde07b0da2aaddc2159de97f4bd956 t/oo-objectaccessor.t SHA1 89c17adf006439ebd807cf2bdc251c47c8e8882b t/parameterization.t SHA1 16c195ee828fbede8b2495a91b33b7e46724d3b5 t/params-badsigs.t SHA1 d4326671e87ee834cb847f8dd06ac72abaa1e6f8 t/params-carping.t SHA1 1013d2c5f2f9e99e43d1fb10d7b40c0e2a6d3cfd t/params-coerce.t SHA1 b79b5916da7b80b23cb5cf1d455a0082eadb56f3 t/params-methods.t SHA1 618c2e8762d0e12d2ed23b7c96ae91b6a70c90e4 t/params-mixednamed.t SHA1 ac9ac0994279db514a3e178254075159bff9d7f1 t/params-named.t SHA1 0d7aa2e04baa82bda6c038ecde66ae87a8e09e78 t/params-noninline.t SHA1 3cfbef8a99b9098d70db8ee10aa211c0d5f13c9e t/params-optional.t SHA1 8b3960f5ca8d29c1cee310914c841f692ebb018f t/params-positional.t SHA1 ea6c08da37b276579f94dbf474481380277d024c t/params-slurpy.t SHA1 bf99cb78a65234c1c906e66f054685d5b57372d9 t/parser.t SHA1 d3fe3e7fc2618fe802d858a6a3de02e3ab2c13e7 t/registry.t SHA1 1a138e763ac487c88ee7d4fcc5fd4acfa5646ff9 t/rt85911.t SHA1 d8c4820e1baa06182934bfa3911a44d24a7d47bc t/rt86004.t SHA1 50f5fe9a71129602c4a5c3129f4db9f495219d5e t/rt86233.t SHA1 1e6ccc08d6adca5820c05099d27dda89ef2befd2 t/rt86239.t SHA1 d3ffb10875a949af2d853ed0675fbe02c0ef8fc9 t/stdlib-mxtmlb-alike.t SHA1 53afc083a22b3a944f77714365ce596c535704bb t/stdlib-optlist.t SHA1 e7ddd8cad949dc66b248a213c5c04c49477c1eaa t/stdlib-overload.t SHA1 d5f4e42b2c9a2685ef4c5eb8e22dc838710e3f93 t/stdlib-strmatch.t SHA1 cb1955207b018b59a074c992e693797ba7f42da9 t/stdlib-structures.t SHA1 d1e87f3acf25e789fe8c59432516e52ef1ab8e40 t/stdlib-tied.t SHA1 2f0a21d894c1b72882836229eb4afc7139dc2f4a t/stdlib.t SHA1 b63bc8cff39f4191d6f6cc8ac5e8fd3aa1eadbea t/subquote.t SHA1 a8d9f929b9e2ad831953102516bfa8b236027c77 t/syntax.t SHA1 d568ccf4b7e54dc78391ac1dc86b46d8a46e7154 t/type-class.t SHA1 3eb8876bb028a0138063a984e5f6eaed5c51e479 t/type-duck.t SHA1 f56976a7ab50bd467886ce9a4ede88d8c356230a t/type-enum.t SHA1 6e8284b962e8b4e2b13747ae92bb647c895e3ee4 t/type-intersection.t SHA1 85be4a2d17bc213211483a4e823d3e714eb87ab5 t/type-role.t SHA1 4d5100ea0b56fe113752f054c8b7e903babc4cd6 t/type-union.t SHA1 c846d3ec58a790618991f7416322dbdc7e7b6cee t/type.t SHA1 c24de2f66695a2038341be5cea9bb8841d6ab1b4 t/validationclass.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.12 (GNU/Linux) iEYEARECAAYFAlIAqS8ACgkQzr+BKGoqfTnLSwCeJ6rKNIuw3NDjSelnUQBXrsDw dj0Anj4QEeqDbjwfg8jT3SbHxkshUiow =yLUb -----END PGP SIGNATURE----- Type-Tiny-0.022/META.ttl0000644000175000017500000025050612200124237012747 0ustar taitai@prefix bugs: . @prefix cpan: . @prefix cpant: . @prefix dc: . @prefix dcs: . @prefix deps: . @prefix dist: . @prefix doap: . @prefix foaf: . @prefix nfo: . @prefix rdfs: . @prefix xsd: . dist:project a doap:Project; doap:name "Type-Tiny"; cpant:perl_version_from [ a nfo:FileDataObject; a nfo:SourceCode; rdfs:label "Type::Tiny"; nfo:fileName "lib/Type/Tiny.pm"; nfo:programmingLanguage "Perl"; ]; cpant:readme_from [ a nfo:Document; a nfo:FileDataObject; nfo:fileName "lib/Type/Tiny/Manual.pod"; ]; cpant:version_from [ a nfo:FileDataObject; a nfo:SourceCode; rdfs:label "Type::Tiny"; nfo:fileName "lib/Type/Tiny.pm"; nfo:programmingLanguage "Perl"; ]; dc:contributor cpan:tobyink; deps:runtime-recommendation [ deps:on "Type::Tie"^^deps:CpanId; rdfs:comment "Type::Tie is needed if you want to constrain the type of a scalar, array or hash variable."@en; ]; deps:runtime-recommendation [ deps:on "Devel::StackTrace"^^deps:CpanId; rdfs:comment "Type::Exception can use Devel::StackTrace for stack traces."@en; ]; deps:runtime-recommendation [ deps:on "Devel::LexAlias 0.05"^^deps:CpanId; rdfs:comment "Devel::LexAlias is useful for some Eval::TypeTiny features."@en; ]; deps:test-requirement [ deps:on "Test::More 0.96"^^deps:CpanId; rdfs:comment "I don't have the patience to maintain a test suite that runs on ancient versions of Test::More."@en; ]; doap:bug-database ; doap:category [ rdfs:label "Moo" ]; doap:category [ rdfs:label "Moose" ]; doap:category [ rdfs:label "Mouse" ]; doap:category [ rdfs:label "Type Constraint" ]; doap:category [ rdfs:label "Type Coercion" ]; doap:category [ rdfs:label "Type Library" ]; doap:category [ rdfs:label "Schema" ]; doap:category [ rdfs:label "Parameter Validation" ]; doap:category [ rdfs:label "Parameter Checking" ]; doap:category [ rdfs:label "Argument Validation" ]; doap:category [ rdfs:label "Argument Checking" ]; doap:category [ rdfs:label "Validation" ]; doap:created "2013-03-23"^^xsd:date; doap:developer cpan:tobyink; doap:download-page ; doap:homepage ; doap:license ; doap:maintainer cpan:tobyink; doap:programming-language "Perl"; doap:release dist:v_0-000_01; doap:release dist:v_0-000_02; doap:release dist:v_0-000_03; doap:release dist:v_0-000_04; doap:release dist:v_0-000_05; doap:release dist:v_0-000_06; doap:release dist:v_0-000_07; doap:release dist:v_0-000_08; doap:release dist:v_0-000_09; doap:release dist:v_0-000_10; doap:release dist:v_0-000_11; doap:release dist:v_0-000_12; doap:release dist:v_0-001; doap:release dist:v_0-002; doap:release dist:v_0-003_01; doap:release dist:v_0-003_02; doap:release dist:v_0-003_03; doap:release dist:v_0-003_04; doap:release dist:v_0-003_05; doap:release dist:v_0-003_06; doap:release dist:v_0-003_07; doap:release dist:v_0-003_08; doap:release dist:v_0-003_09; doap:release dist:v_0-003_10; doap:release dist:v_0-003_11; doap:release dist:v_0-003_12; doap:release dist:v_0-003_13; doap:release dist:v_0-003_14; doap:release dist:v_0-003_15; doap:release dist:v_0-003_16; doap:release dist:v_0-004; doap:release dist:v_0-005_01; doap:release dist:v_0-005_02; doap:release dist:v_0-005_03; doap:release dist:v_0-005_04; doap:release dist:v_0-005_05; doap:release dist:v_0-005_06; doap:release dist:v_0-005_07; doap:release dist:v_0-005_08; doap:release dist:v_0-006; doap:release dist:v_0-007_01; doap:release dist:v_0-007_02; doap:release dist:v_0-007_03; doap:release dist:v_0-007_04; doap:release dist:v_0-007_05; doap:release dist:v_0-007_06; doap:release dist:v_0-007_07; doap:release dist:v_0-007_08; doap:release dist:v_0-007_09; doap:release dist:v_0-007_10; doap:release dist:v_0-008; doap:release dist:v_0-009_01; doap:release dist:v_0-009_02; doap:release dist:v_0-009_03; doap:release dist:v_0-009_04; doap:release dist:v_0-009_05; doap:release dist:v_0-009_06; doap:release dist:v_0-009_07; doap:release dist:v_0-010; doap:release dist:v_0-011_01; doap:release dist:v_0-011_02; doap:release dist:v_0-011_03; doap:release dist:v_0-012; doap:release dist:v_0-013_01; doap:release dist:v_0-014; doap:release dist:v_0-015_01; doap:release dist:v_0-015_02; doap:release dist:v_0-015_03; doap:release dist:v_0-015_04; doap:release dist:v_0-015_05; doap:release dist:v_0-016; doap:release dist:v_0-017_01; doap:release dist:v_0-017_02; doap:release dist:v_0-018; doap:release dist:v_0-019_01; doap:release dist:v_0-020; doap:release dist:v_0-021_01; doap:release dist:v_0-021_02; doap:release dist:v_0-021_03; doap:release dist:v_0-021_04; doap:release dist:v_0-022; doap:repository [ a doap:GitRepository; doap:browse ; ]; doap:shortdesc "tiny, yet Moo(se)-compatible type constraint". dist:v_0-000_01 a cpant:DeveloperRelease; a doap:Version; rdfs:label "Developer preview"; dc:identifier "Type-Tiny-0.000_01"^^xsd:string; dc:issued "2013-04-02"^^xsd:date; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_01"^^xsd:string. dist:v_0-000_02 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_02"^^xsd:string; dc:issued "2013-04-02"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Beginnings of Type::Tiny::Manual."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Anchor enum regexps to beginning and end of string."; ]; dcs:item [ a dcs:Addition; rdfs:label "StrMatch added to Type::Standard."; ]; dcs:item [ a dcs:Addition; rdfs:label "use Type::Library -base"; ]; dcs:item [ a dcs:Addition; rdfs:label "use Type::Library -declare"; ]; dcs:versus dist:v_0-000_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_02"^^xsd:string. dist:v_0-000_03 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_03"^^xsd:string; dc:issued "2013-04-03"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Use more unique stringification for %Moo::HandleMoose::TYPE_MAP keys."; ]; dcs:item [ a dcs:Change; rdfs:label "Make sure Type::Standard's Moose-like built-ins get inflated to real Moose built-in types."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Document Type::Coercion's overloading."; ]; dcs:item [ a dcs:Change; rdfs:label "Create and use compiled type constraint checks; much faster!"; ]; dcs:item [ a dcs:Addition; rdfs:label "Inlined type constraints for all of Type::Standard."; ]; dcs:item [ a dcs:Addition; rdfs:label "Test cases for ScalarRef[`a]."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix the crashing t/moo-inflation.t test case."; ]; dcs:versus dist:v_0-000_02; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_03"^^xsd:string. dist:v_0-000_04 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_04"^^xsd:string; dc:issued "2013-04-03"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Create and use compiled coercions; somewhat faster."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny plus_coercions/minus_coercions/no_coercions methods for creating subtypes with different sets of coercions."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny equals/is_subtype_of/is_supertype_of/is_a_type_of methods for type constraint comparisons."; ]; dcs:item [ a dcs:Addition; rdfs:label "Finally implement Type::Coercion's has_coercion_for_type method."; ]; dcs:item [ a dcs:Change; rdfs:label "Allow coercion code to be expressed as a string; quite a bit faster."; ]; dcs:versus dist:v_0-000_03; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_04"^^xsd:string. dist:v_0-000_05 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_05"^^xsd:string; dc:issued "2013-04-04"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Factor out some functions from test suite into a new module: Test::TypeTiny."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Rearrange test suite slightly."; ]; dcs:item [ a dcs:Change; rdfs:label "Rename Type::Standard module to Types::Standard."; ]; dcs:item [ a dcs:Change; rdfs:label "Types::TypeTiny bootstrapping library now takes care of vaious internal type checking requirements."; ]; dcs:item [ a dcs:Change; rdfs:label "Sanity checks for type constraint names."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix is_parameterized."; ]; dcs:item [ a dcs:Change; rdfs:label "Allow null type constraints with no parent type (e.g. 'Any' in Types::Standard) to be inlined."; ]; dcs:item [ a dcs:Change; rdfs:label "Don't die with full stack trace."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Get Mouse coercions working."; ]; dcs:versus dist:v_0-000_04; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_05"^^xsd:string. dist:v_0-000_06 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_06"^^xsd:string; dc:issued "2013-04-05"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Monkey patch Moose::Meta::TypeConstraint to be able to retrieve Type::Tiny constraints from inflated Moose constraints."; ]; dcs:item [ a dcs:Packaging; rdfs:label "More test cases." ]; dcs:item [ a dcs:Documentation; rdfs:label "Improved documentation of parameterization attributes."; ]; dcs:item [ a dcs:Change; rdfs:label "Footprint reduction: Type::Tiny, Type::Library and Type::Coerce no longer automatically load Types::Standard and Type::Utils."; ]; dcs:item [ a dcs:Change; rdfs:label "Footprint reduction: Type::Tiny and Type::Coercion no longer use if.pm."; ]; dcs:item [ a dcs:Change; rdfs:label "Footprint reduction: Type::Tiny no longer triggers Perl to load its Unicode tables (unless you create a type constraint with a non-ASCII type name)."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny now has an 'inline_assert' function."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Using Type::Tiny with Moo added to manual."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Section in manual comparing Type::Tiny with various other type library frameworks."; ]; dcs:item [ a dcs:Addition; rdfs:label "In Moo, type assertions and coercions are now inlined."; dcs:thanks cpan:mstrout; ]; dcs:versus dist:v_0-000_05; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_06"^^xsd:string. dist:v_0-000_07 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_07"^^xsd:string; dc:issued "2013-04-06"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Packaging; rdfs:label "More test cases." ]; dcs:item [ a dcs:Documentation; rdfs:label "Document constructor for Type::Tiny::Class."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix inlining for Type::Tiny::Intersection."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Types within libraries, if accessed directly rather than exported, did not accept parameters."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Coercion::Union - automatically handles coercion to union types."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix inlining of certain conditionals into coercion code."; ]; dcs:versus dist:v_0-000_06; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_07"^^xsd:string. dist:v_0-000_08 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_08"^^xsd:string; dc:issued "2013-04-07"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Rewrite most of the functions exported by Type::Library-based type libraries to cope better with being used mid-list."; ]; dcs:item [ a dcs:Change; rdfs:label "Most parts of the API that accept Type::Tiny objects (e.g. Type::Utils::from()) now also accept Moose::Meta::TypeConstraint objects."; ]; dcs:item [ a dcs:Addition; rdfs:label "Types::TypeTiny::to_TypeTiny can be used to coerce a Moose type constraint object to Type::Tiny."; ]; dcs:versus dist:v_0-000_07; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_08"^^xsd:string. dist:v_0-000_09 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_09"^^xsd:string; dc:issued "2013-04-08"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Bundle benchmarking scripts."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Tidy up the 'examples' directory."; ]; dcs:item [ a dcs:Packaging; rdfs:label "When generating Moose/Mouse constraints from Type::Tiny objects, prefer to generate anonymous ones."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Fill in the Usage with Moose section of the fine manual."; ]; dcs:versus dist:v_0-000_08; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_09"^^xsd:string. dist:v_0-000_10 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_10"^^xsd:string; dc:issued "2013-04-09"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Improvements to has_coercion_for_{type,value} from Type::Coercion."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix incorrect Test::Requires line in 'mouse-coercion.t'."; ]; dcs:versus dist:v_0-000_09; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_10"^^xsd:string. dist:v_0-000_11 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_11"^^xsd:string; dc:issued "2013-04-11"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Fix prototype for Type::Utils::as."; ]; dcs:item [ a dcs:Change; rdfs:label "No longer need to pass '-moose' parameter when importing a library into a Moose class; only Mouse needs that treatment now."; ]; dcs:versus dist:v_0-000_10; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_11"^^xsd:string. dist:v_0-000_12 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.000_12"^^xsd:string; dc:issued "2013-04-12"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Fix minor typo."; ]; dcs:versus dist:v_0-000_11; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.000_12"^^xsd:string. dist:v_0-001 a doap:Version; rdfs:label "First public release"; dc:identifier "Type-Tiny-0.001"^^xsd:string; dc:issued "2013-04-15"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Minor improvements."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Some inline code assumed that it would be compiled in a package that had 'blessed' imported."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Some inline code wasn't wrapped in parentheses."; ]; dcs:item [ a dcs:Addition; rdfs:label "More test cases for Optional[`a] within Dict[`a]."; ]; dcs:item [ a dcs:Change; rdfs:label "Weaken the reference from a Moose::Meta::TypeConstraint object to its Type::Tiny origin."; ]; dcs:item [ a dcs:Change; rdfs:label "Parameterized type constraints in Types::Standard now do some sanity checking on their arguments."; ]; dcs:item [ a dcs:Change; rdfs:label "Improve test names generated by Test::TypeTiny; allow test scripts to provide test names."; ]; dcs:versus dist:v_0-000_12; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.001"^^xsd:string. dist:v_0-002 a doap:Version; dc:identifier "Type-Tiny-0.002"^^xsd:string; dc:issued "2013-04-26"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Link from Test::TypeTiny to Test::Deep::Type."; ]; dcs:item [ a dcs:Change; rdfs:label "Avoid unnecessarily regenerating parameterized type constraints."; ]; dcs:item [ a dcs:Change; rdfs:label "Make Type::Tiny's has_coercion method more DWIM."; ]; dcs:item [ a dcs:Addition; rdfs:label "Chars and Bytes types added to Types::Standard."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Prevent warnings (about 'my $val' masking a previously declared variable) when several Str checks are being inlined in close proximity, such as Tuple[Str,Str]"; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix method conflicts when exporting type constraints to roles."; dcs:fixes [ bugs:reporter cpan:bowtie ]; dcs:thanks cpan:bowtie; ]; dcs:versus dist:v_0-001; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.002"^^xsd:string. dist:v_0-003_01 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_01"^^xsd:string; dc:issued "2013-04-16"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Link from Test::TypeTiny to Test::Deep::Type."; ]; dcs:item [ a dcs:Change; rdfs:label "Allow a Type::Tiny object to \"freeze\" its coercions. This prevents a Type::Tiny object from becoming out of sync with its equivalent Mouse or Moose constraint objects."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Library packages can now include \"standalone\" Type::Coercion objects, not attached to a type constraint. These can be exported on request."; ]; dcs:item [ a dcs:Addition; rdfs:label "Overload \"+\" operator for Type::Coercion and Type::Tiny allows coercions to be added to each other, and added to type constraints."; ]; dcs:item [ a dcs:Addition; rdfs:label "Build coercions automatically for certain type parameterized constraints. Say there's a Num->Int coercion defined; then we should be able to coerce ArrayRef[Num]->ArrayRef[Int]."; ]; dcs:item [ a dcs:Addition; rdfs:label "Allow subtypes to inherit coercions from their parent type constraint. (They do not by default.)"; ]; dcs:versus dist:v_0-001; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_01"^^xsd:string. dist:v_0-003_02 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_02"^^xsd:string; dc:issued "2013-04-16"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Document how to process sub parameters with Type::Tiny, and point people towards Type::Params."; ]; dcs:item [ a dcs:Change; rdfs:label "Avoid unnecessarily regenerating parameterized type constraints."; ]; dcs:versus dist:v_0-003_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_02"^^xsd:string. dist:v_0-003_03 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_03"^^xsd:string; dc:issued "2013-04-17"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "When inflating Moo type constraints to Moose, don't unnecessarily call 'moose_type' method."; ]; dcs:item [ a dcs:Change; rdfs:label "Make Type::Tiny's has_coercion method more DWIM."; ]; dcs:item [ a dcs:Addition; rdfs:label "Add OptList data type to Types::Standard, plus MkOpt coercion."; ]; dcs:versus dist:v_0-003_02; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_03"^^xsd:string. dist:v_0-003_04 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_04"^^xsd:string; dc:issued "2013-04-18"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Factor out the sub exporting code scattered around (in Type::Utils, Types::TypeTiny and Type::Library) into a single module, Exporter::TypeTiny."; ]; dcs:versus dist:v_0-003_03; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_04"^^xsd:string. dist:v_0-003_05 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_05"^^xsd:string; dc:issued "2013-04-19"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Chars and Bytes types added to Types::Standard."; ]; dcs:item [ a dcs:Addition; rdfs:label "Allow coercions to accept parameters."; ]; dcs:item [ a dcs:Addition; rdfs:label "Encode, Decode, Join and Split coercions added to Types::Standard."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Prevent warnings (about 'my $val' masking a previously declared variable) when several Str checks are being inlined in close proximity, such as Tuple[Str,Str]"; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny::Class now has a plus_constructors method."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Type::Tiny::Manual::Coercions."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Document Exporter::TypeTiny."; ]; dcs:versus dist:v_0-003_04; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_05"^^xsd:string. dist:v_0-003_06 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_06"^^xsd:string; dc:issued "2013-04-25"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "No longer need to add '-mouse' when importing types into Mouse libraries. (Same change as what we did for Moose in 0.000_11.)"; ]; dcs:item [ a dcs:Documentation; rdfs:label "Add lots of stuff to Type::Tiny::Manual::UsingWithMouse."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Document deep coercions (feature added in 0.003_01)."; ]; dcs:item [ a dcs:Change; rdfs:label "Add a bunch of stub methods to Type::Tiny and Type::Coercion in order to make it less necessary to inflate to Moose/Mouse meta objects."; ]; dcs:item [ a dcs:Change; rdfs:label "Various minor changes to Exporter::TypeTiny to make it more Sub::Exporter compatible."; ]; dcs:item [ a dcs:Addition; rdfs:label "Types::TypeTiny::to_TypeTiny can now coerce from a Mouse::Meta::TypeConstraint."; ]; dcs:versus dist:v_0-003_05; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_06"^^xsd:string. dist:v_0-003_07 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_07"^^xsd:string; dc:issued "2013-04-26"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Document usage with Class::InsideOut."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Minor improvements to manual."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix method conflicts when exporting type constraints to roles."; dcs:fixes [ bugs:reporter cpan:bowtie ]; dcs:thanks cpan:bowtie; ]; dcs:versus dist:v_0-003_06; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_07"^^xsd:string. dist:v_0-003_08 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_08"^^xsd:string; dc:issued "2013-04-26"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "ASCII-only strings are now accepted by the Chars constraint in Types::Standard."; ]; dcs:item [ a dcs:Documentation; rdfs:label "More Exporter::TypeTiny docs, including usage with Sub::Exporter::Lexical."; ]; dcs:item [ a dcs:Addition; rdfs:label "Test case using Exporter::TypeTiny with Sub::Exporter::Lexical."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Tiny, Type::Coercion and their subclasses no longer call Types::TypeTiny->import method."; ]; dcs:item [ a dcs:Change; rdfs:label "Types::TypeTiny lazily loads Exporter::TypeTiny - i.e. it loads Exporter::TypeTiny when Types::TypeTiny->import is first called."; ]; dcs:versus dist:v_0-003_07; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_08"^^xsd:string. dist:v_0-003_09 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_09"^^xsd:string; dc:issued "2013-04-28"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Document usage with Params::Check and Object::Accessor."; ]; dcs:item [ a dcs:Addition; rdfs:label "'Tied' type constraint added to Types::Standard."; ]; dcs:item [ a dcs:Change; rdfs:label "If Mouse is already in memory, Type::Tiny will use its super-fast XS subs to validate values when possible."; ]; dcs:versus dist:v_0-003_08; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_09"^^xsd:string. dist:v_0-003_10 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_10"^^xsd:string; dc:issued "2013-04-29"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Improve Exporter::TypeTiny documentation."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Improve advice on inlining type constraints and coercions."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Bump version of Test::More dependency fom 0.88 to 0.96."; ]; dcs:item [ a dcs:Change; rdfs:label "General code tidy-up."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny::SUPPORT_SMARTMATCH constant."; ]; dcs:item [ a dcs:Addition; rdfs:label "Much of the stringy eval stuff has been factored out to a new module: Eval::TypeTiny."; ]; dcs:item [ a dcs:Addition; rdfs:label "Bundle Type::Params, which had previously appeared on CPAN in a separate developer release."; ]; dcs:versus dist:v_0-003_09; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_10"^^xsd:string. dist:v_0-003_11 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_11"^^xsd:string; dc:issued "2013-04-30"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Test cases for Eval::TypeTiny."; ]; dcs:item [ rdfs:label "Automatic coercion for parameterized Dict will no longer drop key/value pairs to force a coercion."; dcs:thanks cpan:mmcleric; rdfs:seeAlso ; ]; dcs:item [ rdfs:label "Automatic coercion for parameterized Tuple will no longer drop values to force a coercion."; dcs:thanks cpan:mmcleric; rdfs:seeAlso ; ]; dcs:versus dist:v_0-003_10; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_11"^^xsd:string. dist:v_0-003_12 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_12"^^xsd:string; dc:issued "2013-05-01"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Allow people to use Carp::{confess,cluck,carp} with Type::Params validators; default is still croak."; ]; dcs:item [ a dcs:Change; rdfs:label "Improved Type::Params documentation."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Sane behaviour for Types::Standard's 'slurpy' function when it appears mid-list."; ]; dcs:item [ rdfs:label "Type::Params validators now explicitly check the number of arguments passed to them."; dcs:thanks cpan:mmcleric; rdfs:seeAlso ; ]; dcs:versus dist:v_0-003_11; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_12"^^xsd:string. dist:v_0-003_13 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_13"^^xsd:string; dc:issued "2013-05-03"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Don't crash in old versions of Moose that have no Class::MOP::_definition_context() function."; ]; dcs:item [ a dcs:Change; rdfs:label "Better documentation and tests of Moose/Mouse-compatible API."; ]; dcs:item [ a dcs:Change; rdfs:label "BAIL_OUT in test suite if 00-compile.t or 01-api.t fail."; ]; dcs:item [ rdfs:label "Fix typo in Type::Params documentation."; dcs:blame cpan:djerius; rdfs:seeAlso ; ]; dcs:versus dist:v_0-003_12; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_13"^^xsd:string. dist:v_0-003_14 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_14"^^xsd:string; dc:issued "2013-05-03"^^xsd:date; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_14"^^xsd:string; rdfs:comment "No functional changes.". dist:v_0-003_15 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_15"^^xsd:string; dc:issued "2013-05-03"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Improvements to to_TypeTiny function, including accepting Validation::Class::Simple objects."; ]; dcs:versus dist:v_0-003_13; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_15"^^xsd:string. dist:v_0-003_16 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.003_16"^^xsd:string; dc:issued "2013-05-05"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Rename Types::Standard::AutomaticCoercion -> Types::Standard::DeepCoercion."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Params produces nicer error messages."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Document that Map[`k,`v] has a deep coercion."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Improve Type::Coercion documentation."; ]; dcs:item [ a dcs:Change; rdfs:label "Minor updates to coderef overloading following Moo 1.002000 release."; ]; dcs:versus dist:v_0-003_15; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.003_16"^^xsd:string. dist:v_0-004 a doap:Version; dc:identifier "Type-Tiny-0.004"^^xsd:string; dc:issued "2013-05-06"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Minor updates to to_TypeTiny following Validation::Class 7.900048 release."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Eval::Closure now strips line breaks and other unsavoury characters from descriptions."; ]; dcs:versus dist:v_0-003_16; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.004"^^xsd:string. dist:v_0-005_01 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.005_01"^^xsd:string; dc:issued "2013-05-07"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Type::Library should require Perl 5.8.1, not 5.8.3."; ]; dcs:item [ a dcs:Addition; rdfs:label "ArrayLike type added to Types::TypeTiny."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Registry." ]; dcs:versus dist:v_0-004; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.005_01"^^xsd:string. dist:v_0-005_02 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.005_02"^^xsd:string; dc:issued "2013-05-14"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Fix a typo in declare_coercion in Type::Tiny::Manual::Coercions."; dcs:blame cpan:mmcleric; ]; dcs:item [ a dcs:Documentation; rdfs:label "Link to Type::Tiny::Manual::Libraries instead of non-existing Type::Tiny::Intro."; dcs:blame cpan:mmcleric; ]; dcs:versus dist:v_0-005_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.005_02"^^xsd:string. dist:v_0-005_03 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.005_03"^^xsd:string; dc:issued "2013-05-14"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Many error conditions now throw exception objects instead of string error messages."; ]; dcs:item [ a dcs:Removal; rdfs:label "Bytes and Chars type constraints removed from Types::Standard."; ]; dcs:item [ a dcs:Removal; rdfs:label "Decode and Encode coercions removed from Types::Standard."; ]; dcs:versus dist:v_0-005_02; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.005_03"^^xsd:string. dist:v_0-005_04 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.005_04"^^xsd:string; dc:issued "2013-05-17"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "All error conditions now throw exception objects instead of string error messages."; ]; dcs:item [ a dcs:Addition; rdfs:label "Deep explanations for Types::Standard::{Map,Maybe,Ref,Dict,Tuple} type constraint assertion failures."; ]; dcs:item [ a dcs:Change; rdfs:label "Test::TypeTiny performs more thorough testing if EXTENDED_TESTING environment variable is set."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fixed bug in non-inlined code for Types::Standard::MkOpt."; ]; dcs:item [ a dcs:Change; rdfs:label "Improved deep explanations for Types::Standard::{ArrayRef,HashRef,ScalarRef}."; ]; dcs:item [ a dcs:Change; rdfs:label "Throw exception if people attempt to set parent types for Type::Tiny::{Class,Role,Duck,Enum,Union,Intersection}."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Exception::Compilation."; ]; dcs:item [ a dcs:Change; rdfs:label "Allow the slurpy tail of a Types::Standard::Tuple to be a treated as a hashref rather than an arrayref."; ]; dcs:versus dist:v_0-005_03; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.005_04"^^xsd:string. dist:v_0-005_05 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.005_05"^^xsd:string; dc:issued "2013-05-24"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Fix warnings under Perl 5.18."; ]; dcs:item [ a dcs:Update; rdfs:label "Suggest newer version of Validation::Class."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny now has an assert_return method, which is used in most places in preference to assert_valid."; ]; dcs:item [ a dcs:Removal; rdfs:label "Removed Type::Registry from the release; it will return at a later date."; ]; dcs:versus dist:v_0-005_04; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.005_05"^^xsd:string. dist:v_0-005_06 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.005_06"^^xsd:string; dc:issued "2013-05-26"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Fold Types::Standard::DeepCoercion into Types::Standard."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix StrMatch to properly support regexps containing slashes."; ]; dcs:versus dist:v_0-005_05; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.005_06"^^xsd:string. dist:v_0-005_07 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.005_07"^^xsd:string; dc:issued "2013-05-28"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Add pure-Perl Mouse to examples/benchmark-constraints.pl."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Assertions using the assert_return pattern were triggering FATAL warnings when inlined with Sub::Quote. Inlined assertions are now prefixed with 'no warnings \"void\";'."; ]; dcs:versus dist:v_0-005_06; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.005_07"^^xsd:string. dist:v_0-005_08 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.005_08"^^xsd:string; dc:issued "2013-05-28"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Update; rdfs:label "Use JSON::PP instead of JSON in test cases, because JSON::PP is a core module since Perl 5.14."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Rearrange test cases; add 00-begin.t."; ]; dcs:versus dist:v_0-005_07; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.005_08"^^xsd:string. dist:v_0-006 a doap:Version; dc:identifier "Type-Tiny-0.006"^^xsd:string; dc:issued "2013-05-28"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Packaging; rdfs:label "Exporter::TypeTiny::mkopt_hash now works."; ]; dcs:versus dist:v_0-005_08; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.006"^^xsd:string. dist:v_0-007_01 a cpant:DeveloperRelease; a doap:Version; rdfs:label "Happy birthday to me..."; dc:identifier "Type-Tiny-0.007_01"^^xsd:string; dc:issued "2013-06-01"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Fix $VERSION defined in Type::Library."; ]; dcs:item [ a dcs:Change; rdfs:label "Re-introduce Type::Registry, with improved parsing thanks to Type::Parser."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Parser." ]; dcs:item [ a dcs:Addition; rdfs:label "Types::Standard now has LaxNum/StrictNum type constraints, and Num selects between them."; ]; dcs:item [ a dcs:Change; rdfs:label "Implemented Types::TypeTiny->meta->get_type."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Generate README from Type::Tiny::Manual instead of Type::Tiny."; ]; dcs:versus dist:v_0-006; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_01"^^xsd:string. dist:v_0-007_02 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.007_02"^^xsd:string; dc:issued "2013-06-04"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Drop use of Carp in Type::Parser."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Improvements to Type::Tiny::Manual."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Improvements to Type::Tiny::Manual::Params, including rewritten manual processing section, and processing type constraints in function signatures via Function::Parameters/Attribute::Constract."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Test cases for usage with Function::Parameters."; ]; dcs:item [ a dcs:Change; rdfs:label "Allow constraint_generators (for parameterizable type constraints) to return full Type::Tiny objects instead of plain coderefs."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Tiny::Duck types now have a parent type constraint of Types::Standard::Object."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Tiny::Role types now have a parent type constraint of Types::Standard::Object."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Tiny::Enum types now have a parent type constraint of Types::Standard::Str."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Tiny::Class types now have an automatically calculated parent type constraint based on @ISA."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Tiny::Union types now have an automatically calculated parent type constraint based on the most specific common parent type constraint."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Tiny::Intersection types now have an arbitrary parent type constraint."; ]; dcs:item [ a dcs:Addition; rdfs:label "New constraints added to Types::Standard: InstanceOf, ConsumerOf, HasMethods and Enum."; dcs:thanks cpan:haarg; ]; dcs:versus dist:v_0-007_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_02"^^xsd:string. dist:v_0-007_03 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.007_03"^^xsd:string; dc:issued "2013-06-08"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Better document Type::Tiny's 'parents' method which differs from the Moose method of the same name."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Inlining of certain deep Dict, Tuple and Map coercions was broken, but Type::Params attempted to inline them anyway, leading to death."; dcs:fixes ; dcs:thanks cpan:djerius; ]; dcs:versus dist:v_0-007_02; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_03"^^xsd:string. dist:v_0-007_04 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.007_04"^^xsd:string; dc:issued "2013-06-09"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "The combination of Dict, Optional and coercions seems to have been broken in certain circumstances."; dcs:fixes ; dcs:thanks cpan:djerius; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Overloading of `$type eq $type` now works in Perl 5.8."; dcs:fixes ; dcs:thanks cpan:mmcleric; ]; dcs:versus dist:v_0-007_03; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_04"^^xsd:string. dist:v_0-007_05 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.007_05"^^xsd:string; dc:issued "2013-06-12"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Add match_on_type and compile_match_on_type to Type::Utils."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Vastly improved documentation for Type::Utils."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Vastly improved documentation for Types::Standard."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Mention Scalar::Does and Type::Tie in manual."; ]; dcs:item [ a dcs:Addition; rdfs:label "Test cases for InstanceOf, ConsumerOf, HasMethods and Enum types defined by Types::Standard."; ]; dcs:item [ a dcs:Change; rdfs:label "Support '0' and '1' as shortcuts for Optional[Any] and Any in Type::Params. (Not documented yet.)"; ]; dcs:versus dist:v_0-007_04; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_05"^^xsd:string. dist:v_0-007_06 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.007_06"^^xsd:string; dc:issued "2013-06-16"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Rearranged documentation for Type::Utils, avoiding previous split into Moose-like and non-Moose-like functions."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Document the evaluation environment used by Eval::TypeTiny."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Exception is now capable of supplying stack traces (requires Devel::StackTrace)."; ]; dcs:item [ a dcs:Change; rdfs:label "Exceptions thrown for Moo isa/coerce now indicate which attribute was involved."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Utils no longer exports 'extends' by default!!"; ]; dcs:item [ rdfs:label "Better prototypes (was `;@`, now `;$`) for parameterizable type 'constants' exported by type libraries."; dcs:thanks cpan:mstrout; ]; dcs:versus dist:v_0-007_05; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_06"^^xsd:string. dist:v_0-007_07 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.007_07"^^xsd:string; dc:issued "2013-06-16"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Partly roll back prototype changes. Now we use `;$` for Perl since 5.14, but `;@`, for older Perls that don't support `;$` so well."; ]; dcs:versus dist:v_0-007_06; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_07"^^xsd:string. dist:v_0-007_08 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.007_08"^^xsd:string; dc:issued "2013-06-17"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Fix problem with interaction between constraints, coercions, and Moose classes that inherit from Moo classes."; dcs:fixes ; dcs:thanks cpan:pjfl; ]; dcs:versus dist:v_0-007_07; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_08"^^xsd:string. dist:v_0-007_09 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.007_09"^^xsd:string; dc:issued "2013-06-18"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Fix problems inlining Dict deep coercions where the target constraint could not be inlined."; dcs:fixes ; dcs:thanks cpan:mmcleric; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix unintuitive Dict deep coercions."; dcs:fixes ; dcs:thanks cpan:mmcleric; ]; dcs:versus dist:v_0-007_08; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_09"^^xsd:string. dist:v_0-007_10 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.007_10"^^xsd:string; dc:issued "2013-06-21"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Type::Parser now supports parentheses in its DSL."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Parser now exports a _std_eval function useful for testing."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fixed many small parsing bugs in Type::Parser."; ]; dcs:item [ a dcs:Change; rdfs:label "Improved error messages from Type::Parser."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Test cases for Type::Parser."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Better test cases for Type::Registry."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Document status of Type::Registry."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "MooseX::Types objects used in Type::Tiny::Union, Type::Tiny::Intersection and parameterized Type::Tiny type constraints would break in some circumstances, as Types::TypeTiny::to_TypeTiny was failing to convert them to native Type::Tiny type constraints."; dcs:fixes ; ]; dcs:versus dist:v_0-007_09; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.007_10"^^xsd:string. dist:v_0-008 a doap:Version; dc:identifier "Type-Tiny-0.008"^^xsd:string; dc:issued "2013-06-21"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Updated NEWS file."; ]; dcs:versus dist:v_0-007_10; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.008"^^xsd:string. dist:v_0-009_01 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.009_01"^^xsd:string; dc:issued "2013-06-21"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Fix error messages from type constraints with null constraint coderefs."; ]; dcs:item [ a dcs:Addition; rdfs:label "Reply::Plugin::TypeTiny."; ]; dcs:versus dist:v_0-008; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.009_01"^^xsd:string. dist:v_0-009_02 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.009_02"^^xsd:string; dc:issued "2013-06-22"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Various minor optimizations for Eval::TypeTiny, Type::Tiny, etc."; ]; dcs:item [ a dcs:Change; rdfs:label "Types::Standard no longer uses Type::Utils."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix for compiled_checks for type constraints inheriting from Type::Tiny::Class, etc."; dcs:fixes ; dcs:thanks cpan:rsimoes; ]; dcs:item [ a dcs:Regression; rdfs:label "Types::Standard types no longer have 'library' attribute set; this subtly breaks Moo type inflation, and breaks the MooX::late test suite which relies on type inflation working correctly."; ]; dcs:versus dist:v_0-009_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.009_02"^^xsd:string. dist:v_0-009_03 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.009_03"^^xsd:string; dc:issued "2013-06-22"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Fix Types::Standard compilation errors under Perl 5.8.x."; ]; dcs:versus dist:v_0-009_02; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.009_03"^^xsd:string. dist:v_0-009_04 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.009_04"^^xsd:string; dc:issued "2013-06-23"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Type::Tiny::Class shouldn't completely trust @ISA when establishing parent class heirarchies."; ]; dcs:item [ a dcs:Change; rdfs:label "Constructors for Type::Tiny subclasses no longer accept the 'constraint' parameter; it doesn't make sense."; ]; dcs:item [ a dcs:Update; rdfs:label "Support Type::API interfaces."; ]; dcs:versus dist:v_0-009_03; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.009_04"^^xsd:string. dist:v_0-009_05 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.009_05"^^xsd:string; dc:issued "2013-06-23"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Type::Registry does the AUTOLOAD thing, so ought to provide a DESTROY method."; ]; dcs:versus dist:v_0-009_04; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.009_05"^^xsd:string. dist:v_0-009_06 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.009_06"^^xsd:string; dc:issued "2013-06-23"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Careful calling the DOES method (it doesn't exist in Perl 5.8)."; ]; dcs:versus dist:v_0-009_05; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.009_06"^^xsd:string. dist:v_0-009_07 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.009_07"^^xsd:string; dc:issued "2013-06-24"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Types::Standard::to_TypeTiny now sets 'display_name' instead of 'name' on generated type constraints."; ]; dcs:item [ a dcs:Packaging; rdfs:label "More test cases for interacting with MooseX::Types type constraints."; ]; dcs:item [ a dcs:Change; rdfs:label "Type::Params no longer uses Type::Utils."; ]; dcs:item [ a dcs:Change; rdfs:label "Subclasses of Type::Tiny reject 'inlined' coderef, just like they already reject 'constraint' coderef."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Make rt86172.t an 'xt' test case because it's causing random CPAN testers failures unrelated to the feature it's supposed to be testing."; ]; dcs:item [ a dcs:Change; rdfs:label "If a Type::Tiny object is instantiated with a Sub::Quote quoted constraint coderef, and no inlined coderef, then Type::Tiny will use Sub::Quote to make an inlined coderef."; ]; dcs:versus dist:v_0-009_06; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.009_07"^^xsd:string. dist:v_0-010 a doap:Version; dc:identifier "Type-Tiny-0.010"^^xsd:string; dc:issued "2013-06-24"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Updated NEWS file."; ]; dcs:versus dist:v_0-009_07; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.010"^^xsd:string. dist:v_0-011_01 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.011_01"^^xsd:string; dc:issued "2013-06-25"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Unions of Type::Tiny and Mouse::Meta::TypeConstraints now work properly. This makes Type::Tiny and MouseX::Types play nice together (much like Type::Tiny already plays nice with MooseX::Types)."; ]; dcs:item [ a dcs:Change; rdfs:label "Cleanups within Type::Coercion. Necessary because in some places the entire type_coercion_map (including conversion coderefs) was passed through Types::Standard::to_TypeTiny, when really only the type constraints should have been."; ]; dcs:item [ a dcs:Addition; rdfs:label "Types::Standard::to_TypeTiny now accepts any object implementing the Type::API::Constraint or Type::API::Constraint::Coercion interfaces. As Mouse::Meta::TypeConstraint implements this interface, specific support for importing Mouse types has been dropped; the generic Type::API import 'just works' for Mouse types."; ]; dcs:item [ a dcs:Addition; rdfs:label "Types::Standard::to_TypeTiny now accepts unblessed coderefs and converts them to type constraints. This allows things like `Int & sub { $_ < 10 }` to work."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "B::SPECIAL-related fix."; dcs:fixes ; dcs:thanks cpan:pjfl; ]; dcs:versus dist:v_0-010; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.011_01"^^xsd:string. dist:v_0-011_02 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.011_02"^^xsd:string; dc:issued "2013-06-25"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Types::Standard 0.009_02 stopped including 'library' attribute in its types, and thus broke MooX::late. Type::Library modified to make 'library' attribute more automatic, and less reliant on Type::Utils to do the right thing."; dcs:thanks cpan:haarg; ]; dcs:versus dist:v_0-011_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.011_02"^^xsd:string. dist:v_0-011_03 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.011_03"^^xsd:string; dc:issued "2013-06-25"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Type::Tiny now overloads `cmp`. Necessary because Mouse does a sort on type constraints in a union, and overload's fallback doesn't seem to cover `cmp` on Perl prior to 5.12."; ]; dcs:versus dist:v_0-011_02; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.011_03"^^xsd:string. dist:v_0-012 a doap:Version; dc:identifier "Type-Tiny-0.012"^^xsd:string; dc:issued "2013-06-25"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Updated NEWS file."; ]; dcs:versus dist:v_0-011_03; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.012"^^xsd:string. dist:v_0-013_01 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.013_01"^^xsd:string; dc:issued "2013-06-27"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Type::Parser's tokenization is now done on a pull basis, allowing one-pass building of the AST."; ]; dcs:item [ a dcs:Removal; rdfs:label "Type::Parser no longer provides a `tokens` function as it no longer pre-emptively tokenizes the whole string it is given."; ]; dcs:item [ a dcs:Removal; rdfs:label "Type::Parser functions no longer accept an arrayref of tokens, as they expect to pull tokens from a stream as required."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Parser now provides a `extract_type` function which parses a type constraint expression from the head of a string and returns a Type::Tiny object, plus the tail of the string. (This is designed to make it easier to use Type::Parser to parse things like function signatures.)"; ]; dcs:versus dist:v_0-012; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.013_01"^^xsd:string. dist:v_0-014 a doap:Version; dc:identifier "Type-Tiny-0.014"^^xsd:string; dc:issued "2013-06-28"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Updated NEWS file."; ]; dcs:versus dist:v_0-013_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.014"^^xsd:string. dist:v_0-015_01 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.015_01"^^xsd:string; dc:issued "2013-07-05"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Type::Parser can now pull in types from MooseX::Types libraries properly."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Utils now provides a `dwim_type` function; this is powered by a hidden Type::Registry::DWIM package."; ]; dcs:versus dist:v_0-014; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.015_01"^^xsd:string. dist:v_0-015_02 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.015_02"^^xsd:string; dc:issued "2013-07-06"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Improvements to DWIMness of Type::Parser for the benefit of `dwim_type`."; ]; dcs:item [ a dcs:Change; rdfs:label "Better test cases for `dwim_type`."; ]; dcs:versus dist:v_0-015_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.015_02"^^xsd:string. dist:v_0-015_03 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.015_03"^^xsd:string; dc:issued "2013-07-08"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "The `dwim_type` function now prioritizes lookups within the caller class' type registry over Types::Standard's built-in types."; ]; dcs:item [ a dcs:Change; rdfs:label "Slight speed improvements for `compile_match_on_type`."; ]; dcs:item [ a dcs:Addition; rdfs:label "Implement TIESCALAR, TIEARRAY and TIEHASH methods for Type::Tiny; this improves Type::Tie integration."; ]; dcs:versus dist:v_0-015_02; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.015_03"^^xsd:string. dist:v_0-015_04 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.015_04"^^xsd:string; dc:issued "2013-07-13"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Mention in Type::Tiny::Manual::Libraries that the `extends` function is no longer exported by default; update example code."; dcs:blame ; dcs:fixes ; dcs:fixes ; rdfs:seeAlso ; ]; dcs:item [ rdfs:label "Allow an inline_as block to return a list of strings (which are implictly joined with &&); allow the first item on the list to be undef, which is treated as the inlined parent type constraint."; dcs:fixes ; dcs:thanks cpan:timb; ]; dcs:item [ a dcs:Documentation; rdfs:label "Clarify when inlining via Sub::Quote may be less efficient than hand-written inlining."; dcs:fixes ; dcs:thanks cpan:timb; ]; dcs:versus dist:v_0-015_03; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.015_04"^^xsd:string. dist:v_0-015_05 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.015_05"^^xsd:string; dc:issued "2013-07-15"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Experimentally drop required version of Perl from 5.8.1 to 5.6.1. I've not been able to extensively test Type-Tiny on Perl 5.6.x, but I believe it should mostly work. (The only feature that seems unlikely to work is non-ASCII names for type constraints and coercions.)"; ]; dcs:item [ a dcs:Change; rdfs:label "Stop monkey-patching Moose::Meta::TypeContraint; it's not necessary and has never been documented."; ]; dcs:versus dist:v_0-015_04; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.015_05"^^xsd:string. dist:v_0-016 a doap:Version; dc:identifier "Type-Tiny-0.016"^^xsd:string; dc:issued "2013-07-16"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Add some pod links."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Updated NEWS file."; ]; dcs:versus dist:v_0-015_05; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.016"^^xsd:string. dist:v_0-017_01 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.017_01"^^xsd:string; dc:issued "2013-07-19"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Update; rdfs:label "Eval::TypeTiny now supports lexical subs under Perl 5.18."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Give an example of the default error messages thrown by Type::Tiny."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Work around lack of B::perlstring() function in Perl 5.6.x."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Improve examples of custom type constraint error message in Type::Utils and Type::Tiny::Manual::Libraries."; dcs:fixes ; dcs:thanks cpan:timb; ]; dcs:item [ a dcs:Documentation; rdfs:label "Fix typo in Types::Standard 'regular exception' -> 'regular expression'."; dcs:blame cpan:markstos; dcs:fixes ; rdfs:seeAlso ; ]; dcs:versus dist:v_0-016; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.017_01"^^xsd:string. dist:v_0-017_02 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.017_02"^^xsd:string; dc:issued "2013-07-20"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Hopefully improved workaround for missing B::perlstring() using Data::Dumper instead of quotemeta()."; dcs:thanks cpan:ribasushi; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Further changes for Perl 5.6.x support."; ]; dcs:versus dist:v_0-017_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.017_02"^^xsd:string. dist:v_0-018 a doap:Version; dc:identifier "Type-Tiny-0.018"^^xsd:string; dc:issued "2013-07-21"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Updated NEWS file."; ]; dcs:versus dist:v_0-017_02; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.018"^^xsd:string. dist:v_0-019_01 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.019_01"^^xsd:string; dc:issued "2013-07-23"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Work around lack of B::perlstring() function in Perl 5.6.x in test suite."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Eval::TypeTiny now closes over variables properly."; ]; dcs:versus dist:v_0-018; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.019_01"^^xsd:string. dist:v_0-020 a doap:Version; dc:identifier "Type-Tiny-0.020"^^xsd:string; dc:issued "2013-07-23"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Documentation; rdfs:label "Updated NEWS file."; ]; dcs:versus dist:v_0-019_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.020"^^xsd:string. dist:v_0-021_01 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.021_01"^^xsd:string; dc:issued "2013-07-24"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny strictly_equals method."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny is_strictly_subtype_of method."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny is_strictly_supertype_of method."; ]; dcs:item [ a dcs:Addition; rdfs:label "Type::Tiny is_strictly_a_type_of method."; ]; dcs:versus dist:v_0-020; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.021_01"^^xsd:string. dist:v_0-021_02 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.021_02"^^xsd:string; dc:issued "2013-07-26"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Use real lexicals again for Eval::TypeTiny; this requires Devel::LexAlias, but there's a fallback to using tied variables."; ]; dcs:versus dist:v_0-021_01; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.021_02"^^xsd:string. dist:v_0-021_03 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.021_03"^^xsd:string; dc:issued "2013-07-30"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "Restore Eval::TypeTiny's pre-0.019_01 behaviour re closing over lexicals, but enable the 0.021_02 behaviour if alias=>1 option is passed in."; ]; dcs:item [ a dcs:Change; rdfs:label "Improve compatibility between Type::Tiny and Moose attribute native traits."; ]; dcs:versus dist:v_0-021_02; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.021_03"^^xsd:string. dist:v_0-021_04 a cpant:DeveloperRelease; a doap:Version; dc:identifier "Type-Tiny-0.021_04"^^xsd:string; dc:issued "2013-07-30"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Bugfix; rdfs:label "Fix Type::Parser's handling of numeric parameters; they shouldn't need quoting."; ]; dcs:item [ a dcs:Packaging; rdfs:label "Add dependency on Exporter 5.57 for older versions of Perl."; ]; dcs:item [ a dcs:Bugfix; rdfs:label "Fix Types::Standard::Dict differentiating between undef and not exists."; dcs:fixes ; dcs:thanks cpan:timb; ]; dcs:versus dist:v_0-021_03; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.021_04"^^xsd:string. dist:v_0-022 a doap:Version; dc:identifier "Type-Tiny-0.022"^^xsd:string; dc:issued "2013-08-06"^^xsd:date; dcs:changeset [ dcs:item [ a dcs:Change; rdfs:label "In Devel::TypeTiny::Perl56Compat, `use strict` and `use warnings`."; ]; dcs:item [ a dcs:Change; rdfs:label "Improved implementations of is_subtype_of/is_strictly_subtype_of; better for subclassing."; ]; dcs:item [ a dcs:Documentation; rdfs:label "Updated NEWS file."; ]; dcs:versus dist:v_0-021_04; ]; dcs:released-by cpan:tobyink; doap:file-release ; doap:revision "0.022"^^xsd:string. cpan:bowtie a foaf:Person; foaf:name "Kevin Dawson"; foaf:nick "BOWTIE"; foaf:page . cpan:djerius a foaf:Person; foaf:name "Diab Jerius"; foaf:nick "DJERIUS"; foaf:page . cpan:haarg a foaf:Person; foaf:name "Graham Knop"; foaf:nick "HAARG"; foaf:page . cpan:ingy a foaf:Person; foaf:name "Ingy döt Net"; foaf:nick "INGY"; foaf:page . cpan:markstos a foaf:Person; foaf:name "Mark Stosberg"; foaf:nick "MARKSTOS"; foaf:page . cpan:mmcleric a foaf:Person; foaf:name "Vyacheslav Matyukhin"; foaf:nick "MMCLERIC"; foaf:page . cpan:mstrout a foaf:Person; foaf:name "Matt S Trout"; foaf:nick "MSTROUT"; foaf:page . cpan:nuffin a foaf:Person; foaf:name "Yuval Kogman"; foaf:nick "NUFFIN"; foaf:page . cpan:pjfl a foaf:Person; foaf:name "Peter Flanigan"; foaf:nick "PJFL"; foaf:page . cpan:ribasushi a foaf:Person; foaf:name "Peter Rabbitson"; foaf:nick "RIBASUSHI"; foaf:page . cpan:rjbs a foaf:Person; foaf:name "Ricardo Signes"; foaf:nick "RJBS"; foaf:page . cpan:rsimoes a foaf:Person; foaf:name "Richard Simões"; foaf:nick "RSIMOES"; foaf:page . cpan:timb a foaf:Person; foaf:name "Tim Bunce"; foaf:nick "TIMB"; foaf:page . cpan:tobyink a foaf:Person; foaf:name "Toby Inkster"; foaf:mbox ; foaf:nick "TOBYINK"; foaf:page . cpan:tokuhirom a foaf:Person; foaf:name "MATSUNO Tokuhiro"; foaf:nick "TOKUHIROM"; foaf:page . foaf:name "Pierre Masci"; foaf:page . dc:title "the same terms as the perl 5 programming language system itself". a bugs:Issue; bugs:id "85895"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "85911"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86001"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86172"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86233"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86239"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86303"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86383"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86813"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86891"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86892"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "86893"^^xsd:string; bugs:page . a bugs:Issue; bugs:id "87443"^^xsd:string; bugs:page . [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "CONTRIBUTING". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "CREDITS". [] a nfo:FileDataObject; a nfo:TextDocument; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "Changes". [] a nfo:FileDataObject; a nfo:TextDocument; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "LICENSE". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "META.ttl". [] a nfo:FileDataObject; a nfo:SourceCode; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "Makefile.PL"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; a nfo:TextDocument; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "NEWS". [] a nfo:FileDataObject; a nfo:TextDocument; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "README". [] a nfo:FileDataObject; a nfo:TextDocument; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "TODO". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "TODO.mm". [] a nfo:FileDataObject; a nfo:SourceCode; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "examples/benchmark-mkopt.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; a nfo:SourceCode; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "examples/benchmark-param-validation.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "meta/changes.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "meta/doap.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "meta/makefile.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "meta/people.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:tobyink; nfo:fileName "meta/rights.pret". [] a nfo:FileDataObject; a nfo:SourceCode; dc:license ; dc:rightsHolder cpan:rjbs; nfo:fileName "inc/Test/Fatal.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; a nfo:SourceCode; dc:license ; dc:rightsHolder cpan:tokuhirom; nfo:fileName "inc/Test/Requires.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; a nfo:SourceCode; dc:license ; dc:rightsHolder cpan:nuffin; nfo:fileName "inc/Try/Tiny.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder cpan:ingy; nfo:fileName "MANIFEST.SKIP". Type-Tiny-0.022/CREDITS0000644000175000017500000000123512200124242012501 0ustar taitaiMaintainer: - Toby Inkster (cpan:TOBYINK) Contributor: - Mark Stosberg (cpan:MARKSTOS) - Diab Jerius (cpan:DJERIUS) - Pierre Masci - Vyacheslav Matyukhin (cpan:MMCLERIC) Thanks: - Matt S Trout (cpan:MSTROUT) - Peter Rabbitson (cpan:RIBASUSHI) - Graham Knop (cpan:HAARG) - Tim Bunce (cpan:TIMB) - Richard Simões (cpan:RSIMOES) - Peter Flanigan (cpan:PJFL) - Kevin Dawson (cpan:BOWTIE) Type-Tiny-0.022/LICENSE0000644000175000017500000004374412200123776012514 0ustar taitaiThis software is copyright (c) 2013 by Toby Inkster . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2013 by Toby Inkster . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2013 by Toby Inkster . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Type-Tiny-0.022/examples/0000755000175000017500000000000012200124456013305 5ustar taitaiType-Tiny-0.022/examples/datetime-coercions.pl0000644000175000017500000000525512161671330017433 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE This example expands upon the Types::Datetime library defined in L. It defines class types for L and L and some structured types for hashes that can be used to instantiate DateTime objects. It defines some coercions for the C class type. A simple L class is provided using some of these types and coercions. The class also defines a couple of extra coercions inline. See the source code of this file for the actual example code. =head1 DEPENDENCIES L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib "lib", "../lib"; BEGIN { package Types::Datetime; use Type::Library -base, -declare => qw( Datetime DatetimeHash Duration EpochHash ); use Type::Utils; use Types::Standard -types; require DateTime; require DateTime::Duration; class_type Datetime, { class => "DateTime" }; class_type Duration, { class => "DateTime::Duration" }; declare DatetimeHash, as Dict[ year => Int, month => Optional[ Int ], day => Optional[ Int ], hour => Optional[ Int ], minute => Optional[ Int ], second => Optional[ Int ], nanosecond => Optional[ Int ], time_zone => Optional[ Str ], ]; declare EpochHash, as Dict[ epoch => Int, time_zone => Optional[ Str ], ]; coerce Datetime, from Int, via { "DateTime"->from_epoch(epoch => $_) }, from Undef, via { "DateTime"->now }, from DatetimeHash, via { "DateTime"->new(%$_) }, from EpochHash, via { "DateTime"->from_epoch(%$_) }; $INC{"Types/Datetime.pm"} = __FILE__; }; BEGIN { package Person; use Moose; use Types::Standard qw( Str Int Num ); use Types::Datetime qw( Datetime Duration ); has name => ( is => "ro", isa => Str, required => 1, ); has age => ( is => "ro", isa => Int->plus_coercions(Num, 'int($_)', Duration, '$_->years'), coerce => 1, init_arg => undef, lazy => 1, builder => "_build_age", ); has date_of_birth => ( is => "ro", isa => Datetime, coerce => 1, required => 1, ); sub _build_age { my $self = shift; return Datetime->class->now - $self->date_of_birth; } }; my $me = Person->new( name => "Toby Inkster", date_of_birth => { epoch => 328646500, time_zone => "Asia/Tokyo" }, ); printf("%s is %d years old.\n", $me->name, $me->age); Type-Tiny-0.022/examples/benchmark-param-validation.pl0000644000175000017500000000640712161671330021035 0ustar taitaiuse strict; use warnings; use feature qw(state); use Benchmark qw(cmpthese); # In today's contest, we'll be comparing Type::Params... # use Type::Params qw( compile validate ); use Type::Utils; use Types::Standard qw( -types ); # ... with Params::Validate... # BEGIN { $ENV{PARAMS_VALIDATE_IMPLEMENTATION} = 'XS' }; # ... which we'll give a fighting chance use Params::Validate qw( validate_pos ARRAYREF SCALAR ); # ... and Data::Validator... use Data::Validator (); use Mouse::Util::TypeConstraints (); # ... and Params::Check... use Params::Check (); # Define custom type constraints... my $PrintAndSay = duck_type PrintAndSay => ["print", "say"]; my $SmallInt = declare SmallInt => as Int, where { $_ < 90 }, inline_as { $_[0]->parent->inline_check($_)." and $_ < 90" }; # ... and for Mouse... my $PrintAndSay2 = Mouse::Util::TypeConstraints::duck_type(PrintAndSay => ["print", "say"]); my $SmallInt2 = Mouse::Util::TypeConstraints::subtype( "SmallInt", Mouse::Util::TypeConstraints::as("Int"), Mouse::Util::TypeConstraints::where(sub { $_ < 90 }), ); sub TypeParams_validate { my @in = validate(\@_, ArrayRef, $PrintAndSay, $SmallInt); } sub TypeParams_compile { state $spec = compile(ArrayRef, $PrintAndSay, $SmallInt); my @in = $spec->(@_); } sub ParamsValidate { state $spec = [ { type => ARRAYREF }, { can => ["print", "say"] }, { type => SCALAR, regex => qr{^\d+$}, callbacks => { 'less than 90' => sub { shift() < 90 } } }, ]; my @in = validate_pos(@_, @$spec); } sub ParamsCheck { state $spec = [ [sub { ref $_[0] eq 'ARRAY' }], [sub { Scalar::Util::blessed($_[0]) and $_[0]->can("print") and $_[0]->can("say") }], [sub { !ref($_[0]) and $_[0] =~ m{^\d+$} and $_[0] < 90 }], ]; # Params::Check::check doesn't support positional parameters. # Params::Check::allow fakery instead. my @in = map { Params::Check::allow($_[$_], $spec->[$_]) ? $_[$_] : die } 0..$#$spec; } sub DataValidator { state $spec = "Data::Validator"->new( first => "ArrayRef", second => $PrintAndSay2, third => $SmallInt2, )->with("StrictSequenced"); my @in = $spec->validate(@_); } # Actually run the benchmarks... # use IO::Handle (); our @data = ( [1, 2, 3], IO::Handle->new, 50, ); cmpthese(-3, { '[D:V]' => q{ DataValidator(@::data) }, '[P:V]' => q{ ParamsValidate(@::data) }, '[P:C]' => q{ ParamsCheck(@::data) }, '[T:P v]' => q{ TypeParams_validate(@::data) }, '[T:P c]' => q{ TypeParams_compile(@::data) }, }); # Now we'll just do a simple check of argument count; not checking any types! print "\n----\n\n"; our $CHK = compile(1, 1, 0); our @ARGS = 1..2; cmpthese(-3, { TypeParamsSimple => q { $::CHK->(@::ARGS) }, ParamsValidateSimple => q { validate_pos(@::ARGS, 1, 1, 0) }, }); __END__ Rate [D:V] [P:V] [P:C] [T:P v] [T:P c] [D:V] 9983/s -- -16% -39% -41% -71% [P:V] 11898/s 19% -- -27% -29% -65% [P:C] 16259/s 63% 37% -- -3% -52% [T:P v] 16797/s 68% 41% 3% -- -51% [T:P c] 34032/s 241% 186% 109% 103% -- ---- Rate ParamsValidateSimple TypeParamsSimple ParamsValidateSimple 74972/s -- -63% TypeParamsSimple 204193/s 172% -- Type-Tiny-0.022/examples/benchmark-mkopt.pl0000644000175000017500000000073512161671330016735 0ustar taitaiuse Benchmark qw(:all); use Data::OptList (); use Exporter::TypeTiny (); use Test::More; our @input = ("a".."i", [], "j".."k"); is_deeply( Data::OptList::mkopt(\@::input), Exporter::TypeTiny::mkopt(\@::input), 'output identical', ); open my $out, '>', \(my $cmp); my $old = select $out; cmpthese(-3, { Data_OptList => q{ Data::OptList::mkopt(\@::input) }, Exporter_TypeTiny => q{ Exporter::TypeTiny::mkopt(\@::input) }, }); select $old; diag $cmp; done_testing; Type-Tiny-0.022/examples/benchmark-coercions.pl0000644000175000017500000000605612161671330017571 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Compares the speed of the constructor in four equivalent classes built using different tools: =over =item B L with L types and non-L coderef coercions. =item B L with L types and coercions. =item B L with L type constraints and coderef coercions. Class is made immutable. =item B L with L type constraints and coercions. Class is made immutable. =back =head1 RESULTS For both Moose and Moo, L type constraints are clearly faster than the conventional approach: Rate Moo_MXTML Moo_TT Moose Moose_TT Moo_MXTML 3412/s -- -33% -49% -60% Moo_TT 5119/s 50% -- -23% -39% Moose 6636/s 94% 30% -- -21% Moose_TT 8452/s 148% 65% 27% -- (Tested versions: Type::Tiny 0.003_16, Moose 2.0604, Moo 1.002000, and MooX::Types::MooseLike 0.16.) =head1 DEPENDENCIES L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Benchmark ':all'; { package Local::Moo_MXTML; use Moo; use MooX::Types::MooseLike::Base qw(HashRef ArrayRef Int is_Int); has attr1 => ( is => "ro", isa => ArrayRef[Int], coerce => sub { is_Int($_[0]) ? [ $_[0] ] : $_[0] }, ); has attr2 => ( is => "ro", isa => HashRef[ArrayRef[Int]], ); } { package Local::Moo_TT; use Moo; use Types::Standard qw(HashRef ArrayRef Int); my $AofI = (ArrayRef[Int])->plus_coercions(Int, '[$_]'); has attr1 => ( is => "ro", isa => $AofI, coerce => $AofI->coercion, ); has attr2 => ( is => "ro", isa => HashRef[ArrayRef[Int]], ); } { package Local::Moose; use Moose; use Moose::Util::TypeConstraints qw(subtype as coerce from via); subtype "AofI", as "ArrayRef[Int]"; coerce "AofI", from "Int", via { [$_] }; has attr1 => ( is => "ro", isa => "AofI", coerce => 1, ); has attr2 => ( is => "ro", isa => "HashRef[ArrayRef[Int]]", ); __PACKAGE__->meta->make_immutable; } { package Local::Moose_TT; use Moose; use Types::Standard qw(HashRef ArrayRef Int); use Sub::Quote; my $AofI = (ArrayRef[Int])->plus_coercions(Int, '[$_]'); has attr1 => ( is => "ro", isa => $AofI, coerce => 1, ); has attr2 => ( is => "ro", isa => HashRef[ArrayRef[Int]], ); __PACKAGE__->meta->make_immutable; } our %data = ( attr1 => 4, attr2 => { one => [0 .. 1], two => [0 .. 2], three => [0 .. 3], }, ); cmpthese(-1, { Moo_MXTML => q{ Local::Moo_MXTML->new(%::data) }, Moo_TT => q{ Local::Moo_TT->new(%::data) }, Moose_TT => q{ Local::Moose_TT->new(%::data) }, Moose => q{ Local::Moose->new(%::data) }, }); Type-Tiny-0.022/examples/benchmark-constraints.pl0000644000175000017500000000714312161671330020152 0ustar taitai=pod =encoding utf-8 =head1 PURPOSE Compares the speed of the constructor in six equivalent classes built using different tools: =over =item B L with L types. =item B L with L types. =item B L with L type constraints. Class is made immutable. =item B L with L type constraints. Class is made immutable. =item B L with L type constraints. Class is made immutable. B<< XS is switched off using C environment variable. >> =item B L with L type constraints. Class is made immutable. B<< XS is switched off using C environment variable. >> =back =head1 RESULTS In all cases, L type constraints are clearly faster than the conventional approach: Rate Moo_MXTML Mouse Moose Moo_TT Mouse_TT Moose_TT Moo_MXTML 2999/s -- -32% -52% -56% -68% -69% Mouse 4436/s 48% -- -29% -34% -52% -54% Moose 6279/s 109% 42% -- -7% -33% -35% Moo_TT 6762/s 125% 52% 8% -- -27% -30% Mouse_TT 9309/s 210% 110% 48% 38% -- -4% Moose_TT 9686/s 223% 118% 54% 43% 4% -- (Tested versions: Type::Tiny 0.005_06, Moose 2.0604, Moo 1.002000, MooX::Types::MooseLike 0.16, and Mouse 1.11) =head1 DEPENDENCIES L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Benchmark ':all'; BEGIN { $ENV{MOUSE_PUREPERL} = 1 }; { package Local::Moo_MXTML; use Moo; use MooX::Types::MooseLike::Base qw(HashRef ArrayRef Int); has attr1 => (is => "ro", isa => ArrayRef[Int]); has attr2 => (is => "ro", isa => HashRef[ArrayRef[Int]]); } { package Local::Moo_TT; use Moo; use Types::Standard qw(HashRef ArrayRef Int); has attr1 => (is => "ro", isa => ArrayRef[Int]); has attr2 => (is => "ro", isa => HashRef[ArrayRef[Int]]); } { package Local::Moose; use Moose; has attr1 => (is => "ro", isa => "ArrayRef[Int]"); has attr2 => (is => "ro", isa => "HashRef[ArrayRef[Int]]"); __PACKAGE__->meta->make_immutable; } { package Local::Moose_TT; use Moose; use Types::Standard qw(HashRef ArrayRef Int); has attr1 => (is => "ro", isa => ArrayRef[Int]); has attr2 => (is => "ro", isa => HashRef[ArrayRef[Int]]); __PACKAGE__->meta->make_immutable; } { package Local::Mouse; use Mouse; has attr1 => (is => "ro", isa => "ArrayRef[Int]"); has attr2 => (is => "ro", isa => "HashRef[ArrayRef[Int]]"); __PACKAGE__->meta->make_immutable; } { package Local::Mouse_TT; use Mouse; use Types::Standard qw(HashRef ArrayRef Int); has attr1 => (is => "ro", isa => ArrayRef[Int]); has attr2 => (is => "ro", isa => HashRef[ArrayRef[Int]]); __PACKAGE__->meta->make_immutable; } our %data = ( attr1 => [1..10], attr2 => { one => [0 .. 1], two => [0 .. 2], three => [0 .. 3], }, ); cmpthese(-1, { Moo_MXTML => q{ Local::Moo_MXTML->new(%::data) }, Moose => q{ Local::Moose->new(%::data) }, Mouse => q{ Local::Mouse->new(%::data) }, Moo_TT => q{ Local::Moo_TT->new(%::data) }, Moose_TT => q{ Local::Moose_TT->new(%::data) }, Mouse_TT => q{ Local::Moose_TT->new(%::data) }, }); Type-Tiny-0.022/Makefile.PL0000644000175000017500000000045012176266405013455 0ustar taitaiuse inc::Module::Package 'RDF:tobyink 0.012'; include "Test::Requires"; include "Test::Fatal"; include "Try::Tiny"; dynamic_config; if ($] < 5.007003) { requires "Scalar::Util" => "1.13"; requires "Text::Balanced" => "1.95"; } if ($] < 5.009001) { requires "Exporter" => "5.57"; } Type-Tiny-0.022/meta/0000755000175000017500000000000012200124456012415 5ustar taitaiType-Tiny-0.022/meta/people.pret0000644000175000017500000000157712172273145014617 0ustar taitai# This file contains data about the project developers. @prefix : . cpan:TOBYINK :name "Toby Inkster"; :mbox . # General credits... cpan:MSTROUT :name "Matt S Trout". cpan:BOWTIE :name "Kevin Dawson". cpan:MMCLERIC :name "Vyacheslav Matyukhin". cpan:DJERIUS :name "Diab Jerius". cpan:HAARG :name "Graham Knop". cpan:PJFL :name "Peter Flanigan". cpan:RSIMOES :name "Richard Simões". :name "Pierre Masci"; :page . cpan:TIMB :name "Tim Bunce". cpan:MARKSTOS :name "Mark Stosberg". cpan:RIBASUSHI :name "Peter Rabbitson". # We bundle some files made by these dudes... cpan:RJBS :name "Ricardo Signes". cpan:TOKUHIROM :name "MATSUNO Tokuhiro". cpan:NUFFIN :name "Yuval Kogman". cpan:INGY :name "Ingy döt Net". Type-Tiny-0.022/meta/changes.pret0000644000175000017500000011351012200123303014710 0ustar taitai# This file acts as the project's changelog. `Type-Tiny 0.000_01 cpan:TOBYINK` issued 2013-04-02; label "Developer preview". `Type-Tiny 0.000_02 cpan:TOBYINK` issued 2013-04-02; changeset [ dcs:versus `Type-Tiny 0.000_01 cpan:TOBYINK`; item "Beginnings of Type::Tiny::Manual."^^Documentation; item "Anchor enum regexps to beginning and end of string."^^Bugfix; item "StrMatch added to Type::Standard."^^Addition; item "use Type::Library -base"^^Addition; item "use Type::Library -declare"^^Addition; ]. `Type-Tiny 0.000_03 cpan:TOBYINK` issued 2013-04-03; changeset [ dcs:versus `Type-Tiny 0.000_02 cpan:TOBYINK`; item "Document Type::Coercion's overloading."^^Documentation; item "Create and use compiled type constraint checks; much faster!"^^Change; item "Inlined type constraints for all of Type::Standard."^^Addition; item "Test cases for ScalarRef[`a]."^^Addition; item "Fix the crashing t/moo-inflation.t test case."^^Bugfix; item "Use more unique stringification for %Moo::HandleMoose::TYPE_MAP keys."^^Change; item "Make sure Type::Standard's Moose-like built-ins get inflated to real Moose built-in types."^^Change; ]. `Type-Tiny 0.000_04 cpan:TOBYINK` issued 2013-04-03; changeset [ dcs:versus `Type-Tiny 0.000_03 cpan:TOBYINK`; item "Create and use compiled coercions; somewhat faster."^^Change; item "Type::Tiny plus_coercions/minus_coercions/no_coercions methods for creating subtypes with different sets of coercions."^^Addition; item "Type::Tiny equals/is_subtype_of/is_supertype_of/is_a_type_of methods for type constraint comparisons."^^Addition; item "Finally implement Type::Coercion's has_coercion_for_type method."^^Addition; item "Allow coercion code to be expressed as a string; quite a bit faster."^^Change; ]. `Type-Tiny 0.000_05 cpan:TOBYINK` issued 2013-04-04; changeset [ dcs:versus `Type-Tiny 0.000_04 cpan:TOBYINK`; item "Factor out some functions from test suite into a new module: Test::TypeTiny."^^Addition; item "Rearrange test suite slightly."^^Packaging; item "Rename Type::Standard module to Types::Standard."^^Change; item "Types::TypeTiny bootstrapping library now takes care of vaious internal type checking requirements."^^Change; item "Sanity checks for type constraint names."^^Change; item "Fix is_parameterized."^^Bugfix; item "Allow null type constraints with no parent type (e.g. 'Any' in Types::Standard) to be inlined."^^Change; item "Don't die with full stack trace."^^Change; item "Get Mouse coercions working."^^Bugfix; ]. `Type-Tiny 0.000_06 cpan:TOBYINK` issued 2013-04-05; changeset [ dcs:versus `Type-Tiny 0.000_05 cpan:TOBYINK`; item "Monkey patch Moose::Meta::TypeConstraint to be able to retrieve Type::Tiny constraints from inflated Moose constraints."^^Addition; item "More test cases."^^Packaging; item "Improved documentation of parameterization attributes."^^Documentation; item "Footprint reduction: Type::Tiny, Type::Library and Type::Coerce no longer automatically load Types::Standard and Type::Utils."^^Change; item "Footprint reduction: Type::Tiny and Type::Coercion no longer use if.pm."^^Change; item "Footprint reduction: Type::Tiny no longer triggers Perl to load its Unicode tables (unless you create a type constraint with a non-ASCII type name)."^^Change; item [ a dcs:Addition; label "In Moo, type assertions and coercions are now inlined."; dcs:thanks cpan:MSTROUT; ]; item "Type::Tiny now has an 'inline_assert' function."^^Addition; item "Using Type::Tiny with Moo added to manual."^^Documentation; item "Section in manual comparing Type::Tiny with various other type library frameworks."^^Documentation; ]. `Type-Tiny 0.000_07 cpan:TOBYINK` issued 2013-04-06; changeset [ dcs:versus `Type-Tiny 0.000_06 cpan:TOBYINK`; item "More test cases."^^Packaging; item "Document constructor for Type::Tiny::Class."^^Documentation; item "Fix inlining for Type::Tiny::Intersection."^^Bugfix; item "Types within libraries, if accessed directly rather than exported, did not accept parameters."^^Bugfix; item "Type::Coercion::Union - automatically handles coercion to union types."^^Addition; item "Fix inlining of certain conditionals into coercion code."^^Bugfix; ]. `Type-Tiny 0.000_08 cpan:TOBYINK` issued 2013-04-07; changeset [ dcs:versus `Type-Tiny 0.000_07 cpan:TOBYINK`; item "Rewrite most of the functions exported by Type::Library-based type libraries to cope better with being used mid-list."^^Change; item "Most parts of the API that accept Type::Tiny objects (e.g. Type::Utils::from()) now also accept Moose::Meta::TypeConstraint objects."^^Change; item "Types::TypeTiny::to_TypeTiny can be used to coerce a Moose type constraint object to Type::Tiny."^^Addition; ]. `Type-Tiny 0.000_09 cpan:TOBYINK` issued 2013-04-08; changeset [ dcs:versus `Type-Tiny 0.000_08 cpan:TOBYINK`; item "Bundle benchmarking scripts."^^Addition; item "Tidy up the 'examples' directory."^^Packaging; item "When generating Moose/Mouse constraints from Type::Tiny objects, prefer to generate anonymous ones."^^Packaging; item "Fill in the Usage with Moose section of the fine manual."^^Documentation; ]. `Type-Tiny 0.000_10 cpan:TOBYINK` issued 2013-04-09; changeset [ dcs:versus `Type-Tiny 0.000_09 cpan:TOBYINK`; item "Improvements to has_coercion_for_{type,value} from Type::Coercion."^^Change; item "Fix incorrect Test::Requires line in 'mouse-coercion.t'."^^Bugfix; ]. `Type-Tiny 0.000_11 cpan:TOBYINK` issued 2013-04-11; changeset [ dcs:versus `Type-Tiny 0.000_10 cpan:TOBYINK`; item "Fix prototype for Type::Utils::as."^^Bugfix; item "No longer need to pass '-moose' parameter when importing a library into a Moose class; only Mouse needs that treatment now."^^Change; ]. `Type-Tiny 0.000_12 cpan:TOBYINK` issued 2013-04-12; changeset [ dcs:versus `Type-Tiny 0.000_11 cpan:TOBYINK`; item "Fix minor typo."^^Documentation; ]. `Type-Tiny 0.001 cpan:TOBYINK` issued 2013-04-15; label "First public release"; changeset [ dcs:versus `Type-Tiny 0.000_12 cpan:TOBYINK`; item "Minor improvements."^^Documentation; item "Some inline code assumed that it would be compiled in a package that had 'blessed' imported."^^Bugfix; item "Some inline code wasn't wrapped in parentheses."^^Bugfix; item "More test cases for Optional[`a] within Dict[`a]."^^Addition; item "Weaken the reference from a Moose::Meta::TypeConstraint object to its Type::Tiny origin."^^Change; item "Parameterized type constraints in Types::Standard now do some sanity checking on their arguments."^^Change; item "Improve test names generated by Test::TypeTiny; allow test scripts to provide test names."^^Change; ]. `Type-Tiny 0.002 cpan:TOBYINK` issued 2013-04-26; changeset [ dcs:versus `Type-Tiny 0.001 cpan:TOBYINK`; item "Link from Test::TypeTiny to Test::Deep::Type."^^Documentation; item "Avoid unnecessarily regenerating parameterized type constraints."^^Change; item "Make Type::Tiny's has_coercion method more DWIM."^^Change; item "Chars and Bytes types added to Types::Standard."^^Addition; item "Prevent warnings (about 'my $val' masking a previously declared variable) when several Str checks are being inlined in close proximity, such as Tuple[Str,Str]"^^Bugfix; item [ a dcs:Bugfix; label "Fix method conflicts when exporting type constraints to roles."; dcs:thanks cpan:BOWTIE; dcs:fixes [ dbug:reporter cpan:BOWTIE ]; ]; ]. `Type-Tiny 0.003_01 cpan:TOBYINK` issued 2013-04-16; changeset [ dcs:versus `Type-Tiny 0.001 cpan:TOBYINK`; item "Link from Test::TypeTiny to Test::Deep::Type."^^Documentation; item "Allow a Type::Tiny object to \"freeze\" its coercions. This prevents a Type::Tiny object from becoming out of sync with its equivalent Mouse or Moose constraint objects."^^Change; item "Type::Library packages can now include \"standalone\" Type::Coercion objects, not attached to a type constraint. These can be exported on request."^^Addition; item "Overload \"+\" operator for Type::Coercion and Type::Tiny allows coercions to be added to each other, and added to type constraints."^^Addition; item "Build coercions automatically for certain type parameterized constraints. Say there's a Num->Int coercion defined; then we should be able to coerce ArrayRef[Num]->ArrayRef[Int]."^^Addition; item "Allow subtypes to inherit coercions from their parent type constraint. (They do not by default.)"^^Addition; ]. `Type-Tiny 0.003_02 cpan:TOBYINK` issued 2013-04-16; changeset [ dcs:versus `Type-Tiny 0.003_01 cpan:TOBYINK`; item "Document how to process sub parameters with Type::Tiny, and point people towards Type::Params."^^Documentation; item "Avoid unnecessarily regenerating parameterized type constraints."^^Change; ]. `Type-Tiny 0.003_03 cpan:TOBYINK` issued 2013-04-17; changeset [ dcs:versus `Type-Tiny 0.003_02 cpan:TOBYINK`; item "When inflating Moo type constraints to Moose, don't unnecessarily call 'moose_type' method."^^Change; item "Make Type::Tiny's has_coercion method more DWIM."^^Change; item "Add OptList data type to Types::Standard, plus MkOpt coercion."^^Addition; ]. `Type-Tiny 0.003_04 cpan:TOBYINK` issued 2013-04-18; changeset [ dcs:versus `Type-Tiny 0.003_03 cpan:TOBYINK`; item "Factor out the sub exporting code scattered around (in Type::Utils, Types::TypeTiny and Type::Library) into a single module, Exporter::TypeTiny."^^Change; ]. `Type-Tiny 0.003_05 cpan:TOBYINK` issued 2013-04-19; changeset [ dcs:versus `Type-Tiny 0.003_04 cpan:TOBYINK`; item "Chars and Bytes types added to Types::Standard."^^Addition; item "Allow coercions to accept parameters."^^Addition; item "Encode, Decode, Join and Split coercions added to Types::Standard."^^Addition; item "Prevent warnings (about 'my $val' masking a previously declared variable) when several Str checks are being inlined in close proximity, such as Tuple[Str,Str]"^^Bugfix; item "Type::Tiny::Class now has a plus_constructors method."^^Addition; item "Type::Tiny::Manual::Coercions."^^Documentation; item "Document Exporter::TypeTiny."^^Documentation; ]. `Type-Tiny 0.003_06 cpan:TOBYINK` issued 2013-04-25; changeset [ dcs:versus `Type-Tiny 0.003_05 cpan:TOBYINK`; item "No longer need to add '-mouse' when importing types into Mouse libraries. (Same change as what we did for Moose in 0.000_11.)"^^Change; item "Add lots of stuff to Type::Tiny::Manual::UsingWithMouse."^^Documentation; item "Document deep coercions (feature added in 0.003_01)."^^Documentation; item "Add a bunch of stub methods to Type::Tiny and Type::Coercion in order to make it less necessary to inflate to Moose/Mouse meta objects."^^Change; item "Various minor changes to Exporter::TypeTiny to make it more Sub::Exporter compatible."^^Change; item "Types::TypeTiny::to_TypeTiny can now coerce from a Mouse::Meta::TypeConstraint."^^Addition; ]. `Type-Tiny 0.003_07 cpan:TOBYINK` issued 2013-04-26; changeset [ dcs:versus `Type-Tiny 0.003_06 cpan:TOBYINK`; item [ a dcs:Bugfix; label "Fix method conflicts when exporting type constraints to roles."; dcs:thanks cpan:BOWTIE; dcs:fixes [ dbug:reporter cpan:BOWTIE ]; ]; item "Document usage with Class::InsideOut."^^Documentation; item "Minor improvements to manual."^^Documentation; ]. `Type-Tiny 0.003_08 cpan:TOBYINK` issued 2013-04-26; changeset [ dcs:versus `Type-Tiny 0.003_07 cpan:TOBYINK`; item "ASCII-only strings are now accepted by the Chars constraint in Types::Standard."^^Change; item "More Exporter::TypeTiny docs, including usage with Sub::Exporter::Lexical."^^Documentation; item "Test case using Exporter::TypeTiny with Sub::Exporter::Lexical."^^Addition; item "Type::Tiny, Type::Coercion and their subclasses no longer call Types::TypeTiny->import method."^^Change; item "Types::TypeTiny lazily loads Exporter::TypeTiny - i.e. it loads Exporter::TypeTiny when Types::TypeTiny->import is first called."^^Change; ]. `Type-Tiny 0.003_09 cpan:TOBYINK` issued 2013-04-28; changeset [ dcs:versus `Type-Tiny 0.003_08 cpan:TOBYINK`; item "Document usage with Params::Check and Object::Accessor."^^Documentation; item "'Tied' type constraint added to Types::Standard."^^Addition; item "If Mouse is already in memory, Type::Tiny will use its super-fast XS subs to validate values when possible."^^Change; ]. `Type-Tiny 0.003_10 cpan:TOBYINK` issued 2013-04-29; changeset [ dcs:versus `Type-Tiny 0.003_09 cpan:TOBYINK`; item "Improve Exporter::TypeTiny documentation."^^Documentation; item "Improve advice on inlining type constraints and coercions."^^Documentation; item "Bump version of Test::More dependency fom 0.88 to 0.96."^^Packaging; item "General code tidy-up."^^Change; item "Type::Tiny::SUPPORT_SMARTMATCH constant."^^Addition; item "Much of the stringy eval stuff has been factored out to a new module: Eval::TypeTiny."^^Addition; item "Bundle Type::Params, which had previously appeared on CPAN in a separate developer release."^^Addition; ]. `Type-Tiny 0.003_11 cpan:TOBYINK` issued 2013-04-30; changeset [ dcs:versus `Type-Tiny 0.003_10 cpan:TOBYINK`; item [ label "Automatic coercion for parameterized Dict will no longer drop key/value pairs to force a coercion."; seealso ; dcs:thanks cpan:MMCLERIC; ]; item [ label "Automatic coercion for parameterized Tuple will no longer drop values to force a coercion."; seealso ; dcs:thanks cpan:MMCLERIC; ]; item "Test cases for Eval::TypeTiny."^^Addition; ]. `Type-Tiny 0.003_12 cpan:TOBYINK` issued 2013-05-01; changeset [ dcs:versus `Type-Tiny 0.003_11 cpan:TOBYINK`; item [ label "Type::Params validators now explicitly check the number of arguments passed to them."; seealso ; dcs:thanks cpan:MMCLERIC; ]; item "Allow people to use Carp::{confess,cluck,carp} with Type::Params validators; default is still croak."^^Change; item "Improved Type::Params documentation."^^Change; item "Sane behaviour for Types::Standard's 'slurpy' function when it appears mid-list."^^Bugfix; ]. `Type-Tiny 0.003_13 cpan:TOBYINK` issued 2013-05-03; changeset [ dcs:versus `Type-Tiny 0.003_12 cpan:TOBYINK`; item [ label "Fix typo in Type::Params documentation."; seealso ; dcs:blame cpan:DJERIUS; ]; item "Don't crash in old versions of Moose that have no Class::MOP::_definition_context() function."^^Bugfix; item "Better documentation and tests of Moose/Mouse-compatible API."^^Change; item "BAIL_OUT in test suite if 00-compile.t or 01-api.t fail."^^Change; ]. `Type-Tiny 0.003_14 cpan:TOBYINK` comment "No functional changes."; issued 2013-05-03. `Type-Tiny 0.003_15 cpan:TOBYINK` issued 2013-05-03; changeset [ dcs:versus `Type-Tiny 0.003_13 cpan:TOBYINK`; # !!! item "Improvements to to_TypeTiny function, including accepting Validation::Class::Simple objects."^^Addition; ]. `Type-Tiny 0.003_16 cpan:TOBYINK` issued 2013-05-05; changeset [ dcs:versus `Type-Tiny 0.003_15 cpan:TOBYINK`; item "Rename Types::Standard::AutomaticCoercion -> Types::Standard::DeepCoercion."^^Change; item "Type::Params produces nicer error messages."^^Change; item "Document that Map[`k,`v] has a deep coercion."^^Documentation; item "Improve Type::Coercion documentation."^^Documentation; item "Minor updates to coderef overloading following Moo 1.002000 release."^^Change; ]. `Type-Tiny 0.004 cpan:TOBYINK` issued 2013-05-06; changeset [ dcs:versus `Type-Tiny 0.003_16 cpan:TOBYINK`; item "Minor updates to to_TypeTiny following Validation::Class 7.900048 release."^^Change; item "Eval::Closure now strips line breaks and other unsavoury characters from descriptions."^^Bugfix; ]. `Type-Tiny 0.005_01 cpan:TOBYINK` issued 2013-05-07; changeset [ dcs:versus `Type-Tiny 0.004 cpan:TOBYINK`; item "Type::Library should require Perl 5.8.1, not 5.8.3."^^Bugfix; item "ArrayLike type added to Types::TypeTiny."^^Addition; item "Type::Registry."^^Addition; ]. `Type-Tiny 0.005_02 cpan:TOBYINK` issued 2013-05-14; changeset [ dcs:versus `Type-Tiny 0.005_01 cpan:TOBYINK`; item [ a dcs:Documentation; label "Fix a typo in declare_coercion in Type::Tiny::Manual::Coercions."; dcs:blame cpan:MMCLERIC; ]; item [ a dcs:Documentation; label "Link to Type::Tiny::Manual::Libraries instead of non-existing Type::Tiny::Intro."; dcs:blame cpan:MMCLERIC; ]; ]. `Type-Tiny 0.005_03 cpan:TOBYINK` issued 2013-05-14; changeset [ dcs:versus `Type-Tiny 0.005_02 cpan:TOBYINK`; item "Many error conditions now throw exception objects instead of string error messages."^^Change; item "Bytes and Chars type constraints removed from Types::Standard."^^Removal; item "Decode and Encode coercions removed from Types::Standard."^^Removal; ]. `Type-Tiny 0.005_04 cpan:TOBYINK` issued 2013-05-17; changeset [ dcs:versus `Type-Tiny 0.005_03 cpan:TOBYINK`; item "All error conditions now throw exception objects instead of string error messages."^^Change; item "Deep explanations for Types::Standard::{Map,Maybe,Ref,Dict,Tuple} type constraint assertion failures."^^Addition; item "Test::TypeTiny performs more thorough testing if EXTENDED_TESTING environment variable is set."^^Change; item "Fixed bug in non-inlined code for Types::Standard::MkOpt."^^Bugfix; item "Improved deep explanations for Types::Standard::{ArrayRef,HashRef,ScalarRef}."^^Change; item "Throw exception if people attempt to set parent types for Type::Tiny::{Class,Role,Duck,Enum,Union,Intersection}."^^Change; item "Type::Exception::Compilation."^^Addition; item "Allow the slurpy tail of a Types::Standard::Tuple to be a treated as a hashref rather than an arrayref."^^Change; ]. `Type-Tiny 0.005_05 cpan:TOBYINK` issued 2013-05-24; changeset [ dcs:versus `Type-Tiny 0.005_04 cpan:TOBYINK`; item "Fix warnings under Perl 5.18."^^Change; item "Suggest newer version of Validation::Class."^^Update; item "Type::Tiny now has an assert_return method, which is used in most places in preference to assert_valid."^^Addition; item "Removed Type::Registry from the release; it will return at a later date."^^Removal; ]. `Type-Tiny 0.005_06 cpan:TOBYINK` issued 2013-05-26; changeset [ dcs:versus `Type-Tiny 0.005_05 cpan:TOBYINK`; item "Fold Types::Standard::DeepCoercion into Types::Standard."^^Change; item "Fix StrMatch to properly support regexps containing slashes."^^Bugfix; ]. `Type-Tiny 0.005_07 cpan:TOBYINK` issued 2013-05-28; changeset [ dcs:versus `Type-Tiny 0.005_06 cpan:TOBYINK`; item "Add pure-Perl Mouse to examples/benchmark-constraints.pl."^^Addition; item "Assertions using the assert_return pattern were triggering FATAL warnings when inlined with Sub::Quote. Inlined assertions are now prefixed with 'no warnings \"void\";'."^^Bugfix; ]. `Type-Tiny 0.005_08 cpan:TOBYINK` issued 2013-05-28; changeset [ dcs:versus `Type-Tiny 0.005_07 cpan:TOBYINK`; item "Use JSON::PP instead of JSON in test cases, because JSON::PP is a core module since Perl 5.14."^^Update; item "Rearrange test cases; add 00-begin.t."^^Packaging; ]. `Type-Tiny 0.006 cpan:TOBYINK` issued 2013-05-28; changeset [ dcs:versus `Type-Tiny 0.005_08 cpan:TOBYINK`; item "Exporter::TypeTiny::mkopt_hash now works."^^Packaging; ]. `Type-Tiny 0.007_01 cpan:TOBYINK` issued 2013-06-01; label "Happy birthday to me..."; changeset [ dcs:versus `Type-Tiny 0.006 cpan:TOBYINK`; item "Fix $VERSION defined in Type::Library."^^Bugfix; item "Re-introduce Type::Registry, with improved parsing thanks to Type::Parser."^^Change; item "Type::Parser."^^Addition; item "Types::Standard now has LaxNum/StrictNum type constraints, and Num selects between them."^^Addition; item "Implemented Types::TypeTiny->meta->get_type."^^Change; item "Generate README from Type::Tiny::Manual instead of Type::Tiny."^^Packaging; ]. `Type-Tiny 0.007_02 cpan:TOBYINK` issued 2013-06-04; changeset [ dcs:versus `Type-Tiny 0.007_01 cpan:TOBYINK`; item "Drop use of Carp in Type::Parser."^^Change; item "Improvements to Type::Tiny::Manual."^^Documentation; item "Improvements to Type::Tiny::Manual::Params, including rewritten manual processing section, and processing type constraints in function signatures via Function::Parameters/Attribute::Constract."^^Documentation; item "Test cases for usage with Function::Parameters."^^Packaging; item "Allow constraint_generators (for parameterizable type constraints) to return full Type::Tiny objects instead of plain coderefs."^^Change; item "Type::Tiny::Duck types now have a parent type constraint of Types::Standard::Object."^^Change; item "Type::Tiny::Role types now have a parent type constraint of Types::Standard::Object."^^Change; item "Type::Tiny::Enum types now have a parent type constraint of Types::Standard::Str."^^Change; item "Type::Tiny::Class types now have an automatically calculated parent type constraint based on @ISA."^^Change; item "Type::Tiny::Union types now have an automatically calculated parent type constraint based on the most specific common parent type constraint."^^Change; item "Type::Tiny::Intersection types now have an arbitrary parent type constraint."^^Change; item [ a dcs:Addition; label "New constraints added to Types::Standard: InstanceOf, ConsumerOf, HasMethods and Enum."; dcs:thanks cpan:HAARG; ]; ]. `Type-Tiny 0.007_03 cpan:TOBYINK` issued 2013-06-08; changeset [ dcs:versus `Type-Tiny 0.007_02 cpan:TOBYINK`; item "Better document Type::Tiny's 'parents' method which differs from the Moose method of the same name."^^Documentation; item [ a dcs:Bugfix; dcs:fixes RT#85911; label "Inlining of certain deep Dict, Tuple and Map coercions was broken, but Type::Params attempted to inline them anyway, leading to death."; dcs:thanks cpan:DJERIUS; ]; ]. `Type-Tiny 0.007_04 cpan:TOBYINK` issued 2013-06-09; changeset [ dcs:versus `Type-Tiny 0.007_03 cpan:TOBYINK`; item [ a dcs:Bugfix; dcs:fixes RT#86001; label "The combination of Dict, Optional and coercions seems to have been broken in certain circumstances."; dcs:thanks cpan:DJERIUS; ]; item [ a dcs:Bugfix; dcs:fixes RT#85895; label "Overloading of `$type eq $type` now works in Perl 5.8."; dcs:thanks cpan:MMCLERIC; ]; ]. `Type-Tiny 0.007_05 cpan:TOBYINK` issued 2013-06-12; changeset [ dcs:versus `Type-Tiny 0.007_04 cpan:TOBYINK`; item "Add match_on_type and compile_match_on_type to Type::Utils."^^Addition; item "Vastly improved documentation for Type::Utils."^^Documentation; item "Vastly improved documentation for Types::Standard."^^Documentation; item "Mention Scalar::Does and Type::Tie in manual."^^Documentation; item "Test cases for InstanceOf, ConsumerOf, HasMethods and Enum types defined by Types::Standard."^^Addition; item "Support '0' and '1' as shortcuts for Optional[Any] and Any in Type::Params. (Not documented yet.)"^^Change; ]. `Type-Tiny 0.007_06 cpan:TOBYINK` issued 2013-06-16; changeset [ dcs:versus `Type-Tiny 0.007_05 cpan:TOBYINK`; item "Rearranged documentation for Type::Utils, avoiding previous split into Moose-like and non-Moose-like functions."^^Documentation; item "Document the evaluation environment used by Eval::TypeTiny."^^Documentation; item "Type::Exception is now capable of supplying stack traces (requires Devel::StackTrace)."^^Addition; item "Exceptions thrown for Moo isa/coerce now indicate which attribute was involved."^^Change; item "Type::Utils no longer exports 'extends' by default!!"^^Change; item [ label "Better prototypes (was `;@`, now `;$`) for parameterizable type 'constants' exported by type libraries."; dcs:thanks cpan:MSTROUT; ]; ]. `Type-Tiny 0.007_07 cpan:TOBYINK` issued 2013-06-16; changeset [ dcs:versus `Type-Tiny 0.007_06 cpan:TOBYINK`; item "Partly roll back prototype changes. Now we use `;$` for Perl since 5.14, but `;@`, for older Perls that don't support `;$` so well."^^Bugfix; ]. `Type-Tiny 0.007_08 cpan:TOBYINK` issued 2013-06-17; changeset [ dcs:versus `Type-Tiny 0.007_07 cpan:TOBYINK`; item [ a dcs:Bugfix; label "Fix problem with interaction between constraints, coercions, and Moose classes that inherit from Moo classes."; dcs:fixes RT#86172; dcs:thanks cpan:PJFL; ]; ]. `Type-Tiny 0.007_09 cpan:TOBYINK` issued 2013-06-18; changeset [ dcs:versus `Type-Tiny 0.007_08 cpan:TOBYINK`; item [ a dcs:Bugfix; label "Fix problems inlining Dict deep coercions where the target constraint could not be inlined."; dcs:fixes RT#86233; dcs:thanks cpan:MMCLERIC; ]; item [ a dcs:Bugfix; label "Fix unintuitive Dict deep coercions."; dcs:fixes RT#86239; dcs:thanks cpan:MMCLERIC; ]; ]. `Type-Tiny 0.007_10 cpan:TOBYINK` issued 2013-06-21; changeset [ dcs:versus `Type-Tiny 0.007_09 cpan:TOBYINK`; item [ a dcs:Bugfix; label "MooseX::Types objects used in Type::Tiny::Union, Type::Tiny::Intersection and parameterized Type::Tiny type constraints would break in some circumstances, as Types::TypeTiny::to_TypeTiny was failing to convert them to native Type::Tiny type constraints."; dcs:fixes RT#86303; ]; item "Type::Parser now supports parentheses in its DSL."^^Addition; item "Type::Parser now exports a _std_eval function useful for testing."^^Addition; item "Fixed many small parsing bugs in Type::Parser."^^Bugfix; item "Improved error messages from Type::Parser."^^Change; item "Test cases for Type::Parser."^^Packaging; item "Better test cases for Type::Registry."^^Packaging; item "Document status of Type::Registry."^^Documentation; ]. `Type-Tiny 0.008 cpan:TOBYINK` issued 2013-06-21; changeset [ dcs:versus `Type-Tiny 0.007_10 cpan:TOBYINK`; item "Updated NEWS file."^^Documentation; ]. `Type-Tiny 0.009_01 cpan:TOBYINK` issued 2013-06-21; changeset [ dcs:versus `Type-Tiny 0.008 cpan:TOBYINK`; item "Fix error messages from type constraints with null constraint coderefs."^^Bugfix; item "Reply::Plugin::TypeTiny."^^Addition; ]. `Type-Tiny 0.009_02 cpan:TOBYINK` issued 2013-06-22; changeset [ dcs:versus `Type-Tiny 0.009_01 cpan:TOBYINK`; item [ a dcs:Bugfix; label "Fix for compiled_checks for type constraints inheriting from Type::Tiny::Class, etc."; dcs:fixes ; dcs:thanks cpan:RSIMOES; ]; item "Various minor optimizations for Eval::TypeTiny, Type::Tiny, etc."^^Change; item "Types::Standard no longer uses Type::Utils."^^Change; item [ a dcs:Regression; label "Types::Standard types no longer have 'library' attribute set; this subtly breaks Moo type inflation, and breaks the MooX::late test suite which relies on type inflation working correctly."; ]; ]. `Type-Tiny 0.009_03 cpan:TOBYINK` issued 2013-06-22; changeset [ dcs:versus `Type-Tiny 0.009_02 cpan:TOBYINK`; item "Fix Types::Standard compilation errors under Perl 5.8.x."^^Bugfix; ]. `Type-Tiny 0.009_04 cpan:TOBYINK` issued 2013-06-23; changeset [ dcs:versus `Type-Tiny 0.009_03 cpan:TOBYINK`; item "Type::Tiny::Class shouldn't completely trust @ISA when establishing parent class heirarchies."^^Bugfix; item "Constructors for Type::Tiny subclasses no longer accept the 'constraint' parameter; it doesn't make sense."^^Change; item "Support Type::API interfaces."^^Update; ]. `Type-Tiny 0.009_05 cpan:TOBYINK` issued 2013-06-23; changeset [ dcs:versus `Type-Tiny 0.009_04 cpan:TOBYINK`; item "Type::Registry does the AUTOLOAD thing, so ought to provide a DESTROY method."^^Bugfix; ]. `Type-Tiny 0.009_06 cpan:TOBYINK` issued 2013-06-23; changeset [ dcs:versus `Type-Tiny 0.009_05 cpan:TOBYINK`; item "Careful calling the DOES method (it doesn't exist in Perl 5.8)."^^Bugfix; ]. `Type-Tiny 0.009_07 cpan:TOBYINK` issued 2013-06-24; changeset [ dcs:versus `Type-Tiny 0.009_06 cpan:TOBYINK`; item "Types::Standard::to_TypeTiny now sets 'display_name' instead of 'name' on generated type constraints."^^Change; item "More test cases for interacting with MooseX::Types type constraints."^^Packaging; item "Type::Params no longer uses Type::Utils."^^Change; item "Subclasses of Type::Tiny reject 'inlined' coderef, just like they already reject 'constraint' coderef."^^Change; item "Make rt86172.t an 'xt' test case because it's causing random CPAN testers failures unrelated to the feature it's supposed to be testing."^^Packaging; item "If a Type::Tiny object is instantiated with a Sub::Quote quoted constraint coderef, and no inlined coderef, then Type::Tiny will use Sub::Quote to make an inlined coderef."^^Change; ]. `Type-Tiny 0.010 cpan:TOBYINK` issued 2013-06-24; changeset [ dcs:versus `Type-Tiny 0.009_07 cpan:TOBYINK`; item "Updated NEWS file."^^Documentation; ]. `Type-Tiny 0.011_01 cpan:TOBYINK` issued 2013-06-25; changeset [ dcs:versus `Type-Tiny 0.010 cpan:TOBYINK`; item "Unions of Type::Tiny and Mouse::Meta::TypeConstraints now work properly. This makes Type::Tiny and MouseX::Types play nice together (much like Type::Tiny already plays nice with MooseX::Types)."^^Bugfix; item "Cleanups within Type::Coercion. Necessary because in some places the entire type_coercion_map (including conversion coderefs) was passed through Types::Standard::to_TypeTiny, when really only the type constraints should have been."^^Change; item "Types::Standard::to_TypeTiny now accepts any object implementing the Type::API::Constraint or Type::API::Constraint::Coercion interfaces. As Mouse::Meta::TypeConstraint implements this interface, specific support for importing Mouse types has been dropped; the generic Type::API import 'just works' for Mouse types."^^Addition; item "Types::Standard::to_TypeTiny now accepts unblessed coderefs and converts them to type constraints. This allows things like `Int & sub { $_ < 10 }` to work."^^Addition; item [ a dcs:Bugfix; label "B::SPECIAL-related fix."; dcs:fixes RT#86383; dcs:thanks cpan:PJFL; ]; ]. `Type-Tiny 0.011_02 cpan:TOBYINK` issued 2013-06-25; changeset [ dcs:versus `Type-Tiny 0.011_01 cpan:TOBYINK`; item [ a dcs:Bugfix; label "Types::Standard 0.009_02 stopped including 'library' attribute in its types, and thus broke MooX::late. Type::Library modified to make 'library' attribute more automatic, and less reliant on Type::Utils to do the right thing."; dcs:thanks cpan:HAARG; ]; ]. `Type-Tiny 0.011_03 cpan:TOBYINK` issued 2013-06-25; changeset [ dcs:versus `Type-Tiny 0.011_02 cpan:TOBYINK`; item "Type::Tiny now overloads `cmp`. Necessary because Mouse does a sort on type constraints in a union, and overload's fallback doesn't seem to cover `cmp` on Perl prior to 5.12."^^Bugfix; ]. `Type-Tiny 0.012 cpan:TOBYINK` issued 2013-06-25; changeset [ dcs:versus `Type-Tiny 0.011_03 cpan:TOBYINK`; item "Updated NEWS file."^^Documentation; ]. `Type-Tiny 0.013_01 cpan:TOBYINK` issued 2013-06-27; changeset [ dcs:versus `Type-Tiny 0.012 cpan:TOBYINK`; item "Type::Parser's tokenization is now done on a pull basis, allowing one-pass building of the AST."^^Change; item "Type::Parser no longer provides a `tokens` function as it no longer pre-emptively tokenizes the whole string it is given."^^Removal; item "Type::Parser functions no longer accept an arrayref of tokens, as they expect to pull tokens from a stream as required."^^Removal; item "Type::Parser now provides a `extract_type` function which parses a type constraint expression from the head of a string and returns a Type::Tiny object, plus the tail of the string. (This is designed to make it easier to use Type::Parser to parse things like function signatures.)"^^Addition; ]. `Type-Tiny 0.014 cpan:TOBYINK` issued 2013-06-28; changeset [ dcs:versus `Type-Tiny 0.013_01 cpan:TOBYINK`; item "Updated NEWS file."^^Documentation; ]. `Type-Tiny 0.015_01 cpan:TOBYINK` issued 2013-07-05; changeset [ dcs:versus `Type-Tiny 0.014 cpan:TOBYINK`; item "Type::Parser can now pull in types from MooseX::Types libraries properly."^^Change; item "Type::Utils now provides a `dwim_type` function; this is powered by a hidden Type::Registry::DWIM package."^^Addition; ]. `Type-Tiny 0.015_02 cpan:TOBYINK` issued 2013-07-06; changeset [ dcs:versus `Type-Tiny 0.015_01 cpan:TOBYINK`; item "Improvements to DWIMness of Type::Parser for the benefit of `dwim_type`."^^Change; item "Better test cases for `dwim_type`."^^Change; ]. `Type-Tiny 0.015_03 cpan:TOBYINK` issued 2013-07-08; changeset [ dcs:versus `Type-Tiny 0.015_02 cpan:TOBYINK`; item "The `dwim_type` function now prioritizes lookups within the caller class' type registry over Types::Standard's built-in types."^^Change; item "Slight speed improvements for `compile_match_on_type`."^^Change; item "Implement TIESCALAR, TIEARRAY and TIEHASH methods for Type::Tiny; this improves Type::Tie integration."^^Addition; ]. `Type-Tiny 0.015_04 cpan:TOBYINK` issued 2013-07-13; changeset [ dcs:versus `Type-Tiny 0.015_03 cpan:TOBYINK`; item [ a dcs:Documentation; label "Mention in Type::Tiny::Manual::Libraries that the `extends` function is no longer exported by default; update example code."; dcs:blame ; dcs:fixes RT#86813, ; seealso ; ]; item [ label "Allow an inline_as block to return a list of strings (which are implictly joined with &&); allow the first item on the list to be undef, which is treated as the inlined parent type constraint."; dcs:thanks cpan:TIMB; dcs:fixes RT#86891; ]; item [ a dcs:Documentation; label "Clarify when inlining via Sub::Quote may be less efficient than hand-written inlining."; dcs:thanks cpan:TIMB; dcs:fixes RT#86893; ]; ]. `Type-Tiny 0.015_05 cpan:TOBYINK` issued 2013-07-15; changeset [ dcs:versus `Type-Tiny 0.015_04 cpan:TOBYINK`; item "Experimentally drop required version of Perl from 5.8.1 to 5.6.1. I've not been able to extensively test Type-Tiny on Perl 5.6.x, but I believe it should mostly work. (The only feature that seems unlikely to work is non-ASCII names for type constraints and coercions.)"^^Change; item "Stop monkey-patching Moose::Meta::TypeContraint; it's not necessary and has never been documented."^^Change; ]. `Type-Tiny 0.016 cpan:TOBYINK` issued 2013-07-16; changeset [ dcs:versus `Type-Tiny 0.015_05 cpan:TOBYINK`; item "Add some pod links."^^Documentation; item "Updated NEWS file."^^Documentation; ]. `Type-Tiny 0.017_01 cpan:TOBYINK` issued 2013-07-19; changeset [ dcs:versus `Type-Tiny 0.016 cpan:TOBYINK`; item "Eval::TypeTiny now supports lexical subs under Perl 5.18."^^Update; item [ a dcs:Documentation; label "Improve examples of custom type constraint error message in Type::Utils and Type::Tiny::Manual::Libraries."; dcs:thanks cpan:TIMB; dcs:fixes RT#86892; ]; item "Give an example of the default error messages thrown by Type::Tiny."^^Documentation; item [ a dcs:Documentation; label "Fix typo in Types::Standard 'regular exception' -> 'regular expression'."; dcs:blame cpan:MARKSTOS; dcs:fixes ; seealso ; ]; item "Work around lack of B::perlstring() function in Perl 5.6.x."^^Bugfix; ]. `Type-Tiny 0.017_02 cpan:TOBYINK` issued 2013-07-20; changeset [ dcs:versus `Type-Tiny 0.017_01 cpan:TOBYINK`; item [ a dcs:Change; label "Hopefully improved workaround for missing B::perlstring() using Data::Dumper instead of quotemeta()."; dcs:thanks cpan:RIBASUSHI; ]; item [ a dcs:Bugfix; label "Further changes for Perl 5.6.x support."; ]; ]. `Type-Tiny 0.018 cpan:TOBYINK` issued 2013-07-21; changeset [ dcs:versus `Type-Tiny 0.017_02 cpan:TOBYINK`; item "Updated NEWS file."^^Documentation; ]. `Type-Tiny 0.019_01 cpan:TOBYINK` issued 2013-07-23; changeset [ dcs:versus `Type-Tiny 0.018 cpan:TOBYINK`; item "Work around lack of B::perlstring() function in Perl 5.6.x in test suite."^^Bugfix; item "Eval::TypeTiny now closes over variables properly."^^Bugfix; ]. `Type-Tiny 0.020 cpan:TOBYINK` issued 2013-07-23; changeset [ dcs:versus `Type-Tiny 0.019_01 cpan:TOBYINK`; item "Updated NEWS file."^^Documentation; ]. `Type-Tiny 0.021_01 cpan:TOBYINK` issued 2013-07-24; changeset [ dcs:versus `Type-Tiny 0.020 cpan:TOBYINK`; item "Type::Tiny strictly_equals method."^^Addition; item "Type::Tiny is_strictly_subtype_of method."^^Addition; item "Type::Tiny is_strictly_supertype_of method."^^Addition; item "Type::Tiny is_strictly_a_type_of method."^^Addition; ]. `Type-Tiny 0.021_02 cpan:TOBYINK` issued 2013-07-26; changeset [ dcs:versus `Type-Tiny 0.021_01 cpan:TOBYINK`; item "Use real lexicals again for Eval::TypeTiny; this requires Devel::LexAlias, but there's a fallback to using tied variables."^^Change; ]. `Type-Tiny 0.021_03 cpan:TOBYINK` issued 2013-07-30; changeset [ dcs:versus `Type-Tiny 0.021_02 cpan:TOBYINK`; item "Restore Eval::TypeTiny's pre-0.019_01 behaviour re closing over lexicals, but enable the 0.021_02 behaviour if alias=>1 option is passed in."^^Change; item "Improve compatibility between Type::Tiny and Moose attribute native traits."^^Change; ]. `Type-Tiny 0.021_04 cpan:TOBYINK` issued 2013-07-30; changeset [ dcs:versus `Type-Tiny 0.021_03 cpan:TOBYINK`; item [ a dcs:Bugfix; label "Fix Types::Standard::Dict differentiating between undef and not exists."; dcs:thanks cpan:TIMB; dcs:fixes RT#87443; ]; item "Fix Type::Parser's handling of numeric parameters; they shouldn't need quoting."^^Bugfix; item "Add dependency on Exporter 5.57 for older versions of Perl."^^Packaging; ]. `Type-Tiny 0.022 cpan:TOBYINK` issued 2013-08-06; changeset [ dcs:versus `Type-Tiny 0.021_04 cpan:TOBYINK`; item "In Devel::TypeTiny::Perl56Compat, `use strict` and `use warnings`."^^Change; item "Improved implementations of is_subtype_of/is_strictly_subtype_of; better for subclassing."^^Change; item "Updated NEWS file."^^Documentation; ]. Type-Tiny-0.022/meta/doap.pret0000644000175000017500000000217112161671331014242 0ustar taitai# This file contains general metadata about the project. @prefix : . `Type-Tiny` :programming-language "Perl" ; :shortdesc "tiny, yet Moo(se)-compatible type constraint"; :homepage ; :download-page ; :bug-database ; :repository [ a :GitRepository; :browse ]; :created 2013-03-23; :license ; :maintainer cpan:TOBYINK; :developer cpan:TOBYINK; :category [ label "Moo" ], [ label "Moose" ], [ label "Mouse" ], [ label "Type Constraint" ], [ label "Type Coercion" ], [ label "Type Library" ], [ label "Schema" ], [ label "Parameter Validation" ], [ label "Parameter Checking" ], [ label "Argument Validation" ], [ label "Argument Checking" ], [ label "Validation" ]. dc:title "the same terms as the perl 5 programming language system itself". Type-Tiny-0.022/meta/rights.pret0000644000175000017500000000367312161671331014627 0ustar taitaif`CONTRIBUTING` dc:license ; dc:rightsHolder cpan:TOBYINK. f`CREDITS` dc:license ; dc:rightsHolder cpan:TOBYINK. f`Changes` dc:license ; dc:rightsHolder cpan:TOBYINK. f`LICENSE` dc:license ; dc:rightsHolder cpan:TOBYINK. f`META.ttl` dc:license ; dc:rightsHolder cpan:TOBYINK. f`Makefile.PL` dc:license ; dc:rightsHolder cpan:TOBYINK. f`NEWS` dc:license ; dc:rightsHolder cpan:TOBYINK. f`README` dc:license ; dc:rightsHolder cpan:TOBYINK. f`TODO` dc:license ; dc:rightsHolder cpan:TOBYINK. f`TODO.mm` dc:license ; dc:rightsHolder cpan:TOBYINK. f`examples/benchmark-mkopt.pl` dc:license ; dc:rightsHolder cpan:TOBYINK. f`examples/benchmark-param-validation.pl` dc:license ; dc:rightsHolder cpan:TOBYINK. f`meta/changes.pret` dc:license ; dc:rightsHolder cpan:TOBYINK. f`meta/doap.pret` dc:license ; dc:rightsHolder cpan:TOBYINK. f`meta/makefile.pret` dc:license ; dc:rightsHolder cpan:TOBYINK. f`meta/people.pret` dc:license ; dc:rightsHolder cpan:TOBYINK. f`meta/rights.pret` dc:license ; dc:rightsHolder cpan:TOBYINK. f`inc/Test/Fatal.pm` dc:license ; dc:rightsHolder cpan:RJBS. f`inc/Test/Requires.pm` dc:license ; dc:rightsHolder cpan:TOKUHIROM. f`inc/Try/Tiny.pm` dc:license ; dc:rightsHolder cpan:NUFFIN. f`MANIFEST.SKIP` dc:license ; dc:rightsHolder cpan:INGY. Type-Tiny-0.022/meta/makefile.pret0000644000175000017500000000161112176276500015077 0ustar taitai# This file provides instructions for packaging. @prefix deps: . `Type-Tiny` perl_version_from m`Type::Tiny`; version_from m`Type::Tiny`; readme_from f`lib/Type/Tiny/Manual.pod`; deps:test-requirement [ deps:on "Test::More 0.96"^^deps:CpanId; comment "I don't have the patience to maintain a test suite that runs on ancient versions of Test::More."@en; ]; deps:runtime-recommendation [ deps:on "Type::Tie"^^deps:CpanId; comment "Type::Tie is needed if you want to constrain the type of a scalar, array or hash variable."@en; ]; deps:runtime-recommendation [ deps:on "Devel::StackTrace"^^deps:CpanId; comment "Type::Exception can use Devel::StackTrace for stack traces."@en; ]; deps:runtime-recommendation [ deps:on "Devel::LexAlias 0.05"^^deps:CpanId; comment "Devel::LexAlias is useful for some Eval::TypeTiny features."@en; ]; . Type-Tiny-0.022/META.yml0000644000175000017500000000232612200124303012732 0ustar taitai--- abstract: 'tiny, yet Moo(se)-compatible type constraint' author: - 'Toby Inkster ' build_requires: ExtUtils::MakeMaker: 6.59 Test::More: 0.96 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' keywords: - 'Argument Checking' - 'Argument Validation' - Moo - Moose - Mouse - 'Parameter Checking' - 'Parameter Validation' - Schema - 'Type Coercion' - 'Type Constraint' - 'Type Library' - Validation license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 module_name: Type::Tiny name: Type-Tiny no_index: directory: - examples - inc - t - xt recommends: Devel::LexAlias: 0.05 Devel::StackTrace: 0 Type::Tie: 0 requires: perl: 5.6.1 resources: bugtracker: http://rt.cpan.org/Dist/Display.html?Queue=Type-Tiny homepage: https://metacpan.org/release/Type-Tiny license: http://dev.perl.org/licenses/ repository: https://github.com/tobyink/p5-type-tiny version: 0.022 x_contributors: - 'Mark Stosberg ' - 'Diab Jerius ' - 'Pierre Masci' - 'Vyacheslav Matyukhin ' Type-Tiny-0.022/Changes0000644000175000017500000006533112200123776012776 0ustar taitaiType-Tiny ========= Created: 2013-03-23 Home page: Bug tracker: Maintainer: Toby Inkster 0.022 2013-08-06 - (Documentation) Updated NEWS file. - Improved implementations of is_subtype_of/is_strictly_subtype_of; better for subclassing. - In Devel::TypeTiny::Perl56Compat, `use strict` and `use warnings`. 0.021_04 2013-07-30 - (Bugfix) Fix Type::Parser's handling of numeric parameters; they shouldn't need quoting. - (Bugfix) Fix Types::Standard::Dict differentiating between undef and not exists. Fixes RT#87443 ++$TIMB - (Packaging) Add dependency on Exporter 5.57 for older versions of Perl. 0.021_03 2013-07-30 - Improve compatibility between Type::Tiny and Moose attribute native traits. - Restore Eval::TypeTiny's pre-0.019_01 behaviour re closing over lexicals, but enable the 0.021_02 behaviour if alias=>1 option is passed in. 0.021_02 2013-07-26 - Use real lexicals again for Eval::TypeTiny; this requires Devel::LexAlias, but there's a fallback to using tied variables. 0.021_01 2013-07-24 - (Addition) Type::Tiny is_strictly_a_type_of method. - (Addition) Type::Tiny is_strictly_subtype_of method. - (Addition) Type::Tiny is_strictly_supertype_of method. - (Addition) Type::Tiny strictly_equals method. 0.020 2013-07-23 - (Documentation) Updated NEWS file. 0.019_01 2013-07-23 - (Bugfix) Eval::TypeTiny now closes over variables properly. - (Bugfix) Work around lack of B::perlstring() function in Perl 5.6.x in test suite. 0.018 2013-07-21 - (Documentation) Updated NEWS file. 0.017_02 2013-07-20 - (Bugfix) Further changes for Perl 5.6.x support. - Hopefully improved workaround for missing B::perlstring() using Data::Dumper instead of quotemeta(). ++$RIBASUSHI 0.017_01 2013-07-19 - (Bugfix Documentation) Fix typo in Types::Standard 'regular exception' -> 'regular expression'. Fixes GH#4 ++$MARKSTOS - (Bugfix Documentation) Improve examples of custom type constraint error message in Type::Utils and Type::Tiny::Manual::Libraries. Fixes RT#86892 ++$TIMB - (Bugfix) Work around lack of B::perlstring() function in Perl 5.6.x. - (Documentation) Give an example of the default error messages thrown by Type::Tiny. - (Update) Eval::TypeTiny now supports lexical subs under Perl 5.18. 0.016 2013-07-16 - (Documentation) Add some pod links. - (Documentation) Updated NEWS file. 0.015_05 2013-07-15 - Experimentally drop required version of Perl from 5.8.1 to 5.6.1. I've not been able to extensively test Type-Tiny on Perl 5.6.x, but I believe it should mostly work. (The only feature that seems unlikely to work is non-ASCII names for type constraints and coercions.) - Stop monkey-patching Moose::Meta::TypeContraint; it's not necessary and has never been documented. 0.015_04 2013-07-13 - (Bugfix Documentation) Clarify when inlining via Sub::Quote may be less efficient than hand-written inlining. Fixes RT#86893 ++$TIMB - (Bugfix Documentation) Mention in Type::Tiny::Manual::Libraries that the `extends` function is no longer exported by default; update example code. Fixes RT#86813 Fixes GH#2 ++"Pierre Masci" - (Bugfix) Allow an inline_as block to return a list of strings (which are implictly joined with &&); allow the first item on the list to be undef, which is treated as the inlined parent type constraint. Fixes RT#86891 ++$TIMB 0.015_03 2013-07-08 - (Addition) Implement TIESCALAR, TIEARRAY and TIEHASH methods for Type::Tiny; this improves Type::Tie integration. - Slight speed improvements for `compile_match_on_type`. - The `dwim_type` function now prioritizes lookups within the caller class' type registry over Types::Standard's built-in types. 0.015_02 2013-07-06 - Better test cases for `dwim_type`. - Improvements to DWIMness of Type::Parser for the benefit of `dwim_type`. 0.015_01 2013-07-05 - (Addition) Type::Utils now provides a `dwim_type` function; this is powered by a hidden Type::Registry::DWIM package. - Type::Parser can now pull in types from MooseX::Types libraries properly. 0.014 2013-06-28 - (Documentation) Updated NEWS file. 0.013_01 2013-06-27 - (Addition) Type::Parser now provides a `extract_type` function which parses a type constraint expression from the head of a string and returns a Type::Tiny object, plus the tail of the string. (This is designed to make it easier to use Type::Parser to parse things like function signatures.) - (Removal) Type::Parser functions no longer accept an arrayref of tokens, as they expect to pull tokens from a stream as required. - (Removal) Type::Parser no longer provides a `tokens` function as it no longer pre-emptively tokenizes the whole string it is given. - Type::Parser's tokenization is now done on a pull basis, allowing one-pass building of the AST. 0.012 2013-06-25 - (Documentation) Updated NEWS file. 0.011_03 2013-06-25 - (Bugfix) Type::Tiny now overloads `cmp`. Necessary because Mouse does a sort on type constraints in a union, and overload's fallback doesn't seem to cover `cmp` on Perl prior to 5.12. 0.011_02 2013-06-25 - (Bugfix) Types::Standard 0.009_02 stopped including 'library' attribute in its types, and thus broke MooX::late. Type::Library modified to make 'library' attribute more automatic, and less reliant on Type::Utils to do the right thing. ++$HAARG 0.011_01 2013-06-25 - (Addition) Types::Standard::to_TypeTiny now accepts any object implementing the Type::API::Constraint or Type::API::Constraint::Coercion interfaces. As Mouse::Meta::TypeConstraint implements this interface, specific support for importing Mouse types has been dropped; the generic Type::API import 'just works' for Mouse types. - (Addition) Types::Standard::to_TypeTiny now accepts unblessed coderefs and converts them to type constraints. This allows things like `Int & sub { $_ < 10 }` to work. - (Bugfix) B::SPECIAL-related fix. Fixes RT#86383 ++$PJFL - (Bugfix) Unions of Type::Tiny and Mouse::Meta::TypeConstraints now work properly. This makes Type::Tiny and MouseX::Types play nice together (much like Type::Tiny already plays nice with MooseX::Types). - Cleanups within Type::Coercion. Necessary because in some places the entire type_coercion_map (including conversion coderefs) was passed through Types::Standard::to_TypeTiny, when really only the type constraints should have been. 0.010 2013-06-24 - (Documentation) Updated NEWS file. 0.009_07 2013-06-24 - (Packaging) Make rt86172.t an 'xt' test case because it's causing random CPAN testers failures unrelated to the feature it's supposed to be testing. - (Packaging) More test cases for interacting with MooseX::Types type constraints. - If a Type::Tiny object is instantiated with a Sub::Quote quoted constraint coderef, and no inlined coderef, then Type::Tiny will use Sub::Quote to make an inlined coderef. - Subclasses of Type::Tiny reject 'inlined' coderef, just like they already reject 'constraint' coderef. - Type::Params no longer uses Type::Utils. - Types::Standard::to_TypeTiny now sets 'display_name' instead of 'name' on generated type constraints. 0.009_06 2013-06-23 - (Bugfix) Careful calling the DOES method (it doesn't exist in Perl 5.8). 0.009_05 2013-06-23 - (Bugfix) Type::Registry does the AUTOLOAD thing, so ought to provide a DESTROY method. 0.009_04 2013-06-23 - (Bugfix) Type::Tiny::Class shouldn't completely trust @ISA when establishing parent class heirarchies. - (Update) Support Type::API interfaces. - Constructors for Type::Tiny subclasses no longer accept the 'constraint' parameter; it doesn't make sense. 0.009_03 2013-06-22 - (Bugfix) Fix Types::Standard compilation errors under Perl 5.8.x. 0.009_02 2013-06-22 - (Bugfix) Fix for compiled_checks for type constraints inheriting from Type::Tiny::Class, etc. Fixes GH#1 ++$RSIMOES - (Regression) Types::Standard types no longer have 'library' attribute set; this subtly breaks Moo type inflation, and breaks the MooX::late test suite which relies on type inflation working correctly. - Types::Standard no longer uses Type::Utils. - Various minor optimizations for Eval::TypeTiny, Type::Tiny, etc. 0.009_01 2013-06-21 - (Addition) Reply::Plugin::TypeTiny. - (Bugfix) Fix error messages from type constraints with null constraint coderefs. 0.008 2013-06-21 - (Documentation) Updated NEWS file. 0.007_10 2013-06-21 - (Addition) Type::Parser now exports a _std_eval function useful for testing. - (Addition) Type::Parser now supports parentheses in its DSL. - (Bugfix) Fixed many small parsing bugs in Type::Parser. - (Bugfix) MooseX::Types objects used in Type::Tiny::Union, Type::Tiny::Intersection and parameterized Type::Tiny type constraints would break in some circumstances, as Types::TypeTiny::to_TypeTiny was failing to convert them to native Type::Tiny type constraints. Fixes RT#86303 - (Documentation) Document status of Type::Registry. - (Packaging) Better test cases for Type::Registry. - (Packaging) Test cases for Type::Parser. - Improved error messages from Type::Parser. 0.007_09 2013-06-18 - (Bugfix) Fix problems inlining Dict deep coercions where the target constraint could not be inlined. Fixes RT#86233 ++$MMCLERIC - (Bugfix) Fix unintuitive Dict deep coercions. Fixes RT#86239 ++$MMCLERIC 0.007_08 2013-06-17 - (Bugfix) Fix problem with interaction between constraints, coercions, and Moose classes that inherit from Moo classes. Fixes RT#86172 ++$PJFL 0.007_07 2013-06-16 - (Bugfix) Partly roll back prototype changes. Now we use `;$` for Perl since 5.14, but `;@`, for older Perls that don't support `;$` so well. 0.007_06 2013-06-16 - (Addition) Type::Exception is now capable of supplying stack traces (requires Devel::StackTrace). - (Documentation) Document the evaluation environment used by Eval::TypeTiny. - (Documentation) Rearranged documentation for Type::Utils, avoiding previous split into Moose-like and non-Moose-like functions. - Better prototypes (was `;@`, now `;$`) for parameterizable type 'constants' exported by type libraries. ++$MSTROUT - Exceptions thrown for Moo isa/coerce now indicate which attribute was involved. - Type::Utils no longer exports 'extends' by default!! 0.007_05 2013-06-12 - (Addition) Add match_on_type and compile_match_on_type to Type::Utils. - (Addition) Test cases for InstanceOf, ConsumerOf, HasMethods and Enum types defined by Types::Standard. - (Documentation) Mention Scalar::Does and Type::Tie in manual. - (Documentation) Vastly improved documentation for Type::Utils. - (Documentation) Vastly improved documentation for Types::Standard. - Support '0' and '1' as shortcuts for Optional[Any] and Any in Type::Params. (Not documented yet.) 0.007_04 2013-06-09 - (Bugfix) Overloading of `$type eq $type` now works in Perl 5.8. Fixes RT#85895 ++$MMCLERIC - (Bugfix) The combination of Dict, Optional and coercions seems to have been broken in certain circumstances. Fixes RT#86001 ++$DJERIUS 0.007_03 2013-06-08 - (Bugfix) Inlining of certain deep Dict, Tuple and Map coercions was broken, but Type::Params attempted to inline them anyway, leading to death. Fixes RT#85911 ++$DJERIUS - (Documentation) Better document Type::Tiny's 'parents' method which differs from the Moose method of the same name. 0.007_02 2013-06-04 - (Addition) New constraints added to Types::Standard: InstanceOf, ConsumerOf, HasMethods and Enum. ++$HAARG - (Documentation) Improvements to Type::Tiny::Manual. - (Documentation) Improvements to Type::Tiny::Manual::Params, including rewritten manual processing section, and processing type constraints in function signatures via Function::Parameters/Attribute::Constract. - (Packaging) Test cases for usage with Function::Parameters. - Allow constraint_generators (for parameterizable type constraints) to return full Type::Tiny objects instead of plain coderefs. - Drop use of Carp in Type::Parser. - Type::Tiny::Class types now have an automatically calculated parent type constraint based on @ISA. - Type::Tiny::Duck types now have a parent type constraint of Types::Standard::Object. - Type::Tiny::Enum types now have a parent type constraint of Types::Standard::Str. - Type::Tiny::Intersection types now have an arbitrary parent type constraint. - Type::Tiny::Role types now have a parent type constraint of Types::Standard::Object. - Type::Tiny::Union types now have an automatically calculated parent type constraint based on the most specific common parent type constraint. 0.007_01 2013-06-01 Happy birthday to me... - (Addition) Type::Parser. - (Addition) Types::Standard now has LaxNum/StrictNum type constraints, and Num selects between them. - (Bugfix) Fix $VERSION defined in Type::Library. - (Packaging) Generate README from Type::Tiny::Manual instead of Type::Tiny. - Implemented Types::TypeTiny->meta->get_type. - Re-introduce Type::Registry, with improved parsing thanks to Type::Parser. 0.006 2013-05-28 - (Packaging) Exporter::TypeTiny::mkopt_hash now works. 0.005_08 2013-05-28 - (Packaging) Rearrange test cases; add 00-begin.t. - (Update) Use JSON::PP instead of JSON in test cases, because JSON::PP is a core module since Perl 5.14. 0.005_07 2013-05-28 - (Addition) Add pure-Perl Mouse to examples/benchmark-constraints.pl. - (Bugfix) Assertions using the assert_return pattern were triggering FATAL warnings when inlined with Sub::Quote. Inlined assertions are now prefixed with 'no warnings "void";'. 0.005_06 2013-05-26 - (Bugfix) Fix StrMatch to properly support regexps containing slashes. - Fold Types::Standard::DeepCoercion into Types::Standard. 0.005_05 2013-05-24 - (Addition) Type::Tiny now has an assert_return method, which is used in most places in preference to assert_valid. - (Removal) Removed Type::Registry from the release; it will return at a later date. - (Update) Suggest newer version of Validation::Class. - Fix warnings under Perl 5.18. 0.005_04 2013-05-17 - (Addition) Deep explanations for Types::Standard::{Map,Maybe,Ref,Dict,Tuple} type constraint assertion failures. - (Addition) Type::Exception::Compilation. - (Bugfix) Fixed bug in non-inlined code for Types::Standard::MkOpt. - All error conditions now throw exception objects instead of string error messages. - Allow the slurpy tail of a Types::Standard::Tuple to be a treated as a hashref rather than an arrayref. - Improved deep explanations for Types::Standard::{ArrayRef,HashRef,ScalarRef}. - Test::TypeTiny performs more thorough testing if EXTENDED_TESTING environment variable is set. - Throw exception if people attempt to set parent types for Type::Tiny::{Class,Role,Duck,Enum,Union,Intersection}. 0.005_03 2013-05-14 - (Removal) Bytes and Chars type constraints removed from Types::Standard. - (Removal) Decode and Encode coercions removed from Types::Standard. - Many error conditions now throw exception objects instead of string error messages. 0.005_02 2013-05-14 - (Documentation) Fix a typo in declare_coercion in Type::Tiny::Manual::Coercions. ++$MMCLERIC - (Documentation) Link to Type::Tiny::Manual::Libraries instead of non-existing Type::Tiny::Intro. ++$MMCLERIC 0.005_01 2013-05-07 - (Addition) ArrayLike type added to Types::TypeTiny. - (Addition) Type::Registry. - (Bugfix) Type::Library should require Perl 5.8.1, not 5.8.3. 0.004 2013-05-06 - (Bugfix) Eval::Closure now strips line breaks and other unsavoury characters from descriptions. - Minor updates to to_TypeTiny following Validation::Class 7.900048 release. 0.003_16 2013-05-05 - (Documentation) Document that Map[`k,`v] has a deep coercion. - (Documentation) Improve Type::Coercion documentation. - Minor updates to coderef overloading following Moo 1.002000 release. - Rename Types::Standard::AutomaticCoercion -> Types::Standard::DeepCoercion. - Type::Params produces nicer error messages. 0.003_15 2013-05-03 - (Addition) Improvements to to_TypeTiny function, including accepting Validation::Class::Simple objects. 0.003_14 2013-05-03 0.003_13 2013-05-03 - (Bugfix) Don't crash in old versions of Moose that have no Class::MOP::_definition_context() function. - BAIL_OUT in test suite if 00-compile.t or 01-api.t fail. - Better documentation and tests of Moose/Mouse-compatible API. - Fix typo in Type::Params documentation. ++$DJERIUS 0.003_12 2013-05-01 - (Bugfix) Sane behaviour for Types::Standard's 'slurpy' function when it appears mid-list. - Allow people to use Carp::{confess,cluck,carp} with Type::Params validators; default is still croak. - Improved Type::Params documentation. - Type::Params validators now explicitly check the number of arguments passed to them. ++$MMCLERIC 0.003_11 2013-04-30 - (Addition) Test cases for Eval::TypeTiny. - Automatic coercion for parameterized Dict will no longer drop key/value pairs to force a coercion. ++$MMCLERIC - Automatic coercion for parameterized Tuple will no longer drop values to force a coercion. ++$MMCLERIC 0.003_10 2013-04-29 - (Addition) Bundle Type::Params, which had previously appeared on CPAN in a separate developer release. - (Addition) Much of the stringy eval stuff has been factored out to a new module: Eval::TypeTiny. - (Addition) Type::Tiny::SUPPORT_SMARTMATCH constant. - (Documentation) Improve Exporter::TypeTiny documentation. - (Documentation) Improve advice on inlining type constraints and coercions. - (Packaging) Bump version of Test::More dependency fom 0.88 to 0.96. - General code tidy-up. 0.003_09 2013-04-28 - (Addition) 'Tied' type constraint added to Types::Standard. - (Documentation) Document usage with Params::Check and Object::Accessor. - If Mouse is already in memory, Type::Tiny will use its super-fast XS subs to validate values when possible. 0.003_08 2013-04-26 - (Addition) Test case using Exporter::TypeTiny with Sub::Exporter::Lexical. - (Documentation) More Exporter::TypeTiny docs, including usage with Sub::Exporter::Lexical. - ASCII-only strings are now accepted by the Chars constraint in Types::Standard. - Type::Tiny, Type::Coercion and their subclasses no longer call Types::TypeTiny->import method. - Types::TypeTiny lazily loads Exporter::TypeTiny - i.e. it loads Exporter::TypeTiny when Types::TypeTiny->import is first called. 0.003_07 2013-04-26 - (Bugfix) Fix method conflicts when exporting type constraints to roles. ++$BOWTIE - (Documentation) Document usage with Class::InsideOut. - (Documentation) Minor improvements to manual. 0.002 2013-04-26 - (Addition) Chars and Bytes types added to Types::Standard. - (Bugfix) Fix method conflicts when exporting type constraints to roles. ++$BOWTIE - (Bugfix) Prevent warnings (about 'my $val' masking a previously declared variable) when several Str checks are being inlined in close proximity, such as Tuple[Str,Str] - (Documentation) Link from Test::TypeTiny to Test::Deep::Type. - Avoid unnecessarily regenerating parameterized type constraints. - Make Type::Tiny's has_coercion method more DWIM. 0.003_06 2013-04-25 - (Addition) Types::TypeTiny::to_TypeTiny can now coerce from a Mouse::Meta::TypeConstraint. - (Documentation) Add lots of stuff to Type::Tiny::Manual::UsingWithMouse. - (Documentation) Document deep coercions (feature added in 0.003_01). - Add a bunch of stub methods to Type::Tiny and Type::Coercion in order to make it less necessary to inflate to Moose/Mouse meta objects. - No longer need to add '-mouse' when importing types into Mouse libraries. (Same change as what we did for Moose in 0.000_11.) - Various minor changes to Exporter::TypeTiny to make it more Sub::Exporter compatible. 0.003_05 2013-04-19 - (Addition) Allow coercions to accept parameters. - (Addition) Chars and Bytes types added to Types::Standard. - (Addition) Encode, Decode, Join and Split coercions added to Types::Standard. - (Addition) Type::Tiny::Class now has a plus_constructors method. - (Bugfix) Prevent warnings (about 'my $val' masking a previously declared variable) when several Str checks are being inlined in close proximity, such as Tuple[Str,Str] - (Documentation) Document Exporter::TypeTiny. - (Documentation) Type::Tiny::Manual::Coercions. 0.003_04 2013-04-18 - Factor out the sub exporting code scattered around (in Type::Utils, Types::TypeTiny and Type::Library) into a single module, Exporter::TypeTiny. 0.003_03 2013-04-17 - (Addition) Add OptList data type to Types::Standard, plus MkOpt coercion. - Make Type::Tiny's has_coercion method more DWIM. - When inflating Moo type constraints to Moose, don't unnecessarily call 'moose_type' method. 0.003_02 2013-04-16 - (Documentation) Document how to process sub parameters with Type::Tiny, and point people towards Type::Params. - Avoid unnecessarily regenerating parameterized type constraints. 0.003_01 2013-04-16 - (Addition) Allow subtypes to inherit coercions from their parent type constraint. (They do not by default.) - (Addition) Build coercions automatically for certain type parameterized constraints. Say there's a Num->Int coercion defined; then we should be able to coerce ArrayRef[Num]->ArrayRef[Int]. - (Addition) Overload "+" operator for Type::Coercion and Type::Tiny allows coercions to be added to each other, and added to type constraints. - (Addition) Type::Library packages can now include "standalone" Type::Coercion objects, not attached to a type constraint. These can be exported on request. - (Documentation) Link from Test::TypeTiny to Test::Deep::Type. - Allow a Type::Tiny object to "freeze" its coercions. This prevents a Type::Tiny object from becoming out of sync with its equivalent Mouse or Moose constraint objects. 0.001 2013-04-15 First public release - (Addition) More test cases for Optional[`a] within Dict[`a]. - (Bugfix) Some inline code assumed that it would be compiled in a package that had 'blessed' imported. - (Bugfix) Some inline code wasn't wrapped in parentheses. - (Documentation) Minor improvements. - Improve test names generated by Test::TypeTiny; allow test scripts to provide test names. - Parameterized type constraints in Types::Standard now do some sanity checking on their arguments. - Weaken the reference from a Moose::Meta::TypeConstraint object to its Type::Tiny origin. 0.000_12 2013-04-12 - (Documentation) Fix minor typo. 0.000_11 2013-04-11 - (Bugfix) Fix prototype for Type::Utils::as. - No longer need to pass '-moose' parameter when importing a library into a Moose class; only Mouse needs that treatment now. 0.000_10 2013-04-09 - (Bugfix) Fix incorrect Test::Requires line in 'mouse-coercion.t'. - Improvements to has_coercion_for_{type,value} from Type::Coercion. 0.000_09 2013-04-08 - (Addition) Bundle benchmarking scripts. - (Documentation) Fill in the Usage with Moose section of the fine manual. - (Packaging) Tidy up the 'examples' directory. - (Packaging) When generating Moose/Mouse constraints from Type::Tiny objects, prefer to generate anonymous ones. 0.000_08 2013-04-07 - (Addition) Types::TypeTiny::to_TypeTiny can be used to coerce a Moose type constraint object to Type::Tiny. - Most parts of the API that accept Type::Tiny objects (e.g. Type::Utils::from()) now also accept Moose::Meta::TypeConstraint objects. - Rewrite most of the functions exported by Type::Library-based type libraries to cope better with being used mid-list. 0.000_07 2013-04-06 - (Addition) Type::Coercion::Union - automatically handles coercion to union types. - (Bugfix) Fix inlining for Type::Tiny::Intersection. - (Bugfix) Fix inlining of certain conditionals into coercion code. - (Bugfix) Types within libraries, if accessed directly rather than exported, did not accept parameters. - (Documentation) Document constructor for Type::Tiny::Class. - (Packaging) More test cases. 0.000_06 2013-04-05 - (Addition) In Moo, type assertions and coercions are now inlined. ++$MSTROUT - (Addition) Monkey patch Moose::Meta::TypeConstraint to be able to retrieve Type::Tiny constraints from inflated Moose constraints. - (Addition) Type::Tiny now has an 'inline_assert' function. - (Documentation) Improved documentation of parameterization attributes. - (Documentation) Section in manual comparing Type::Tiny with various other type library frameworks. - (Documentation) Using Type::Tiny with Moo added to manual. - (Packaging) More test cases. - Footprint reduction: Type::Tiny and Type::Coercion no longer use if.pm. - Footprint reduction: Type::Tiny no longer triggers Perl to load its Unicode tables (unless you create a type constraint with a non-ASCII type name). - Footprint reduction: Type::Tiny, Type::Library and Type::Coerce no longer automatically load Types::Standard and Type::Utils. 0.000_05 2013-04-04 - (Addition) Factor out some functions from test suite into a new module: Test::TypeTiny. - (Bugfix) Fix is_parameterized. - (Bugfix) Get Mouse coercions working. - (Packaging) Rearrange test suite slightly. - Allow null type constraints with no parent type (e.g. 'Any' in Types::Standard) to be inlined. - Don't die with full stack trace. - Rename Type::Standard module to Types::Standard. - Sanity checks for type constraint names. - Types::TypeTiny bootstrapping library now takes care of vaious internal type checking requirements. 0.000_04 2013-04-03 - (Addition) Finally implement Type::Coercion's has_coercion_for_type method. - (Addition) Type::Tiny equals/is_subtype_of/is_supertype_of/is_a_type_of methods for type constraint comparisons. - (Addition) Type::Tiny plus_coercions/minus_coercions/no_coercions methods for creating subtypes with different sets of coercions. - Allow coercion code to be expressed as a string; quite a bit faster. - Create and use compiled coercions; somewhat faster. 0.000_03 2013-04-03 - (Addition) Inlined type constraints for all of Type::Standard. - (Addition) Test cases for ScalarRef[`a]. - (Bugfix) Fix the crashing t/moo-inflation.t test case. - (Documentation) Document Type::Coercion's overloading. - Create and use compiled type constraint checks; much faster! - Make sure Type::Standard's Moose-like built-ins get inflated to real Moose built-in types. - Use more unique stringification for %Moo::HandleMoose::TYPE_MAP keys. 0.000_02 2013-04-02 - (Addition) StrMatch added to Type::Standard. - (Addition) use Type::Library -base - (Addition) use Type::Library -declare - (Bugfix) Anchor enum regexps to beginning and end of string. - (Documentation) Beginnings of Type::Tiny::Manual. 0.000_01 2013-04-02 Developer preview