Make perlcritic a bit happier
[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);
f46dd377
MG
13use Carp;
14
222de36b 15our $VERSION = 0.17;
f46dd377
MG
16
17# An ugly hack to go from caller() to the relevant parser state
18# variable
19my %parsers;
20
21sub 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
58sub 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
98sub 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
109sub textblock { goto \&verbatim }
110
f46dd377 111sub 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 133sub 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 155sub 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 183sub 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 1961;
49655cb6
MG
197__END__
198
199=encoding utf-8
200
201=head1 NAME
202
203Pod::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
252This module allows you to specify those constants that should be
253documented in your POD, and pull them out a run time in a fairly
254arbitrary fashion.
255
256Pod::Constants uses Pod::Parser to do the parsing of the source file.
257It has to open the source file it is called from, and does so directly
258either 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
263I 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
265reason why you think it should match other POD sections, drop me a
266line and if I'm convinced I'll put it in the standard version.
267
268For `for' and `begin' sections, only the first word is counted as
269being a part of the specifier, as opposed to `headN' and `item', where
270the entire rest of the line counts.
271
272=head1 FUNCTIONS
273
274=head2 import(@args)
275
276This function is called when we are "use"'d. It determines the source
277file by inspecting the value of caller() or $0.
278
279The form of @args is HOOK => $where.
280
281$where may be a scalar reference, in which case the contents of the
282POD section called "HOOK" will be loaded into $where.
283
284$where may be an array reference, in which case the contents of the
285array will be the contents of the POD section called "HOOK", split
286into lines.
287
288$where may be a hash reference, in which case any lines with a "=>"
289symbol present will have everything on the left have side of the =>
290operator as keys and everything on the right as values. You do not
291need to quote either, nor have trailing commas at the end of the
292lines.
293
294$where may be a code reference (sub { }), in which case the sub is
295called when the hook is encountered. $_ is set to the value of the
296POD paragraph.
297
298You may also specify the behaviour of whitespace trimming; by default,
299no trimming is done except on the HOOK names. Setting "-trim => 1"
300turns on a package "global" (until the next time import is called)
301that will trim the $_ sent for processing by the hook processing
302function (be it a given function, or the built-in array/hash
303splitters) for leading and trailing whitespace.
304
305The 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
309Note that the supplied functions for array and hash splitting are
310exactly equivalent to fairly simple Perl blocks:
311
312Array:
313
314 HOOK => sub { @array = split /\n/, $_ }
315
316Hash:
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
328Well, they're simple if you can grok map, a regular expression like
329that and a functional programming style. If you can't I'm sure it is
330probably voodoo to you.
331
332Here'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
346Very similar to straight "import", but you specify the source filename
347explicitly.
348
349=head2 add_hook(NAME => value)
350
351This function adds another hook, it is useful for dynamic updating of
352parsing through the document.
353
354For an example, please see t/01-constants.t in the source
355distribution. More detailed examples will be added in a later
356release.
357
358=head2 delete_hook(@list)
359
360Deletes the named hooks. Companion function to add_hook
361
f46dd377
MG
362=head2 CLOSURES AS DESTINATIONS
363
364If 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
366applying your own custom mutations to the POD to change it from human
367readable text into something your program can use.
368
369After I added this function, I just kept on thinking of cool uses for
370it. The nice, succinct code you can make with it is one of
371Pod::Constant's strongest features.
372
373Below are some examples.
374
375=head1 EXAMPLES
376
377=head2 Module Makefile.PL maintenance
378
379Tired of keeping those module Makefile.PL's up to date? Note: This
380method 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
442Sam Vilain, <samv@cpan.org>
443
444=head1 BUGS/TODO
445
446I keep thinking it would be nice to be able to import an =item list
447into an array or something, eg for a program argument list. But I'm
448not too sure how it would be all that useful in practice; you'd end up
449putting the function names for callbacks in the pod or something
450(perhaps not all that bad).
451
452Would this be useful?
453
454 Pod::Constants::import(Foo::SECTION => \$myvar);
455
456Debug output is not very readable
457
458=head1 PATCHES WELCOME
459
460If you have any suggestions for enhancements, they are much more likely
461to happen if you submit them as a patch to the distribution.
462
463Source is kept at
464
465 git://utsl.gen.nz/Pod-Constants
466
f46dd377 467
49655cb6 468=cut
This page took 0.03921 seconds and 4 git commands to generate.