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