Commit | Line | Data |
7a63380c |
1 | package Function::Parameters; |
2 | |
7dd35535 |
3 | use v5.14.0; |
4 | |
7a63380c |
5 | use strict; |
6 | use warnings; |
7 | |
db81d362 |
8 | use XSLoader; |
9 | BEGIN { |
10 | our $VERSION = '0.05_01'; |
11 | XSLoader::load; |
7a63380c |
12 | } |
13 | |
db81d362 |
14 | use B::Hooks::EndOfScope qw(on_scope_end); |
15 | use Carp qw(confess); |
16 | use bytes (); |
7a63380c |
17 | |
2d5cf47a |
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 | |
125c067e |
25 | my @bare_arms = qw(function method); |
2d5cf47a |
26 | my %type_map = ( |
27 | function => { name => 'optional' }, |
28 | method => { name => 'optional', shift => '$self' }, |
29 | ); |
c9a39f6b |
30 | |
db81d362 |
31 | sub import { |
32 | my $class = shift; |
7a63380c |
33 | |
125c067e |
34 | @_ or @_ = ('fun', 'method'); |
35 | if (@_ == 1 && ref($_[0]) eq 'HASH') { |
36 | @_ = map [$_, $_[0]{$_}], keys %{$_[0]} |
37 | or return; |
38 | } |
7a63380c |
39 | |
125c067e |
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; |
2d5cf47a |
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)]; |
db81d362 |
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 | } |
125c067e |
64 | |
db81d362 |
65 | $spec{$name} = $type; |
125c067e |
66 | } |
67 | |
db81d362 |
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 "; |
125c067e |
78 | } |
eeb7df5f |
79 | } |
80 | |
db81d362 |
81 | sub unimport { |
eeb7df5f |
82 | my $class = shift; |
125c067e |
83 | |
db81d362 |
84 | if (!@_) { |
85 | delete $^H{+HINTK_KEYWORDS}; |
125c067e |
86 | return; |
87 | } |
88 | |
db81d362 |
89 | for my $kw (@_) { |
90 | $^H{+HINTK_KEYWORDS} =~ s/(?<![^ ])\Q$kw\E //g; |
125c067e |
91 | } |
92 | } |
93 | |
125c067e |
94 | sub _fini { |
7a63380c |
95 | on_scope_end { |
db81d362 |
96 | xs_fini; |
7a63380c |
97 | }; |
98 | } |
99 | |
db81d362 |
100 | |
125c067e |
101 | 'ok' |
7a63380c |
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; |
125c067e |
126 | |
127 | method set_name($name) { |
128 | $self->{name} = $name; |
129 | } |
7a63380c |
130 | |
125c067e |
131 | =cut |
132 | |
133 | =pod |
134 | |
135 | use Function::Parameters 'proc', 'meth'; |
c9a39f6b |
136 | |
125c067e |
137 | my $f = proc ($x) { $x * 2 }; |
138 | meth get_age() { |
139 | return $self->{age}; |
140 | } |
141 | |
7a63380c |
142 | =head1 DESCRIPTION |
143 | |
144 | This module lets you use parameter lists in your subroutines. Thanks to |
db81d362 |
145 | L<perlapi/PL_keyword_plugin> it works without source filters. |
7a63380c |
146 | |
db81d362 |
147 | WARNING: This is my first attempt at writing L<XS code|perlxs> and I have |
7a63380c |
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 |
125c067e |
157 | writing an anonymous sub) you can write a parameter list in parentheses. This |
7a63380c |
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 | |
125c067e |
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) = @_; >. |
7a63380c |
168 | |
125c067e |
169 | =head2 Customizing the generated keywords |
c9a39f6b |
170 | |
125c067e |
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: |
7a63380c |
173 | |
125c067e |
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 |
ce052c57 |
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>. |
125c067e |
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 | |
ce052c57 |
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 | |
125c067e |
230 | =head2 Other advanced stuff |
7a63380c |
231 | |
232 | Normally, Perl subroutines are not in scope in their own body, meaning the |
125c067e |
233 | parser doesn't know the name C<foo> or its prototype while processing |
7a63380c |
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 | |
125c067e |
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 | |
db81d362 |
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>); |
eeb7df5f |
254 | |
255 | package Some::Wrapper; |
256 | use Function::Parameters (); |
257 | sub import { |
db81d362 |
258 | Function::Parameters->import; |
259 | # or Function::Parameters->import(@other_import_args); |
eeb7df5f |
260 | } |
261 | |
7a63380c |
262 | =head1 AUTHOR |
263 | |
264 | Lukas Mai, C<< <l.mai at web.de> >> |
265 | |
266 | =head1 COPYRIGHT & LICENSE |
267 | |
db81d362 |
268 | Copyright 2010, 2011, 2012 Lukas Mai. |
7a63380c |
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 |