]>
iEval git - pod-constants.git/blob - lib/Pod/Constants.pm
0ad1a556f9d3941b5e79b9d6608a463efd169e6a
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.
6 package Pod
::Constants
;
10 Pod::Constants - Include constants from POD
14 use vars qw($myvar $VERSION @myarray $html %myhash);
16 use Pod::Constants -trim => 1,
17 'Pod Section Name' => \$myvar,
18 'Version' => sub { eval },
19 'Some list' => \@myarray,
21 'Some hash' => \%myhash;
23 =head2 Pod Section Name
25 This string will be loaded into $myvar
29 # This is an example of using a closure. $_ is set to the
30 # contents of the paragraph. In this example, "eval" is
31 # used to execute this code at run time.
36 Each line from this section of the file
37 will be placed into a separate array element.
38 For example, this is $myarray[2].
42 This text will not go into the hash, because
43 it doesn't look like a definition list.
44 key1 => Some value (this will go into the hash)
45 var2 => Some Other value (so will this)
46 wtf = This won't make it in.
48 =head2 %myhash's value after the above:
50 ( key1 => "Some value (this will go into the hash)",
51 var2 => "Some Other value (so will this)" )
53 =begin html <p>This text will be in $html</p>
59 This module allows you to specify those constants that should be
60 documented in your POD, and pull them out a run time in a fairly
63 Pod::Constants uses Pod::Parser to do the parsing of the source file.
64 It has to open the source file it is called from, and does so directly
65 either by lookup in %INC or by assuming it is $0 if the caller is
66 "main" (or it can't find %INC{caller()})
68 =head2 ARBITARY DECISIONS
70 I have made this code only allow the "Pod Section Name" to match
71 `headN', `item', `for' and `begin' POD sections. If you have a good
72 reason why you think it should match other POD sections, drop me a
73 line and if I'm convinced I'll put it in the standard version.
75 For `for' and `begin' sections, only the first word is counted as
76 being a part of the specifier, as opposed to `headN' and `item', where
77 the entire rest of the line counts.
84 use base
qw(Pod::Parser Exporter);
88 use vars
qw($VERSION);
91 # An ugly hack to go from caller() to the relevant parser state
96 #my ($parser, $command, $paragraph, $line_num) = (@_);
99 return unless $parser->{active};
101 print "Found end of $parser->{active}\n" if ($parser->{DEBUG});
102 my $whereto = $parser->{wanted_pod_tags}->{$parser->{active}};
103 print "\$_ will be set to:\n---\n$parser->{paragraphs}\n---\n"
104 if ($parser->{DEBUG});
106 $parser->{paragraphs} =~ s/^\s*|\s*$//gs
107 if $parser->{trimmed_tags}->{$parser->{active}};
109 if (ref $whereto eq "CODE") {
110 print "calling sub\n" if $parser->{DEBUG};
111 local ($_) = $parser->{paragraphs};
113 print "done\n" if $parser->{DEBUG};
114 } elsif (ref $whereto eq "SCALAR") {
115 print "inserting into scalar\n" if $parser->{DEBUG};
116 $$whereto = $parser->{paragraphs};
117 } elsif (ref $whereto eq "ARRAY") {
118 print "inserting into array\n" if $parser->{DEBUG};
119 @$whereto = split /\n/, $parser->{paragraphs};
120 } elsif (ref $whereto eq "HASH") {
121 print "inserting into hash\n" if $parser->{DEBUG};
122 # Oh, sorry, should I be in LISP101?
123 %$whereto = (map { map { s/^\s*|\s*$//g; $_ }
126 ( (?:[^=]|=[^>])+ ) # scan up to "=>"
128 ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
130 split /\n/, $parser->{paragraphs});
131 } else { die $whereto }
132 $parser->{active} = undef;
135 # Pod::Parser overloaded command
137 my ($parser, $command, $paragraph, $line_num) = @_;
139 $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
141 print "Got command =$command, value=$paragraph\n"
144 $parser->end_input() if $parser->{active};
146 my $does_she_want_it_sir;
149 # first check for a catch-all for this command type
150 if ( exists $parser->{wanted_pod_tags}->{"*$command"} ) {
151 $parser->{paragraphs} = $paragraph;
152 $parser->{active} = "*$command";
153 $does_she_want_it_sir = "oohw";
155 } elsif ($command =~ m/^(head\d+|item|(for|begin))$/) {
157 # if it's a "for" or "begin" section, the title is the
159 ($lookup, $parser->{paragraphs}) =
160 ($paragraph =~ m/^\s*(\S*)\s*(.*)/s);
162 # otherwise, it's up to the end of the line
163 ($lookup, $parser->{paragraphs})
164 = ($paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s);
167 # Look for a match by name
169 and exists $parser->{wanted_pod_tags}->{$lookup}) {
170 print "Found $lookup\n" if ($parser->{DEBUG});
171 $parser->{active} = $lookup;
172 $does_she_want_it_sir = "suits you sir";
177 print "Ignoring =$command (not known)\n" if $parser->{DEBUG};
182 print "Ignoring =$command $paragraph (lookup = $lookup)\n"
183 if (!$does_she_want_it_sir and $parser->{DEBUG})
187 # Pod::Parser overloaded verbatim
189 my ($parser, $paragraph, $line_num) = @_;
190 $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
192 print("Got paragraph: $paragraph ("
193 .($parser->{active}?"using":"ignoring").")\n")
196 if (defined $parser->{active}) {
197 $parser->{paragraphs} .= $paragraph;
201 # Pod::Parser overloaded textblock
202 sub textblock { goto \&verbatim }
208 This function is called when we are "use"'d. It determines the source
209 file by inspecting the value of caller() or $0.
211 The form of @args is HOOK => $where.
213 $where may be a scalar reference, in which case the contents of the
214 POD section called "HOOK" will be loaded into $where.
216 $where may be an array reference, in which case the contents of the
217 array will be the contents of the POD section called "HOOK", split
220 $where may be a hash reference, in which case any lines with a "=>"
221 symbol present will have everything on the left have side of the =>
222 operator as keys and everything on the right as values. You do not
223 need to quote either, nor have trailing commas at the end of the
226 $where may be a code reference (sub { }), in which case the sub is
227 called when the hook is encountered. $_ is set to the value of the
230 You may also specify the behaviour of whitespace trimming; by default,
231 no trimming is done except on the HOOK names. Setting "-trim => 1"
232 turns on a package "global" (until the next time import is called)
233 that will trim the $_ sent for processing by the hook processing
234 function (be it a given function, or the built-in array/hash
235 splitters) for leading and trailing whitespace.
237 The name of HOOK is matched against any "=head1", "=head2", "=item",
238 "=for", "=begin" value. If you specify the special hooknames "*item",
239 "*head1", etc, then you will get a function that is run for every
241 Note that the supplied functions for array and hash splitting are
242 exactly equivalent to fairly simple Perl blocks:
246 HOOK => sub { @array = split /\n/, $_ }
252 (map { map { s/^\s+|\s+$//g; $_ } split /=>/, $_ }
254 ( (?:[^=]|=[^>])+ ) # scan up to "=>"
256 ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
257 $/x, split /\n/, $_));
260 Well, they're simple if you can grok map, a regular expression like
261 that and a functional programming style. If you can't I'm sure it is
262 probably voodoo to you.
264 Here's the procedural equivalent:
267 for my $line (split /\n/, $_) {
268 my ($key, $value, $junk) = split /=>/, $line;
270 $key =~ s/^\s+|\s+$//g
271 $value =~ s/^\s+|\s+$//g
272 $hash{$key} = $value;
281 # if no args, just return
284 # try to guess the source file of the caller
286 if (caller ne "main") {
287 (my $module = caller().".pm") =~ s|::|/|g;
288 $source_file = $INC{$module};
293 or croak ("Cannot find source file (guessed $source_file) for"
294 ." package ".caller());
296 # nasty tricks with the stack so we don't have to be silly with
298 unshift @_, $source_file;
299 goto \&import_from_file;
302 =head2 import_from_file($filename, @args)
304 Very similar to straight "import", but you specify the source filename
311 sub import_from_file {
312 my $filename = shift;
314 my $parser = __PACKAGE__->new();
316 $parser->{wanted_pod_tags} = {};
317 $parser->{trimmed_tags} = {};
318 $parser->{trim_next} = 0;
319 $parser->{DEBUG} = 0;
320 $parser->{active} = undef;
321 $parsers{caller()} = $parser;
323 $parser->add_hook(@_);
325 print "Pod::Parser: DEBUG: Opening $filename for reading\n"
327 my $fh = new IO::Handle;
328 open $fh, "<$filename"
329 or die ("cannot open $filename for reading; $!");
331 $parser->parse_from_filehandle($fh, \*STDOUT);
336 =head2 add_hook(NAME => value)
338 This function adds another hook, it is useful for dynamic updating of
339 parsing through the document.
341 For an example, please see t/01-constants.t in the source
342 distribution. More detailed examples will be added in a later
349 if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
352 $parser = $parsers{caller()}
353 or die("add_hook called, but don't know what for - "
354 ."caller = ".caller());
356 while (my ($pod_tag, $var) = splice @_, 0, 2) {
357 #print "$pod_tag: $var\n";
358 if (lc($pod_tag) eq "-trim") {
359 $parser->{trim_next} = $var;
360 } elsif ( lc($pod_tag) eq "-debug" ) {
361 $parser->{DEBUG} = $var;
362 } elsif (lc($pod_tag) eq "-usage") {
363 # an idea for later - automatic "usage"
364 #%wanted_pod_tags{@tags}
366 if ((ref $var) =~ /^(?:SCALAR|CODE|ARRAY|HASH)$/) {
367 print "Will look for $pod_tag.\n"
368 if ($parser->{DEBUG});
369 $parser->{wanted_pod_tags}->{$pod_tag} = $var;
370 $parser->{trimmed_tags}->{$pod_tag} = 1
371 if $parser->{trim_next};
373 die ("Sorry - need a reference to import POD "
374 ."sections into, not the scalar value $var"
375 ." importing $pod_tag into ".caller());
381 =head2 delete_hook(@list)
383 Deletes the named hooks. Companion function to add_hook
389 if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
392 $parser = $parsers{caller()}
393 or die("delete_hook called, but don't know what for - "
394 ."caller = ".caller());
396 while ( my $label = shift ) {
397 delete $parser->{wanted_pod_tags}->{$label};
398 delete $parser->{trimmed_tags}->{$label};
402 =head2 CLOSURES AS DESTINATIONS
404 If the given value is a ref CODE, then that function is called, with
405 $_ set to the value of the paragraph. This can be very useful for
406 applying your own custom mutations to the POD to change it from human
407 readable text into something your program can use.
409 After I added this function, I just kept on thinking of cool uses for
410 it. The nice, succinct code you can make with it is one of
411 Pod::Constant's strongest features.
413 Below are some examples.
417 =head2 Module Makefile.PL maintenance
419 Tired of keeping those module Makefile.PL's up to date? Note: This
420 method seems to break dh-make-perl.
422 =head2 Example Makefile.PL
424 eval "use Pod::Constants";
425 ($Pod::Constants::VERSION >= 0.11)
428 #### ERROR: This module requires Pod::Constants 0.11 or
429 #### higher to be installed.
433 my ($VERSION, $NAME, $PREREQ_PM, $ABSTRACT, $AUTHOR);
434 Pod
::Constants
::import_from_file
437 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+)/ },
438 'DEPENDENCIES' => ($PREREQ_PM = { }),
440 'NAME' => sub { $ABSTRACT=$_; ($NAME) = m/(\S+)/ },
441 'AUTHOR' => \
$AUTHOR,
447 'PREREQ_PM' => $PREREQ_PM,
448 'VERSION' => $VERSION,
449 ($] >= 5.005 ?
## Add these new keywords supported since 5.005
450 (ABSTRACT
=> $ABSTRACT,
451 AUTHOR
=> $AUTHOR) : ()),
454 =head2 Corresponding Module
458 MyTestModule - Demonstrate Pod::Constant's Makefile.PL usefulness
460 =head2 MODULE RELEASE
462 This is release 1.05 of this module.
466 The following modules are required to make this module:
472 Ima Twat <ima@twat.name>
476 use vars qw($VERSION);
477 use Pod::Constants -trim => 1,
478 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+) or die };
482 Sam Vilain, <samv@cpan.org>
486 I keep thinking it would be nice to be able to import an =item list
487 into an array or something, eg for a program argument list. But I'm
488 not too sure how it would be all that useful in practice; you'd end up
489 putting the function names for callbacks in the pod or something
490 (perhaps not all that bad).
492 Would this be useful?
494 Pod::Constants::import(Foo::SECTION => \$myvar);
496 Debug output is not very readable
498 =head1 PATCHES WELCOME
500 If you have any suggestions for enhancements, they are much more likely
501 to happen if you submit them as a patch to the distribution.
505 git://utsl.gen.nz/Pod-Constants
510 Pod
::Constants
->import
513 eval pop @
{[ grep /^\s*\$VERSION/, split /\n/, $_ ]}
This page took 0.097202 seconds and 4 git commands to generate.