lib/Pod/Constants.pm

   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
   6 package Pod::Constants;
   7
   8 use 5.004;
   9 use strict;
  10
  11 use base qw(Pod::Parser Exporter);
  12 use Data::Dumper;
  13 use Carp;
  14
  15 use vars qw($VERSION);
  16 $VERSION = 0.17;
  17
  18 # An ugly hack to go from caller() to the relevant parser state
  19 # variable
  20 my %parsers;
  21
  22 sub end_input {
  23         #my ($parser, $command, $paragraph, $line_num) = (@_);
  24         my $parser = shift;
  25
  26         return unless $parser->{active};
  27
  28         print "Found end of $parser->{active}\n" if ($parser->{DEBUG});
  29         my $whereto = $parser->{wanted_pod_tags}->{$parser->{active}};
  30         print "\$_ will be set to:\n---\n$parser->{paragraphs}\n---\n"
  31           if ($parser->{DEBUG});
  32
  33         $parser->{paragraphs} =~ s/^\s*|\s*$//gs
  34           if $parser->{trimmed_tags}->{$parser->{active}};
  35
  36         if (ref $whereto eq "CODE") {
  37                 print "calling sub\n" if $parser->{DEBUG};
  38                 local ($_) = $parser->{paragraphs};
  39                 $whereto->();
  40                 print "done\n" if $parser->{DEBUG};
  41         } elsif (ref $whereto eq "SCALAR") {
  42                 print "inserting into scalar\n" if $parser->{DEBUG};
  43                 $$whereto = $parser->{paragraphs};
  44         } elsif (ref $whereto eq "ARRAY") {
  45                 print "inserting into array\n" if $parser->{DEBUG};
  46                 @$whereto = split /\n/, $parser->{paragraphs};
  47         } elsif (ref $whereto eq "HASH") {
  48                 print "inserting into hash\n" if $parser->{DEBUG};
  49                 # Oh, sorry, should I be in LISP101?
  50                 %$whereto = (map { map { s/^\s*|\s*$//g; $_ }
  51                                                          split /=>/, $_ }
  52                                            grep m/^
  53                                                           ( (?:[^=]|=[^>])+ )   # scan up to "=>"
  54                                                           =>
  55                                                           ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
  56                                                           $/x,
  57                                          split /\n/, $parser->{paragraphs});
  58         } else { die $whereto }
  59         $parser->{active} = undef;
  60 }
  61
  62 # Pod::Parser overloaded command
  63 sub command {
  64         my ($parser, $command, $paragraph, $line_num) = @_;
  65
  66         $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
  67
  68         print "Got command =$command, value=$paragraph\n"
  69           if $parser->{DEBUG};
  70
  71         $parser->end_input() if $parser->{active};
  72
  73         my $does_she_want_it_sir;
  74
  75         my ($lookup);
  76         # first check for a catch-all for this command type
  77         if ( exists $parser->{wanted_pod_tags}->{"*$command"} ) {
  78                 $parser->{paragraphs} = $paragraph;
  79                 $parser->{active} = "*$command";
  80                 $does_she_want_it_sir = "oohw";
  81
  82         } elsif ($command =~ m/^(head\d+|item|(for|begin))$/) {
  83                 if ( $2 ) {
  84                         # if it's a "for" or "begin" section, the title is the
  85                         # first word only
  86                         ($lookup, $parser->{paragraphs}) =
  87                           ($paragraph =~ m/^\s*(\S*)\s*(.*)/s);
  88                 } else {
  89                         # otherwise, it's up to the end of the line
  90                         ($lookup, $parser->{paragraphs})
  91                           = ($paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s);
  92                 }
  93
  94                 # Look for a match by name
  95                 if (defined $lookup
  96                           and exists $parser->{wanted_pod_tags}->{$lookup}) {
  97                         print "Found $lookup\n" if ($parser->{DEBUG});
  98                         $parser->{active} = $lookup;
  99                         $does_she_want_it_sir = "suits you sir";
 100                 }
 101
 102         } else {
 103                 # nothing
 104                 print "Ignoring =$command (not known)\n" if $parser->{DEBUG};
 105         }
 106
 107         {
 108                 local $^W = 0;
 109                 print "Ignoring =$command $paragraph (lookup = $lookup)\n"
 110                   if (!$does_she_want_it_sir and $parser->{DEBUG})
 111           }
 112 }
 113
 114 # Pod::Parser overloaded verbatim
 115 sub verbatim {
 116         my ($parser, $paragraph, $line_num) = @_;
 117         $paragraph =~ s/(?:\r\n|\n\r)/\n/g;
 118
 119         print("Got paragraph: $paragraph ("
 120                         .($parser->{active}?"using":"ignoring").")\n")
 121           if $parser->{DEBUG};
 122
 123         if (defined $parser->{active}) {
 124                 $parser->{paragraphs} .= $paragraph;
 125         }
 126 }
 127
 128 # Pod::Parser overloaded textblock
 129 sub textblock { goto \&verbatim }
 130
 131 sub import {
 132         my $class = shift;
 133
 134         # if no args, just return
 135         return unless (@_);
 136
 137         # try to guess the source file of the caller
 138         my $source_file;
 139         if (caller ne "main") {
 140                 (my $module = caller().".pm") =~ s|::|/|g;
 141                 $source_file = $INC{$module};
 142         }
 143         $source_file ||= $0;
 144
 145         ( -f $source_file )
 146           or croak ("Cannot find source file (guessed $source_file) for"
 147                                 ." package ".caller());
 148
 149         # nasty tricks with the stack so we don't have to be silly with
 150         # caller()
 151         unshift @_, $source_file;
 152         goto \&import_from_file;
 153 }
 154
 155 use IO::Handle;
 156
 157 sub import_from_file {
 158         my $filename = shift;
 159
 160         my $parser = __PACKAGE__->new();
 161
 162         $parser->{wanted_pod_tags} = {};
 163         $parser->{trimmed_tags} = {};
 164         $parser->{trim_next} = 0;
 165         $parser->{DEBUG} = 0;
 166         $parser->{active} = undef;
 167         $parsers{caller()} = $parser;
 168
 169         $parser->add_hook(@_);
 170
 171         print "Pod::Parser: DEBUG: Opening $filename for reading\n"
 172           if $parser->{DEBUG};
 173         my $fh = new IO::Handle;
 174         open $fh, "<$filename"
 175           or die ("cannot open $filename for reading; $!");
 176
 177         $parser->parse_from_filehandle($fh, \*STDOUT);
 178
 179         close $fh;
 180 }
 181
 182 sub add_hook {
 183         my $parser;
 184         if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
 185                 $parser = shift;
 186         } else {
 187                 $parser = $parsers{caller()}
 188                   or die("add_hook called, but don't know what for - "
 189                                  ."caller = ".caller());
 190         }
 191         while (my ($pod_tag, $var) = splice @_, 0, 2) {
 192                 #print "$pod_tag: $var\n";
 193                 if (lc($pod_tag) eq "-trim") {
 194                         $parser->{trim_next} = $var;
 195                 } elsif ( lc($pod_tag) eq "-debug" ) {
 196                         $parser->{DEBUG} = $var;
 197                 } elsif (lc($pod_tag) eq "-usage") {
 198                         # an idea for later - automatic "usage"
 199                         #%wanted_pod_tags{@tags}
 200                 } else {
 201                         if ((ref $var) =~ /^(?:SCALAR|CODE|ARRAY|HASH)$/) {
 202                                 print "Will look for $pod_tag.\n"
 203                                   if ($parser->{DEBUG});
 204                                 $parser->{wanted_pod_tags}->{$pod_tag} = $var;
 205                                 $parser->{trimmed_tags}->{$pod_tag} = 1
 206                                   if $parser->{trim_next};
 207                         } else {
 208                                 die ("Sorry - need a reference to import POD "
 209                                            ."sections into, not the scalar value $var"
 210                                            ." importing $pod_tag into ".caller());
 211                         }
 212                 }
 213         }
 214 }
 215
 216 sub delete_hook {
 217         my $parser;
 218         if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) {
 219                 $parser = shift;
 220         } else {
 221                 $parser = $parsers{caller()}
 222                   or die("delete_hook called, but don't know what for - "
 223                                  ."caller = ".caller());
 224         }
 225         while ( my $label = shift ) {
 226                 delete $parser->{wanted_pod_tags}->{$label};
 227                 delete $parser->{trimmed_tags}->{$label};
 228         }
 229 }
 230
 231 BEGIN {
 232         Pod::Constants->import
 233                 (
 234                         SYNOPSIS => sub {
 235                                 eval pop @{[ grep /^\s*\$VERSION/, split /\n/, $_ ]}
 236                         }
 237                 )
 238 };
 239
 240 1.4142;
 241 __END__
 242
 243 =encoding utf-8
 244
 245 =head1 NAME
 246
 247 Pod::Constants - Include constants from POD
 248
 249 =head1 SYNOPSIS
 250
 251  use vars qw($myvar $VERSION @myarray $html %myhash);
 252
 253  use Pod::Constants -trim => 1,
 254      'Pod Section Name' => \$myvar,
 255      'Version' => sub { eval },
 256      'Some list' => \@myarray,
 257      html => \$html,
 258      'Some hash' => \%myhash;
 259
 260  =head2 Pod Section Name
 261
 262  This string will be loaded into $myvar
 263
 264  =head2 Version
 265
 266  # This is an example of using a closure.  $_ is set to the
 267  # contents of the paragraph.  In this example, "eval" is
 268  # used to execute this code at run time.
 269  $VERSION = 0.17;
 270
 271  =head2 Some list
 272
 273  Each line from this section of the file
 274  will be placed into a separate array element.
 275  For example, this is $myarray[2].
 276
 277  =head2 Some hash
 278
 279  This text will not go into the hash, because
 280  it doesn't look like a definition list.
 281      key1 => Some value (this will go into the hash)
 282      var2 => Some Other value (so will this)
 283      wtf = This won't make it in.
 284
 285  =head2 %myhash's value after the above:
 286
 287     ( key1 => "Some value (this will go into the hash)",
 288       var2 => "Some Other value (so will this)"          )
 289
 290  =begin html <p>This text will be in $html</p>
 291
 292  =cut
 293
 294 =head1 DESCRIPTION
 295
 296 This module allows you to specify those constants that should be
 297 documented in your POD, and pull them out a run time in a fairly
 298 arbitrary fashion.
 299
 300 Pod::Constants uses Pod::Parser to do the parsing of the source file.
 301 It has to open the source file it is called from, and does so directly
 302 either by lookup in %INC or by assuming it is $0 if the caller is
 303 "main" (or it can't find %INC{caller()})
 304
 305 =head2 ARBITARY DECISIONS
 306
 307 I have made this code only allow the "Pod Section Name" to match
 308 `headN', `item', `for' and `begin' POD sections.  If you have a good
 309 reason why you think it should match other POD sections, drop me a
 310 line and if I'm convinced I'll put it in the standard version.
 311
 312 For `for' and `begin' sections, only the first word is counted as
 313 being a part of the specifier, as opposed to `headN' and `item', where
 314 the entire rest of the line counts.
 315
 316 =head1 FUNCTIONS
 317
 318 =head2 import(@args)
 319
 320 This function is called when we are "use"'d.  It determines the source
 321 file by inspecting the value of caller() or $0.
 322
 323 The form of @args is HOOK => $where.
 324
 325 $where may be a scalar reference, in which case the contents of the
 326 POD section called "HOOK" will be loaded into $where.
 327
 328 $where may be an array reference, in which case the contents of the
 329 array will be the contents of the POD section called "HOOK", split
 330 into lines.
 331
 332 $where may be a hash reference, in which case any lines with a "=>"
 333 symbol present will have everything on the left have side of the =>
 334 operator as keys and everything on the right as values.  You do not
 335 need to quote either, nor have trailing commas at the end of the
 336 lines.
 337
 338 $where may be a code reference (sub { }), in which case the sub is
 339 called when the hook is encountered.  $_ is set to the value of the
 340 POD paragraph.
 341
 342 You may also specify the behaviour of whitespace trimming; by default,
 343 no trimming is done except on the HOOK names.  Setting "-trim => 1"
 344 turns on a package "global" (until the next time import is called)
 345 that will trim the $_ sent for processing by the hook processing
 346 function (be it a given function, or the built-in array/hash
 347 splitters) for leading and trailing whitespace.
 348
 349 The name of HOOK is matched against any "=head1", "=head2", "=item",
 350 "=for", "=begin" value.  If you specify the special hooknames "*item",
 351 "*head1", etc, then you will get a function that is run for every
 352
 353 Note that the supplied functions for array and hash splitting are
 354 exactly equivalent to fairly simple Perl blocks:
 355
 356 Array:
 357
 358   HOOK => sub { @array = split /\n/, $_ }
 359
 360 Hash:
 361
 362   HOOK => sub {
 363   %hash =
 364       (map { map { s/^\s+|\s+$//g; $_ } split /=>/, $_ }
 365         (grep m/^
 366             ( (?:[^=]|=[^>])+ )   # scan up to "=>"
 367             =>
 368             ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
 369             $/x, split /\n/, $_));
 370   }
 371
 372 Well, they're simple if you can grok map, a regular expression like
 373 that and a functional programming style.  If you can't I'm sure it is
 374 probably voodoo to you.
 375
 376 Here's the procedural equivalent:
 377
 378   HOOK => sub {
 379      for my $line (split /\n/, $_) {
 380          my ($key, $value, $junk) = split /=>/, $line;
 381          next if $junk;
 382          $key =~ s/^\s+|\s+$//g
 383          $value =~ s/^\s+|\s+$//g
 384          $hash{$key} = $value;
 385      }
 386   },
 387
 388 =head2 import_from_file($filename, @args)
 389
 390 Very similar to straight "import", but you specify the source filename
 391 explicitly.
 392
 393 =head2 add_hook(NAME => value)
 394
 395 This function adds another hook, it is useful for dynamic updating of
 396 parsing through the document.
 397
 398 For an example, please see t/01-constants.t in the source
 399 distribution.  More detailed examples will be added in a later
 400 release.
 401
 402 =head2 delete_hook(@list)
 403
 404 Deletes the named hooks.  Companion function to add_hook
 405
 406 =head2 CLOSURES AS DESTINATIONS
 407
 408 If the given value is a ref CODE, then that function is called, with
 409 $_ set to the value of the paragraph.  This can be very useful for
 410 applying your own custom mutations to the POD to change it from human
 411 readable text into something your program can use.
 412
 413 After I added this function, I just kept on thinking of cool uses for
 414 it.  The nice, succinct code you can make with it is one of
 415 Pod::Constant's strongest features.
 416
 417 Below are some examples.
 418
 419 =head1 EXAMPLES
 420
 421 =head2 Module Makefile.PL maintenance
 422
 423 Tired of keeping those module Makefile.PL's up to date?  Note: This
 424 method seems to break dh-make-perl.
 425
 426 =head2 Example Makefile.PL
 427
 428  eval "use Pod::Constants";
 429  ($Pod::Constants::VERSION >= 0.11)
 430      or die <<EOF
 431  ####
 432  ####  ERROR: This module requires Pod::Constants 0.11 or
 433  ####  higher to be installed.
 434  ####
 435  EOF
 436
 437  my ($VERSION, $NAME, $PREREQ_PM, $ABSTRACT, $AUTHOR);
 438  Pod::Constants::import_from_file
 439      (
 440       'MyTestModule.pm',
 441       'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+)/ },
 442       'DEPENDENCIES' => ($PREREQ_PM = { }),
 443        -trim => 1,
 444       'NAME' => sub { $ABSTRACT=$_; ($NAME) = m/(\S+)/ },
 445       'AUTHOR' => \$AUTHOR,
 446      );
 447
 448  WriteMakefile
 449      (
 450       'NAME'        => $NAME,
 451       'PREREQ_PM'        => $PREREQ_PM,
 452       'VERSION'          => $VERSION,
 453       ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
 454        (ABSTRACT         => $ABSTRACT,
 455         AUTHOR           => $AUTHOR) : ()),
 456      );
 457
 458 =head2 Corresponding Module
 459
 460  =head1 NAME
 461
 462  MyTestModule - Demonstrate Pod::Constant's Makefile.PL usefulness
 463
 464  =head2 MODULE RELEASE
 465
 466  This is release 1.05 of this module.
 467
 468  =head2 DEPENDENCIES
 469
 470  The following modules are required to make this module:
 471
 472     Some::Module => 0.02
 473
 474  =head2 AUTHOR
 475
 476  Ima Twat <ima@twat.name>
 477
 478  =cut
 479
 480  use vars qw($VERSION);
 481  use Pod::Constants -trim => 1,
 482      'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+) or die };
 483
 484 =head1 AUTHOR
 485
 486 Sam Vilain, <samv@cpan.org>
 487
 488 =head1 BUGS/TODO
 489
 490 I keep thinking it would be nice to be able to import an =item list
 491 into an array or something, eg for a program argument list.  But I'm
 492 not too sure how it would be all that useful in practice; you'd end up
 493 putting the function names for callbacks in the pod or something
 494 (perhaps not all that bad).
 495
 496 Would this be useful?
 497
 498  Pod::Constants::import(Foo::SECTION => \$myvar);
 499
 500 Debug output is not very readable
 501
 502 =head1 PATCHES WELCOME
 503
 504 If you have any suggestions for enhancements, they are much more likely
 505 to happen if you submit them as a patch to the distribution.
 506
 507 Source is kept at
 508
 509   git://utsl.gen.nz/Pod-Constants
 510
 511
 512 =cut