This text will be in $html
- - =cut - -=head1 DESCRIPTION - -This module allows you to specify those constants that should be -documented in your POD, and pull them out a run time in a fairly -arbitrary fashion. - -Pod::Constants uses Pod::Parser to do the parsing of the source file. -It has to open the source file it is called from, and does so directly -either by lookup in %INC or by assuming it is $0 if the caller is -"main" (or it can't find %INC{caller()}) - -=head2 ARBITARY DECISIONS - -I have made this code only allow the "Pod Section Name" to match -`headN', `item', `for' and `begin' POD sections. If you have a good -reason why you think it should match other POD sections, drop me a -line and if I'm convinced I'll put it in the standard version. - -For `for' and `begin' sections, only the first word is counted as -being a part of the specifier, as opposed to `headN' and `item', where -the entire rest of the line counts. - -=cut - -use 5.004; +use 5.006002; use strict; +use warnings; use base qw(Pod::Parser Exporter); -use Data::Dumper; use Carp; -use vars qw($VERSION); -$VERSION = 0.17; +our $VERSION = 0.19; # An ugly hack to go from caller() to the relevant parser state # variable @@ -98,36 +19,32 @@ sub end_input { return unless $parser->{active}; - print "Found end of $parser->{active}\n" if ($parser->{DEBUG}); + print "Found end of $parser->{active}\n" if $parser->{DEBUG}; my $whereto = $parser->{wanted_pod_tags}->{$parser->{active}}; - print "\$_ will be set to:\n---\n$parser->{paragraphs}\n---\n" - if ($parser->{DEBUG}); + print "\$_ will be set to:\n---\n$parser->{paragraphs}\n---\n" if $parser->{DEBUG}; - $parser->{paragraphs} =~ s/^\s*|\s*$//gs - if $parser->{trimmed_tags}->{$parser->{active}}; + $parser->{paragraphs} =~ s/^\s*|\s*$//gs if $parser->{trimmed_tags}->{$parser->{active}}; - if (ref $whereto eq "CODE") { + if (ref $whereto eq 'CODE') { print "calling sub\n" if $parser->{DEBUG}; local ($_) = $parser->{paragraphs}; $whereto->(); print "done\n" if $parser->{DEBUG}; - } elsif (ref $whereto eq "SCALAR") { + } elsif (ref $whereto eq 'SCALAR') { print "inserting into scalar\n" if $parser->{DEBUG}; $$whereto = $parser->{paragraphs}; - } elsif (ref $whereto eq "ARRAY") { + } elsif (ref $whereto eq 'ARRAY') { print "inserting into array\n" if $parser->{DEBUG}; @$whereto = split /\n/, $parser->{paragraphs}; - } elsif (ref $whereto eq "HASH") { + } elsif (ref $whereto eq 'HASH') { print "inserting into hash\n" if $parser->{DEBUG}; # Oh, sorry, should I be in LISP101? - %$whereto = (map { map { s/^\s*|\s*$//g; $_ } - split /=>/, $_ } - grep m/^ - ( (?:[^=]|=[^>])+ ) # scan up to "=>" - => - ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s - $/x, - split /\n/, $parser->{paragraphs}); + %$whereto = ( + map { map { s/^\s*|\s*$//g; $_ } split /=>/ } grep m/^ + ( (?:[^=]|=[^>])+ ) # scan up to "=>" + => + ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s + $/x, split /\n/, $parser->{paragraphs},); } else { die $whereto } $parser->{active} = undef; } @@ -138,50 +55,38 @@ sub command { $paragraph =~ s/(?:\r\n|\n\r)/\n/g; - print "Got command =$command, value=$paragraph\n" - if $parser->{DEBUG}; + print "Got command =$command, value=$paragraph\n" if $parser->{DEBUG}; $parser->end_input() if $parser->{active}; - my $does_she_want_it_sir; - my ($lookup); # first check for a catch-all for this command type if ( exists $parser->{wanted_pod_tags}->{"*$command"} ) { $parser->{paragraphs} = $paragraph; $parser->{active} = "*$command"; - $does_she_want_it_sir = "oohw"; - } elsif ($command =~ m/^(head\d+|item|(for|begin))$/) { if ( $2 ) { # if it's a "for" or "begin" section, the title is the # first word only - ($lookup, $parser->{paragraphs}) = - ($paragraph =~ m/^\s*(\S*)\s*(.*)/s); + ($lookup, $parser->{paragraphs}) = $paragraph =~ m/^\s*(\S*)\s*(.*)/s; } else { # otherwise, it's up to the end of the line - ($lookup, $parser->{paragraphs}) - = ($paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s); + ($lookup, $parser->{paragraphs}) = $paragraph =~ m/^\s*(\S[^\n]*?)\s*\n(.*)$/s; } # Look for a match by name - if (defined $lookup - and exists $parser->{wanted_pod_tags}->{$lookup}) { + if (defined $lookup && exists $parser->{wanted_pod_tags}->{$lookup}) { print "Found $lookup\n" if ($parser->{DEBUG}); $parser->{active} = $lookup; - $does_she_want_it_sir = "suits you sir"; + } elsif ($parser->{DEBUG}) { + local $^W = 0; + print "Ignoring =$command $paragraph (lookup = $lookup)\n" } } else { # nothing print "Ignoring =$command (not known)\n" if $parser->{DEBUG}; } - - { - local $^W = 0; - print "Ignoring =$command $paragraph (lookup = $lookup)\n" - if (!$does_she_want_it_sir and $parser->{DEBUG}) - } } # Pod::Parser overloaded verbatim @@ -189,18 +94,176 @@ sub verbatim { my ($parser, $paragraph, $line_num) = @_; $paragraph =~ s/(?:\r\n|\n\r)/\n/g; - print("Got paragraph: $paragraph (" - .($parser->{active}?"using":"ignoring").")\n") - if $parser->{DEBUG}; + my $status = $parser->{active} ? 'using' : 'ignoring'; + print "Got paragraph: $paragraph ($status)\n" if $parser->{DEBUG}; - if (defined $parser->{active}) { - $parser->{paragraphs} .= $paragraph; - } + $parser->{paragraphs} .= $paragraph if defined $parser->{active} } # Pod::Parser overloaded textblock sub textblock { goto \&verbatim } +sub import { + my $class = shift; + + # if no args, just return + return unless (@_); + + # try to guess the source file of the caller + my $source_file; + if (caller ne 'main') { + (my $module = caller.'.pm') =~ s|::|/|g; + $source_file = $INC{$module}; + } + $source_file ||= $0; + + croak "Cannot find source file (guessed $source_file) for package ".caller unless -f $source_file; + + # nasty tricks with the stack so we don't have to be silly with + # caller() + unshift @_, $source_file; + goto \&import_from_file; +} + +sub import_from_file { + my $filename = shift; + + my $parser = __PACKAGE__->new(); + + $parser->{wanted_pod_tags} = {}; + $parser->{trimmed_tags} = {}; + $parser->{trim_next} = 0; + $parser->{DEBUG} = 0; + $parser->{active} = undef; + $parsers{caller()} = $parser; + + $parser->add_hook(@_); + + print "Pod::Parser: DEBUG: Opening $filename for reading\n" if $parser->{DEBUG}; + open my $fh, '<', $filename or croak "cannot open $filename for reading; $!"; + + $parser->parse_from_filehandle($fh, \*STDOUT); + + close $fh; +} + +sub add_hook { + my $parser; + if (eval { $_[0]->isa(__PACKAGE__) }) { + $parser = shift; + } else { + $parser = $parsers{caller()} or croak 'add_hook called, but don\'t know what for - caller = '.caller; + } + while (my ($pod_tag, $var) = splice @_, 0, 2) { + #print "$pod_tag: $var\n"; + if (lc($pod_tag) eq '-trim') { + $parser->{trim_next} = $var; + } elsif ( lc($pod_tag) eq '-debug' ) { + $parser->{DEBUG} = $var; + } elsif (lc($pod_tag) eq '-usage') { + # an idea for later - automatic "usage" + #%wanted_pod_tags{@tags} + } else { + if ((ref $var) =~ /^(?:SCALAR|CODE|ARRAY|HASH)$/) { + print "Will look for $pod_tag.\n" if $parser->{DEBUG}; + $parser->{wanted_pod_tags}->{$pod_tag} = $var; + $parser->{trimmed_tags}->{$pod_tag} = 1 if $parser->{trim_next}; + } else { + croak "Sorry - need a reference to import POD sections into, not the scalar value $var" + } + } + } +} + +sub delete_hook { + my $parser; + if (eval { $_[0]->isa(__PACKAGE__) }) { + $parser = shift; + } else { + $parser = $parsers{caller()} or croak 'delete_hook called, but don\'t know what for - caller = '.caller; + } + while ( my $label = shift ) { + delete $parser->{wanted_pod_tags}->{$label}; + delete $parser->{trimmed_tags}->{$label}; + } +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Pod::Constants - Include constants from POD + +=head1 SYNOPSIS + + our ($myvar, $VERSION, @myarray, $html, %myhash); + + use Pod::Constants -trim => 1, + 'Pod Section Name' => \$myvar, + 'Version' => sub { eval }, + 'Some list' => \@myarray, + html => \$html, + 'Some hash' => \%myhash; + + =head2 Pod Section Name + + This string will be loaded into $myvar + + =head2 Version + + # This is an example of using a closure. $_ is set to the + # contents of the paragraph. In this example, "eval" is + # used to execute this code at run time. + $VERSION = 0.19; + + =head2 Some list + + Each line from this section of the file + will be placed into a separate array element. + For example, this is $myarray[2]. + + =head2 Some hash + + This text will not go into the hash, because + it doesn't look like a definition list. + key1 => Some value (this will go into the hash) + var2 => Some Other value (so will this) + wtf = This won't make it in. + + =head2 %myhash's value after the above: + + ( key1 => "Some value (this will go into the hash)", + var2 => "Some Other value (so will this)" ) + + =begin htmlThis text will be in $html
+ + =cut + +=head1 DESCRIPTION + +This module allows you to specify those constants that should be +documented in your POD, and pull them out a run time in a fairly +arbitrary fashion. + +Pod::Constants uses Pod::Parser to do the parsing of the source file. +It has to open the source file it is called from, and does so directly +either by lookup in %INC or by assuming it is $0 if the caller is +"main" (or it can't find %INC{caller()}) + +=head2 ARBITARY DECISIONS + +I have made this code only allow the "Pod Section Name" to match +`headN', `item', `for' and `begin' POD sections. If you have a good +reason why you think it should match other POD sections, drop me a +line and if I'm convinced I'll put it in the standard version. + +For `for' and `begin' sections, only the first word is counted as +being a part of the specifier, as opposed to `headN' and `item', where +the entire rest of the line counts. + =head1 FUNCTIONS =head2 import(@args) @@ -273,66 +336,11 @@ Here's the procedural equivalent: } }, -=cut - -sub import { - my $class = shift; - - # if no args, just return - return unless (@_); - - # try to guess the source file of the caller - my $source_file; - if (caller ne "main") { - (my $module = caller().".pm") =~ s|::|/|g; - $source_file = $INC{$module}; - } - $source_file ||= $0; - - ( -f $source_file ) - or croak ("Cannot find source file (guessed $source_file) for" - ." package ".caller()); - - # nasty tricks with the stack so we don't have to be silly with - # caller() - unshift @_, $source_file; - goto \&import_from_file; -} - =head2 import_from_file($filename, @args) Very similar to straight "import", but you specify the source filename explicitly. -=cut - -use IO::Handle; - -sub import_from_file { - my $filename = shift; - - my $parser = __PACKAGE__->new(); - - $parser->{wanted_pod_tags} = {}; - $parser->{trimmed_tags} = {}; - $parser->{trim_next} = 0; - $parser->{DEBUG} = 0; - $parser->{active} = undef; - $parsers{caller()} = $parser; - - $parser->add_hook(@_); - - print "Pod::Parser: DEBUG: Opening $filename for reading\n" - if $parser->{DEBUG}; - my $fh = new IO::Handle; - open $fh, "<$filename" - or die ("cannot open $filename for reading; $!"); - - $parser->parse_from_filehandle($fh, \*STDOUT); - - close $fh; -} - =head2 add_hook(NAME => value) This function adds another hook, it is useful for dynamic updating of @@ -342,63 +350,10 @@ For an example, please see t/01-constants.t in the source distribution. More detailed examples will be added in a later release. -=cut - -sub add_hook { - my $parser; - if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) { - $parser = shift; - } else { - $parser = $parsers{caller()} - or die("add_hook called, but don't know what for - " - ."caller = ".caller()); - } - while (my ($pod_tag, $var) = splice @_, 0, 2) { - #print "$pod_tag: $var\n"; - if (lc($pod_tag) eq "-trim") { - $parser->{trim_next} = $var; - } elsif ( lc($pod_tag) eq "-debug" ) { - $parser->{DEBUG} = $var; - } elsif (lc($pod_tag) eq "-usage") { - # an idea for later - automatic "usage" - #%wanted_pod_tags{@tags} - } else { - if ((ref $var) =~ /^(?:SCALAR|CODE|ARRAY|HASH)$/) { - print "Will look for $pod_tag.\n" - if ($parser->{DEBUG}); - $parser->{wanted_pod_tags}->{$pod_tag} = $var; - $parser->{trimmed_tags}->{$pod_tag} = 1 - if $parser->{trim_next}; - } else { - die ("Sorry - need a reference to import POD " - ."sections into, not the scalar value $var" - ." importing $pod_tag into ".caller()); - } - } - } -} - =head2 delete_hook(@list) Deletes the named hooks. Companion function to add_hook -=cut - -sub delete_hook { - my $parser; - if ( UNIVERSAL::isa($_[0], __PACKAGE__) ) { - $parser = shift; - } else { - $parser = $parsers{caller()} - or die("delete_hook called, but don't know what for - " - ."caller = ".caller()); - } - while ( my $label = shift ) { - delete $parser->{wanted_pod_tags}->{$label}; - delete $parser->{trimmed_tags}->{$label}; - } -} - =head2 CLOSURES AS DESTINATIONS If the given value is a ref CODE, then that function is called, with @@ -473,7 +428,7 @@ method seems to break dh-make-perl. =cut - use vars qw($VERSION); + our $VERSION; use Pod::Constants -trim => 1, 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+) or die }; @@ -481,6 +436,20 @@ method seems to break dh-make-perl. Sam Vilain,