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