X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFunction%2FParameters.pm;h=27c018e306af75c5fa296ef1cd74593ff4b78758;hb=65c90cb1d1e0f41cbdeb4b84996b400841a6f31e;hp=c67e6ecc8c8ba906be8260c1d362902d0c6761f2;hpb=ebdc721b189a191184af4bbb1d405ab4ad33a183;p=p5sagit%2FFunction-Parameters.git diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm index c67e6ec..27c018e 100644 --- a/lib/Function/Parameters.pm +++ b/lib/Function/Parameters.pm @@ -8,7 +8,9 @@ use Carp qw(confess); use XSLoader; BEGIN { - our $VERSION = '1.00'; + our $VERSION = '1.0101_01'; + our $XS_VERSION = $VERSION; + $VERSION = eval $VERSION; XSLoader::load; } @@ -32,12 +34,14 @@ my %type_map = ( default_arguments => 1, check_argument_count => 0, named_parameters => 1, + types => 1, }, method => { name => 'optional', default_arguments => 1, check_argument_count => 0, named_parameters => 1, + types => 1, attrs => ':method', shift => '$self', invocant => 1, @@ -47,6 +51,7 @@ my %type_map = ( default_arguments => 1, check_argument_count => 0, named_parameters => 1, + types => 1, attributes => ':method', shift => '$class', invocant => 1, @@ -116,6 +121,7 @@ sub import { $clean{check_argument_count} = !!delete $type{check_argument_count}; $clean{invocant} = !!delete $type{invocant}; $clean{named_parameters} = !!delete $type{named_parameters}; + $clean{types} = !!delete $type{types}; %type and confess "Invalid keyword property: @{[keys %type]}"; @@ -131,9 +137,10 @@ sub import { FLAG_ANON_OK | FLAG_NAME_OK ; $flags |= FLAG_DEFAULT_ARGS if $type->{default_arguments}; - $flags |= FLAG_CHECK_NARGS if $type->{check_argument_count}; + $flags |= FLAG_CHECK_NARGS | FLAG_CHECK_TARGS if $type->{check_argument_count}; $flags |= FLAG_INVOCANT if $type->{invocant}; $flags |= FLAG_NAMED_PARAMS if $type->{named_parameters}; + $flags |= FLAG_TYPES_OK if $type->{types}; $^H{HINTK_FLAGS_ . $kw} = $flags; $^H{HINTK_SHIFT_ . $kw} = $type->{shift}; $^H{HINTK_ATTRS_ . $kw} = $type->{attrs}; @@ -162,40 +169,58 @@ sub _register_info { $key, $declarator, $invocant, + $invocant_type, $positional_required, $positional_optional, $named_required, $named_optional, $slurpy, + $slurpy_type, ) = @_; - my $blob = pack '(Z*)*', - $declarator, - $invocant // '', - join(' ', @$positional_required), - join(' ', @$positional_optional), - join(' ', @$named_required), - join(' ', @$named_optional), - $slurpy // '', - ; - - $metadata{$key} = $blob; + my $info = { + declarator => $declarator, + invocant => defined $invocant ? [$invocant, $invocant_type] : undef, + slurpy => defined $slurpy ? [$slurpy , $slurpy_type ] : undef, + positional_required => $positional_required, + positional_optional => $positional_optional, + named_required => $named_required, + named_optional => $named_optional, + }; + + $metadata{$key} = $info; +} + +sub _mkparam1 { + my ($pair) = @_; + my ($v, $t) = @{$pair || []} or return undef; + Function::Parameters::Param->new( + name => $v, + type => $t, + ) +} + +sub _mkparams { + my @r; + while (my ($v, $t) = splice @_, 0, 2) { + push @r, Function::Parameters::Param->new( + name => $v, + type => $t, + ); + } + \@r } sub info { my ($func) = @_; my $key = _cv_root $func or return undef; - my $blob = $metadata{$key} or return undef; - my @info = unpack '(Z*)*', $blob; + my $info = $metadata{$key} or return undef; require Function::Parameters::Info; Function::Parameters::Info->new( - keyword => $info[0], - invocant => $info[1] || undef, - _positional_required => [split ' ', $info[2]], - _positional_optional => [split ' ', $info[3]], - _named_required => [split ' ', $info[4]], - _named_optional => [split ' ', $info[5]], - slurpy => $info[6] || undef, + keyword => $info->{declarator}, + invocant => _mkparam1($info->{invocant}), + slurpy => _mkparam1($info->{slurpy}), + (map +("_$_" => _mkparams @{$info->{$_}}), glob '{positional,named}_{required,optional}') ) } @@ -621,6 +646,11 @@ exported, so you have to call it by its full name). It takes a reference to a function, and returns either C (if it knows nothing about the function) or a L object describing the parameter list. +Note: This feature is implemented using L, so you'll need to have L +installed if you want to call C (alternatively, if +L is already loaded by the time C is first +called, it will use that instead). + See L for examples. =head2 Wrapping C @@ -636,6 +666,44 @@ affects the file that is currently being compiled. # or Function::Parameters->import(@custom_import_args); } +=head2 Experimental feature: Types + +An experimental feature is now available: You can annotate parameters with +L. That is, before each parameter you can put +a type specification consisting of identifiers (C), unions (C<... | ...>), +and parametric types (C<...[...]>). Example: + + fun foo(Int $n, ArrayRef[String | CodeRef] $cb) { ... } + +If you do this, L will be loaded automatically (if that hasn't happened +yet). These specifications are parsed and validated using +L|Moose::Util::TypeConstraints/find_or_parse_type_constraint>. + +If you are in "lax" mode, nothing further happens and the types are ignored. If +you are in "strict" mode, C generates code to make sure +any values passed in conform to the type (via +L<< C<< $constraint->check($value) >>|Moose::Meta::TypeConstraint/$constraint->check($value) >>). + +In addition, these type constraints are inspectable through the +L object returned by +L|/Introspection>. + +=head2 Experimental experimental feature: Type expressions + +An even more experimental feature is the ability to specify arbitrary +expressions as types. The syntax for this is like the literal types described +above, but with an expression wrapped in parentheses (C<( EXPR )>). Example: + + fun foo(('Int') $n, ($othertype) $x) { ... } + +Every type expression must return either a string (which is resolved as for +literal types), or a L +(providing C and C methods). + +Note that these expressions are evaluated (once) at parse time (similar to +C blocks), so make sure that any variables you use are set and any +functions you call are defined at parse time. + =head2 How it works The module is actually written in L and uses @@ -653,6 +721,39 @@ generated code corresponds to: # ... turns into ... sub bar :method { my $self = shift; my ($x, $y, @z) = @_; sub bar; ... } +=head1 SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the +perldoc command. + + perldoc Function::Parameters + +You can also look for information at: + +=over + +=item MetaCPAN + +L + +=item RT, CPAN's request tracker + +L + +=item AnnoCPAN, Annotated CPAN documentation + +L + +=item CPAN Ratings + +L + +=item Search CPAN + +L + +=back + =head1 SEE ALSO L @@ -663,7 +764,7 @@ Lukas Mai, C<< >> =head1 COPYRIGHT & LICENSE -Copyright 2010, 2011, 2012 Lukas Mai. +Copyright 2010-2013 Lukas Mai. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published