File Coverage

blib/lib/Method/Signatures/Simple.pm
Criterion Covered Total %
statement 45 45 100.0
branch 16 16 100.0
condition 13 16 81.2
subroutine 7 7 100.0
pod 1 3 33.3
total 82 87 94.2


line stmt bran cond sub pod time code
1             package Method::Signatures::Simple;
2             {
3             $Method::Signatures::Simple::VERSION = '1.07';
4             }
5              
6 8     8   201497 use warnings;
  8         25  
  8         283  
7 8     8   44 use strict;
  8         15  
  8         359  
8              
9             =head1 NAME
10              
11             Method::Signatures::Simple - Basic method declarations with signatures, without source filters
12              
13             =head1 VERSION
14              
15             version 1.07
16              
17             =cut
18              
19 8     8   43 use base 'Devel::Declare::MethodInstaller::Simple';
  8         17  
  8         15225  
20              
21             sub import {
22 12     12   489 my $class = shift;
23 12         36 my %opts = @_;
24 12   33     110 $opts{into} ||= caller;
25              
26 12   100     74 my $meth = delete $opts{name} || delete $opts{method_keyword};
27 12         29 my $func = delete $opts{function_keyword};
28              
29             # if no options are provided at all, then we supply defaults
30 12 100 100     91 unless (defined $meth || defined $func) {
31 9         24 $meth = 'method';
32 9         19 $func = 'func';
33             }
34              
35             # we only install keywords that are requested
36 12 100       41 if (defined $meth) {
37 11         106 $class->install_methodhandler(
38             name => $meth,
39             invocant => '$self',
40             %opts,
41             );
42             }
43 12 100       2969 if (defined $func) {
44 10         71 $class->install_methodhandler(
45             name => $func,
46             %opts,
47             invocant => undef,
48             );
49             }
50             }
51              
52             sub strip_proto {
53 16     16 0 33925 my $self = shift;
54 16 100       92 my ($proto) = $self->SUPER::strip_proto()
55             or return '';
56             # we strip comments and newlines here, and stash the number of newlines.
57             # we will re-inject the newlines in strip_attrs(), because DD does not
58             # like it when you inject them into the following code block. it does not
59             # object to tacking on newlines to the code attribute spec though.
60             # (see the call to inject_if_block() in DD::MethodInstaller::Simple->parser)
61 13         592 $proto =~ s/\s*#.*$//mg;
62 13         101 $self->{__nls} = $proto =~ s/[\r\n]//g;
63 13         44 $proto;
64             }
65              
66             sub strip_attrs {
67 16     16 0 113 my $self = shift;
68 16         267 my ($attrs) = $self->SUPER::strip_attrs();
69 16   100     394 $attrs ||= '';
70 16 100       68 $attrs .= $/ x $self->{__nls} if $self->{__nls};
71 16         64 $attrs;
72             }
73              
74             sub parse_proto {
75 21     21 1 4408 my $self = shift;
76 21         34 my ($proto) = @_;
77 21   100     179 $proto ||= '';
78 21         36 $proto =~ s/\s*#.*$//mg;
79 21         60 $proto =~ s/^\s+//mg;
80 21         58 $proto =~ s/\s+$//mg;
81 21         34 $proto =~ s/[\r\n]//g;
82 21         45 my $invocant = $self->{invocant};
83              
84 21 100       96 $invocant = $1 if $proto =~ s{(\$\w+)\s*:\s*}{};
85              
86 21         30 my $inject = '';
87 21 100       88 $inject .= "my ${invocant} = shift;" if $invocant;
88 21 100 66     120 $inject .= "my ($proto) = \@_;" if defined $proto and length $proto;
89 21         42 $inject .= '();'; # fix for empty method body
90              
91 21         69 return $inject;
92             }
93              
94              
95             =head1 SYNOPSIS
96              
97             # -- a basic class -- #
98             package User;
99             use Method::Signatures::Simple;
100              
101             method new ($class: $name, $email) {
102             my $user = {
103             id => new_id(42),
104             name => $name,
105             email => $email,
106             };
107             bless $user, $class;
108             }
109              
110             func new_id ($seed) {
111             state $id = $seed;
112             $id++;
113             }
114              
115             method name { $self->{name}; }
116             method email { $self->{email}; }
117             1;
118              
119              
120             # -- other features -- #
121             # attributes
122             method foo : lvalue { $self->{foo} }
123              
124             # change invocant name
125             use Method::Signatures::Simple invocant => '$this';
126             method foo ($bar) { $this->bar($bar) }
127             method bar ($class: $bar) { $class->baz($bar) }
128              
129             # use a different function keyword
130             use Method::Signatures::Simple function_keyword => 'fun';
131             fun triple ($num) { 3 * $num }
132              
133             # use a different method keyword
134             use Method::Signatures::Simple method_keyword => 'action';
135             action foo { $self->bar }
136              
137             =head1 RATIONALE
138              
139             This module provides basic C and C keywords with simple
140             signatures. It's intentionally simple, and is supposed to be a stepping stone
141             for its bigger brothers L and
142             L. It only has a small benefit over regular subs, so
143             if you want more features, look at those modules. But if you're looking
144             for a small amount of syntactic sugar, this might just be enough.
145              
146             =head1 FEATURES
147              
148             =over 4
149              
150             =item * invocant
151              
152             The C keyword automatically injects the annoying C
153             for you. You can rename the invocant with the first argument, followed by a
154             colon:
155              
156             method ($this:) {}
157             method ($this: $that) {}
158              
159             The C keyword doesn't inject an invocant, but does do the signature
160             processing below:
161              
162             func ($that) {}
163              
164             =item * signature
165              
166             The signature C<($sig)> is transformed into C<"my ($sig) = \@_;">. That way, we
167             mimic perl's usual argument handling.
168              
169             method foo ($bar, $baz, %opts) {
170             func xyzzy ($plugh, @zorkmid) {
171              
172             # becomes
173              
174             sub foo {
175             my $self = shift;
176             my ($bar, $baz, %opts) = @_;
177              
178             sub xyzzy {
179             my ($plugh, @zorkmid) = @_;
180              
181             =back
182              
183             =head1 ADVANCED CONFIGURATION
184              
185             Since this module subclasses L, you
186             can change the keywords and the default invocant with import arguments. These
187             changes affect the current scope.
188              
189             =over 4
190              
191             =item * change the invocant name
192              
193             use Method::Signatures::Simple invocant => '$this';
194             method x { $this->{x} }
195             method y { $this->{y} }
196              
197             # and this of course still works:
198             method z ($self:) { $self->{z} }
199              
200             =item * change the keywords
201              
202             You can install a different keyword (instead of the default 'method' and
203             'func'), by passing names to the C line:
204              
205             use Method::Signatures::Simple method_keyword => 'action',
206             function_keyword => 'thing';
207              
208             action foo ($some, $args) { ... }
209             thing bar ($whatever) { ... }
210              
211             One benefit of this is that you can use this module together with e.g.
212             L:
213              
214             # untested
215             use MooseX::Declare;
216              
217             class Foo {
218             use Method::Signatures::Simple method_keyword => 'routine';
219             method x (Int $x) { ... } # from MooseX::Method::Signatures
220             routine y ($y) { ... } # from this module
221             }
222              
223             If you specify neither C nor C, then we
224             default to injecting C and C. If you only specify one of these
225             options, then we only inject that one keyword into your scope.
226              
227             Examples:
228              
229             # injects 'method' and 'func'
230             use Method::Signatures::Simple;
231              
232             # only injects 'action'
233             use Method::Signatures::Simple method_keyword => 'action';
234              
235             # only injects 'procedure'
236             use Method::Signatures::Simple function_keyword => 'procedure';
237              
238             # injects 'action' and 'function'
239             use Method::Signatures::Simple method_keyword => 'action',
240             function_keyword => 'function';
241              
242             =item * install several keywords
243              
244             You're not limited to a single C line, so you can install several keywords with the same
245             semantics as 'method' into the current scope:
246              
247             use Method::Signatures::Simple; # provides 'method' and 'func'
248             use Method::Signatures::Simple method_keyword => 'action';
249              
250             method x { ... }
251             func y { ... }
252             action z { ... }
253              
254             =back
255              
256             =begin pod-coverage
257              
258             =over 4
259              
260             =item parse_proto
261              
262             Overridden.
263              
264             =back
265              
266             =end pod-coverage
267              
268             =head1 AUTHOR
269              
270             Rhesa Rozendaal, C<< >>
271              
272             =head1 BUGS
273              
274             Please report any bugs or feature requests to C, or through
275             the web interface at L. I will be notified, and then you'll
276             automatically be notified of progress on your bug as I make changes.
277              
278             =head1 SUPPORT
279              
280             You can find documentation for this module with the perldoc command.
281              
282             perldoc Method::Signatures::Simple
283              
284              
285             You can also look for information at:
286              
287             =over 4
288              
289             =item * RT: CPAN's request tracker
290              
291             L
292              
293             =item * AnnoCPAN: Annotated CPAN documentation
294              
295             L
296              
297             =item * CPAN Ratings
298              
299             L
300              
301             =item * Search CPAN
302              
303             L
304              
305             =back
306              
307             =head1 ACKNOWLEDGEMENTS
308              
309             =over 4
310              
311             =item * MSTROUT
312              
313             For writing L and providing the core concepts.
314              
315             =item * MSCHWERN
316              
317             For writing L and publishing about it. This is what got my attention.
318              
319             =item * FLORA
320              
321             For helping me abstracting the Devel::Declare bits and suggesting improvements.
322              
323             =item * CHIPS
324              
325             For suggesting we add a 'func' keyword.
326              
327             =back
328              
329             =head1 SEE ALSO
330              
331             L, L, L.
332              
333             =head1 COPYRIGHT & LICENSE
334              
335             Copyright 2011 Rhesa Rozendaal, all rights reserved.
336              
337             This program is free software; you can redistribute it and/or modify it
338             under the same terms as Perl itself.
339              
340              
341             =cut
342              
343             1; # End of Method::Signatures::Simple