Pod-Constants-0.16/0000755000175000017500000000000010706612444012636 5ustar samvsamvPod-Constants-0.16/t/0000755000175000017500000000000010706612444013101 5ustar samvsamvPod-Constants-0.16/t/cheese.pl0000644000175000017500000000015610706611333014670 0ustar samvsamv use strict; use vars qw($foo); use Pod::Constants -trim => 1, foo => \$foo; =head1 foo detcepxe =cut 1; Pod-Constants-0.16/t/Cheese.pm0000644000175000017500000000046710706611333014636 0ustar samvsamvpackage Cheese; use strict; use vars qw($foo $quux); use Pod::Constants -debug => 1, -trim => 1, foo => \$foo, bar => sub { print "GOT HERE\n"; eval "use ReEntrancyTest"; print "GOT HERE TOO. \$\@ is `$@'\n"; }, quux => \$quux, ; =head1 foo detcepxe =head1 bar =head2 quux Blah. =cut 1; Pod-Constants-0.16/t/ReEntrancyTest.pm0000644000175000017500000000025510706611333016347 0ustar samvsamv package ReEntrancyTest; use strict; use vars qw($wohoo $foo); use Pod::Constants -debug => 1, -trim => 1, foobar => \$wohoo; =head1 foobar Re-entrancy works! =cut 1; Pod-Constants-0.16/t/01-constants.t0000644000175000017500000000747110706611333015525 0ustar samvsamv#!/usr/bin/perl -w use strict; use Test::More tests => 20; use Data::Dumper; use vars qw($section_1 $section_2 $section_3 $section_4 %options); use_ok( "Pod::Constants", section_1 => \$section_1, -trim => 1, section_2 => \$section_2, section_3 => sub { tr/[a-z]/[A-Z]/; $section_3 = $_ }, section_4 => sub { eval }, 'command line parameters' => sub { &Pod::Constants::add_hook ( #-trim => 0, '*item' => sub { my ($options, $description) = m/^(.*?)\n\n(.*)/s; my (@options, $longest); $longest = ""; for my $option ($options =~ m/\G((?:-\w|--\w+))(?:,\s*)?/g) { push @options, $option; if ( length $option > length $longest) { $longest = $option; } } $longest =~ s/^-*//; $options{$longest} = { options => \@options, description => $description, }; } ) }, ); # try as hard as we can to get the path to perl use Config; my @PERL = ($Config{perlpath}, $^X); if (open MAKEMAKERISAHORRIDHACK, "; chomp($FROM_MAKEMAKER); close MAKEMAKERISAHORRIDHACK; push @PERL, $FROM_MAKEMAKER; } else { warn "could not open a temporary file saved by Makefile.PL"; } unshift @PERL, $ENV{PERL}; my $PERL; for (@PERL) { defined $_ && ( -x ) && do { $PERL = $_; last } } $PERL ||= "perl"; print "perl is $PERL\n"; ok($Pod::Constants::VERSION, "Pod::Constants sets its own VERSION"); BEGIN { push @INC, "t"; }; # to avoid a warning if ( 0 ) { $Cheese::foo = $ReEntrancyTest::wohoo = $Cheese::quux; } eval "use Cheese"; is($section_1, "Legalise Cannabis!\n\n", "no trim from main"); is($section_2, "42", "with trim from main"); is($section_3, "STICKY BUD", "sub"); is($section_4, "hash cookies", "eval"); is($Cheese::foo, "detcepxe", "From module"); is($ReEntrancyTest::wohoo, "Re-entrancy works!", "From module"); is($Cheese::quux, "Blah.", "From module(2)"); like(`$PERL -c t/Cheese.pm 2>&1`, qr/syntax OK/, "perl -c module"); like(`$PERL -c t/cheese.pl 2>&1`, qr/syntax OK/, "perl -c script"); # test the examples on the man page :) package Pod::Constants; Pod::Constants->import (SYNOPSIS => sub { $main::section_1 = join "\n", map { s/^ //; $_ } split /\n/, $_ }); package main; open NEWPKG, ">t/TestManPage.pm" or die $!; # why define your test results when you can read them in from POD? $section_1 =~ s/myhash\)/myhash %myhash2)/; $section_1 =~ s/myhash;/myhash, "%myhash\'s value after the above:" => sub { %myhash2 = eval };/; print NEWPKG "package TestManPage;\n$section_1\n2.818;\n"; close NEWPKG; use_ok("TestManPage"); is($TestManPage::myvar, 'This string will be loaded into $myvar', "man page example 1"); is($TestManPage::VERSION, $Pod::Constants::VERSION, "man page example 2"); ok($TestManPage::VERSION, "man page example 2 cross-check"); is($TestManPage::myarray[2], 'For example, this is $myarray[2].', "man page example 3"); my $ok = 0; while (my ($k, $v) = each %TestManPage::myhash) { if (exists $TestManPage::myhash2{$k}) { $ok ++ }; if ($v eq $TestManPage::myhash2{$k}) { $ok ++ }; } is($ok, 4, "man page example 4"); is(scalar keys %TestManPage::myhash, 2, "man page example 4 cross-check"); is($TestManPage::html, '

This text will be in $html

', "man page example 5"); # supress warnings $TestManPage::myvar = $TestManPage::html = undef; @TestManPage::myarray = (); is($options{foo}->{options}->[0], "-f", "Pod::Constants::add_hook"); =head2 section_1 Legalise Cannabis! =head2 section_2 42 =head2 section_3 sticky bud =head2 section_4 $section_4 = "hash cookies" =cut =head1 command line parameters the following command line parameters are supported =item -f, --foo This does something cool. =item -h, --help This also does something pretty cool. =cut Pod-Constants-0.16/Changes0000644000175000017500000000221110706612105014117 0ustar samvsamvRevision history for Perl extension Pod::Constants. 0.16 Sun Oct 21 21:55:59 NZDT 2007 - Lots of boring release engineering. Imported to git, etc. Removed the debian/ directory. Updated the license (now not just Artistic) 0.15 Mon Apr 8 19:43:38 BST 2002 - Really fixed lack of re-entrancy, added test script for same 0.14 Mon Apr 8 17:34:35 BST 2002 - Fixed lack of re-entrancy - Fixed CR/LF handling properly 0.13 Wed Jan 23 16:55:59 GMT 2002 - Fixed regular expression bug affecting perl versions <= 5.005. 0.12 Mon Dec 10 16:21:54 GMT 2001 - Added add_hook and delete_hook function - more details on man page 0.11 Tue Nov 20 18:24:34 GMT 2001 - Corrected man page, added section on automatic Makefile.PL generation 0.10 Sat Nov 10 01:14:00 GMT 2001 - Added support for importing data into hashes, arrays, and processing with closures. - not released to world at large (man page incorrect) 0.02 Fri Nov 2 04:15:54 GMT 2001 - now handles "perl -c Module.pm" properly 0.01 Mon Oct 15 19:39:20 2001 - original version. scalars only. Pod-Constants-0.16/Constants.pm0000644000175000017500000003306010706612430015145 0ustar samvsamv# Copyright (C) 2001, 2002, 2007 Sam Vilain. All Rights Reserved. # This module is free software. It may be used, redistributed and/or # modified under the terms of the Perl Artistic License, version 2 or # later, OR the terms of the GNU General Public License, v3 or later. package Pod::Constants; =head1 NAME Pod::Constants - Include constants from POD =head1 SYNOPSIS use vars qw($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.16; =head2 Some list Each line from this section of the file will be placed into a seperate 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 html

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 strict; use base qw(Pod::Parser Exporter); use Data::Dumper; use Carp; use vars qw($VERSION); # An ugly hack to go from caller() to the relevant parser state # variable my %parsers; sub end_input { #my ($parser, $command, $paragraph, $line_num) = (@_); my $parser = shift; return unless $parser->{active}; 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}); $parser->{paragraphs} =~ s/^\s*|\s*$//gs if $parser->{trimmed_tags}->{$parser->{active}}; 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") { print "inserting into scalar\n" if $parser->{DEBUG}; $$whereto = $parser->{paragraphs}; } elsif (ref $whereto eq "ARRAY") { print "inserting into array\n" if $parser->{DEBUG}; @$whereto = split /\n/, $parser->{paragraphs}; } 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}); } else { die $whereto } $parser->{active} = undef; } # Pod::Parser overloaded command sub command { my ($parser, $command, $paragraph, $line_num) = @_; $paragraph =~ s/(?:\r\n|\n\r)/\n/g; 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); } else { # otherwise, it's up to the end of the line ($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}) { print "Found $lookup\n" if ($parser->{DEBUG}); $parser->{active} = $lookup; $does_she_want_it_sir = "suits you sir"; } } 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 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}; if (defined $parser->{active}) { $parser->{paragraphs} .= $paragraph; } } # Pod::Parser overloaded textblock sub textblock { goto \&verbatim } =head1 FUNCTIONS =head2 import(@args) This function is called when we are "use"'d. It determines the source file by inspecting the value of caller() or $0. The form of @args is HOOK => $where. $where may be a scalar reference, in which case the contents of the POD section called "HOOK" will be loaded into $where. $where may be an array reference, in which case the contents of the array will be the contents of the POD section called "HOOK", split into lines. $where may be a hash reference, in which case any lines with a "=>" symbol present will have everything on the left have side of the => operator as keys and everything on the right as values. You do not need to quote either, nor have trailing commas at the end of the lines. $where may be a code reference (sub { }), in which case the sub is called when the hook is encountered. $_ is set to the value of the POD paragraph. You may also specify the behaviour of whitespace trimming; by default, no trimming is done except on the HOOK names. Setting "-trim => 1" turns on a package "global" (until the next time import is called) that will trim the $_ sent for processing by the hook processing function (be it a given function, or the built-in array/hash splitters) for leading and trailing whitespace. The name of HOOK is matched against any "=head1", "=head2", "=item", "=for", "=begin" value. If you specify the special hooknames "*item", "*head1", etc, then you will get a function that is run for every Note that the supplied functions for array and hash splitting are exactly equivalent to fairly simple Perl blocks: Array: HOOK => sub { @array = split /\n/, $_ } Hash: HOOK => sub { %hash = (map { map { s/^\s+|\s+$//g; $_ } split /=>/, $_ } (grep m/^ ( (?:[^=]|=[^>])+ ) # scan up to "=>" => ( (?:[^=]|=[^>])+ =? )# don't allow more "=>"'s $/x, split /\n/, $_)); } Well, they're simple if you can grok map, a regular expression like that and a functional programming style. If you can't I'm sure it is probably voodoo to you. Here's the procedural equivalent: HOOK => sub { for my $line (split /\n/, $_) { my ($key, $value, $junk) = split /=>/, $line; next if $junk; $key =~ s/^\s+|\s+$//g $value =~ s/^\s+|\s+$//g $hash{$key} = $value; } }, =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 parsing through the document. 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 $_ set to the value of the paragraph. This can be very useful for applying your own custom mutations to the POD to change it from human readable text into something your program can use. After I added this function, I just kept on thinking of cool uses for it. The nice, succinct code you can make with it is one of Pod::Constant's strongest features. Below are some examples. =head1 EXAMPLES =head2 Module Makefile.PL maintenance Tired of keeping those module Makefile.PL's up to date? Note: This method seems to break dh-make-perl. =head2 Example Makefile.PL eval "use Pod::Constants"; ($Pod::Constants::VERSION >= 0.11) or die < sub { ($VERSION) = m/(\d+\.\d+)/ }, 'DEPENDANCIES' => ($PREREQ_PM = { }), -trim => 1, 'NAME' => sub { $ABSTRACT=$_; ($NAME) = m/(\S+)/ }, 'AUTHOR' => \$AUTHOR, ); WriteMakefile ( 'NAME' => $NAME, 'PREREQ_PM' => $PREREQ_PM, 'VERSION' => $VERSION, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT => $ABSTRACT, AUTHOR => $AUTHOR) : ()), ); =head2 Corresponding Module =head1 NAME MyTestModule - Demonstrate Pod::Constant's Makefile.PL usefulness =head2 MODULE RELEASE This is release 1.05 of this module. =head2 DEPENDANCIES The following modules are required to make this module: Some::Module => 0.02 =head2 AUTHOR Ima Twat =cut use vars qw($VERSION); use Pod::Constants -trim => 1, 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+) or die }; =head1 AUTHOR Sam Vilain, =head1 BUGS/TODO I keep thinking it would be nice to be able to import an =item list into an array or something, eg for a program argument list. But I'm not too sure how it would be all that useful in practice; you'd end up putting the function names for callbacks in the pod or something (perhaps not all that bad). Would this be useful? Pod::Constants::import(Foo::SECTION => \$myvar); Debug output is not very readable =head1 PATCHES WELCOME If you have any suggestions for enhancements, they are much more likely to happen if you submit them as a patch to the distribution. Source is kept at git://utsl.gen.nz/Pod-Constants =cut BEGIN { Pod::Constants->import ( SYNOPSIS => sub { eval pop @{[ grep /^\s*\$VERSION/, split /\n/, $_ ]} } ) }; 1.4142; Pod-Constants-0.16/MANIFEST0000644000175000017500000000027510706612444013773 0ustar samvsamvChanges Constants.pm Makefile.PL MANIFEST README t/01-constants.t t/Cheese.pm t/cheese.pl t/ReEntrancyTest.pm META.yml Module meta-data (added by MakeMaker) Pod-Constants-0.16/Makefile.PL0000644000175000017500000000246410706611333014612 0ustar samvsamvuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # Extract the version from the file. I don't think it's right to use # my own module to do this, so resort to something that should work # everywhere :-) my $VERSION; open FOO, " ) { last if ($VERSION) = m/^\s*\$VERSION\s*=\s*(\d+\.\d+)/; } close FOO; # If this function is not called manually on older versions of # ExtUtils::MakeMaker, it goes tits up. ExtUtils::MakeMaker::full_setup(); # "MM" comes from the "ExtUtils::MakeMaker" package my $mm = MM->new({ 'NAME' => 'Pod::Constants', 'VERSION' => $VERSION, 'PREREQ_PM' => { Pod::Parser => 1.13, Test::Simple => 0.18, }, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'Constants.pm', # retrieve abstract from module AUTHOR => 'Sam Vilain ') : ()), }); if (open MAKEMAKERISAHORRIDHACK, ">t/perlpath") { print MAKEMAKERISAHORRIDHACK $mm->{FULLPERL},"\n"; close MAKEMAKERISAHORRIDHACK; } else { warn("could not open t/perlpath for writing; $!. It is remotely " ."possible that some of the test scripts will test against " ."the wrong version of perl."); } $mm->flush(); 0; Pod-Constants-0.16/README0000644000175000017500000000167410706611726013530 0ustar samvsamvPod::Constants version 0.16 =========================== Pod::Constants allows you to extract data from your POD at run-time, meaning you can do things like declare constants in POD and not have to update two places at once every time you make a change. This version adds the ability to read structured data from POD sections, as well as insert arbitrary hooks into the extraction of data. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES Pod::Parser, 1.13 or better. That is to say, I haven't tested it on any earlier version. Running the test suite requires Test::Simple 0.18. COPYRIGHT AND LICENCE Copyright (C) 2001, 2002, 2007 Sam Vilain. All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the terms of the Perl Artistic License, version 2 or later, OR the terms of the GNU General Public License, v3 or later. Pod-Constants-0.16/META.yml0000664000175000017500000000056510706612444014117 0ustar samvsamv# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Pod-Constants version: 0.16 version_from: installdirs: site requires: Pod::Parser: 1.13 Test::Simple: 0.18 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30_01