package Function::Parameters;
-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);
+use v5.14.0;
+use warnings;
-# 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;
+use XSLoader;
+BEGIN {
+ our $VERSION = '1.0004';
+ XSLoader::load;
+}
- for (my $level = $start; ; ++$level) {
- my ($pkg, $function) = (caller $level)[0, 3] or last;
- $function =~ /::import\z/ or return $caller;
- $caller = $pkg;
- }
- $defcaller
+sub _assert_valid_identifier {
+ my ($name, $with_dollar) = @_;
+ my $bonus = $with_dollar ? '\$' : '';
+ $name =~ /^${bonus}[^\W\d]\w*\z/
+ or confess qq{"$name" doesn't look like a valid identifier};
}
+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};
+}
-# Parse import spec and make shit happen.
-#
my @bare_arms = qw(function method);
+my %type_map = (
+ function => {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ named_parameters => 1,
+ },
+ method => {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ named_parameters => 1,
+ attrs => ':method',
+ shift => '$self',
+ invocant => 1,
+ },
+ classmethod => {
+ name => 'optional',
+ default_arguments => 1,
+ check_argument_count => 0,
+ named_parameters => 1,
+ 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;
- $name =~ /^[^\W\d]\w*\z/
- or confess qq{"$name" doesn't look like a valid identifier};
- my ($index) = grep $bare_arms[$_] eq $type, 0 .. $#bare_arms
- or confess qq{"$type" doesn't look like a valid type (one of ${\join ', ', @bare_arms})};
+ my ($name, $proto_type) = @$item;
+ _assert_valid_identifier $name;
+
+ 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})];
+ }
+
+ my %type = %$proto_type;
+ my %clean;
+
+ $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)];
+
+ $clean{shift} = delete $type{shift} || '';
+ _assert_valid_identifier $clean{shift}, 1 if $clean{shift};
+
+ $clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs);
+ _assert_valid_attributes $clean{attrs} if $clean{attrs};
- $spec{$name} = {const => mk_parse($index)};
+ $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};
+ $clean{named_parameters} = !!delete $type{named_parameters};
+
+ %type and confess "Invalid keyword property: @{[keys %type]}";
+
+ $spec{$name} = \%clean;
}
- Devel::Declare->setup_for($victim, \%spec);
- for my $name (keys %spec) {
- no strict 'refs';
- *{$victim . '::' . $name} = \&_declarator;
+ for my $kw (keys %spec) {
+ my $type = $spec{$kw};
+
+ 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};
+ $flags |= FLAG_NAMED_PARAMS if $type->{named_parameters};
+ $^H{HINTK_FLAGS_ . $kw} = $flags;
+ $^H{HINTK_SHIFT_ . $kw} = $type->{shift};
+ $^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
+ $^H{+HINTK_KEYWORDS} .= "$kw ";
}
}
-sub import {
+sub unimport {
my $class = shift;
- my $caller = guess_caller;
- import_into $caller, @_;
-}
-sub _declarator {
- $_[0]
+ if (!@_) {
+ delete $^H{+HINTK_KEYWORDS};
+ return;
+ }
+
+ for my $kw (@_) {
+ $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g;
+ }
}
-# 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]
-}
+'ok'
-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;
-}
+__END__
-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';
-}
+=encoding UTF-8
-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;
- }
- }
+=head1 NAME
- if ($c eq ')') {
- $ctx->{offset}++;
- _skip_space $ctx, 'params';
- return;
- }
+Function::Parameters - subroutine definitions with parameter lists
- if ($c eq '') {
- croak "Unexpected EOF in parameter list";
- }
+=head1 SYNOPSIS
- croak "Unexpected '$c' in parameter list";
- }
-}
+ use Function::Parameters qw(:strict);
+
+ # simple function
+ fun foo($bar, $baz) {
+ return $bar + $baz;
+ }
+
+ # function with prototype
+ fun mymap($fun, @args)
+ :(&@)
+ {
+ my @res;
+ for (@args) {
+ push @res, $fun->($_);
+ }
+ @res
+ }
+
+ 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 optional parameters
+ fun search($haystack, $needle = qr/^(?!)/, $offset = 0) {
+ ...
+ }
+
+ # method with named parameters
+ method resize(:$width, :$height) {
+ $self->{width} = $width;
+ $self->{height} = $height;
+ }
+
+ $obj->resize(height => 4, width => 5);
+
+ # function with named optional parameters
+ fun search($haystack, :$needle = qr/^(?!)/, :$offset = 0) {
+ ...
+ }
+
+ my $results = search $text, offset => 200;
-sub _parse_parens {
- my ($ctx) = @_;
+=head1 DESCRIPTION
- my $strlen = Devel::Declare::toke_scan_str $ctx->{offset};
- $strlen == 0 || $strlen == -1 and return;
+This module extends Perl with keywords that let you define functions with
+parameter lists. It uses Perl's L<keyword plugin|perlapi/PL_keyword_plugin>
+API, so it works reliably and doesn't require a source filter.
- $strlen < 0 and confess "Devel::Declare::toke_scan_str done fucked up ($strlen); see https://rt.cpan.org/Ticket/Display.html?id=51679";
+=head2 Basics
- my $str = Devel::Declare::get_lex_stuff;
- Devel::Declare::clear_lex_stuff;
+The anatomy of a function (as recognized by this module):
- $ctx->{offset} += $strlen;
+=over
- $str
-}
+=item 1.
-sub _grab_proto {
- my ($ctx) = @_;
+The keyword introducing the function.
- my $savepos = $ctx->{offset};
+=item 2.
- substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq ':'
- or return;
- $ctx->{offset}++;
- _skip_space $ctx, 'proto_tmp';
+The function name (optional).
- unless (substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq '(') {
- $ctx->{offset} = $savepos;
- delete $ctx->{space}{proto_tmp};
- return;
- }
- $_->{proto} .= delete $_->{proto_tmp} for $ctx->{space};
+=item 3.
- defined(my $str = _parse_parens $ctx)
- or croak "Malformed prototype";
- $ctx->{proto} = $str;
+The parameter list (optional).
- _skip_space $ctx, 'proto';
-}
+=item 4.
-sub _grab_attr {
- my ($ctx) = @_;
+The prototype (optional).
- my $pcount = 0;
+=item 5.
- if (substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq ':') {
- $ctx->{offset}++;
- _skip_space $ctx, "attr_$pcount";
- } elsif (!defined $ctx->{proto}) {
- return;
- }
+The attribute list (optional).
- 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++;
+=item 6.
- if (substr(Devel::Declare::get_linestr, $ctx->{offset}, 1) eq ':') {
- $ctx->{offset}++;
- _skip_space $ctx, "attr_$pcount";
- }
- }
-}
+The function body.
-# 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, $implicit_self) = @_;
+=back
- my $gen = '(do{sub';
+Example:
- my $skipped = join '', values %{$ctx->{space}};
- my $lines = $skipped =~ tr/\n//;
- $gen .= "\n" x $lines;
+ # (1) (2) (3) (4) (5) (6)
+ fun foo ($x, $y) :($$) :lvalue { ... }
+
+ # (1) (6)
+ my $f = fun { ... };
- my $proto = defined $ctx->{proto} ? "($ctx->{proto})" : '';
+In the following section I'm going to describe all parts in order from simplest to most complex.
- my $is_stmt = 0;
- if (defined(my $name = $ctx->{name})) {
- $is_stmt = 1;
- $gen .= " $name$proto;";
- $gen .= "sub $name";
- }
+=head3 Body
- $gen .= $proto;
+This is just a normal block of statements, as with L<C<sub>|perlsub>. No surprises here.
- if (defined $ctx->{attr}) {
- $gen .= ":$ctx->{attr}";
- }
+=head3 Name
- $gen .= '{';
- $gen .= "BEGIN{${\__PACKAGE__}::_fini($is_stmt)}";
+If present, it specifies the name of the function being defined. As with
+L<C<sub>|perlsub>, if a name is present, the whole declaration is syntactically
+a statement and its effects are performed at compile time (i.e. at runtime you
+can call functions whose definitions only occur later in the file). If no name
+is present, the declaration is an expression that evaluates to a reference to
+the function in question. No surprises here either.
- if ($implicit_self) {
- $gen .= 'my$self=shift;';
- }
- if (defined $ctx->{params}) {
- $gen .= "my($ctx->{params})=\@_;";
- }
- $gen
-}
+=head3 Attributes
-sub mk_parse {
- my ($implicit_self) = @_;
+Attributes are relatively unusual in Perl code, but if you want them, they work
+exactly the same as with L<C<sub>|perlsub/Subroutine-Attributes>.
- sub {
- my ($declarator, $offset_orig) = @_;
- my $ctx = {
- offset => $offset_orig,
- space => {},
- };
+=head3 Prototype
- $ctx->{offset} += Devel::Declare::toke_move_past_token($ctx->{offset});
- _skip_space $ctx;
+As with L<C<sub>|perlsub/Prototypes>, a prototype, if present, contains hints as to how
+the compiler should parse calls to this function. This means prototypes have no
+effect if the function call is compiled before the function declaration has
+been seen by the compiler or if the function to call is only determined at
+runtime (e.g. because it's called as a method or through a reference).
- my $start = $ctx->{offset};
+With L<C<sub>|perlsub>, a prototype comes directly after the function name (if
+any). C<Function::Parameters> reserves this spot for the
+L<parameter list|/"Parameter list">. To specify a prototype, put it as the
+first attribute (e.g. C<fun foo :(&$$)>). This is syntactically unambiguous
+because normal L<attributes|/Attributes> need a name after the colon.
- _grab_name $ctx;
- _grab_params $ctx;
- _grab_proto $ctx;
- _grab_attr $ctx;
+=head3 Parameter list
- my $offset = $ctx->{offset};
+The parameter list is a list of variables enclosed in parentheses, except it's
+actually a bit more complicated than that. A parameter list can include the
+following 6 parts, all of which are optional:
- my $linestr = Devel::Declare::get_linestr;
- substr($linestr, $offset, 1) eq '{'
- or croak qq[I was expecting a function body, not "${\substr $linestr, $offset}"];
+=over
- my $gen = _generate $ctx, $declarator, $implicit_self;
- my $oldlen = $offset + 1 - $start;
- _substring $linestr, $start, $offset + 1, (' ' x $oldlen) . $gen;
- Devel::Declare::set_linestr $linestr;
- }
-}
+=item 1. Invocant
-# 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;
- };
-}
+This is a scalar variable followed by a colon (C<:>) and no comma. If an
+invocant is present in the parameter list, the first element of
+L<C<@_>|perlvar/@ARG> is automatically L<C<shift>ed|perlfunc/shift> off and
+placed in this variable. This is intended for methods:
-'ok'
+ method new($class: %init) {
+ return bless { %init }, $class;
+ }
-__END__
+ method throw($self:) {
+ die $self;
+ }
-=head1 NAME
+=item 2. Required positional parameters
-Function::Parameters - subroutine definitions with parameter lists
+The most common kind of parameter. This is simply a comma-separated list of
+scalars, which are filled from left to right with the arguments that the caller
+passed in:
-=head1 SYNOPSIS
+ fun add($x, $y) {
+ return $x + $y;
+ }
+
+ say add(2, 3); # "5"
+
+=item 3. Optional positional parameters
+
+Parameters can be marked as optional by putting an equals sign (C<=>) and an
+expression (the "default argument") after them. If no corresponding argument is
+passed in by the caller, the default argument will be used to initialize the
+parameter:
- use Function::Parameters;
+ fun scale($base, $factor = 2) {
+ return $base * $factor;
+ }
- fun foo($bar, $baz) {
- return $bar + $baz;
- }
+ say scale(3, 5); # "15"
+ say scale(3); # "6"
+
+The default argument is I<not> cached. Every time a function is called with
+some optional arguments missing, the corresponding default arguments are
+evaluated from left to right. This makes no difference for a value like C<2>
+but it is important for expressions with side effects, such as reference
+constructors (C<[]>, C<{}>) or function calls.
+
+Default arguments see not only the surrounding lexical scope of their function
+but also any preceding parameters. This allows the creation of dynamic defaults
+based on previous arguments:
+
+ method set_name($self: $nick = $self->default_nick, $real_name = $nick) {
+ $self->{nick} = $nick;
+ $self->{real_name} = $real_name;
+ }
- fun mymap($fun, @args) :(&@) {
- my @res;
- for (@args) {
- push @res, $fun->($_);
- }
- @res
- }
+ $obj->set_name("simplicio"); # same as: $obj->set_name("simplicio", "simplicio");
+
+Because default arguments are actually evaluated as part of the function body,
+you can also do silly things like this:
+
+ fun foo($n = return "nope") {
+ "you gave me $n"
+ }
- print "$_\n" for mymap { $_ * 2 } 1 .. 4;
+ say foo(2 + 2); # "you gave me 4"
+ say foo(); # "nope"
+
+=item 4. Required named parameters
+
+By putting a colon (C<:>) in front of a parameter you can make it named
+instead of positional:
+
+ fun rectangle(:$width, :$height) {
+ ...
+ }
- method set_name($name) {
- $self->{name} = $name;
- }
+ rectangle(width => 2, height => 5);
+ rectangle(height => 5, width => 2); # same thing!
+
+That is, the caller must specify a key name in addition to the value, but in
+exchange the order of the arguments doesn't matter anymore. As with hash
+initialization, you can specify the same key multiple times and the last
+occurrence wins:
+
+ rectangle(height => 1, width => 2, height => 2, height => 5;
+ # same as: rectangle(width => 2, height => 5);
+
+You can combine positional and named parameters as long as the positional
+parameters come first:
+
+ fun named_rectangle($name, :$width, :$height) {
+ ...
+ }
+
+ named_rectangle("Avocado", width => 0.5, height => 1.2);
+
+=item 5. Optional named parameters
+
+As with positional parameters, you can make named parameters optional by
+specifying a default argument after an equals sign (C<=>):
+
+ fun rectangle(:$width, :$height, :$color = "chartreuse") {
+ ...
+ }
+
+ rectangle(height => 10, width => 5);
+ # same as: rectangle(height => 10, width => 5, color => "chartreuse");
=cut
=pod
+
+ fun get($url, :$cookie_jar = HTTP::Cookies->new(), :$referrer = $url) {
+ ...
+ }
+
+ my $data = get "http://www.example.com/", referrer => undef; # overrides $referrer = $url
+
+The above example shows that passing any value (even C<undef>) will override
+the default argument.
+
+=item 6. Slurpy parameter
- use Function::Parameters 'proc', 'meth';
+Finally you can put an array or hash in the parameter list, which will gobble
+up the remaining arguments (if any):
+
+ fun foo($x, $y, @rest) { ... }
- my $f = proc ($x) { $x * 2 };
- meth get_age() {
- return $self->{age};
- }
+ foo "a", "b"; # $x = "a", $y = "b", @rest = ()
+ foo "a", "b", "c"; # $x = "a", $y = "b", @rest = ("c")
+ foo "a", "b", "c", "d"; # $x = "a", $y = "b", @rest = ("c", "d")
-=head1 DESCRIPTION
+If you combine this with named parameters, the slurpy parameter will end up
+containing all unrecognized keys:
-This module lets you use parameter lists in your subroutines. Thanks to
-L<Devel::Declare> it works without source filters.
+ fun bar(:$size, @whatev) { ... }
+
+ bar weight => 20, size => 2, location => [0, -3];
+ # $size = 2, @whatev = ('weight', 20, 'location', [0, -3])
-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.
+=back
-=head2 Basic stuff
+Apart from the L<C<shift>|perlfunc/shift> performed by the L<invocant|/"1.
+Invocant">, all of the above leave L<C<@_>|perlvar/@ARG> unchanged; and if you
+don't specify a parameter list at all, L<C<@_>|perlvar/@ARG> is all you get.
-To use this new functionality, you have to use C<fun> instead of C<sub> -
-C<sub> continues to work as before. The syntax is almost the same as for
-C<sub>, but after the subroutine name (or directly after C<fun> if you're
-writing an anonymous sub) you can write a parameter list in parentheses. This
-list consists of comma-separated variables.
+=head3 Keyword
-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/"@_">.
+The keywords provided by C<Function::Parameters> are customizable. Since
+C<Function::Parameters> is actually a L<pragma|perlpragma>, the provided
+keywords have lexical scope. The following import variants can be used:
-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
-C<method foo($bar, $baz) {> you get the same effect as
-C<sub foo { my $self = shift; my ($bar, $baz) = @_; >.
+=over
-=head2 Customizing the generated keywords
+=item C<use Function::Parameters ':strict'>
-You can customize the names of the keywords injected in your package. To do that
-you pass a hash reference in the import list:
+Provides the keywords C<fun> and C<method> (described below) and enables
+argument checks so that calling a function and omitting a required argument (or
+passing too many arguments) will throw an error.
- use Function::Parameters { proc => 'function', meth => 'method' }; # -or-
- use Function::Parameters { proc => 'function' }; # -or-
- use Function::Parameters { meth => 'method' };
+=item C<use Function::Parameters>
-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> or C<method>. The difference between
-C<function> and C<method> is that C<method>s automatically
-L<shift|perlfunc/shift> their first argument into C<$self>.
+Provides the keywords C<fun> and C<method> (described below) and enables
+"lax" mode: Omitting a required argument sets it to C<undef> while excess
+arguments are silently ignored.
-The following shortcuts are available:
+=item C<< use Function::Parameters { KEYWORD1 => TYPE1, KEYWORD2 => TYPE2, ... } >>
- use Function::Parameters;
- # is equivalent to #
- use Function::Parameters { fun => 'function', method => 'method' };
+Provides completely custom keywords as described by their types. A "type" is
+either a string (one of the predefined types C<function>, C<method>,
+C<classmethod>, C<function_strict>, C<method_strict>, C<classmethod_strict>) or
+a reference to a hash with the following keys:
-=cut
+=over
-=pod
+=item C<name>
- use Function::Parameters 'foo';
- # is equivalent to #
- use Function::Parameters { 'foo' => 'function' };
+Valid values: C<optional> (default), C<required> (all functions defined with
+this keyword must have a name), and C<prohibited> (functions defined with this
+keyword must be anonymous).
-=cut
+=item C<shift>
-=pod
+Valid values: strings that look like scalar variables. This lets you specify a
+default L<invocant|/"1. Invocant">, i.e. a function defined with this keyword
+that doesn't have an explicit invocant in its parameter list will automatically
+L<C<shift>|perlfunc/shift> its first argument into the variable specified here.
- use Function::Parameters 'foo', 'bar';
- # is equivalent to #
- use Function::Parameters { 'foo' => 'function', 'bar' => 'method' };
-
-=head2 Other advanced stuff
-
-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
-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,
-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 }>.
-
-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).
-
-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:
-
- 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;
- }
+=item C<invocant>
+
+Valid values: booleans. If you set this to a true value, the keyword will
+accept L<invocants|/"1. Invocant"> in parameter lists; otherwise specifying
+an invocant in a function defined with this keyword is a syntax error.
+
+=item C<attributes>
+
+Valid values: strings containing (source code for) attributes. This causes any
+function defined with this keyword to have the specified
+L<attributes|attributes> (in addition to any attributes specified in the
+function definition itself).
+
+=item C<default_arguments>
+
+Valid values: booleans. This property is on by default; use
+C<< default_arguments => 0 >> to turn it off. This controls whether optional
+parameters are allowed. If it is turned off, using C<=> in parameter lists is
+a syntax error.
+
+=item C<check_argument_count>
+
+Valid values: booleans. If turned on, functions defined with this keyword will
+automatically check that they have been passed all required arguments and no
+excess arguments. If this check fails, an exception will by thrown via
+L<C<Carp::croak>|Carp>.
+
+=back
+
+The predefined type C<function> is equivalent to:
+
+ {
+ name => 'optional',
+ invocant => 0,
+ default_arguments => 1,
+ check_argument_count => 0,
+ }
+
+These are all default values, so C<function> is also equivalent to C<{}>.
+
+C<method> is equivalent to:
+
+ {
+ name => 'optional',
+ shift => '$self',
+ invocant => 1,
+ attributes => ':method',
+ default_arguments => 1,
+ check_argument_count => 0,
+ }
+
+
+C<classmethod> is equivalent to:
+
+ {
+ name => 'optional',
+ shift => '$class',
+ invocant => 1,
+ attributes => ':method',
+ default_arguments => 1,
+ check_argument_count => 0,
+ }
+
+C<function_strict>, C<method_strict>, and
+C<classmethod_strict> are like C<function>, C<method>, and
+C<classmethod>, respectively, but with C<< check_argument_count => 1 >>.
+
+=back
+
+Plain C<use Function::Parameters> is equivalent to
+C<< use Function::Parameters { fun => 'function', method => 'method' } >>.
+
+C<use Function::Parameters qw(:strict)> is equivalent to
+C<< use Function::Parameters { fun => 'function_strict', method => 'method_strict' } >>.
+
+=head2 Wrapping C<Function::Parameters>
+
+If you want to write a wrapper around C<Function::Parameters>, you only have to
+call its C<import> method. Due to its L<pragma|perlpragma> nature it always
+affects the file that is currently being compiled.
+
+ package Some::Wrapper;
+ use Function::Parameters ();
+ sub import {
+ Function::Parameters->import;
+ # or Function::Parameters->import(@custom_import_args);
+ }
+
+=head2 How it works
+
+The module is actually written in L<C|perlxs> and uses
+L<C<PL_keyword_plugin>|perlapi/PL_keyword_plugin> to generate opcodes directly.
+However, you can run L<C<perl -MO=Deparse ...>|B::Deparse> on your code to see
+what happens under the hood. In the simplest case (no argument checks, possibly
+an L<invocant|/"1. Invocant">, required positional/slurpy parameters only), the
+generated code corresponds to:
+
+ fun foo($x, $y, @z) { ... }
+ # ... turns into ...
+ sub foo { my ($x, $y, @z) = @_; sub foo; ... }
-C<import_into> is not exported by this module, so you have to use a fully
-qualified name to call it.
+ method bar($x, $y, @z) { ... }
+ # ... turns into ...
+ sub bar :method { my $self = shift; my ($x, $y, @z) = @_; sub bar; ... }
=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