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_02';
  11         XSLoader::load;
  12 }
  13
  14 use B::Hooks::EndOfScope qw(on_scope_end);
  15 use Carp qw(confess);
  16 use bytes ();
  17
  18 sub _assert_valid_identifier {
  19         my ($name, $with_dollar) = @_;
  20         my $bonus = $with_dollar ? '\$' : '';
  21         $name =~ /^${bonus}[^\W\d]\w*\z/
  22                 or confess qq{"$name" doesn't look like a valid identifier};
  23 }
  24
  25 my @bare_arms = qw(function method);
  26 my %type_map = (
  27         function => { name => 'optional' },
  28         method   => { name => 'optional', shift => '$self' },
  29 );
  30
  31 sub import {
  32         my $class = shift;
  33
  34         @_ or @_ = ('fun', 'method');
  35         if (@_ == 1 && ref($_[0]) eq 'HASH') {
  36                 @_ = map [$_, $_[0]{$_}], keys %{$_[0]}
  37                         or return;
  38         }
  39
  40         my %spec;
  41
  42         my $bare = 0;
  43         for my $proto (@_) {
  44                 my $item = ref $proto
  45                         ? $proto
  46                         : [$proto, $bare_arms[$bare++] || confess(qq{Don't know what to do with "$proto"})]
  47                 ;
  48                 my ($name, $type) = @$item;
  49                 _assert_valid_identifier $name;
  50
  51                 unless (ref $type) {
  52                         # use '||' instead of 'or' to preserve $type in the error message
  53                         $type = $type_map{$type}
  54                                 || confess qq["$type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
  55                 }
  56                 $type->{name} ||= 'optional';
  57                 $type->{name} =~ /^(?:optional|required|prohibited)\z/
  58                         or confess qq["$type->{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
  59                 if ($type->{shift}) {
  60                         _assert_valid_identifier $type->{shift}, 1;
  61                         bytes::length($type->{shift}) < SHIFT_NAME_LIMIT
  62                                 or confess qq["$type->{shift}" is longer than I can handle];
  63                 }
  64
  65                 $spec{$name} = $type;
  66         }
  67
  68         for my $kw (keys %spec) {
  69                 my $type = $spec{$kw};
  70
  71                 $^H{HINTK_SHIFT_ . $kw} = $type->{shift} || '';
  72                 $^H{HINTK_NAME_ . $kw} =
  73                         $type->{name} eq 'prohibited' ? FLAG_NAME_PROHIBITED :
  74                         $type->{name} eq 'required' ? FLAG_NAME_REQUIRED :
  75                         FLAG_NAME_OPTIONAL
  76                 ;
  77                 $^H{+HINTK_KEYWORDS} .= "$kw ";
  78         }
  79 }
  80
  81 sub unimport {
  82         my $class = shift;
  83
  84         if (!@_) {
  85                 delete $^H{+HINTK_KEYWORDS};
  86                 return;
  87         }
  88
  89         for my $kw (@_) {
  90                 $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g;
  91         }
  92 }
  93
  94 sub _fini {
  95         on_scope_end {
  96                 xs_fini;
  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 'proc', 'meth';
 136
 137  my $f = proc ($x) { $x * 2 };
 138  meth get_age() {
 139    return $self->{age};
 140  }
 141
 142 =head1 DESCRIPTION
 143
 144 This module lets you use parameter lists in your subroutines. Thanks to
 145 L<perlapi/PL_keyword_plugin> it works without source filters.
 146
 147 WARNING: This is my first attempt at writing L<XS code|perlxs> and I have
 148 almost no experience with perl's internals. So while this module might
 149 appear to work, it could also conceivably make your programs segfault.
 150 Consider this module alpha quality.
 151
 152 =head2 Basic stuff
 153
 154 To use this new functionality, you have to use C<fun> instead of C<sub> -
 155 C<sub> continues to work as before. The syntax is almost the same as for
 156 C<sub>, but after the subroutine name (or directly after C<fun> if you're
 157 writing an anonymous sub) you can write a parameter list in parentheses. This
 158 list consists of comma-separated variables.
 159
 160 The effect of C<fun foo($bar, $baz) {> is as if you'd written
 161 C<sub foo { my ($bar, $baz) = @_; >, i.e. the parameter list is simply
 162 copied into C<my> and initialized from L<@_|perlvar/"@_">.
 163
 164 In addition you can use C<method>, which understands the same syntax as C<fun>
 165 but automatically creates a C<$self> variable for you. So by writing
 166 C<method foo($bar, $baz) {> you get the same effect as
 167 C<sub foo { my $self = shift; my ($bar, $baz) = @_; >.
 168
 169 =head2 Customizing the generated keywords
 170
 171 You can customize the names of the keywords injected in your package. To do that
 172 you pass a hash reference in the import list:
 173
 174  use Function::Parameters { proc => 'function', meth => 'method' }; # -or-
 175  use Function::Parameters { proc => 'function' }; # -or-
 176  use Function::Parameters { meth => 'method' };
 177
 178 The first line creates two keywords, C<proc> and C<meth> (for defining
 179 functions and methods, respectively). The last two lines only create one
 180 keyword. Generally the hash keys can be any identifiers you want while the
 181 values have to be either C<function>, C<method>, or a hash reference (see
 182 below). The difference between C<function> and C<method> is that C<method>s
 183 automatically L<shift|perlfunc/shift> their first argument into C<$self>.
 184
 185 The following shortcuts are available:
 186
 187  use Function::Parameters;
 188     # is equivalent to #
 189  use Function::Parameters { fun => 'function', method => 'method' };
 190
 191 =cut
 192
 193 =pod
 194
 195  use Function::Parameters 'foo';
 196    # is equivalent to #
 197  use Function::Parameters { 'foo' => 'function' };
 198
 199 =cut
 200
 201 =pod
 202
 203  use Function::Parameters 'foo', 'bar';
 204    # is equivalent to #
 205  use Function::Parameters { 'foo' => 'function', 'bar' => 'method' };
 206
 207 You can customize things even more by passing a hashref instead of C<function>
 208 or C<method>. This hash can have the following keys:
 209
 210 =over
 211
 212 =item C<name>
 213
 214 Valid values: C<optional> (default), C<required> (all uses of this keyword must
 215 specify a function name), and C<prohibited> (all uses of this keyword must not
 216 specify a function name). This means a C<< name => 'prohibited' >> keyword can
 217 only be used for defining anonymous functions.
 218
 219 =item C<shift>
 220
 221 Valid values: strings that look like a scalar variable. Any function created by
 222 this keyword will automatically L<shift|perlfunc/shift> its first argument into
 223 a local variable with the name specified here.
 224
 225 =back
 226
 227 Plain C<function> is equivalent to C<< { name => 'optional' } >>, and plain
 228 C<method> is equivalent to C<< { name => 'optional', shift => '$self'} >>.
 229
 230 =head2 Other advanced stuff
 231
 232 Normally, Perl subroutines are not in scope in their own body, meaning the
 233 parser doesn't know the name C<foo> or its prototype while processing
 234 C<sub foo ($) { foo $bar[1], $bar[0]; }>, parsing it as
 235 C<$bar-E<gt>foo([1], $bar[0])>. Yes. You can add parens to change the
 236 interpretation of this code, but C<foo($bar[1], $bar[0])> will only trigger
 237 a I<foo() called too early to check prototype> warning. This module attempts
 238 to fix all of this by adding a subroutine declaration before the definition,
 239 so the parser knows the name (and possibly prototype) while it processes the
 240 body. Thus C<fun foo($x) :($) { $x }> really turns into
 241 C<sub foo ($); sub foo ($) { my ($x) = @_; $x }>.
 242
 243 If you need L<subroutine attributes|perlsub/"Subroutine Attributes">, you can
 244 put them after the parameter list with their usual syntax.
 245
 246 Syntactically, these new parameter lists live in the spot normally occupied
 247 by L<prototypes|perlsub/"Prototypes">. However, you can include a prototype by
 248 specifying it as the first attribute (this is syntactically unambiguous
 249 because normal attributes have to start with a letter).
 250
 251 If you want to wrap L<Function::Parameters>, you just have to call its
 252 C<import> method. It always applies to the file that is currently being parsed
 253 and its effects are lexical (i.e. it works like L<warnings> or L<strict>);
 254
 255   package Some::Wrapper;
 256   use Function::Parameters ();
 257   sub import {
 258     Function::Parameters->import;
 259     # or Function::Parameters->import(@other_import_args);
 260   }
 261
 262 =head1 AUTHOR
 263
 264 Lukas Mai, C<< <l.mai at web.de> >>
 265
 266 =head1 COPYRIGHT & LICENSE
 267
 268 Copyright 2010, 2011, 2012 Lukas Mai.
 269
 270 This program is free software; you can redistribute it and/or modify it
 271 under the terms of either: the GNU General Public License as published
 272 by the Free Software Foundation; or the Artistic License.
 273
 274 See http://dev.perl.org/licenses/ for more information.
 275
 276 =cut