package Function::Parameters;
+use v5.14.0;
+
use strict;
use warnings;
-our $VERSION = '0.05';
-
-use Carp qw(croak confess);
-use Devel::Declare;
-use B::Hooks::EndOfScope;
-
-our @CARP_NOT = qw(Devel::Declare);
-
-
-# Make our import chainable so a wrapper module that wants to turn on F:P
-# for its users can just say
-# sub import { Function::Parameters->import; }
-#
-# To make that possible we skip all subs named 'import' in our search for the
-# target package.
-#
-sub guess_caller {
- my ($start) = @_;
- $start ||= 1;
+use Carp qw(confess);
- my $defcaller = (caller $start)[0];
- my $caller = $defcaller;
-
- for (my $level = $start; ; ++$level) {
- my ($pkg, $function) = (caller $level)[0, 3] or last;
- $function =~ /::import\z/ or return $caller;
- $caller = $pkg;
- }
- $defcaller
+use XSLoader;
+BEGIN {
+ our $VERSION = '0.10';
+ XSLoader::load;
}
-
sub _assert_valid_identifier {
my ($name, $with_dollar) = @_;
my $bonus = $with_dollar ? '\$' : '';
or confess qq{"$name" doesn't look like a valid identifier};
}
-# Parse import spec and make shit happen.
-#
+sub _assert_valid_attributes {
+ my ($attrs) = @_;
+ $attrs =~ /^\s*:\s*[^\W\d]\w*\s*(?:(?:\s|:\s*)[^\W\d]\w*\s*)*(?:\(|\z)/
+ or confess qq{"$attrs" doesn't look like valid attributes};
+}
+
my @bare_arms = qw(function method);
my %type_map = (
- function => { name => 'optional' },
- method => { name => 'optional', shift => '$self' },
+ function => {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ },
+ method => {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ attrs => ':method',
+ shift => '$self',
+ invocant => 1,
+ },
+ classmethod => {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ attributes => ':method',
+ shift => '$class',
+ invocant => 1,
+ },
);
+for my $k (keys %type_map) {
+ $type_map{$k . '_strict'} = {
+ %{$type_map{$k}},
+ check_argument_count => 1,
+ };
+}
-sub import_into {
- my $victim = shift;
+sub import {
+ my $class = shift;
- @_ or @_ = ('fun', 'method');
+ if (!@_) {
+ @_ = {
+ fun => 'function',
+ method => 'method',
+ };
+ }
+ if (@_ == 1 && $_[0] eq ':strict') {
+ @_ = {
+ fun => 'function_strict',
+ method => 'method_strict',
+ };
+ }
if (@_ == 1 && ref($_[0]) eq 'HASH') {
- @_ = map [$_, $_[0]{$_}], keys %{$_[0]}
- or return;
+ @_ = map [$_, $_[0]{$_}], keys %{$_[0]};
}
my %spec;
? $proto
: [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})]
;
- my ($name, $type) = @$item;
+ my ($name, $proto_type) = @$item;
_assert_valid_identifier $name;
- unless (ref $type) {
- # use '||' instead of 'or' to preserve $type in the error message
- $type = $type_map{$type}
- || confess qq["$type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
+ unless (ref $proto_type) {
+ # use '||' instead of 'or' to preserve $proto_type in the error message
+ $proto_type = $type_map{$proto_type}
+ || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
}
- $type->{name} ||= 'optional';
- $type->{name} =~ /^(?:optional|required|prohibited)\z/
- or confess qq["$type->{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
-
- $spec{$name} = {const => mk_parse($type)};
- }
-
- Devel::Declare->setup_for($victim, \%spec);
- for my $name (keys %spec) {
- no strict 'refs';
- *{$victim . '::' . $name} = \&_declarator;
- }
-}
-
-sub import {
- my $class = shift;
- my $caller = guess_caller;
- import_into $caller, @_;
-}
-
-sub _declarator {
- $_[0]
-}
-
-# Wrapper around substr where param 3 is an end offset, not a length.
-#
-sub _substring {
- @_ >= 4
- ? substr $_[0], $_[1], $_[2] - $_[1], $_[3]
- : substr $_[0], $_[1], $_[2] - $_[1]
-}
+ my %type = %$proto_type;
+ my %clean;
-sub _skip_space {
- my ($ctx, $key) = @_;
- my $cur = my $start = $ctx->{offset};
- while (my $d = Devel::Declare::toke_skipspace $cur) {
- $cur += $d;
- }
- $ctx->{space}{$key} .= _substring Devel::Declare::get_linestr, $start, $cur if $key;
- $ctx->{offset} = $cur;
-}
-
-sub _grab_name {
- my ($ctx) = @_;
- my $p = $ctx->{offset};
- my $namlen = Devel::Declare::toke_scan_word $p, !!'handle_package'
- or return;
- my $str = Devel::Declare::get_linestr;
- $ctx->{name} = substr $str, $p, $namlen;
- $ctx->{offset} += $namlen;
- _skip_space $ctx, 'name';
-}
+ $clean{name} = delete $type{name} || 'optional';
+ $clean{name} =~ /^(?:optional|required|prohibited)\z/
+ or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
-sub _grab_params {
- my ($ctx) = @_;
- substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq '('
- or return;
- $ctx->{offset}++;
- _skip_space $ctx, 'params';
-
- my $pcount = 0;
-
- LOOP: {
- my $c = substr Devel::Declare::get_linestr, $ctx->{offset}, 1;
-
- if ($c =~ /^[\$\@%]\z/) {
- $ctx->{offset}++;
- _skip_space $ctx, "params_$pcount";
- my $namlen = Devel::Declare::toke_scan_word $ctx->{offset}, !'handle_package'
- or croak "Missing identifier";
- my $name = substr Devel::Declare::get_linestr, $ctx->{offset}, $namlen;
- $ctx->{params} .= $c . $name . ',';
- $ctx->{offset} += $namlen;
- _skip_space $ctx, "params_$pcount";
-
- $c = substr Devel::Declare::get_linestr, $ctx->{offset}, 1;
- if ($c eq ',') {
- $ctx->{offset}++;
- _skip_space $ctx, "params_$pcount";
- $pcount++;
- redo LOOP;
- }
- }
+ $clean{shift} = delete $type{shift} || '';
+ _assert_valid_identifier $clean{shift}, 1 if $clean{shift};
- if ($c eq ')') {
- $ctx->{offset}++;
- _skip_space $ctx, 'params';
- return;
- }
+ $clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs);
+ _assert_valid_attributes $clean{attrs} if $clean{attrs};
+
+ $clean{default_arguments} =
+ exists $type{default_arguments}
+ ? !!delete $type{default_arguments}
+ : 1
+ ;
+ $clean{check_argument_count} = !!delete $type{check_argument_count};
+ $clean{invocant} = !!delete $type{invocant};
- if ($c eq '') {
- croak "Unexpected EOF in parameter list";
- }
+ %type and confess "Invalid keyword property: @{[keys %type]}";
- croak "Unexpected '$c' in parameter list";
+ $spec{$name} = \%clean;
}
-}
-
-sub _parse_parens {
- my ($ctx) = @_;
-
- my $strlen = Devel::Declare::toke_scan_str $ctx->{offset};
- $strlen == 0 || $strlen == -1 and return;
-
- $strlen < 0 and confess "Devel::Declare::toke_scan_str done fucked up ($strlen); see https://rt.cpan.org/Ticket/Display.html?id=51679";
-
- my $str = Devel::Declare::get_lex_stuff;
- Devel::Declare::clear_lex_stuff;
-
- $ctx->{offset} += $strlen;
-
- $str
-}
-
-sub _grab_proto {
- my ($ctx) = @_;
-
- my $savepos = $ctx->{offset};
-
- substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq ':'
- or return;
- $ctx->{offset}++;
- _skip_space $ctx, 'proto_tmp';
+
+ for my $kw (keys %spec) {
+ my $type = $spec{$kw};
- unless (substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq '(') {
- $ctx->{offset} = $savepos;
- delete $ctx->{space}{proto_tmp};
- return;
+ my $flags =
+ $type->{name} eq 'prohibited' ? FLAG_ANON_OK :
+ $type->{name} eq 'required' ? FLAG_NAME_OK :
+ 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_INVOCANT if $type->{invocant};
+ $^H{HINTK_FLAGS_ . $kw} = $flags;
+ $^H{HINTK_SHIFT_ . $kw} = $type->{shift};
+ $^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
+ $^H{+HINTK_KEYWORDS} .= "$kw ";
}
- $_->{proto} .= delete $_->{proto_tmp} for $ctx->{space};
-
- defined(my $str = _parse_parens $ctx)
- or croak "Malformed prototype";
- $ctx->{proto} = $str;
-
- _skip_space $ctx, 'proto';
}
-sub _grab_attr {
- my ($ctx) = @_;
-
- my $pcount = 0;
+sub unimport {
+ my $class = shift;
- if (substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq ':') {
- $ctx->{offset}++;
- _skip_space $ctx, "attr_$pcount";
- } elsif (!defined $ctx->{proto}) {
+ if (!@_) {
+ delete $^H{+HINTK_KEYWORDS};
return;
}
- while () {
- my $namlen = Devel::Declare::toke_scan_word $ctx->{offset}, !'handle_package'
- or return;
- $ctx->{attr} .= substr Devel::Declare::get_linestr, $ctx->{offset}, $namlen;
- $ctx->{offset} += $namlen;
- _skip_space $ctx, "attr_$pcount";
- if (substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq '(') {
- defined(my $str = _parse_parens $ctx)
- or croak "Malformed attribute argument list";
- $ctx->{attr} .= "($str)";
- _skip_space $ctx, "attr_$pcount";
- }
- $pcount++;
-
- if (substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq ':') {
- $ctx->{offset}++;
- _skip_space $ctx, "attr_$pcount";
- }
- }
-}
-
-# IN:
-# fun name (params) :(proto) :attr { ... }
-# OUT:
-# fun (do { sub (proto) :attr { self? my (params) = @_; ... } })
-# fun (do { sub name (proto); sub name (proto) :attr { self? my (params) = @_; ... } });
-#
-sub _generate {
- my ($ctx, $declarator, $shift) = @_;
-
- my $gen = '(do{sub';
-
- my $skipped = join '', values %{$ctx->{space}};
- my $lines = $skipped =~ tr/\n//;
- $gen .= "\n" x $lines;
-
- my $proto = defined $ctx->{proto} ? "($ctx->{proto})" : '';
-
- my $is_stmt = 0;
- if (defined(my $name = $ctx->{name})) {
- $is_stmt = 1;
- $gen .= " $name$proto;";
- $gen .= "sub $name";
- }
-
- $gen .= $proto;
-
- if (defined $ctx->{attr}) {
- $gen .= ":$ctx->{attr}";
- }
-
- $gen .= '{';
- $gen .= "BEGIN{${\__PACKAGE__}::_fini($is_stmt)}";
-
- if ($shift) {
- _assert_valid_identifier $shift, 1;
- $gen .= "my$shift=shift;";
- }
- if (defined $ctx->{params}) {
- $gen .= "my($ctx->{params})=\@_;";
+ for my $kw (@_) {
+ $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g;
}
- $gen
}
-sub mk_parse {
- my ($spec) = @_;
-
- sub {
- my ($declarator, $offset_orig) = @_;
- my $ctx = {
- offset => $offset_orig,
- space => {},
- };
-
- $ctx->{offset} += Devel::Declare::toke_move_past_token($ctx->{offset});
- _skip_space $ctx;
-
- my $start = $ctx->{offset};
-
- _grab_name $ctx unless $spec->{name} eq 'prohibited';
- $ctx->{name} or croak qq[I was expecting a function name, not "${\substr Devel::Declare::get_linestr, $ctx->{offset}}"] if $spec->{name} eq 'required';
- _grab_params $ctx;
- _grab_proto $ctx;
- _grab_attr $ctx;
-
- my $offset = $ctx->{offset};
-
- my $linestr = Devel::Declare::get_linestr;
- substr($linestr, $offset, 1) eq '{'
- or croak qq[I was expecting a function body, not "${\substr $linestr, $offset}"];
-
- my $gen = _generate $ctx, $declarator, $spec->{shift};
- my $oldlen = $offset + 1 - $start;
- _substring $linestr, $start, $offset + 1, (' ' x $oldlen) . $gen;
- Devel::Declare::set_linestr $linestr;
- }
-}
-
-# Patch in the end of our synthetic 'do' block, close argument list, and
-# optionally terminate the statement.
-#
-sub _fini {
- my ($stmt) = @_;
- on_scope_end {
- my $off = Devel::Declare::get_linestr_offset;
- my $str = Devel::Declare::get_linestr;
- substr $str, $off, 0, '})' . ($stmt ? ';' : '');
- Devel::Declare::set_linestr $str;
- };
-}
'ok'
__END__
+=encoding UTF-8
+
=head1 NAME
Function::Parameters - subroutine definitions with parameter lists
use Function::Parameters;
+ # simple function
fun foo($bar, $baz) {
return $bar + $baz;
}
- fun mymap($fun, @args) :(&@) {
+ # function with prototype
+ fun mymap($fun, @args)
+ :(&@)
+ {
my @res;
for (@args) {
push @res, $fun->($_);
print "$_\n" for mymap { $_ * 2 } 1 .. 4;
+ # method with implicit $self
method set_name($name) {
$self->{name} = $name;
}
+
+ # method with explicit invocant
+ method new($class: %init) {
+ return bless { %init }, $class;
+ }
+
+ # function with default arguments
+ fun search($haystack, $needle = qr/^(?!)/, $offset = 0) {
+ ...
+ }
+
+ # method with default arguments
+ method skip($amount = 1) {
+ $self->{position} += $amount;
+ }
+
+=cut
+
+=pod
+
+ use Function::Parameters qw(:strict);
+
+ fun greet($x) {
+ print "Hello, $x\n";
+ }
+
+ greet "foo", "bar";
+ # Dies at runtime with "Too many arguments for fun greet"
+
+ greet;
+ # Dies at runtime with "Not enough arguments for fun greet"
=cut
=pod
- use Function::Parameters 'proc', 'meth';
+ # use different keywords
+ use Function::Parameters {
+ proc => 'function',
+ meth => 'method',
+ };
my $f = proc ($x) { $x * 2 };
meth get_age() {
=head1 DESCRIPTION
This module lets you use parameter lists in your subroutines. Thanks to
-L<Devel::Declare> it works without source filters.
-
-WARNING: This is my first attempt at using L<Devel::Declare> and I have
-almost no experience with perl's internals. So while this module might
-appear to work, it could also conceivably make your programs segfault.
-Consider this module alpha quality.
+L<PL_keyword_plugin|perlapi/PL_keyword_plugin> it works without source filters.
=head2 Basic stuff
The effect of C<fun foo($bar, $baz) {> is as if you'd written
C<sub foo { my ($bar, $baz) = @_; >, i.e. the parameter list is simply
-copied into C<my> and initialized from L<@_|perlvar/"@_">.
+copied into L<my|perlfunc/my-EXPR> and initialized from L<@_|perlvar/"@_">.
In addition you can use C<method>, which understands the same syntax as C<fun>
but automatically creates a C<$self> variable for you. So by writing
=head2 Customizing the generated keywords
-You can customize the names of the keywords injected in your package. To do that
-you pass a hash reference in the import list:
+You can customize the names of the keywords injected into your scope. To do
+that you pass a reference to a hash mapping keywords to types in the import
+list:
+
+ use Function::Parameters {
+ KEYWORD1 => TYPE1,
+ KEYWORD2 => TYPE2,
+ ...
+ };
+
+Or more concretely:
use Function::Parameters { proc => 'function', meth => 'method' }; # -or-
use Function::Parameters { proc => 'function' }; # -or-
- use Function::Parameters { meth => 'method' };
+ use Function::Parameters { meth => 'method' }; # etc.
The first line creates two keywords, C<proc> and C<meth> (for defining
functions and methods, respectively). The last two lines only create one
-keyword. Generally the hash keys can be any identifiers you want while the
-values have to be either C<function>, C<method>, or a hash reference (see
-below). The difference between C<function> and C<method> is that C<method>s
-automatically L<shift|perlfunc/shift> their first argument into C<$self>.
+keyword. Generally the hash keys (keywords) can be any identifiers you want
+while the values (types) have to be either a hash reference (see below) or
+C<'function'>, C<'method'>, C<'classmethod'>, C<'function_strict'>,
+C<'method_strict'>, or C<'classmethod_strict'>. The main difference between
+C<'function'> and C<'method'> is that C<'method'>s automatically
+L<shift|perlfunc/shift> their first argument into C<$self> (C<'classmethod'>s
+are similar but shift into C<$class>).
The following shortcuts are available:
=pod
+ use Function::Parameters ':strict';
+ # is equivalent to #
+ use Function::Parameters { fun => 'function_strict', method => 'method_strict' };
+
+=pod
+
+The following shortcuts are deprecated and may be removed from a future version
+of this module:
+
+ # DEPRECATED
use Function::Parameters 'foo';
# is equivalent to #
use Function::Parameters { 'foo' => 'function' };
=pod
+ # DEPRECATED
use Function::Parameters 'foo', 'bar';
# is equivalent to #
use Function::Parameters { 'foo' => 'function', 'bar' => 'method' };
-You can customize things even more by passing a hashref instead of C<function>
-or C<method>. This hash can have the following keys:
+That is, if you want to create custom keywords with L<Function::Parameters>,
+use a hashref, not a list of strings.
+
+You can tune the properties of the generated keywords even more by passing
+a hashref instead of a string. This hash can have the following keys:
=over
Valid values: strings that look like a scalar variable. Any function created by
this keyword will automatically L<shift|perlfunc/shift> its first argument into
-a local variable with the name specified here.
+a local variable whose name is specified here.
+
+=item C<invocant>
+
+Valid values: booleans. This lets users of this keyword specify an explicit
+invocant, that is, the first parameter may be followed by a C<:> (colon)
+instead of a comma and will by initialized by shifting the first element off
+C<@_>.
+
+You can combine C<shift> and C<invocant>, in which case the variable named in
+C<shift> serves as a default shift target for functions that don't specify an
+explicit invocant.
+
+=item C<attributes>, C<attrs>
+
+Valid values: strings that are valid source code for attributes. Any value
+specified here will be inserted as a subroutine attribute in the generated
+code. Thus:
+
+ use Function::Parameters { sub_l => { attributes => ':lvalue' } };
+ sub_l foo() {
+ ...
+ }
+
+turns into
+
+ sub foo :lvalue {
+ ...
+ }
+
+It is recommended that you use C<attributes> in new code but C<attrs> is also
+accepted for now.
+
+=item C<default_arguments>
+
+Valid values: booleans. This property is on by default, so you have to pass
+C<< default_arguments => 0 >> to turn it off. If it is disabled, using C<=> in
+a parameter list causes a syntax error. Otherwise it lets you specify
+default arguments directly in the parameter list:
+
+ fun foo($x, $y = 42, $z = []) {
+ ...
+ }
+
+turns into
+
+ sub foo {
+ my ($x, $y, $z) = @_;
+ $y = 42 if @_ < 2;
+ $z = [] if @_ < 3;
+ ...
+ }
+
+You can even refer to previous parameters in the same parameter list:
+
+ print fun ($x, $y = $x + 1) { "$x and $y" }->(9); # "9 and 10"
+
+This also works with the implicit first parameter of methods:
+
+ method scale($factor = $self->default_factor) {
+ $self->{amount} *= $factor;
+ }
+
+=item C<check_argument_count>
+
+Valid values: booleans. This property is off by default. If it is enabled, the
+generated code will include checks to make sure the number of passed arguments
+is correct (and otherwise throw an exception via L<Carp::croak|Carp>):
+
+ fun foo($x, $y = 42, $z = []) {
+ ...
+ }
+
+turns into
+
+ sub foo {
+ Carp::croak "Not enough arguments for fun foo" if @_ < 1;
+ Carp::croak "Too many arguments for fun foo" if @_ > 3;
+ my ($x, $y, $z) = @_;
+ $y = 42 if @_ < 2;
+ $z = [] if @_ < 3;
+ ...
+ }
=back
-Plain C<function> is equivalent to C<< { name => 'optional' } >>, and plain
-C<method> is equivalent to C<< { name => 'optional', shift => '$self'} >>.
+Plain C<'function'> is equivalent to:
+
+ {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ }
+
+(These are all default values so C<'function'> is also equivalent to C<{}>.)
+
+C<'function_strict'> is like C<'function'> but with
+C<< check_argument_count => 1 >>.
+
+C<'method'> is equivalent to:
+
+ {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ attributes => ':method',
+ shift => '$self',
+ invocant => 1,
+ }
-=head2 Other advanced stuff
+C<'method_strict'> is like C<'method'> but with
+C<< check_argument_count => 1 >>.
+
+C<'classmethod'> is equivalent to:
+
+ {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ attributes => ':method',
+ shift => '$class',
+ invocant => 1,
+ }
+
+C<'classmethod_strict'> is like C<'classmethod'> but with
+C<< check_argument_count => 1 >>.
+
+=head2 Syntax and generated code
Normally, Perl subroutines are not in scope in their own body, meaning the
-parser doesn't know the name C<foo> or its prototype while processing
-C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
+parser doesn't know the name C<foo> or its prototype while processing the body
+of C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the
interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger
a I<foo() called too early to check prototype> warning. This module attempts
-to fix all of this by adding a subroutine declaration before the definition,
+to fix all of this by adding a subroutine declaration before the function body,
so the parser knows the name (and possibly prototype) while it processes the
body. Thus C<fun foo($x) :($) { $x }> really turns into
-C<sub foo ($); sub foo ($) { my ($x) = @_; $x }>.
+C<sub foo ($) { sub foo ($); my ($x) = @_; $x }>.
-If you need L<subroutine attributes|perlsub/"Subroutine Attributes">, you can
+If you need L<subroutine attributes|perlsub/Subroutine-Attributes>, you can
put them after the parameter list with their usual syntax.
Syntactically, these new parameter lists live in the spot normally occupied
by L<prototypes|perlsub/"Prototypes">. However, you can include a prototype by
specifying it as the first attribute (this is syntactically unambiguous
-because normal attributes have to start with a letter).
+because normal attributes have to start with a letter while a prototype starts
+with C<(>).
+
+As an example, the following declaration uses every available feature
+(subroutine name, parameter list, default arguments, prototype, default
+attributes, attributes, argument count checks, and implicit C<$self> overriden
+by an explicit invocant declaration):
+
+ method foo($this: $x, $y, $z = sqrt 5)
+ :($$$;$)
+ :lvalue
+ :Banana(2 + 2)
+ {
+ ...
+ }
-If you want to wrap C<Function::Parameters>, you may find C<import_into>
-helpful. It lets you specify a target package for the syntax magic, as in:
+And here's what it turns into:
- package Some::Wrapper;
- use Function::Parameters ();
- sub import {
- my $caller = caller;
- Function::Parameters::import_into $caller;
- # or Function::Parameters::import_into $caller, @other_import_args;
- }
+ sub foo ($$$;$) :method :lvalue :Banana(2 + 2) {
+ sub foo ($$$;$);
+ Carp::croak "Not enough arguments for method foo" if @_ < 3;
+ Carp::croak "Too many arguments for method foo" if @_ > 4;
+ my $this = shift;
+ my ($x, $y, $z) = @_;
+ $z = sqrt 5 if @_ < 3;
+ ...
+ }
-C<import_into> is not exported by this module, so you have to use a fully
-qualified name to call it.
+Another example:
+
+ my $coderef = fun ($p, $q)
+ :(;$$)
+ :lvalue
+ :Gazebo((>:O)) {
+ ...
+ };
+
+And the generated code:
+
+ my $coderef = sub (;$$) :lvalue :Gazebo((>:O)) {
+ # vvv only if check_argument_count is enabled vvv
+ Carp::croak "Not enough arguments for fun (anon)" if @_ < 2;
+ Carp::croak "Too many arguments for fun (anon)" if @_ > 2;
+ # ^^^ ^^^
+ my ($p, $q) = @_;
+ ...
+ };
+
+=head2 Wrapping Function::Parameters
+
+If you want to wrap L<Function::Parameters>, you just have to call its
+C<import> method. It always applies to the file that is currently being parsed
+and its effects are L<lexical|perlpragma> (i.e. it works like L<warnings> or
+L<strict>).
+
+ package Some::Wrapper;
+ use Function::Parameters ();
+ sub import {
+ Function::Parameters->import;
+ # or Function::Parameters->import(@custom_import_args);
+ }
=head1 AUTHOR
=head1 COPYRIGHT & LICENSE
-Copyright 2010, 2011 Lukas Mai.
+Copyright 2010, 2011, 2012 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
projects / p5sagit/Function-Parameters.git / blobdiff