lib/Function/Parameters.pm

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