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