lib/Function/Parameters.pm

   1 package Function::Parameters;
   2
   3 use v5.14.0;
   4
   5 use strict;
   6 use warnings;
   7
   8 use XSLoader;
   9 BEGIN {
  10         our $VERSION = '0.05_03';
  11         XSLoader::load;
  12 }
  13
  14 use Carp qw(confess);
  15
  16 sub _assert_valid_identifier {
  17         my ($name, $with_dollar) = @_;
  18         my $bonus = $with_dollar ? '\$' : '';
  19         $name =~ /^${bonus}[^\W\d]\w*\z/
  20                 or confess qq{"$name" doesn't look like a valid identifier};
  21 }
  22
  23 sub _assert_valid_attributes {
  24         my ($attrs) = @_;
  25         $attrs =~ /^\s*:\s*[^\W\d]\w*\s*(?:(?:\s|:\s*)[^\W\d]\w*\s*)*(?:\(|\z)/
  26                 or confess qq{"$attrs" doesn't look like valid attributes};
  27 }
  28
  29 my @bare_arms = qw(function method);
  30 my %type_map = (
  31         function => { name => 'optional' },
  32         method   => {
  33                 name => 'optional',
  34                 shift => '$self',
  35                 attrs => ':method',
  36         },
  37 );
  38
  39 sub import {
  40         my $class = shift;
  41
  42         @_ or @_ = {
  43                 fun => 'function',
  44                 method => 'method',
  45         };
  46         if (@_ == 1 && ref($_[0]) eq 'HASH') {
  47                 @_ = map [$_, $_[0]{$_}], keys %{$_[0]}
  48                         or return;
  49         }
  50
  51         my %spec;
  52
  53         my $bare = 0;
  54         for my $proto (@_) {
  55                 my $item = ref $proto
  56                         ? $proto
  57                         : [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})]
  58                 ;
  59                 my ($name, $proto_type) = @$item;
  60                 _assert_valid_identifier $name;
  61
  62                 unless (ref $proto_type) {
  63                         # use '||' instead of 'or' to preserve $proto_type in the error message
  64                         $proto_type = $type_map{$proto_type}
  65                                 || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
  66                 }
  67
  68                 my %type = %$proto_type;
  69                 my %clean;
  70
  71                 $clean{name} = delete $type{name} || 'optional';
  72                 $clean{name} =~ /^(?:optional|required|prohibited)\z/
  73                         or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
  74
  75                 $clean{shift} = delete $type{shift} || '';
  76                 _assert_valid_identifier $clean{shift}, 1 if $clean{shift};
  77
  78                 $clean{attrs} = delete $type{attrs} || '';
  79                 _assert_valid_attributes $clean{attrs} if $clean{attrs};
  80
  81                 %type and confess "Invalid keyword property: @{[keys %type]}";
  82
  83                 $spec{$name} = \%clean;
  84         }
  85
  86         for my $kw (keys %spec) {
  87                 my $type = $spec{$kw};
  88
  89                 $^H{HINTK_SHIFT_ . $kw} = $type->{shift};
  90                 $^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
  91                 $^H{HINTK_NAME_ . $kw} =
  92                         $type->{name} eq 'prohibited' ? FLAG_NAME_PROHIBITED :
  93                         $type->{name} eq 'required' ? FLAG_NAME_REQUIRED :
  94                         FLAG_NAME_OPTIONAL
  95                 ;
  96                 $^H{+HINTK_KEYWORDS} .= "$kw ";
  97         }
  98 }
  99
 100 sub unimport {
 101         my $class = shift;
 102
 103         if (!@_) {
 104                 delete $^H{+HINTK_KEYWORDS};
 105                 return;
 106         }
 107
 108         for my $kw (@_) {
 109                 $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g;
 110         }
 111 }
 112
 113
 114 'ok'
 115
 116 __END__
 117
 118 =head1 NAME
 119
 120 Function::Parameters - subroutine definitions with parameter lists
 121
 122 =head1 SYNOPSIS
 123
 124  use Function::Parameters;
 125
 126  fun foo($bar, $baz) {
 127    return $bar + $baz;
 128  }
 129
 130  fun mymap($fun, @args) :(&@) {
 131    my @res;
 132    for (@args) {
 133      push @res, $fun->($_);
 134    }
 135    @res
 136  }
 137
 138  print "$_\n" for mymap { $_ * 2 } 1 .. 4;
 139
 140  method set_name($name) {
 141    $self->{name} = $name;
 142  }
 143
 144 =cut
 145
 146 =pod
 147
 148  use Function::Parameters {
 149    proc => 'function',
 150    meth => 'method',
 151  };
 152
 153  my $f = proc ($x) { $x * 2 };
 154  meth get_age() {
 155    return $self->{age};
 156  }
 157
 158 =head1 DESCRIPTION
 159
 160 This module lets you use parameter lists in your subroutines. Thanks to
 161 L<PL_keyword_plugin|perlapi/PL_keyword_plugin> it works without source filters.
 162
 163 WARNING: This is my first attempt at writing L<XS code|perlxs> and I have
 164 almost no experience with perl's internals. So while this module might
 165 appear to work, it could also conceivably make your programs segfault.
 166 Consider this module alpha quality.
 167
 168 =head2 Basic stuff
 169
 170 To use this new functionality, you have to use C<fun> instead of C<sub> -
 171 C<sub> continues to work as before. The syntax is almost the same as for
 172 C<sub>, but after the subroutine name (or directly after C<fun> if you're
 173 writing an anonymous sub) you can write a parameter list in parentheses. This
 174 list consists of comma-separated variables.
 175
 176 The effect of C<fun foo($bar, $baz) {> is as if you'd written
 177 C<sub foo { my ($bar, $baz) = @_; >, i.e. the parameter list is simply
 178 copied into C<my> and initialized from L<@_|perlvar/"@_">.
 179
 180 In addition you can use C<method>, which understands the same syntax as C<fun>
 181 but automatically creates a C<$self> variable for you. So by writing
 182 C<method foo($bar, $baz) {> you get the same effect as
 183 C<sub foo { my $self = shift; my ($bar, $baz) = @_; >.
 184
 185 =head2 Customizing the generated keywords
 186
 187 You can customize the names of the keywords injected into your scope. To do
 188 that you pass a hash reference in the import list:
 189
 190  use Function::Parameters { proc => 'function', meth => 'method' }; # -or-
 191  use Function::Parameters { proc => 'function' }; # -or-
 192  use Function::Parameters { meth => 'method' };
 193
 194 The first line creates two keywords, C<proc> and C<meth> (for defining
 195 functions and methods, respectively). The last two lines only create one
 196 keyword. Generally the hash keys can be any identifiers you want while the
 197 values have to be either C<function>, C<method>, or a hash reference (see
 198 below). The difference between C<function> and C<method> is that C<method>s
 199 automatically L<shift|perlfunc/shift> their first argument into C<$self>.
 200
 201 The following shortcuts are available:
 202
 203  use Function::Parameters;
 204     # is equivalent to #
 205  use Function::Parameters { fun => 'function', method => 'method' };
 206
 207 =cut
 208
 209 =pod
 210
 211 The following shortcuts are deprecated and may be removed from a future version
 212 of the module:
 213
 214  # DEPRECATED
 215  use Function::Parameters 'foo';
 216    # is equivalent to #
 217  use Function::Parameters { 'foo' => 'function' };
 218
 219 =cut
 220
 221 =pod
 222
 223  # DEPRECATED
 224  use Function::Parameters 'foo', 'bar';
 225    # is equivalent to #
 226  use Function::Parameters { 'foo' => 'function', 'bar' => 'method' };
 227
 228 That is, if you want to pass arguments to L<Function::Parameters>, use a
 229 hashref, not a list of strings.
 230
 231 You can customize things even more by passing a hashref instead of C<function>
 232 or C<method>. This hash can have the following keys:
 233
 234 =over
 235
 236 =item C<name>
 237
 238 Valid values: C<optional> (default), C<required> (all uses of this keyword must
 239 specify a function name), and C<prohibited> (all uses of this keyword must not
 240 specify a function name). This means a C<< name => 'prohibited' >> keyword can
 241 only be used for defining anonymous functions.
 242
 243 =item C<shift>
 244
 245 Valid values: strings that look like a scalar variable. Any function created by
 246 this keyword will automatically L<shift|perlfunc/shift> its first argument into
 247 a local variable whose name is specified here.
 248
 249 =item C<attrs>
 250
 251 Valid values: strings that are valid source code for attributes. Any value
 252 specified here will be inserted as a subroutine attribute in the generated
 253 code. Thus:
 254
 255  use Function::Parameters { sub_l => { attrs => ':lvalue' } };
 256  sub_l foo() {
 257    ...
 258  }
 259
 260 turns into
 261
 262  sub foo :lvalue {
 263    ...
 264  }
 265
 266 =back
 267
 268 Plain C<'function'> is equivalent to C<< { name => 'optional' } >>, and plain
 269 C<'method'> is equivalent to
 270 C<< { name => 'optional', shift => '$self', attrs => ':method' } >>.
 271
 272 =head2 Syntax and generated code
 273
 274 Normally, Perl subroutines are not in scope in their own body, meaning the
 275 parser doesn't know the name C<foo> or its prototype while processing the body
 276 of C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
 277 C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the
 278 interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger
 279 a I<foo() called too early to check prototype> warning. This module attempts
 280 to fix all of this by adding a subroutine declaration before the definition,
 281 so the parser knows the name (and possibly prototype) while it processes the
 282 body. Thus C<fun foo($x) :($) { $x }> really turns into
 283 C<sub foo ($); sub foo ($) { my ($x) = @_; $x }>.
 284
 285 If you need L<subroutine attributes|perlsub/"Subroutine Attributes">, you can
 286 put them after the parameter list with their usual syntax.
 287
 288 Syntactically, these new parameter lists live in the spot normally occupied
 289 by L<prototypes|perlsub/"Prototypes">. However, you can include a prototype by
 290 specifying it as the first attribute (this is syntactically unambiguous
 291 because normal attributes have to start with a letter while a prototype starts
 292 with C<(>).
 293
 294 As an example, the following declaration uses every feature available
 295 (subroutine name, parameter list, prototype, attributes, and implicit
 296 C<$self>):
 297
 298  method foo($x, $y, @z) :($;$@) :lvalue :Banana(2 + 2) {
 299    ...
 300  }
 301
 302 And here's what it turns into:
 303
 304  sub foo ($;$@); sub foo ($;$@) :lvalue :Banana(2 + 2) { my $self = shift; my ($x, $y, @z) = @_;
 305    ...
 306  }
 307
 308 Another example:
 309
 310  my $coderef = fun ($p, $q) :(;$$)
 311    :lvalue
 312    :Gazebo((>:O)) {
 313    ...
 314  };
 315
 316 And the generated code:
 317
 318  my $coderef = sub (;$$) :lvalue :Gazebo((>:O)) { my ($p, $q) = @_;
 319    ...
 320  };
 321
 322 =head2 Wrapping Function::Parameters
 323
 324 If you want to wrap L<Function::Parameters>, you just have to call its
 325 C<import> method. It always applies to the file that is currently being parsed
 326 and its effects are lexical (i.e. it works like L<warnings> or L<strict>):
 327
 328  package Some::Wrapper;
 329  use Function::Parameters ();
 330  sub import {
 331    Function::Parameters->import;
 332    # or Function::Parameters->import(@other_import_args);
 333  }
 334
 335 =head1 AUTHOR
 336
 337 Lukas Mai, C<< <l.mai at web.de> >>
 338
 339 =head1 COPYRIGHT & LICENSE
 340
 341 Copyright 2010, 2011, 2012 Lukas Mai.
 342
 343 This program is free software; you can redistribute it and/or modify it
 344 under the terms of either: the GNU General Public License as published
 345 by the Free Software Foundation; or the Artistic License.
 346
 347 See http://dev.perl.org/licenses/ for more information.
 348
 349 =cut