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