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