]> iEval git - pod-constants.git/blame_incremental - lib/Pod/Constants.pm
No need for IO::Handle
[pod-constants.git] / lib / Pod / Constants.pm
... / ...
CommitLineData
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
8use 5.006002;
9use strict;
10use warnings;
11
12use base qw(Pod::Parser Exporter);
13use Carp;
14
15our $VERSION = 0.17;
16
17# An ugly hack to go from caller() to the relevant parser state
18# variable
19my %parsers;
20
21sub end_input {
22 #my ($parser, $command, $paragraph, $line_num) = (@_);
23 my $parser = shift;
24
25 return unless $parser->{active};
26
27 print "Found end of $parser->{active}\n" if $parser->{DEBUG};
28 my $whereto = $parser->{wanted_pod_tags}->{$parser->{active}};
29 print "\$_ will be set to:\n---\n$parser->{paragraphs}\n---\n" if $parser->{DEBUG};
30
31 $parser->{paragraphs} =~ s/^\s*|\s*$//gs if $parser->{trimmed_tags}->{$parser->{active}};
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?
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});
53 } else { die $whereto }
54 $parser->{active} = undef;
55}
56
57# Pod::Parser overloaded command
58sub command {
59 my ($parser, $command, $paragraph, $line_num) = @_;
60
61 $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
62
63 print "Got command =$command, value=$paragraph\n" if $parser->{DEBUG};
64
65 $parser->end_input() if $parser->{active};
66
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";
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
76 ($lookup, $parser->{paragraphs}) = $paragraph =~ m/^\s*(\S*)\s*(.*)/s;
77 } else {
78 # otherwise, it's up to the end of the line
79 ($lookup, $parser->{paragraphs}) = $paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s;
80 }
81
82 # Look for a match by name
83 if (defined $lookup && exists $parser->{wanted_pod_tags}->{$lookup}) {
84 print "Found $lookup\n" if ($parser->{DEBUG});
85 $parser->{active} = $lookup;
86 } elsif ($parser->{DEBUG}) {
87 local $^W = 0;
88 print "Ignoring =$command $paragraph (lookup = $lookup)\n"
89 }
90
91 } else {
92 # nothing
93 print "Ignoring =$command (not known)\n" if $parser->{DEBUG};
94 }
95}
96
97# Pod::Parser overloaded verbatim
98sub verbatim {
99 my ($parser, $paragraph, $line_num) = @_;
100 $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
101
102 my $status = $parser->{active} ? "using" : "ignoring";
103 print "Got paragraph: $paragraph ($status)\n" if $parser->{DEBUG};
104
105 $parser->{paragraphs} .= $paragraph if defined $parser->{active}
106}
107
108# Pod::Parser overloaded textblock
109sub textblock { goto \&verbatim }
110
111sub import {
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
125 croak "Cannot find source file (guessed $source_file) for package ".caller unless -f $source_file;
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;
131}
132
133sub import_from_file {
134 my $filename = shift;
135
136 my $parser = __PACKAGE__->new();
137
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;
144
145 $parser->add_hook(@_);
146
147 print "Pod::Parser: DEBUG: Opening $filename for reading\n" if $parser->{DEBUG};
148 open my $fh, "<$filename" or die "cannot open $filename for reading; $!";
149
150 $parser->parse_from_filehandle($fh, \*STDOUT);
151
152 close $fh;
153}
154
155sub add_hook {
156 my $parser;
157 if (UNIVERSAL::isa($_[0], __PACKAGE__)) {
158 $parser = shift;
159 } else {
160 $parser = $parsers{caller()} or die "add_hook called, but don't know what for - caller = ".caller;
161 }
162 while (my ($pod_tag, $var) = splice @_, 0, 2) {
163 #print "$pod_tag: $var\n";
164 if (lc($pod_tag) eq "-trim") {
165 $parser->{trim_next} = $var;
166 } elsif ( lc($pod_tag) eq "-debug" ) {
167 $parser->{DEBUG} = $var;
168 } elsif (lc($pod_tag) eq "-usage") {
169 # an idea for later - automatic "usage"
170 #%wanted_pod_tags{@tags}
171 } else {
172 if ((ref $var) =~ /^(?:SCALAR|CODE|ARRAY|HASH)$/) {
173 print "Will look for $pod_tag.\n" if $parser->{DEBUG};
174 $parser->{wanted_pod_tags}->{$pod_tag} = $var;
175 $parser->{trimmed_tags}->{$pod_tag} = 1 if $parser->{trim_next};
176 } else {
177 die "Sorry - need a reference to import POD sections into, not the scalar value $var"
178 }
179 }
180 }
181}
182
183sub delete_hook {
184 my $parser;
185 if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
186 $parser = shift;
187 } else {
188 $parser = $parsers{caller()} or die "delete_hook called, but don't know what for - caller = ".caller;
189 }
190 while ( my $label = shift ) {
191 delete $parser->{wanted_pod_tags}->{$label};
192 delete $parser->{trimmed_tags}->{$label};
193 }
194}
195
1961.4142;
197__END__
198
199=encoding utf-8
200
201=head1 NAME
202
203Pod::Constants - Include constants from POD
204
205=head1 SYNOPSIS
206
207 our ($myvar, $VERSION, @myarray, $html, %myhash);
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
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+)/ },
398 'DEPENDENCIES' => ($PREREQ_PM = { }),
399 -trim => 1,
400 'NAME' => sub { $ABSTRACT=$_; ($NAME) = m/(\S+)/ },
401 'AUTHOR' => \$AUTHOR,
402 );
403
404 WriteMakefile
405 (
406 'NAME' => $NAME,
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
424 =head2 DEPENDENCIES
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
436 our $VERSION;
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
467
468=cut
This page took 0.029531 seconds and 4 git commands to generate.