Commit | Line | Data |
---|---|---|
f46dd377 MG |
1 | # Copyright (C) 2001, 2002, 2007 Sam Vilain. All Rights Reserved. |
2 | # This module is free software. It may be used, redistributed and/or | |
3 | # modified under the terms of the Perl Artistic License, version 2 or | |
4 | # later, OR the terms of the GNU General Public License, v3 or later. | |
5 | ||
6 | package Pod::Constants; | |
7 | ||
222de36b | 8 | use 5.006002; |
f46dd377 | 9 | use strict; |
222de36b | 10 | use warnings; |
f46dd377 MG |
11 | |
12 | use base qw(Pod::Parser Exporter); | |
f46dd377 MG |
13 | use Carp; |
14 | ||
222de36b | 15 | our $VERSION = 0.17; |
f46dd377 MG |
16 | |
17 | # An ugly hack to go from caller() to the relevant parser state | |
18 | # variable | |
19 | my %parsers; | |
20 | ||
21 | sub end_input { | |
db966dd0 MG |
22 | #my ($parser, $command, $paragraph, $line_num) = (@_); |
23 | my $parser = shift; | |
24 | ||
25 | return unless $parser->{active}; | |
26 | ||
612aada2 | 27 | print "Found end of $parser->{active}\n" if $parser->{DEBUG}; |
db966dd0 | 28 | my $whereto = $parser->{wanted_pod_tags}->{$parser->{active}}; |
612aada2 | 29 | print "\$_ will be set to:\n---\n$parser->{paragraphs}\n---\n" if $parser->{DEBUG}; |
db966dd0 | 30 | |
612aada2 | 31 | $parser->{paragraphs} =~ s/^\s*|\s*$//gs if $parser->{trimmed_tags}->{$parser->{active}}; |
db966dd0 | 32 | |
fa6e78f4 | 33 | if (ref $whereto eq 'CODE') { |
db966dd0 MG |
34 | print "calling sub\n" if $parser->{DEBUG}; |
35 | local ($_) = $parser->{paragraphs}; | |
36 | $whereto->(); | |
37 | print "done\n" if $parser->{DEBUG}; | |
fa6e78f4 | 38 | } elsif (ref $whereto eq 'SCALAR') { |
db966dd0 MG |
39 | print "inserting into scalar\n" if $parser->{DEBUG}; |
40 | $$whereto = $parser->{paragraphs}; | |
fa6e78f4 | 41 | } elsif (ref $whereto eq 'ARRAY') { |
db966dd0 MG |
42 | print "inserting into array\n" if $parser->{DEBUG}; |
43 | @$whereto = split /\n/, $parser->{paragraphs}; | |
fa6e78f4 | 44 | } elsif (ref $whereto eq 'HASH') { |
db966dd0 MG |
45 | print "inserting into hash\n" if $parser->{DEBUG}; |
46 | # Oh, sorry, should I be in LISP101? | |
612aada2 | 47 | %$whereto = ( |
fa6e78f4 | 48 | map { map { s/^\s*|\s*$//g; $_ } split /=>/ } grep m/^ |
612aada2 MG |
49 | ( (?:[^=]|=[^>])+ ) # scan up to "=>" |
50 | => | |
51 | ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s | |
fa6e78f4 | 52 | $/x, split /\n/, $parser->{paragraphs},); |
db966dd0 MG |
53 | } else { die $whereto } |
54 | $parser->{active} = undef; | |
f46dd377 MG |
55 | } |
56 | ||
57 | # Pod::Parser overloaded command | |
58 | sub command { | |
db966dd0 MG |
59 | my ($parser, $command, $paragraph, $line_num) = @_; |
60 | ||
61 | $paragraph =~ s/(?:\r\n|\n\r)/\n/g; | |
62 | ||
612aada2 | 63 | print "Got command =$command, value=$paragraph\n" if $parser->{DEBUG}; |
db966dd0 MG |
64 | |
65 | $parser->end_input() if $parser->{active}; | |
66 | ||
db966dd0 MG |
67 | my ($lookup); |
68 | # first check for a catch-all for this command type | |
69 | if ( exists $parser->{wanted_pod_tags}->{"*$command"} ) { | |
70 | $parser->{paragraphs} = $paragraph; | |
71 | $parser->{active} = "*$command"; | |
db966dd0 MG |
72 | } elsif ($command =~ m/^(head\d+|item|(for|begin))$/) { |
73 | if ( $2 ) { | |
74 | # if it's a "for" or "begin" section, the title is the | |
75 | # first word only | |
612aada2 | 76 | ($lookup, $parser->{paragraphs}) = $paragraph =~ m/^\s*(\S*)\s*(.*)/s; |
db966dd0 MG |
77 | } else { |
78 | # otherwise, it's up to the end of the line | |
612aada2 | 79 | ($lookup, $parser->{paragraphs}) = $paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s; |
db966dd0 MG |
80 | } |
81 | ||
82 | # Look for a match by name | |
612aada2 | 83 | if (defined $lookup && exists $parser->{wanted_pod_tags}->{$lookup}) { |
db966dd0 MG |
84 | print "Found $lookup\n" if ($parser->{DEBUG}); |
85 | $parser->{active} = $lookup; | |
612aada2 MG |
86 | } elsif ($parser->{DEBUG}) { |
87 | local $^W = 0; | |
88 | print "Ignoring =$command $paragraph (lookup = $lookup)\n" | |
db966dd0 | 89 | } |
f46dd377 | 90 | |
f46dd377 | 91 | } else { |
db966dd0 MG |
92 | # nothing |
93 | print "Ignoring =$command (not known)\n" if $parser->{DEBUG}; | |
f46dd377 | 94 | } |
f46dd377 MG |
95 | } |
96 | ||
97 | # Pod::Parser overloaded verbatim | |
98 | sub verbatim { | |
db966dd0 MG |
99 | my ($parser, $paragraph, $line_num) = @_; |
100 | $paragraph =~ s/(?:\r\n|\n\r)/\n/g; | |
f46dd377 | 101 | |
fa6e78f4 | 102 | my $status = $parser->{active} ? 'using' : 'ignoring'; |
612aada2 | 103 | print "Got paragraph: $paragraph ($status)\n" if $parser->{DEBUG}; |
f46dd377 | 104 | |
612aada2 | 105 | $parser->{paragraphs} .= $paragraph if defined $parser->{active} |
f46dd377 MG |
106 | } |
107 | ||
108 | # Pod::Parser overloaded textblock | |
109 | sub textblock { goto \&verbatim } | |
110 | ||
f46dd377 | 111 | sub import { |
db966dd0 MG |
112 | my $class = shift; |
113 | ||
114 | # if no args, just return | |
115 | return unless (@_); | |
116 | ||
117 | # try to guess the source file of the caller | |
118 | my $source_file; | |
fa6e78f4 MG |
119 | if (caller ne 'main') { |
120 | (my $module = caller.'.pm') =~ s|::|/|g; | |
db966dd0 MG |
121 | $source_file = $INC{$module}; |
122 | } | |
123 | $source_file ||= $0; | |
124 | ||
612aada2 | 125 | croak "Cannot find source file (guessed $source_file) for package ".caller unless -f $source_file; |
db966dd0 MG |
126 | |
127 | # nasty tricks with the stack so we don't have to be silly with | |
128 | # caller() | |
129 | unshift @_, $source_file; | |
130 | goto \&import_from_file; | |
f46dd377 MG |
131 | } |
132 | ||
f46dd377 | 133 | sub import_from_file { |
db966dd0 | 134 | my $filename = shift; |
f46dd377 | 135 | |
db966dd0 | 136 | my $parser = __PACKAGE__->new(); |
f46dd377 | 137 | |
db966dd0 MG |
138 | $parser->{wanted_pod_tags} = {}; |
139 | $parser->{trimmed_tags} = {}; | |
140 | $parser->{trim_next} = 0; | |
141 | $parser->{DEBUG} = 0; | |
142 | $parser->{active} = undef; | |
143 | $parsers{caller()} = $parser; | |
f46dd377 | 144 | |
db966dd0 | 145 | $parser->add_hook(@_); |
f46dd377 | 146 | |
612aada2 | 147 | print "Pod::Parser: DEBUG: Opening $filename for reading\n" if $parser->{DEBUG}; |
fa6e78f4 | 148 | open my $fh, '<', $filename or croak "cannot open $filename for reading; $!"; |
f46dd377 | 149 | |
db966dd0 | 150 | $parser->parse_from_filehandle($fh, \*STDOUT); |
f46dd377 | 151 | |
db966dd0 | 152 | close $fh; |
f46dd377 MG |
153 | } |
154 | ||
f46dd377 | 155 | sub add_hook { |
db966dd0 | 156 | my $parser; |
fa6e78f4 | 157 | if (eval { $_[0]->isa(__PACKAGE__) }) { |
db966dd0 | 158 | $parser = shift; |
f46dd377 | 159 | } else { |
fa6e78f4 | 160 | $parser = $parsers{caller()} or croak 'add_hook called, but don\'t know what for - caller = '.caller; |
db966dd0 MG |
161 | } |
162 | while (my ($pod_tag, $var) = splice @_, 0, 2) { | |
163 | #print "$pod_tag: $var\n"; | |
fa6e78f4 | 164 | if (lc($pod_tag) eq '-trim') { |
db966dd0 | 165 | $parser->{trim_next} = $var; |
fa6e78f4 | 166 | } elsif ( lc($pod_tag) eq '-debug' ) { |
db966dd0 | 167 | $parser->{DEBUG} = $var; |
fa6e78f4 | 168 | } elsif (lc($pod_tag) eq '-usage') { |
db966dd0 MG |
169 | # an idea for later - automatic "usage" |
170 | #%wanted_pod_tags{@tags} | |
171 | } else { | |
172 | if ((ref $var) =~ /^(?:SCALAR|CODE|ARRAY|HASH)$/) { | |
612aada2 | 173 | print "Will look for $pod_tag.\n" if $parser->{DEBUG}; |
db966dd0 | 174 | $parser->{wanted_pod_tags}->{$pod_tag} = $var; |
612aada2 | 175 | $parser->{trimmed_tags}->{$pod_tag} = 1 if $parser->{trim_next}; |
db966dd0 | 176 | } else { |
fa6e78f4 | 177 | croak "Sorry - need a reference to import POD sections into, not the scalar value $var" |
db966dd0 MG |
178 | } |
179 | } | |
f46dd377 | 180 | } |
f46dd377 MG |
181 | } |
182 | ||
f46dd377 | 183 | sub delete_hook { |
db966dd0 | 184 | my $parser; |
fa6e78f4 | 185 | if (eval { $_[0]->isa(__PACKAGE__) }) { |
db966dd0 MG |
186 | $parser = shift; |
187 | } else { | |
fa6e78f4 | 188 | $parser = $parsers{caller()} or croak 'delete_hook called, but don\'t know what for - caller = '.caller; |
db966dd0 MG |
189 | } |
190 | while ( my $label = shift ) { | |
191 | delete $parser->{wanted_pod_tags}->{$label}; | |
192 | delete $parser->{trimmed_tags}->{$label}; | |
193 | } | |
f46dd377 MG |
194 | } |
195 | ||
fa6e78f4 | 196 | 1; |
49655cb6 MG |
197 | __END__ |
198 | ||
199 | =encoding utf-8 | |
200 | ||
201 | =head1 NAME | |
202 | ||
203 | Pod::Constants - Include constants from POD | |
204 | ||
205 | =head1 SYNOPSIS | |
206 | ||
612aada2 | 207 | our ($myvar, $VERSION, @myarray, $html, %myhash); |
49655cb6 MG |
208 | |
209 | use Pod::Constants -trim => 1, | |
210 | 'Pod Section Name' => \$myvar, | |
211 | 'Version' => sub { eval }, | |
212 | 'Some list' => \@myarray, | |
213 | html => \$html, | |
214 | 'Some hash' => \%myhash; | |
215 | ||
216 | =head2 Pod Section Name | |
217 | ||
218 | This string will be loaded into $myvar | |
219 | ||
220 | =head2 Version | |
221 | ||
222 | # This is an example of using a closure. $_ is set to the | |
223 | # contents of the paragraph. In this example, "eval" is | |
224 | # used to execute this code at run time. | |
225 | $VERSION = 0.17; | |
226 | ||
227 | =head2 Some list | |
228 | ||
229 | Each line from this section of the file | |
230 | will be placed into a separate array element. | |
231 | For example, this is $myarray[2]. | |
232 | ||
233 | =head2 Some hash | |
234 | ||
235 | This text will not go into the hash, because | |
236 | it doesn't look like a definition list. | |
237 | key1 => Some value (this will go into the hash) | |
238 | var2 => Some Other value (so will this) | |
239 | wtf = This won't make it in. | |
240 | ||
241 | =head2 %myhash's value after the above: | |
242 | ||
243 | ( key1 => "Some value (this will go into the hash)", | |
244 | var2 => "Some Other value (so will this)" ) | |
245 | ||
246 | =begin html <p>This text will be in $html</p> | |
247 | ||
248 | =cut | |
249 | ||
250 | =head1 DESCRIPTION | |
251 | ||
252 | This module allows you to specify those constants that should be | |
253 | documented in your POD, and pull them out a run time in a fairly | |
254 | arbitrary fashion. | |
255 | ||
256 | Pod::Constants uses Pod::Parser to do the parsing of the source file. | |
257 | It has to open the source file it is called from, and does so directly | |
258 | either by lookup in %INC or by assuming it is $0 if the caller is | |
259 | "main" (or it can't find %INC{caller()}) | |
260 | ||
261 | =head2 ARBITARY DECISIONS | |
262 | ||
263 | I have made this code only allow the "Pod Section Name" to match | |
264 | `headN', `item', `for' and `begin' POD sections. If you have a good | |
265 | reason why you think it should match other POD sections, drop me a | |
266 | line and if I'm convinced I'll put it in the standard version. | |
267 | ||
268 | For `for' and `begin' sections, only the first word is counted as | |
269 | being a part of the specifier, as opposed to `headN' and `item', where | |
270 | the entire rest of the line counts. | |
271 | ||
272 | =head1 FUNCTIONS | |
273 | ||
274 | =head2 import(@args) | |
275 | ||
276 | This function is called when we are "use"'d. It determines the source | |
277 | file by inspecting the value of caller() or $0. | |
278 | ||
279 | The form of @args is HOOK => $where. | |
280 | ||
281 | $where may be a scalar reference, in which case the contents of the | |
282 | POD section called "HOOK" will be loaded into $where. | |
283 | ||
284 | $where may be an array reference, in which case the contents of the | |
285 | array will be the contents of the POD section called "HOOK", split | |
286 | into lines. | |
287 | ||
288 | $where may be a hash reference, in which case any lines with a "=>" | |
289 | symbol present will have everything on the left have side of the => | |
290 | operator as keys and everything on the right as values. You do not | |
291 | need to quote either, nor have trailing commas at the end of the | |
292 | lines. | |
293 | ||
294 | $where may be a code reference (sub { }), in which case the sub is | |
295 | called when the hook is encountered. $_ is set to the value of the | |
296 | POD paragraph. | |
297 | ||
298 | You may also specify the behaviour of whitespace trimming; by default, | |
299 | no trimming is done except on the HOOK names. Setting "-trim => 1" | |
300 | turns on a package "global" (until the next time import is called) | |
301 | that will trim the $_ sent for processing by the hook processing | |
302 | function (be it a given function, or the built-in array/hash | |
303 | splitters) for leading and trailing whitespace. | |
304 | ||
305 | The name of HOOK is matched against any "=head1", "=head2", "=item", | |
306 | "=for", "=begin" value. If you specify the special hooknames "*item", | |
307 | "*head1", etc, then you will get a function that is run for every | |
308 | ||
309 | Note that the supplied functions for array and hash splitting are | |
310 | exactly equivalent to fairly simple Perl blocks: | |
311 | ||
312 | Array: | |
313 | ||
314 | HOOK => sub { @array = split /\n/, $_ } | |
315 | ||
316 | Hash: | |
317 | ||
318 | HOOK => sub { | |
319 | %hash = | |
320 | (map { map { s/^\s+|\s+$//g; $_ } split /=>/, $_ } | |
321 | (grep m/^ | |
322 | ( (?:[^=]|=[^>])+ ) # scan up to "=>" | |
323 | => | |
324 | ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s | |
325 | $/x, split /\n/, $_)); | |
326 | } | |
327 | ||
328 | Well, they're simple if you can grok map, a regular expression like | |
329 | that and a functional programming style. If you can't I'm sure it is | |
330 | probably voodoo to you. | |
331 | ||
332 | Here's the procedural equivalent: | |
333 | ||
334 | HOOK => sub { | |
335 | for my $line (split /\n/, $_) { | |
336 | my ($key, $value, $junk) = split /=>/, $line; | |
337 | next if $junk; | |
338 | $key =~ s/^\s+|\s+$//g | |
339 | $value =~ s/^\s+|\s+$//g | |
340 | $hash{$key} = $value; | |
341 | } | |
342 | }, | |
343 | ||
344 | =head2 import_from_file($filename, @args) | |
345 | ||
346 | Very similar to straight "import", but you specify the source filename | |
347 | explicitly. | |
348 | ||
349 | =head2 add_hook(NAME => value) | |
350 | ||
351 | This function adds another hook, it is useful for dynamic updating of | |
352 | parsing through the document. | |
353 | ||
354 | For an example, please see t/01-constants.t in the source | |
355 | distribution. More detailed examples will be added in a later | |
356 | release. | |
357 | ||
358 | =head2 delete_hook(@list) | |
359 | ||
360 | Deletes the named hooks. Companion function to add_hook | |
361 | ||
f46dd377 MG |
362 | =head2 CLOSURES AS DESTINATIONS |
363 | ||
364 | If the given value is a ref CODE, then that function is called, with | |
365 | $_ set to the value of the paragraph. This can be very useful for | |
366 | applying your own custom mutations to the POD to change it from human | |
367 | readable text into something your program can use. | |
368 | ||
369 | After I added this function, I just kept on thinking of cool uses for | |
370 | it. The nice, succinct code you can make with it is one of | |
371 | Pod::Constant's strongest features. | |
372 | ||
373 | Below are some examples. | |
374 | ||
375 | =head1 EXAMPLES | |
376 | ||
377 | =head2 Module Makefile.PL maintenance | |
378 | ||
379 | Tired of keeping those module Makefile.PL's up to date? Note: This | |
380 | method seems to break dh-make-perl. | |
381 | ||
382 | =head2 Example Makefile.PL | |
383 | ||
384 | eval "use Pod::Constants"; | |
385 | ($Pod::Constants::VERSION >= 0.11) | |
386 | or die <<EOF | |
387 | #### | |
388 | #### ERROR: This module requires Pod::Constants 0.11 or | |
389 | #### higher to be installed. | |
390 | #### | |
391 | EOF | |
392 | ||
393 | my ($VERSION, $NAME, $PREREQ_PM, $ABSTRACT, $AUTHOR); | |
394 | Pod::Constants::import_from_file | |
395 | ( | |
396 | 'MyTestModule.pm', | |
397 | 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+)/ }, | |
e18addae | 398 | 'DEPENDENCIES' => ($PREREQ_PM = { }), |
f46dd377 MG |
399 | -trim => 1, |
400 | 'NAME' => sub { $ABSTRACT=$_; ($NAME) = m/(\S+)/ }, | |
401 | 'AUTHOR' => \$AUTHOR, | |
402 | ); | |
403 | ||
404 | WriteMakefile | |
405 | ( | |
db966dd0 | 406 | 'NAME' => $NAME, |
f46dd377 MG |
407 | 'PREREQ_PM' => $PREREQ_PM, |
408 | 'VERSION' => $VERSION, | |
409 | ($] >= 5.005 ? ## Add these new keywords supported since 5.005 | |
410 | (ABSTRACT => $ABSTRACT, | |
411 | AUTHOR => $AUTHOR) : ()), | |
412 | ); | |
413 | ||
414 | =head2 Corresponding Module | |
415 | ||
416 | =head1 NAME | |
417 | ||
418 | MyTestModule - Demonstrate Pod::Constant's Makefile.PL usefulness | |
419 | ||
420 | =head2 MODULE RELEASE | |
421 | ||
422 | This is release 1.05 of this module. | |
423 | ||
e18addae | 424 | =head2 DEPENDENCIES |
f46dd377 MG |
425 | |
426 | The following modules are required to make this module: | |
427 | ||
428 | Some::Module => 0.02 | |
429 | ||
430 | =head2 AUTHOR | |
431 | ||
432 | Ima Twat <ima@twat.name> | |
433 | ||
434 | =cut | |
435 | ||
222de36b | 436 | our $VERSION; |
f46dd377 MG |
437 | use Pod::Constants -trim => 1, |
438 | 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+) or die }; | |
439 | ||
440 | =head1 AUTHOR | |
441 | ||
442 | Sam Vilain, <samv@cpan.org> | |
443 | ||
444 | =head1 BUGS/TODO | |
445 | ||
446 | I keep thinking it would be nice to be able to import an =item list | |
447 | into an array or something, eg for a program argument list. But I'm | |
448 | not too sure how it would be all that useful in practice; you'd end up | |
449 | putting the function names for callbacks in the pod or something | |
450 | (perhaps not all that bad). | |
451 | ||
452 | Would this be useful? | |
453 | ||
454 | Pod::Constants::import(Foo::SECTION => \$myvar); | |
455 | ||
456 | Debug output is not very readable | |
457 | ||
458 | =head1 PATCHES WELCOME | |
459 | ||
460 | If you have any suggestions for enhancements, they are much more likely | |
461 | to happen if you submit them as a patch to the distribution. | |
462 | ||
463 | Source is kept at | |
464 | ||
465 | git://utsl.gen.nz/Pod-Constants | |
466 | ||
f46dd377 | 467 | |
49655cb6 | 468 | =cut |