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