]>
iEval git - pod-constants.git/blob - lib/Pod/Constants.pm
1 package Pod
::Constants
;
7 use base
qw(Pod::Parser Exporter);
12 # An ugly hack to go from caller() to the relevant parser state
17 #my ($parser, $command, $paragraph, $line_num) = (@_);
20 return unless $parser->{active
};
22 print "Found end of $parser->{active}\n" if $parser->{DEBUG
};
23 my $whereto = $parser->{wanted_pod_tags
}->{$parser->{active
}};
24 print "\$_ will be set to:\n---\n$parser->{paragraphs}\n---\n" if $parser->{DEBUG
};
26 $parser->{paragraphs
} =~ s/^\s*|\s*$//gs if $parser->{trimmed_tags
}->{$parser->{active
}};
28 if (ref $whereto eq 'CODE') {
29 print "calling sub\n" if $parser->{DEBUG
};
30 local ($_) = $parser->{paragraphs
};
32 print "done\n" if $parser->{DEBUG
};
33 } elsif (ref $whereto eq 'SCALAR') {
34 print "inserting into scalar\n" if $parser->{DEBUG
};
35 $$whereto = $parser->{paragraphs
};
36 } elsif (ref $whereto eq 'ARRAY') {
37 print "inserting into array\n" if $parser->{DEBUG
};
38 @
$whereto = split /\n/, $parser->{paragraphs
};
39 } elsif (ref $whereto eq 'HASH') {
40 print "inserting into hash\n" if $parser->{DEBUG
};
41 # Oh, sorry, should I be in LISP101?
43 map { map { s/^\s*|\s*$//g; $_ } split /=>/ } grep m
/^
44 ( (?
:[^=]|=[^>])+ ) # scan up to "=>"
46 ( (?
:[^=]|=[^>])+ =?
)# don't allow more "=>"'s
47 $/x, split /\n/, $parser->{paragraphs
},);
48 } else { die $whereto }
49 $parser->{active
} = undef;
52 # Pod::Parser overloaded command
54 my ($parser, $command, $paragraph, $line_num) = @_;
56 $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
58 print "Got command =$command, value=$paragraph\n" if $parser->{DEBUG
};
60 $parser->end_input() if $parser->{active
};
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";
67 } elsif ($command =~ m/^(head\d+|item|(for|begin))$/) {
69 # if it's a "for" or "begin" section, the title is the
71 ($lookup, $parser->{paragraphs
}) = $paragraph =~ m/^\s*(\S*)\s*(.*)/s;
73 # otherwise, it's up to the end of the line
74 ($lookup, $parser->{paragraphs
}) = $paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s;
77 # Look for a match by name
78 if (defined $lookup && exists $parser->{wanted_pod_tags
}->{$lookup}) {
79 print "Found $lookup\n" if ($parser->{DEBUG
});
80 $parser->{active
} = $lookup;
81 } elsif ($parser->{DEBUG
}) {
83 print "Ignoring =$command $paragraph (lookup = $lookup)\n"
88 print "Ignoring =$command (not known)\n" if $parser->{DEBUG
};
92 # Pod::Parser overloaded verbatim
94 my ($parser, $paragraph, $line_num) = @_;
95 $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
97 my $status = $parser->{active
} ?
'using' : 'ignoring';
98 print "Got paragraph: $paragraph ($status)\n" if $parser->{DEBUG
};
100 $parser->{paragraphs
} .= $paragraph if defined $parser->{active
}
103 # Pod::Parser overloaded textblock
104 sub textblock
{ goto \
&verbatim
}
109 # if no args, just return
112 # try to guess the source file of the caller
114 if (caller ne 'main') {
115 (my $module = caller.'.pm') =~ s
|::|/|g
;
116 $source_file = $INC{$module};
120 croak
"Cannot find source file (guessed $source_file) for package ".caller unless -f
$source_file;
122 # nasty tricks with the stack so we don't have to be silly with
124 unshift @_, $source_file;
125 goto \
&import_from_file
;
128 sub import_from_file
{
129 my $filename = shift;
131 my $parser = __PACKAGE__
->new();
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;
140 $parser->add_hook(@_);
142 print "Pod::Parser: DEBUG: Opening $filename for reading\n" if $parser->{DEBUG
};
143 open my $fh, '<', $filename or croak
"cannot open $filename for reading; $!";
145 $parser->parse_from_filehandle($fh, \
*STDOUT
);
152 if (eval { $_[0]->isa(__PACKAGE__
) }) {
155 $parser = $parsers{caller()} or croak
'add_hook called, but don\'t know what for - caller = '.caller;
157 while (my ($pod_tag, $var) = splice @_, 0, 2) {
158 #print "$pod_tag: $var\n";
159 if (lc($pod_tag) eq '-trim') {
160 $parser->{trim_next
} = $var;
161 } elsif ( lc($pod_tag) eq '-debug' ) {
162 $parser->{DEBUG
} = $var;
163 } elsif (lc($pod_tag) eq '-usage') {
164 # an idea for later - automatic "usage"
165 #%wanted_pod_tags{@tags}
167 if ((ref $var) =~ /^(?:SCALAR|CODE|ARRAY|HASH)$/) {
168 print "Will look for $pod_tag.\n" if $parser->{DEBUG
};
169 $parser->{wanted_pod_tags
}->{$pod_tag} = $var;
170 $parser->{trimmed_tags
}->{$pod_tag} = 1 if $parser->{trim_next
};
172 croak
"Sorry - need a reference to import POD sections into, not the scalar value $var"
180 if (eval { $_[0]->isa(__PACKAGE__
) }) {
183 $parser = $parsers{caller()} or croak
'delete_hook called, but don\'t know what for - caller = '.caller;
185 while ( my $label = shift ) {
186 delete $parser->{wanted_pod_tags
}->{$label};
187 delete $parser->{trimmed_tags
}->{$label};
198 Pod::Constants - Include constants from POD
202 our ($myvar, $VERSION, @myarray, $html, %myhash);
204 use Pod::Constants -trim => 1,
205 'Pod Section Name' => \$myvar,
206 'Version' => sub { eval },
207 'Some list' => \@myarray,
209 'Some hash' => \%myhash;
211 =head2 Pod Section Name
213 This string will be loaded into $myvar
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.
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].
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.
236 =head2 %myhash's value after the above:
238 ( key1 => "Some value (this will go into the hash)",
239 var2 => "Some Other value (so will this)" )
241 =begin html <p>This text will be in $html</p>
247 This module allows you to specify those constants that should be
248 documented in your POD, and pull them out a run time in a fairly
251 Pod::Constants uses Pod::Parser to do the parsing of the source file.
252 It has to open the source file it is called from, and does so directly
253 either by lookup in %INC or by assuming it is $0 if the caller is
254 "main" (or it can't find %INC{caller()})
256 =head2 ARBITARY DECISIONS
258 I 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
260 reason why you think it should match other POD sections, drop me a
261 line and if I'm convinced I'll put it in the standard version.
263 For `for' and `begin' sections, only the first word is counted as
264 being a part of the specifier, as opposed to `headN' and `item', where
265 the entire rest of the line counts.
271 This function is called when we are "use"'d. It determines the source
272 file by inspecting the value of caller() or $0.
274 The form of @args is HOOK => $where.
276 $where may be a scalar reference, in which case the contents of the
277 POD section called "HOOK" will be loaded into $where.
279 $where may be an array reference, in which case the contents of the
280 array will be the contents of the POD section called "HOOK", split
283 $where may be a hash reference, in which case any lines with a "=>"
284 symbol present will have everything on the left have side of the =>
285 operator as keys and everything on the right as values. You do not
286 need to quote either, nor have trailing commas at the end of the
289 $where may be a code reference (sub { }), in which case the sub is
290 called when the hook is encountered. $_ is set to the value of the
293 You may also specify the behaviour of whitespace trimming; by default,
294 no trimming is done except on the HOOK names. Setting "-trim => 1"
295 turns on a package "global" (until the next time import is called)
296 that will trim the $_ sent for processing by the hook processing
297 function (be it a given function, or the built-in array/hash
298 splitters) for leading and trailing whitespace.
300 The 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
304 Note that the supplied functions for array and hash splitting are
305 exactly equivalent to fairly simple Perl blocks:
309 HOOK => sub { @array = split /\n/, $_ }
315 (map { map { s/^\s+|\s+$//g; $_ } split /=>/, $_ }
317 ( (?:[^=]|=[^>])+ ) # scan up to "=>"
319 ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
320 $/x, split /\n/, $_));
323 Well, they're simple if you can grok map, a regular expression like
324 that and a functional programming style. If you can't I'm sure it is
325 probably voodoo to you.
327 Here's the procedural equivalent:
330 for my $line (split /\n/, $_) {
331 my ($key, $value, $junk) = split /=>/, $line;
333 $key =~ s/^\s+|\s+$//g
334 $value =~ s/^\s+|\s+$//g
335 $hash{$key} = $value;
339 =head2 import_from_file($filename, @args)
341 Very similar to straight "import", but you specify the source filename
344 =head2 add_hook(NAME => value)
346 This function adds another hook, it is useful for dynamic updating of
347 parsing through the document.
349 For an example, please see t/01-constants.t in the source
350 distribution. More detailed examples will be added in a later
353 =head2 delete_hook(@list)
355 Deletes the named hooks. Companion function to add_hook
357 =head2 CLOSURES AS DESTINATIONS
359 If 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
361 applying your own custom mutations to the POD to change it from human
362 readable text into something your program can use.
364 After I added this function, I just kept on thinking of cool uses for
365 it. The nice, succinct code you can make with it is one of
366 Pod::Constant's strongest features.
368 Below are some examples.
372 =head2 Module Makefile.PL maintenance
374 Tired of keeping those module Makefile.PL's up to date? Note: This
375 method seems to break dh-make-perl.
377 =head2 Example Makefile.PL
379 eval "use Pod::Constants";
380 ($Pod::Constants::VERSION >= 0.11)
383 #### ERROR: This module requires Pod::Constants 0.11 or
384 #### higher to be installed.
388 my ($VERSION, $NAME, $PREREQ_PM, $ABSTRACT, $AUTHOR);
389 Pod::Constants::import_from_file
392 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+)/ },
393 'DEPENDENCIES' => ($PREREQ_PM = { }),
395 'NAME' => sub { $ABSTRACT=$_; ($NAME) = m/(\S+)/ },
396 'AUTHOR' => \$AUTHOR,
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) : ()),
409 =head2 Corresponding Module
413 MyTestModule - Demonstrate Pod::Constant's Makefile.PL usefulness
415 =head2 MODULE RELEASE
417 This is release 1.05 of this module.
421 The following modules are required to make this module:
427 Ima Twat <ima@twat.name>
432 use Pod::Constants -trim => 1,
433 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+) or die };
437 Sam Vilain, <samv@cpan.org>
439 Maintained by Marius Gavrilescu, <marius@ieval.ro> since July 2015
441 =head1 COPYRIGHT AND LICENSE
443 Copyright (C) 2001, 2002, 2007 Sam Vilain. All Rights Reserved.
445 Copyright (C) 2015-2016 by Marius Gavrilescu <marius@ieval.ro>.
447 This module is free software. It may be used, redistributed and/or
448 modified under the terms of the Perl Artistic License, version 2.
450 See the LICENSE file in the root of this distribution for a copy of
451 the Perl Artistic License, version 2.
455 I keep thinking it would be nice to be able to import an =item list
456 into an array or something, eg for a program argument list. But I'm
457 not too sure how it would be all that useful in practice; you'd end up
458 putting the function names for callbacks in the pod or something
459 (perhaps not all that bad).
461 Would this be useful?
463 Pod::Constants::import(Foo::SECTION => \$myvar);
465 Debug output is not very readable
This page took 0.102289 seconds and 4 git commands to generate.