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