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