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 1.4142;
 232 __END__
 233
 234 =encoding utf-8
 235
 236 =head1 NAME
 237
 238 Pod::Constants - Include constants from POD
 239
 240 =head1 SYNOPSIS
 241
 242  use vars qw($myvar $VERSION @myarray $html %myhash);
 243
 244  use Pod::Constants -trim => 1,
 245      'Pod Section Name' => \$myvar,
 246      'Version' => sub { eval },
 247      'Some list' => \@myarray,
 248      html => \$html,
 249      'Some hash' => \%myhash;
 250
 251  =head2 Pod Section Name
 252
 253  This string will be loaded into $myvar
 254
 255  =head2 Version
 256
 257  # This is an example of using a closure.  $_ is set to the
 258  # contents of the paragraph.  In this example, "eval" is
 259  # used to execute this code at run time.
 260  $VERSION = 0.17;
 261
 262  =head2 Some list
 263
 264  Each line from this section of the file
 265  will be placed into a separate array element.
 266  For example, this is $myarray[2].
 267
 268  =head2 Some hash
 269
 270  This text will not go into the hash, because
 271  it doesn't look like a definition list.
 272      key1 => Some value (this will go into the hash)
 273      var2 => Some Other value (so will this)
 274      wtf = This won't make it in.
 275
 276  =head2 %myhash's value after the above:
 277
 278     ( key1 => "Some value (this will go into the hash)",
 279       var2 => "Some Other value (so will this)"          )
 280
 281  =begin html <p>This text will be in $html</p>
 282
 283  =cut
 284
 285 =head1 DESCRIPTION
 286
 287 This module allows you to specify those constants that should be
 288 documented in your POD, and pull them out a run time in a fairly
 289 arbitrary fashion.
 290
 291 Pod::Constants uses Pod::Parser to do the parsing of the source file.
 292 It has to open the source file it is called from, and does so directly
 293 either by lookup in %INC or by assuming it is $0 if the caller is
 294 "main" (or it can't find %INC{caller()})
 295
 296 =head2 ARBITARY DECISIONS
 297
 298 I have made this code only allow the "Pod Section Name" to match
 299 `headN', `item', `for' and `begin' POD sections.  If you have a good
 300 reason why you think it should match other POD sections, drop me a
 301 line and if I'm convinced I'll put it in the standard version.
 302
 303 For `for' and `begin' sections, only the first word is counted as
 304 being a part of the specifier, as opposed to `headN' and `item', where
 305 the entire rest of the line counts.
 306
 307 =head1 FUNCTIONS
 308
 309 =head2 import(@args)
 310
 311 This function is called when we are "use"'d.  It determines the source
 312 file by inspecting the value of caller() or $0.
 313
 314 The form of @args is HOOK => $where.
 315
 316 $where may be a scalar reference, in which case the contents of the
 317 POD section called "HOOK" will be loaded into $where.
 318
 319 $where may be an array reference, in which case the contents of the
 320 array will be the contents of the POD section called "HOOK", split
 321 into lines.
 322
 323 $where may be a hash reference, in which case any lines with a "=>"
 324 symbol present will have everything on the left have side of the =>
 325 operator as keys and everything on the right as values.  You do not
 326 need to quote either, nor have trailing commas at the end of the
 327 lines.
 328
 329 $where may be a code reference (sub { }), in which case the sub is
 330 called when the hook is encountered.  $_ is set to the value of the
 331 POD paragraph.
 332
 333 You may also specify the behaviour of whitespace trimming; by default,
 334 no trimming is done except on the HOOK names.  Setting "-trim => 1"
 335 turns on a package "global" (until the next time import is called)
 336 that will trim the $_ sent for processing by the hook processing
 337 function (be it a given function, or the built-in array/hash
 338 splitters) for leading and trailing whitespace.
 339
 340 The name of HOOK is matched against any "=head1", "=head2", "=item",
 341 "=for", "=begin" value.  If you specify the special hooknames "*item",
 342 "*head1", etc, then you will get a function that is run for every
 343
 344 Note that the supplied functions for array and hash splitting are
 345 exactly equivalent to fairly simple Perl blocks:
 346
 347 Array:
 348
 349   HOOK => sub { @array = split /\n/, $_ }
 350
 351 Hash:
 352
 353   HOOK => sub {
 354   %hash =
 355       (map { map { s/^\s+|\s+$//g; $_ } split /=>/, $_ }
 356         (grep m/^
 357             ( (?:[^=]|=[^>])+ )   # scan up to "=>"
 358             =>
 359             ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s
 360             $/x, split /\n/, $_));
 361   }
 362
 363 Well, they're simple if you can grok map, a regular expression like
 364 that and a functional programming style.  If you can't I'm sure it is
 365 probably voodoo to you.
 366
 367 Here's the procedural equivalent:
 368
 369   HOOK => sub {
 370      for my $line (split /\n/, $_) {
 371          my ($key, $value, $junk) = split /=>/, $line;
 372          next if $junk;
 373          $key =~ s/^\s+|\s+$//g
 374          $value =~ s/^\s+|\s+$//g
 375          $hash{$key} = $value;
 376      }
 377   },
 378
 379 =head2 import_from_file($filename, @args)
 380
 381 Very similar to straight "import", but you specify the source filename
 382 explicitly.
 383
 384 =head2 add_hook(NAME => value)
 385
 386 This function adds another hook, it is useful for dynamic updating of
 387 parsing through the document.
 388
 389 For an example, please see t/01-constants.t in the source
 390 distribution.  More detailed examples will be added in a later
 391 release.
 392
 393 =head2 delete_hook(@list)
 394
 395 Deletes the named hooks.  Companion function to add_hook
 396
 397 =head2 CLOSURES AS DESTINATIONS
 398
 399 If the given value is a ref CODE, then that function is called, with
 400 $_ set to the value of the paragraph.  This can be very useful for
 401 applying your own custom mutations to the POD to change it from human
 402 readable text into something your program can use.
 403
 404 After I added this function, I just kept on thinking of cool uses for
 405 it.  The nice, succinct code you can make with it is one of
 406 Pod::Constant's strongest features.
 407
 408 Below are some examples.
 409
 410 =head1 EXAMPLES
 411
 412 =head2 Module Makefile.PL maintenance
 413
 414 Tired of keeping those module Makefile.PL's up to date?  Note: This
 415 method seems to break dh-make-perl.
 416
 417 =head2 Example Makefile.PL
 418
 419  eval "use Pod::Constants";
 420  ($Pod::Constants::VERSION >= 0.11)
 421      or die <<EOF
 422  ####
 423  ####  ERROR: This module requires Pod::Constants 0.11 or
 424  ####  higher to be installed.
 425  ####
 426  EOF
 427
 428  my ($VERSION, $NAME, $PREREQ_PM, $ABSTRACT, $AUTHOR);
 429  Pod::Constants::import_from_file
 430      (
 431       'MyTestModule.pm',
 432       'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+)/ },
 433       'DEPENDENCIES' => ($PREREQ_PM = { }),
 434        -trim => 1,
 435       'NAME' => sub { $ABSTRACT=$_; ($NAME) = m/(\S+)/ },
 436       'AUTHOR' => \$AUTHOR,
 437      );
 438
 439  WriteMakefile
 440      (
 441       'NAME'        => $NAME,
 442       'PREREQ_PM'        => $PREREQ_PM,
 443       'VERSION'          => $VERSION,
 444       ($] >= 5.005 ?    ## Add these new keywords supported since 5.005
 445        (ABSTRACT         => $ABSTRACT,
 446         AUTHOR           => $AUTHOR) : ()),
 447      );
 448
 449 =head2 Corresponding Module
 450
 451  =head1 NAME
 452
 453  MyTestModule - Demonstrate Pod::Constant's Makefile.PL usefulness
 454
 455  =head2 MODULE RELEASE
 456
 457  This is release 1.05 of this module.
 458
 459  =head2 DEPENDENCIES
 460
 461  The following modules are required to make this module:
 462
 463     Some::Module => 0.02
 464
 465  =head2 AUTHOR
 466
 467  Ima Twat <ima@twat.name>
 468
 469  =cut
 470
 471  use vars qw($VERSION);
 472  use Pod::Constants -trim => 1,
 473      'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+) or die };
 474
 475 =head1 AUTHOR
 476
 477 Sam Vilain, <samv@cpan.org>
 478
 479 =head1 BUGS/TODO
 480
 481 I keep thinking it would be nice to be able to import an =item list
 482 into an array or something, eg for a program argument list.  But I'm
 483 not too sure how it would be all that useful in practice; you'd end up
 484 putting the function names for callbacks in the pod or something
 485 (perhaps not all that bad).
 486
 487 Would this be useful?
 488
 489  Pod::Constants::import(Foo::SECTION => \$myvar);
 490
 491 Debug output is not very readable
 492
 493 =head1 PATCHES WELCOME
 494
 495 If you have any suggestions for enhancements, they are much more likely
 496 to happen if you submit them as a patch to the distribution.
 497
 498 Source is kept at
 499
 500   git://utsl.gen.nz/Pod-Constants
 501
 502
 503 =cut