1package Pod::Constants; 2 3use 5.006002; 4use strict; 5use warnings; 6 7use base qw(Pod::Parser Exporter); 8use Carp; 9 10our $VERSION = 0.19; 11 12# An ugly hack to go from caller() to the relevant parser state 13# variable 14my %parsers; 15 16sub end_input { 17 #my ($parser, $command, $paragraph, $line_num) = (@_); 18 my $parser = shift; 19 20 return unless $parser->{active}; 21 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}; 25 26 $parser->{paragraphs} =~ s/^\s*|\s*$//gs if $parser->{trimmed_tags}->{$parser->{active}}; 27 28 if (ref $whereto eq 'CODE') { 29 print "calling sub\n" if $parser->{DEBUG}; 30 local ($_) = $parser->{paragraphs}; 31 $whereto->(); 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? 42 %$whereto = ( 43 map { map { s/^\s*|\s*$//g; $_ } split /=>/ } grep m/^ 44 ( (?:[^=]|=[^>])+ ) # scan up to "=>" 45 => 46 ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s 47 $/x, split /\n/, $parser->{paragraphs},); 48 } else { die $whereto } 49 $parser->{active} = undef; 50} 51 52# Pod::Parser overloaded command 53sub command { 54 my ($parser, $command, $paragraph, $line_num) = @_; 55 56 $paragraph =~ s/(?:\r\n|\n\r)/\n/g; 57 58 print "Got command =$command, value=$paragraph\n" if $parser->{DEBUG}; 59 60 $parser->end_input() if $parser->{active}; 61 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"; 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 71 ($lookup, $parser->{paragraphs}) = $paragraph =~ m/^\s*(\S*)\s*(.*)/s; 72 } else { 73 # otherwise, it's up to the end of the line 74 ($lookup, $parser->{paragraphs}) = $paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s; 75 } 76 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}) { 82 local $^W = 0; 83 print "Ignoring =$command $paragraph (lookup = $lookup)\n" 84 } 85 86 } else { 87 # nothing 88 print "Ignoring =$command (not known)\n" if $parser->{DEBUG}; 89 } 90} 91 92# Pod::Parser overloaded verbatim 93sub verbatim { 94 my ($parser, $paragraph, $line_num) = @_; 95 $paragraph =~ s/(?:\r\n|\n\r)/\n/g; 96 97 my $status = $parser->{active} ? 'using' : 'ignoring'; 98 print "Got paragraph: $paragraph ($status)\n" if $parser->{DEBUG}; 99 100 $parser->{paragraphs} .= $paragraph if defined $parser->{active} 101} 102 103# Pod::Parser overloaded textblock 104sub textblock { goto \&verbatim } 105 106sub import { 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; 114 if (caller ne 'main') { 115 (my $module = caller.'.pm') =~ s|::|/|g; 116 $source_file = $INC{$module}; 117 } 118 $source_file ||= $0; 119 120 croak "Cannot find source file (guessed $source_file) for package ".caller unless -f $source_file; 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; 126} 127 128sub import_from_file { 129 my $filename = shift; 130 131 my $parser = __PACKAGE__->new(); 132 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; 139 140 $parser->add_hook(@_); 141 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; $!"; 144 145 $parser->parse_from_filehandle($fh, \*STDOUT); 146 147 close $fh; 148} 149 150sub add_hook { 151 my $parser; 152 if (eval { $_[0]->isa(__PACKAGE__) }) { 153 $parser = shift; 154 } else { 155 $parser = $parsers{caller()} or croak 'add_hook called, but don\'t know what for - caller = '.caller; 156 } 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} 166 } else { 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}; 171 } else { 172 croak "Sorry - need a reference to import POD sections into, not the scalar value $var" 173 } 174 } 175 } 176} 177 178sub delete_hook { 179 my $parser; 180 if (eval { $_[0]->isa(__PACKAGE__) }) { 181 $parser = shift; 182 } else { 183 $parser = $parsers{caller()} or croak 'delete_hook called, but don\'t know what for - caller = '.caller; 184 } 185 while ( my $label = shift ) { 186 delete $parser->{wanted_pod_tags}->{$label}; 187 delete $parser->{trimmed_tags}->{$label}; 188 } 189} 190 1911; 192__END__ 193 194=encoding utf-8 195 196=head1 NAME 197 198Pod::Constants - Include constants from POD 199 200=head1 SYNOPSIS 201 202 our ($myvar, $VERSION, @myarray, $html, %myhash); 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.19; 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 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+)/ }, 393 'DEPENDENCIES' => ($PREREQ_PM = { }), 394 -trim => 1, 395 'NAME' => sub { $ABSTRACT=$_; ($NAME) = m/(\S+)/ }, 396 'AUTHOR' => \$AUTHOR, 397 ); 398 399 WriteMakefile 400 ( 401 'NAME' => $NAME, 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 419 =head2 DEPENDENCIES 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 431 our $VERSION; 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 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. 444 445Copyright (C) 2015-2016 by Marius Gavrilescu <marius@ieval.ro>. 446 447This module is free software. It may be used, redistributed and/or 448modified under the terms of the Perl Artistic License, version 2. 449 450See the LICENSE file in the root of this distribution for a copy of 451the Perl Artistic License, version 2. 452 453=head1 BUGS/TODO 454 455I keep thinking it would be nice to be able to import an =item list 456into an array or something, eg for a program argument list. But I'm 457not too sure how it would be all that useful in practice; you'd end up 458putting the function names for callbacks in the pod or something 459(perhaps not all that bad). 460 461Would this be useful? 462 463 Pod::Constants::import(Foo::SECTION => \$myvar); 464 465Debug output is not very readable 466 467 468=cut 469