| 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 |