line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Keyword::Simple; |
2
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
95038
|
use v5.12.0; |
|
3
|
|
|
|
|
14
|
|
|
3
|
|
|
|
|
216
|
|
4
|
3
|
|
|
3
|
|
18
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
102
|
|
5
|
|
|
|
|
|
|
|
6
|
3
|
|
|
3
|
|
18
|
use Carp qw(croak); |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
231
|
|
7
|
3
|
|
|
3
|
|
3489
|
use B::Hooks::EndOfScope; |
|
3
|
|
|
|
|
54072
|
|
|
3
|
|
|
|
|
22
|
|
8
|
|
|
|
|
|
|
|
9
|
3
|
|
|
3
|
|
310
|
use XSLoader; |
|
3
|
|
|
|
|
7
|
|
|
3
|
|
|
|
|
133
|
|
10
|
|
|
|
|
|
|
BEGIN { |
11
|
3
|
|
|
3
|
|
6
|
our $VERSION = '0.02'; |
12
|
3
|
|
|
|
|
2382
|
XSLoader::load __PACKAGE__, $VERSION; |
13
|
|
|
|
|
|
|
} |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# all shall burn |
16
|
|
|
|
|
|
|
our @meta; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub define { |
19
|
2
|
|
|
2
|
1
|
673
|
my ($kw, $sub) = @_; |
20
|
3
|
50
|
|
3
|
|
4744
|
$kw =~ /^\p{XIDS}\p{XIDC}*\z/ or croak "'$kw' doesn't look like an identifier"; |
|
3
|
|
|
|
|
31
|
|
|
3
|
|
|
|
|
45
|
|
|
2
|
|
|
|
|
21
|
|
21
|
2
|
50
|
|
|
|
13
|
ref($sub) eq 'CODE' or croak "'$sub' doesn't look like a coderef"; |
22
|
|
|
|
|
|
|
|
23
|
2
|
|
|
|
|
5
|
my $n = @meta; |
24
|
2
|
|
|
|
|
5
|
push @meta, $sub; |
25
|
|
|
|
|
|
|
|
26
|
2
|
|
|
|
|
36
|
$^H{+HINTK_KEYWORDS} .= " $kw:$n"; |
27
|
|
|
|
|
|
|
on_scope_end { |
28
|
2
|
|
|
2
|
|
534
|
delete $meta[$n]; |
29
|
2
|
|
|
|
|
17
|
}; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
sub undefine { |
33
|
0
|
|
|
0
|
1
|
|
my ($kw) = @_; |
34
|
0
|
0
|
|
|
|
|
$kw =~ /^\p{XIDS}\p{XIDC}*\z/ or croak "'$kw' doesn't look like an identifier"; |
35
|
|
|
|
|
|
|
|
36
|
0
|
|
|
|
|
|
$^H{+HINTK_KEYWORDS} .= " $kw:-"; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
'ok' |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
__END__ |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=encoding UTF-8 |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head1 NAME |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Keyword::Simple - define new keywords in pure Perl |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 SYNOPSIS |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
package Some::Module; |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
use Keyword::Simple; |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub import { |
56
|
|
|
|
|
|
|
# create keyword 'provided', expand it to 'if' at parse time |
57
|
|
|
|
|
|
|
Keyword::Simple::define 'provided', sub { |
58
|
|
|
|
|
|
|
my ($ref) = @_; |
59
|
|
|
|
|
|
|
substr($$ref, 0, 0) = 'if'; # inject 'if' at beginning of parse buffer |
60
|
|
|
|
|
|
|
}; |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub unimport { |
64
|
|
|
|
|
|
|
# lexically disable keyword again |
65
|
|
|
|
|
|
|
Keyword::Simple::undefine 'provided'; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
'ok' |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=head1 DESCRIPTION |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
Warning: This module is still new and experimental. The API may change in |
73
|
|
|
|
|
|
|
future versions. The code may be buggy. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
This module lets you implement new keywords in pure Perl. To do this, you need |
76
|
|
|
|
|
|
|
to write a module and call |
77
|
|
|
|
|
|
|
L<C<Keyword::Simple::define>|/Keyword::Simple::define> in your C<import> |
78
|
|
|
|
|
|
|
method. Any keywords defined this way will be available in the lexical scope |
79
|
|
|
|
|
|
|
that's currently being compiled. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=head2 Functions |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=over |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=item C<Keyword::Simple::define> |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
Takes two arguments, the name of a keyword and a coderef. Injects the keyword |
88
|
|
|
|
|
|
|
in the lexical scope currently being compiled. For every occurrence of the |
89
|
|
|
|
|
|
|
keyword, your coderef will be called with one argument: A reference to a scalar |
90
|
|
|
|
|
|
|
holding the rest of the source code (following the keyword). |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
You can modify this scalar in any way you like and after your coderef returns, |
93
|
|
|
|
|
|
|
perl will continue parsing from that scalar as if its contents had been the |
94
|
|
|
|
|
|
|
real source code in the first place. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=item C<Keyword::Simple::undefine> |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Takes one argument, the name of a keyword. Disables that keyword in the lexical |
99
|
|
|
|
|
|
|
scope that's currently being compiled. You can call this from your C<unimport> |
100
|
|
|
|
|
|
|
method to make the C<no Foo;> syntax work. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=back |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Every new keyword is actually a complete statement by itself. The parsing magic |
107
|
|
|
|
|
|
|
only happens afterwards. This means that e.g. the code in the L</SYNOPSIS> |
108
|
|
|
|
|
|
|
actually does this: |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
provided ($foo > 2) { |
111
|
|
|
|
|
|
|
... |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# expands to |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
; if |
117
|
|
|
|
|
|
|
($foo > 2) { |
118
|
|
|
|
|
|
|
... |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
The C<;> represents a no-op statement, the C<if> was injected by the Perl code, |
122
|
|
|
|
|
|
|
and the rest of the file is unchanged. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
This also means your new keywords can only occur at the beginning of a |
125
|
|
|
|
|
|
|
statement, not embedded in an expression. |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
There are barely any tests. |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head1 AUTHOR |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Lukas Mai, C<< <l.mai at web.de> >> |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
Copyright 2012, 2013 Lukas Mai. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
138
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
139
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut |