]>
iEval git - pod-constants.git/blob - lib/Pod/Constants.pm
05f33a0dde37fccb559886090e1c1dc4ba596d31
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
;
12 use base
qw(Pod::Parser Exporter);
17 # An ugly hack to go from caller() to the relevant parser state
22 #my ($parser, $command, $paragraph, $line_num) = (@_);
25 return unless $parser->{active
};
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
};
31 $parser->{paragraphs
} =~ s/^\s*|\s*$//gs if $parser->{trimmed_tags
}->{$parser->{active
}};
33 if (ref $whereto eq 'CODE') {
34 print "calling sub\n" if $parser->{DEBUG
};
35 local ($_) = $parser->{paragraphs
};
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?
48 map { map { s/^\s*|\s*$//g; $_ } split /=>/ } grep m
/^
49 ( (?
:[^=]|=[^>])+ ) # scan up to "=>"
51 ( (?
:[^=]|=[^>])+ =?
)# don't allow more "=>"'s
52 $/x, split /\n/, $parser->{paragraphs
},);
53 } else { die $whereto }
54 $parser->{active
} = undef;
57 # Pod::Parser overloaded command
59 my ($parser, $command, $paragraph, $line_num) = @_;
61 $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
63 print "Got command =$command, value=$paragraph\n" if $parser->{DEBUG
};
65 $parser->end_input() if $parser->{active
};
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))$/) {
74 # if it's a "for" or "begin" section, the title is the
76 ($lookup, $parser->{paragraphs
}) = $paragraph =~ m/^\s*(\S*)\s*(.*)/s;
78 # otherwise, it's up to the end of the line
79 ($lookup, $parser->{paragraphs
}) = $paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s;
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
}) {
88 print "Ignoring =$command $paragraph (lookup = $lookup)\n"
93 print "Ignoring =$command (not known)\n" if $parser->{DEBUG
};
97 # Pod::Parser overloaded verbatim
99 my ($parser, $paragraph, $line_num) = @_;
100 $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
102 my $status = $parser->{active
} ?
'using' : 'ignoring';
103 print "Got paragraph: $paragraph ($status)\n" if $parser->{DEBUG
};
105 $parser->{paragraphs
} .= $paragraph if defined $parser->{active
}
108 # Pod::Parser overloaded textblock
109 sub textblock
{ goto \
&verbatim
}
114 # if no args, just return
117 # try to guess the source file of the caller
119 if (caller ne 'main') {
120 (my $module = caller.'.pm') =~ s
|::|/|g
;
121 $source_file = $INC{$module};
125 croak
"Cannot find source file (guessed $source_file) for package ".caller unless -f
$source_file;
127 # nasty tricks with the stack so we don't have to be silly with
129 unshift @_, $source_file;
130 goto \
&import_from_file
;
133 sub import_from_file
{
134 my $filename = shift;
136 my $parser = __PACKAGE__
->new();
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;
145 $parser->add_hook(@_);
147 print "Pod::Parser: DEBUG: Opening $filename for reading\n" if $parser->{DEBUG
};
148 open my $fh, '<', $filename or croak
"cannot open $filename for reading; $!";
150 $parser->parse_from_filehandle($fh, \
*STDOUT
);
157 if (eval { $_[0]->isa(__PACKAGE__
) }) {
160 $parser = $parsers{caller()} or croak
'add_hook called, but don\'t know what for - caller = '.caller;
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}
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
};
177 croak
"Sorry - need a reference to import POD sections into, not the scalar value $var"
185 if (eval { $_[0]->isa(__PACKAGE__
) }) {
188 $parser = $parsers{caller()} or croak
'delete_hook called, but don\'t know what for - caller = '.caller;
190 while ( my $label = shift ) {
191 delete $parser->{wanted_pod_tags
}->{$label};
192 delete $parser->{trimmed_tags
}->{$label};
203 Pod::Constants - Include constants from POD
207 our ($myvar, $VERSION, @myarray, $html, %myhash);
209 use Pod::Constants -trim => 1,
210 'Pod Section Name' => \$myvar,
211 'Version' => sub { eval },
212 'Some list' => \@myarray,
214 'Some hash' => \%myhash;
216 =head2 Pod Section Name
218 This string will be loaded into $myvar
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.
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].
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.
241 =head2 %myhash's value after the above:
243 ( key1 => "Some value (this will go into the hash)",
244 var2 => "Some Other value (so will this)" )
246 =begin html <p>This text will be in $html</p>
252 This module allows you to specify those constants that should be
253 documented in your POD, and pull them out a run time in a fairly
256 Pod::Constants uses Pod::Parser to do the parsing of the source file.
257 It has to open the source file it is called from, and does so directly
258 either by lookup in %INC or by assuming it is $0 if the caller is
259 "main" (or it can't find %INC{caller()})
261 =head2 ARBITARY DECISIONS
263 I 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
265 reason why you think it should match other POD sections, drop me a
266 line and if I'm convinced I'll put it in the standard version.
268 For `for' and `begin' sections, only the first word is counted as
269 being a part of the specifier, as opposed to `headN' and `item', where
270 the entire rest of the line counts.
276 This function is called when we are "use"'d. It determines the source
277 file by inspecting the value of caller() or $0.
279 The form of @args is HOOK => $where.
281 $where may be a scalar reference, in which case the contents of the
282 POD section called "HOOK" will be loaded into $where.
284 $where may be an array reference, in which case the contents of the
285 array will be the contents of the POD section called "HOOK", split
288 $where may be a hash reference, in which case any lines with a "=>"
289 symbol present will have everything on the left have side of the =>
290 operator as keys and everything on the right as values. You do not
291 need to quote either, nor have trailing commas at the end of the
294 $where may be a code reference (sub { }), in which case the sub is
295 called when the hook is encountered. $_ is set to the value of the
298 You may also specify the behaviour of whitespace trimming; by default,
299 no trimming is done except on the HOOK names. Setting "-trim => 1"
300 turns on a package "global" (until the next time import is called)
301 that will trim the $_ sent for processing by the hook processing
302 function (be it a given function, or the built-in array/hash
303 splitters) for leading and trailing whitespace.
305 The 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
309 Note that the supplied functions for array and hash splitting are
310 exactly equivalent to fairly simple Perl blocks:
314 HOOK => sub { @array = split /\n/, $_ }
320 (map { map { s/^\s+|\s+$//g; $_ } split /=>/, $_ }
322 ( (?:[^=]|=[^>])+ ) # scan up to "=>"
324 ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
325 $/x, split /\n/, $_));
328 Well, they're simple if you can grok map, a regular expression like
329 that and a functional programming style. If you can't I'm sure it is
330 probably voodoo to you.
332 Here's the procedural equivalent:
335 for my $line (split /\n/, $_) {
336 my ($key, $value, $junk) = split /=>/, $line;
338 $key =~ s/^\s+|\s+$//g
339 $value =~ s/^\s+|\s+$//g
340 $hash{$key} = $value;
344 =head2 import_from_file($filename, @args)
346 Very similar to straight "import", but you specify the source filename
349 =head2 add_hook(NAME => value)
351 This function adds another hook, it is useful for dynamic updating of
352 parsing through the document.
354 For an example, please see t/01-constants.t in the source
355 distribution. More detailed examples will be added in a later
358 =head2 delete_hook(@list)
360 Deletes the named hooks. Companion function to add_hook
362 =head2 CLOSURES AS DESTINATIONS
364 If 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
366 applying your own custom mutations to the POD to change it from human
367 readable text into something your program can use.
369 After I added this function, I just kept on thinking of cool uses for
370 it. The nice, succinct code you can make with it is one of
371 Pod::Constant's strongest features.
373 Below are some examples.
377 =head2 Module Makefile.PL maintenance
379 Tired of keeping those module Makefile.PL's up to date? Note: This
380 method seems to break dh-make-perl.
382 =head2 Example Makefile.PL
384 eval "use Pod::Constants";
385 ($Pod::Constants::VERSION >= 0.11)
388 #### ERROR: This module requires Pod::Constants 0.11 or
389 #### higher to be installed.
393 my ($VERSION, $NAME, $PREREQ_PM, $ABSTRACT, $AUTHOR);
394 Pod::Constants::import_from_file
397 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+)/ },
398 'DEPENDENCIES' => ($PREREQ_PM = { }),
400 'NAME' => sub { $ABSTRACT=$_; ($NAME) = m/(\S+)/ },
401 'AUTHOR' => \$AUTHOR,
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) : ()),
414 =head2 Corresponding Module
418 MyTestModule - Demonstrate Pod::Constant's Makefile.PL usefulness
420 =head2 MODULE RELEASE
422 This is release 1.05 of this module.
426 The following modules are required to make this module:
432 Ima Twat <ima@twat.name>
437 use Pod::Constants -trim => 1,
438 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+) or die };
442 Sam Vilain, <samv@cpan.org>
446 I keep thinking it would be nice to be able to import an =item list
447 into an array or something, eg for a program argument list. But I'm
448 not too sure how it would be all that useful in practice; you'd end up
449 putting the function names for callbacks in the pod or something
450 (perhaps not all that bad).
452 Would this be useful?
454 Pod::Constants::import(Foo::SECTION => \$myvar);
456 Debug output is not very readable
458 =head1 PATCHES WELCOME
460 If you have any suggestions for enhancements, they are much more likely
461 to happen if you submit them as a patch to the distribution.
465 git://utsl.gen.nz/Pod-Constants
This page took 0.084258 seconds and 3 git commands to generate.