1package Keyword::Pluggable;
2
3use v5.14.0;
4use warnings;
5our %kw;
6
7use Carp qw(croak);
8
9use XSLoader;
10BEGIN {
11	our $VERSION = '1.04';
12	XSLoader::load __PACKAGE__, $VERSION;
13}
14
15sub define {
16	my %p = @_;
17	my ($kw, $sub, $expression, $global, $package) = @p{qw(keyword code expression global package)};
18	$kw =~ /^\p{XIDS}\p{XIDC}*\z/ or croak "'$kw' doesn't look like an identifier";
19	defined($sub) or croak "'code' is not defined";
20
21	my $xsub = (ref($sub) eq 'CODE') ? $sub :
22		sub { substr ${$_[0]}, 0, 0, $sub };
23
24	my $entry = [ $xsub, !!$expression ];
25
26	if ( defined $package) {
27		no strict 'refs';
28		my $keywords = \%{$package . '::/keywords' };
29		$keywords->{$kw} = $entry;
30	} elsif ( $global ) {
31		define_global($kw, $entry);
32	} else {
33		my %keywords = %{$^H{+HINTK_KEYWORDS} // {}};
34		$keywords{$kw} = $entry;
35		$^H{+HINTK_KEYWORDS} = \%keywords;
36	}
37}
38
39sub undefine {
40	my %p = @_;
41	my ($kw, $global, $package) = @p{qw(keyword global package)};
42	$kw =~ /^\p{XIDS}\p{XIDC}*\z/ or croak "'$kw' doesn't look like an identifier";
43
44	if ( defined $package ) {
45		no strict 'refs';
46		my $keywords = \%{$package . '::/keywords' };
47		delete $keywords->{$kw};
48	} elsif ( $global ) {
49		undefine_global($kw);
50	} else {
51		my %keywords = %{$^H{+HINTK_KEYWORDS} // {}};
52		delete $keywords{$kw};
53		$^H{+HINTK_KEYWORDS} = \%keywords;
54	}
55}
56
57END { cleanup() }
58
59'ok'
60
61__END__
62
63=encoding UTF-8
64
65=for highlighter language=perl
66
67=head1 NAME
68
69Keyword::Pluggable - define new keywords in pure Perl
70
71=head1 SYNOPSIS
72
73 package Some::Module;
74
75 use Keyword::Pluggable;
76
77 sub import {
78     # create keyword 'provided', expand it to 'if' at parse time
79     Keyword::Pluggable::define
80	 keyword => 'provided',
81	 package => scalar(caller),
82	 code    => 'if',
83     ;
84 }
85
86 sub unimport {
87    # disable keyword again
88    Keyword::Pluggable::undefine keyword => 'provided', package => scalar(caller);
89 }
90
91 'ok'
92
93=head1 DESCRIPTION
94
95Warning: This module is still new and experimental. The API may change in
96future versions. The code may be buggy. Also, this module is a fork from
97C<Keyword::Simple>, that somehow got stalled. If its author accepts pull
98requests, then it will probably be best to use it instead.
99
100This module lets you implement new keywords in pure Perl. To do this, you need
101to write a module and call
102L<C<Keyword::Pluggable::define>|/Keyword::Pluggable::define> in your C<import>
103method. Any keywords defined this way will be available in the scope
104that's currently being compiled. The scope can be lexical, packaged, and global.
105
106=head2 Functions
107
108=over
109
110=item C<Keyword::Pluggable::define %options>
111
112=over
113
114=item keyword
115
116The keyword is injected in the scope currently being compiled
117
118=item code (string or coderef)
119
120For every occurrence of the keyword, your coderef will be called and its result
121will be injected into perl's parse buffer, so perl will continue parsing as if
122its contents had been the real source code in the first place. First paramater
123to the eventual coderef will be all code textref following the keyword to be replaced,
124if examination and change is needed.
125
126=item expression
127
128Boolean flag; if true then the perl parser will treat new code as expression,
129otherwise as a statement
130
131=item global
132
133Boolean flag; if set, then the scope is global, otherwise it is lexical or packaged
134
135=item package
136
137If set, the scope will be limited to that package, otherwise it will be lexical
138
139=back
140
141=item C<Keyword::Pluggable::undefine %options>
142
143Allows options: C<keyword>, C<global>, C<package> (see above).
144
145Disables the keyword in the given scope. You can call this from your
146C<unimport> method to make the C<no Foo;> syntax work.
147
148=back
149
150=head1 BUGS AND LIMITATIONS
151
152This module depends on the L<pluggable keyword|perlapi.html/PL_keyword_plugin>
153API introduced in perl 5.12. C<parse_> functions were introduced in 5.14.
154Older versions of perl are not supported.
155
156Every new keyword is actually a complete statement or an expression by itself. The parsing magic
157only happens afterwards. This means that e.g. the code in the L</SYNOPSIS>
158actually does this:
159
160  provided ($foo > 2) {
161	...
162  }
163
164  # expands to
165
166  ; if
167  ($foo > 2) {
168	...
169  }
170
171The C<;> represents a no-op statement, the C<if> was injected by the Perl code,
172and the rest of the file is unchanged. This also means your it can
173only occur at the beginning of a statement, not embedded in an expression.
174To be able to do that, use C<< expression => 1 >> flag.
175
176Keywords in the replacement part of a C<s//.../e> substitution aren't handled
177correctly and break parsing.
178
179There are barely any tests.
180
181=head1 AUTHOR
182
183Lukas Mai, C<< <l.mai at web.de> >>
184
185Dmitry Karasik , C<< <dmitry at karasik.eu.org> >>
186
187=head1 COPYRIGHT & LICENSE
188
189Copyright (C) 2012, 2013 Lukas Mai.
190Copyright (C) 2018 Dmitry Karasik
191
192This program is free software; you can redistribute it and/or modify it
193under the terms of either: the GNU General Public License as published
194by the Free Software Foundation; or the Artistic License.
195
196See http://dev.perl.org/licenses/ for more information.
197
198=cut
199