r8417 - in /branches/upstream/libpod-constants-perl: ./ current/ current/t/
hanska-guest at users.alioth.debian.org
hanska-guest at users.alioth.debian.org
Sun Oct 21 12:08:50 UTC 2007
Author: hanska-guest
Date: Sun Oct 21 12:08:50 2007
New Revision: 8417
URL: http://svn.debian.org/wsvn/?sc=1&rev=8417
Log:
[svn-inject] Installing original source of libpod-constants-perl
Added:
branches/upstream/libpod-constants-perl/
branches/upstream/libpod-constants-perl/current/
branches/upstream/libpod-constants-perl/current/Changes
branches/upstream/libpod-constants-perl/current/Constants.pm
branches/upstream/libpod-constants-perl/current/MANIFEST
branches/upstream/libpod-constants-perl/current/META.yml
branches/upstream/libpod-constants-perl/current/Makefile.PL
branches/upstream/libpod-constants-perl/current/README
branches/upstream/libpod-constants-perl/current/t/
branches/upstream/libpod-constants-perl/current/t/01-constants.t
branches/upstream/libpod-constants-perl/current/t/Cheese.pm
branches/upstream/libpod-constants-perl/current/t/ReEntrancyTest.pm
branches/upstream/libpod-constants-perl/current/t/cheese.pl
Added: branches/upstream/libpod-constants-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/Changes?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/Changes (added)
+++ branches/upstream/libpod-constants-perl/current/Changes Sun Oct 21 12:08:50 2007
@@ -1,0 +1,36 @@
+Revision 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.
Added: branches/upstream/libpod-constants-perl/current/Constants.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/Constants.pm?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/Constants.pm (added)
+++ branches/upstream/libpod-constants-perl/current/Constants.pm Sun Oct 21 12:08:50 2007
@@ -1,0 +1,517 @@
+# 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 <p>This text will be in $html</p>
+
+ =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 <<EOF
+ ####
+ #### ERROR: This module requires Pod::Constants 0.11 or
+ #### higher to be installed.
+ ####
+ EOF
+
+ my ($VERSION, $NAME, $PREREQ_PM, $ABSTRACT, $AUTHOR);
+ Pod::Constants::import_from_file
+ (
+ 'MyTestModule.pm',
+ 'MODULE RELEASE' => 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 <ima at twat.name>
+
+ =cut
+
+ use vars qw($VERSION);
+ use Pod::Constants -trim => 1,
+ 'MODULE RELEASE' => sub { ($VERSION) = m/(\d+\.\d+) or die };
+
+=head1 AUTHOR
+
+Sam Vilain, <samv at cpan.org>
+
+=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;
Added: branches/upstream/libpod-constants-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/MANIFEST?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/MANIFEST (added)
+++ branches/upstream/libpod-constants-perl/current/MANIFEST Sun Oct 21 12:08:50 2007
@@ -1,0 +1,10 @@
+Changes
+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)
Added: branches/upstream/libpod-constants-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/META.yml?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/META.yml (added)
+++ branches/upstream/libpod-constants-perl/current/META.yml Sun Oct 21 12:08:50 2007
@@ -1,0 +1,12 @@
+# 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
Added: branches/upstream/libpod-constants-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/Makefile.PL?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/Makefile.PL (added)
+++ branches/upstream/libpod-constants-perl/current/Makefile.PL Sun Oct 21 12:08:50 2007
@@ -1,0 +1,43 @@
+use 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, "<Constants.pm" or die $!;
+while ( <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 <sam at vilain.net>') : ()),
+});
+
+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;
Added: branches/upstream/libpod-constants-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/README?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/README (added)
+++ branches/upstream/libpod-constants-perl/current/README Sun Oct 21 12:08:50 2007
@@ -1,0 +1,33 @@
+Pod::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.
Added: branches/upstream/libpod-constants-perl/current/t/01-constants.t
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/t/01-constants.t?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/t/01-constants.t (added)
+++ branches/upstream/libpod-constants-perl/current/t/01-constants.t Sun Oct 21 12:08:50 2007
@@ -1,0 +1,152 @@
+#!/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, "<t/perlpath") {
+ my $FROM_MAKEMAKER = <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, '<p>This text will be in $html</p>',
+ "man page example 5");
+# supress warnings
+$TestManPage::myvar = $TestManPage::html = undef;
+ at 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
Added: branches/upstream/libpod-constants-perl/current/t/Cheese.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/t/Cheese.pm?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/t/Cheese.pm (added)
+++ branches/upstream/libpod-constants-perl/current/t/Cheese.pm Sun Oct 21 12:08:50 2007
@@ -1,0 +1,25 @@
+package 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;
Added: branches/upstream/libpod-constants-perl/current/t/ReEntrancyTest.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/t/ReEntrancyTest.pm?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/t/ReEntrancyTest.pm (added)
+++ branches/upstream/libpod-constants-perl/current/t/ReEntrancyTest.pm Sun Oct 21 12:08:50 2007
@@ -1,0 +1,15 @@
+
+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;
Added: branches/upstream/libpod-constants-perl/current/t/cheese.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libpod-constants-perl/current/t/cheese.pl?rev=8417&op=file
==============================================================================
--- branches/upstream/libpod-constants-perl/current/t/cheese.pl (added)
+++ branches/upstream/libpod-constants-perl/current/t/cheese.pl Sun Oct 21 12:08:50 2007
@@ -1,0 +1,13 @@
+
+use strict;
+
+use vars qw($foo);
+use Pod::Constants -trim => 1, foo => \$foo;
+
+=head1 foo
+
+detcepxe
+
+=cut
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list