Module-Metadata-1.000019/000755 000767 000024 00000000000 12224312233 015155 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/Changes000644 000767 000024 00000006655 12224312174 016470 0ustar00etherstaff000000 000000 Release history for Module-Metadata 1.000019 2013-10-06 - warnings now disabled inside during the evaluation of generated version sub (BinGOs, RT#89282) 1.000018 2013-09-11 - re-release of detainting fix without unstated non-core test dependencies 1.000017 2013-09-10 - detaint version, if needed (RT#88576, Chris Williams) 1.000016 2013-08-21 - Re-release to fix prereqs and other metadata 1.000015 2013-08-21 - Change wording about safety/security to satisfy CVE-2013-1437 1.000014 2013-05-09 - Remove "now installs to 'site' for perl 5.12+" from last version 1.000013 2013-05-08 - Fix reliance on recent Test::Builder - Make tests perl 5.6 compatible - now installs to 'site' for perl 5.12+, as per p5p recommendation 1.000012 2013-05-04 - improved package detection heuristics (thanks, Edward Zborowski!) - fix ->contains_pod (RT#84932, Tokuhiro Matsuno) - fix detection of pod after __END__ (RT79656, Tokuhiro Matsuno) 1.000011 2012-08-16 - LEONT++ hasn't found any issues with my changes; mark it done (or at least ready for smoking). (APEIRON) 1.000010_003 2012-08-16 01:00:00 - Remove other spurious message (APEIRON) 1.000010_002 2012-08-15 20:15:00 - APEIRON is an idiot (APEIRON) 1.000010_001 2012-08-15 20:00:00 - Dev release to test removing a warning about modules not using the 'eval $VERSION' syntax which causes lots of spew. (APEIRON) 1.000010 2012-07-29 19:30:00 - Performance improvement: the creation of a Module::Metadata object for a typical module file has been sped up by about 40% (VPIT) - Fix t/metadata.t failure under Cygwin (JDHEDDEN) - Portability fix-ups for new_from_module() and test failures on VMS (CBERRY) 1.000009 2012-02-08 12:00:00 - API of 'provides' changed to require a 'version' argument to future proof the function against CPAN Meta Spec changes (DAGOLDEN) - Fatal errors now use 'croak' instead of 'die'; Carp added as prerequisite (DAGOLDEN) 1.000008 2012-02-07 22:30:00 - Adds 'provides' method to generate a CPAN META provides data structure correctly; use of package_versions_from_directory is discouraged (DAGOLDEN) 1.000007 2011-09-07 12:00:00 - Apply VMS fixes backported from blead (Craig A. Berry) 1.000006 2011-08-29 04:00:00 - Support PACKAGE BLOCK syntax (VPIT) 1.000005 2011-08-02 09:45:00 - Localize $package::VERSION during version discovery (MIYAGAWA) - Fix references to Module::Build::ModuleInfo [RT #66133] (DAGOLDEN) - Added 'new_from_handle()' method [RT #68875] (DAGOLDEN) - Improved documentation (SYNOPSIS, broke out class/object method, and other minor edits) (DAGOLDEN) 1.000004 2011-02-03 07:55:00 - Fix broken metadata.t when @INC has relative paths (JJORE) 1.000003 2011-01-06 21:35:00 - Pod cleanup (DAGOLDEN) 1.000002 2010-12-10 12:00:00 - Remove Module::Metadata::Version and depend directly on version.pm (DAGOLDEN) - Munge versions that fail even "lax" version number rules to try to return something sensible (DAGOLDEN) 1.000001 2010-07-09 00:52:37 - fix build code to prevent Author.PL being mistakenly run during make and add some extra author-side tools (MSTROUT) 1.000000 2010-07-07 - Initial release (MSTROUT) - Code extracted from Module::Build + Module::Build::Version (MSTROUT) - Tests extracted from Module::Build (DAGOLDEN) - POD coverage (MSTROUT) - Use of Log::Contextual when loaded with fallback to warn() (MSTROUT) Module-Metadata-1.000019/lib/000755 000767 000024 00000000000 12224312232 015722 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/maint/000755 000767 000024 00000000000 12224312232 016264 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/Makefile.PL000644 000767 000024 00000003265 12224311404 017134 0ustar00etherstaff000000 000000 use strict; use warnings FATAL => 'all'; use ExtUtils::MakeMaker; use 5.006; # TODO: convert to dzil and use [OnlyCorePrereqs], and possibly [DualLife] (do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; WriteMakefile( NAME => 'Module::Metadata', VERSION_FROM => 'lib/Module/Metadata.pm', ABSTRACT_FROM => 'lib/Module/Metadata.pm', LICENSE => 'perl', MIN_PERL_VERSION => '5.006', PREREQ_PM => { 'Carp' => 0, 'File::Find' => 0, 'File::Spec' => 0, 'IO::File' => 0, 'strict' => 0, 'warnings' => 0, 'vars' => 0, 'version' => 0.87, 'warnings' => 0, $] < 5.008 ? ( 'IO::Scalar' => 0 ) : () , }, -f 'META.yml' ? () : ( META_MERGE => { 'meta-spec' => { version => 2 }, dynamic_config => 0, resources => { # r/w: p5sagit@git.shadowcat.co.uk:Module-Metadata.git repository => { url => 'git://git.shadowcat.co.uk/p5sagit/Module-Metadata.git', web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/Module-Metadata.git', type => 'git', }, bugtracker => { mailto => 'bug-Module-Metadata@rt.cpan.org', web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Metadata', }, }, prereqs => { test => { requires => { 'Test::More' => 0, 'Carp' => 0, 'Config' => 0, 'Cwd' => 0, 'Data::Dumper' => 0, 'Exporter' => 0, 'File::Basename' => 0, 'File::Find' => 0, 'File::Path' => 0, 'File::Spec' => 0, 'File::Temp' => 0, 'IO::File' => 0, }, }, }, } ), ); Module-Metadata-1.000019/MANIFEST000644 000767 000024 00000001200 12224312233 016277 0ustar00etherstaff000000 000000 Changes lib/Module/Metadata.pm maint/bump-version maint/Makefile.include maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/contains_pod.t t/encoding.t t/endpod.t t/lib/0_1/Foo.pm t/lib/0_2/Foo.pm t/lib/BOMTest/UTF16BE.pm t/lib/BOMTest/UTF16LE.pm t/lib/BOMTest/UTF8.pm t/lib/DistGen.pm t/lib/ENDPOD.pm t/lib/MBTest.pm t/lib/Tie/CPHash.pm t/metadata.t t/taint.t t/version.t xt/pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) Module-Metadata-1.000019/META.json000644 000767 000024 00000003620 12224312232 016576 0ustar00etherstaff000000 000000 { "abstract" : "Gather package and POD information from perl module files", "author" : [ "Ken Williams , Randy W. Sims " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.132620", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Module-Metadata", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "File::Find" : "0", "File::Spec" : "0", "IO::File" : "0", "perl" : "5.006", "strict" : "0", "vars" : "0", "version" : "0.87", "warnings" : "0" } }, "test" : { "requires" : { "Carp" : "0", "Config" : "0", "Cwd" : "0", "Data::Dumper" : "0", "Exporter" : "0", "File::Basename" : "0", "File::Find" : "0", "File::Path" : "0", "File::Spec" : "0", "File::Temp" : "0", "IO::File" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Module-Metadata@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Metadata" }, "repository" : { "type" : "git", "url" : "git://git.shadowcat.co.uk/p5sagit/Module-Metadata.git", "web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/Module-Metadata.git" } }, "version" : "1.000019" } Module-Metadata-1.000019/META.yml000644 000767 000024 00000001707 12224312232 016432 0ustar00etherstaff000000 000000 --- abstract: 'Gather package and POD information from perl module files' author: - 'Ken Williams , Randy W. Sims ' build_requires: Carp: 0 Config: 0 Cwd: 0 Data::Dumper: 0 Exporter: 0 ExtUtils::MakeMaker: 0 File::Basename: 0 File::Find: 0 File::Path: 0 File::Spec: 0 File::Temp: 0 IO::File: 0 Test::More: 0 dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 6.78, CPAN::Meta::Converter version 2.132620' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Module-Metadata no_index: directory: - t - inc requires: Carp: 0 File::Find: 0 File::Spec: 0 IO::File: 0 perl: 5.006 strict: 0 vars: 0 version: 0.87 warnings: 0 resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Metadata repository: git://git.shadowcat.co.uk/p5sagit/Module-Metadata.git version: 1.000019 Module-Metadata-1.000019/README000644 000767 000024 00000017117 12224312233 016044 0ustar00etherstaff000000 000000 NAME Module::Metadata - Gather package and POD information from perl module files SYNOPSIS use Module::Metadata; # information about a .pm file my $info = Module::Metadata->new_from_file( $file ); my $version = $info->version; # CPAN META 'provides' field for .pm files in a directory my $provides = Module::Metadata->provides( dir => 'lib', version => 2 ); DESCRIPTION This module provides a standard way to gather metadata about a .pm file through (mostly) static analysis and (some) code execution. When determining the version of a module, the $VERSION assignment is "eval"ed, as is traditional in the CPAN toolchain. USAGE Class methods "new_from_file($filename, collect_pod => 1)" Constructs a "Module::Metadata" object given the path to a file. Returns undef if the filename does not exist. "collect_pod" is a optional boolean argument that determines whether POD data is collected and stored for reference. POD data is not collected by default. POD headings are always collected. If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then it is skipped before processing, and the content of the file is also decoded appropriately starting from perl 5.8. "new_from_handle($handle, $filename, collect_pod => 1)" This works just like "new_from_file", except that a handle can be provided as the first argument. Note that there is no validation to confirm that the handle is a handle or something that can act like one. Passing something that isn't a handle will cause a exception when trying to read from it. The "filename" argument is mandatory or undef will be returned. You are responsible for setting the decoding layers on $handle if required. "new_from_module($module, collect_pod => 1, inc => \@dirs)" Constructs a "Module::Metadata" object given a module or package name. Returns undef if the module cannot be found. In addition to accepting the "collect_pod" argument as described above, this method accepts a "inc" argument which is a reference to an array of directories to search for the module. If none are given, the default is @INC. If the file that contains the module begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then it is skipped before processing, and the content of the file is also decoded appropriately starting from perl 5.8. "find_module_by_name($module, \@dirs)" Returns the path to a module given the module or package name. A list of directories can be passed in as an optional parameter, otherwise @INC is searched. Can be called as either an object or a class method. "find_module_dir_by_name($module, \@dirs)" Returns the entry in @dirs (or @INC by default) that contains the module $module. A list of directories can be passed in as an optional parameter, otherwise @INC is searched. Can be called as either an object or a class method. "provides( %options )" This is a convenience wrapper around "package_versions_from_directory" to generate a CPAN META "provides" data structure. It takes key/value pairs. Valid option keys include: version (required) Specifies which version of the CPAN::Meta::Spec should be used as the format of the "provides" output. Currently only '1.4' and '2' are supported (and their format is identical). This may change in the future as the definition of "provides" changes. The "version" option is required. If it is omitted or if an unsupported version is given, then "provides" will throw an error. dir Directory to search recursively for .pm files. May not be specified with "files". files Array reference of files to examine. May not be specified with "dir". prefix String to prepend to the "file" field of the resulting output. This defaults to lib, which is the common case for most CPAN distributions with their .pm files in lib. This option ensures the META information has the correct relative path even when the "dir" or "files" arguments are absolute or have relative paths from a location other than the distribution root. For example, given "dir" of 'lib' and "prefix" of 'lib', the return value is a hashref of the form: { 'Package::Name' => { version => '0.123', file => 'lib/Package/Name.pm' }, 'OtherPackage::Name' => ... } "package_versions_from_directory($dir, \@files?)" Scans $dir for .pm files (unless @files is given, in which case looks for those files in $dir - and reads each file for packages and versions, returning a hashref of the form: { 'Package::Name' => { version => '0.123', file => 'Package/Name.pm' }, 'OtherPackage::Name' => ... } The "DB" and "main" packages are always omitted, as are any "private" packages that have leading underscores in the namespace (e.g. "Foo::_private") Note that the file path is relative to $dir if that is specified. This must not be used directly for CPAN META "provides". See the "provides" method instead. "log_info (internal)" Used internally to perform logging; imported from Log::Contextual if Log::Contextual has already been loaded, otherwise simply calls warn. Object methods "name()" Returns the name of the package represented by this module. If there are more than one packages, it makes a best guess based on the filename. If it's a script (i.e. not a *.pm) the package name is 'main'. "version($package)" Returns the version as defined by the $VERSION variable for the package as returned by the "name" method if no arguments are given. If given the name of a package it will attempt to return the version of that package if it is specified in the file. "filename()" Returns the absolute path to the file. "packages_inside()" Returns a list of packages. Note: this is a raw list of packages discovered (or assumed, in the case of "main"). It is not filtered for "DB", "main" or private packages the way the "provides" method does. Invalid package names are not returned, for example "Foo:Bar". Strange but valid package names are returned, for example "Foo::Bar::", and are left up to the caller on how to handle. "pod_inside()" Returns a list of POD sections. "contains_pod()" Returns true if there is any POD in the file. "pod($section)" Returns the POD data in the given section. AUTHOR Original code from Module::Build::ModuleInfo by Ken Williams , Randy W. Sims Released as Module::Metadata by Matt S Trout (mst) with assistance from David Golden (xdg) . COPYRIGHT & LICENSE Original code Copyright (c) 2001-2011 Ken Williams. Additional code Copyright (c) 2010-2011 Matt Trout and David Golden. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Module-Metadata-1.000019/t/000755 000767 000024 00000000000 12224312232 015417 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/xt/000755 000767 000024 00000000000 12224312232 015607 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/xt/pod.t000644 000767 000024 00000000551 12142552640 016567 0ustar00etherstaff000000 000000 use Test::More 0.88; use Test::Pod; use Test::Pod::Coverage; use strict; use warnings FATAL => 'all'; # the all_ things attempt to plan, which we didn't want, so stop them # from doing that no warnings 'redefine'; local *Test::Builder::plan = sub { }; all_pod_files_ok; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::CountParents' }); done_testing; Module-Metadata-1.000019/t/contains_pod.t000644 000767 000024 00000001700 12142552457 020300 0ustar00etherstaff000000 000000 use strict; use warnings; use Test::More tests => 3; use Module::Metadata; *fh_from_string = $] < 5.008 ? require IO::Scalar && sub ($) { IO::Scalar->new(\$_[0]); } : sub ($) { open my $fh, '<', \$_[0]; $fh } ; { my $src = <<'...'; package Foo; 1; ... my $fh = fh_from_string($src); my $module = Module::Metadata->new_from_handle($fh, 'Foo.pm'); ok(!$module->contains_pod(), 'This module does not contains POD'); } { my $src = <<'...'; package Foo; 1; =head1 NAME Foo - bar ... my $fh = fh_from_string($src); my $module = Module::Metadata->new_from_handle($fh, 'Foo.pm'); ok($module->contains_pod(), 'This module contains POD'); } { my $src = <<'...'; package Foo; 1; =head1 NAME Foo - bar =head1 AUTHORS Tokuhiro Matsuno ... my $fh = fh_from_string($src); my $module = Module::Metadata->new_from_handle($fh, 'Foo.pm'); ok($module->contains_pod(), 'This module contains POD'); } Module-Metadata-1.000019/t/encoding.t000644 000767 000024 00000001406 12213137175 017404 0ustar00etherstaff000000 000000 #!perl use strict; use warnings; use File::Spec; use Test::More; use Module::Metadata; if ("$]" < 5.008_003) { plan skip_all => 'Encoding test needs at least perl 5.8.3'; } my %versions = ( UTF8 => 3, UTF16BE => 4, UTF16LE => 5, ); plan tests => 4 * scalar(keys %versions); for my $enc (sort keys %versions) { my $pkg = "BOMTest::$enc"; my $vers = $versions{$enc}; my $pm = File::Spec->catfile(qw => "$enc.pm"); my $info = Module::Metadata->new_from_file($pm); is( $info->name, $pkg, "$enc: default package was found" ); is( $info->version, $vers, "$enc: version for default package" ); is( $info->version('Heart'), '1', 'version for ASCII package' ); is( $info->version("C\x{153}ur"), '2', 'version for Unicode package' ); } Module-Metadata-1.000019/t/endpod.t000644 000767 000024 00000000522 12142552457 017072 0ustar00etherstaff000000 000000 use strict; use warnings; use utf8; use Test::More tests => 2; use Module::Metadata; # This test case tests about parsing pod after `__END__` token. my $pm_info = Module::Metadata->new_from_file('t/lib/ENDPOD.pm', collect_pod => 1,); is( $pm_info->name, 'ENDPOD', 'found default package' ); is(join(',', $pm_info->pod_inside), 'NAME'); Module-Metadata-1.000019/t/lib/000755 000767 000024 00000000000 12224312232 016165 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/t/metadata.t000644 000767 000024 00000045265 12224311404 017400 0ustar00etherstaff000000 000000 #!/usr/bin/perl -w # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- # vim:ts=8:sw=2:et:sta:sts=2 use strict; use warnings; use lib 't/lib'; use IO::File; use MBTest; my $undef; # parse various module $VERSION lines # these will be reversed later to create %modules my @modules = ( $undef => <<'---', # no $VERSION line package Simple; --- $undef => <<'---', # undefined $VERSION package Simple; our $VERSION; --- '1.23' => <<'---', # declared & defined on same line with 'our' package Simple; our $VERSION = '1.23'; --- '1.23' => <<'---', # declared & defined on separate lines with 'our' package Simple; our $VERSION; $VERSION = '1.23'; --- '1.23' => <<'---', # commented & defined on same line package Simple; our $VERSION = '1.23'; # our $VERSION = '4.56'; --- '1.23' => <<'---', # commented & defined on separate lines package Simple; # our $VERSION = '4.56'; our $VERSION = '1.23'; --- '1.23' => <<'---', # use vars package Simple; use vars qw( $VERSION ); $VERSION = '1.23'; --- '1.23' => <<'---', # choose the right default package based on package/file name package Simple::_private; $VERSION = '0'; package Simple; $VERSION = '1.23'; # this should be chosen for version --- '1.23' => <<'---', # just read the first $VERSION line package Simple; $VERSION = '1.23'; # we should see this line $VERSION = eval $VERSION; # and ignore this one --- '1.23' => <<'---', # just read the first $VERSION line in reopened package (1) package Simple; $VERSION = '1.23'; package Error::Simple; $VERSION = '2.34'; package Simple; --- '1.23' => <<'---', # just read the first $VERSION line in reopened package (2) package Simple; package Error::Simple; $VERSION = '2.34'; package Simple; $VERSION = '1.23'; --- '1.23' => <<'---', # mentions another module's $VERSION package Simple; $VERSION = '1.23'; if ( $Other::VERSION ) { # whatever } --- '1.23' => <<'---', # mentions another module's $VERSION in a different package package Simple; $VERSION = '1.23'; package Simple2; if ( $Simple::VERSION ) { # whatever } --- '1.23' => <<'---', # $VERSION checked only in assignments, not regexp ops package Simple; $VERSION = '1.23'; if ( $VERSION =~ /1\.23/ ) { # whatever } --- '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops package Simple; $VERSION = '1.23'; if ( $VERSION == 3.45 ) { # whatever } --- '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops package Simple; $VERSION = '1.23'; package Simple2; if ( $Simple::VERSION == 3.45 ) { # whatever } --- '1.23' => <<'---', # Fully qualified $VERSION declared in package package Simple; $Simple::VERSION = 1.23; --- '1.23' => <<'---', # Differentiate fully qualified $VERSION in a package package Simple; $Simple2::VERSION = '999'; $Simple::VERSION = 1.23; --- '1.23' => <<'---', # Differentiate fully qualified $VERSION and unqualified package Simple; $Simple2::VERSION = '999'; $VERSION = 1.23; --- '1.23' => <<'---', # $VERSION declared as package variable from within 'main' package $Simple::VERSION = '1.23'; { package Simple; $x = $y, $cats = $dogs; } --- '1.23' => <<'---', # $VERSION wrapped in parens - space inside package Simple; ( $VERSION ) = '1.23'; --- '1.23' => <<'---', # $VERSION wrapped in parens - no space inside package Simple; ($VERSION) = '1.23'; --- '1.23' => <<'---', # $VERSION follows a spurious 'package' in a quoted construct package Simple; __PACKAGE__->mk_accessors(qw( program socket proc package filename line codeline subroutine finished)); our $VERSION = "1.23"; --- '1.23' => <<'---', # $VERSION using version.pm package Simple; use version; our $VERSION = version->new('1.23'); --- '1.23' => <<'---', # $VERSION using version.pm and qv() package Simple; use version; our $VERSION = qv('1.230'); --- '1.23' => <<'---', # Two version assignments, should ignore second one $Simple::VERSION = '1.230'; $Simple::VERSION = eval $Simple::VERSION; --- '1.23' => <<'---', # declared & defined on same line with 'our' package Simple; our $VERSION = '1.23_00_00'; --- '1.23' => <<'---', # package NAME VERSION package Simple 1.23; --- '1.23_01' => <<'---', # package NAME VERSION package Simple 1.23_01; --- 'v1.2.3' => <<'---', # package NAME VERSION package Simple v1.2.3; --- 'v1.2_3' => <<'---', # package NAME VERSION package Simple v1.2_3; --- '1.23' => <<'---', # trailing crud package Simple; our $VERSION; $VERSION = '1.23-alpha'; --- '1.23' => <<'---', # trailing crud package Simple; our $VERSION; $VERSION = '1.23b'; --- '1.234' => <<'---', # multi_underscore package Simple; our $VERSION; $VERSION = '1.2_3_4'; --- '0' => <<'---', # non-numeric package Simple; our $VERSION; $VERSION = 'onetwothree'; --- $undef => <<'---', # package NAME BLOCK, undef $VERSION package Simple { our $VERSION; } --- '1.23' => <<'---', # package NAME BLOCK, with $VERSION package Simple { our $VERSION = '1.23'; } --- '1.23' => <<'---', # package NAME VERSION BLOCK package Simple 1.23 { 1; } --- 'v1.2.3_4' => <<'---', # package NAME VERSION BLOCK package Simple v1.2.3_4 { 1; } --- '0' => <<'---', # set from separately-initialised variable package Simple; our $CVSVERSION = '$Revision: 1.7 $'; our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); } --- ); my %modules = reverse @modules; my @pkg_names = ( [ 'Simple' ] => <<'---', # package NAME package Simple; --- [ 'Simple::Edward' ] => <<'---', # package NAME::SUBNAME package Simple::Edward; --- [ 'Simple::Edward::' ] => <<'---', # package NAME::SUBNAME:: package Simple::Edward::; --- [ "Simple'Edward" ] => <<'---', # package NAME'SUBNAME package Simple'Edward; --- [ "Simple'Edward::" ] => <<'---', # package NAME'SUBNAME:: package Simple'Edward::; --- [ 'Simple::::Edward' ] => <<'---', # package NAME::::SUBNAME package Simple::::Edward; --- [ '::Simple::Edward' ] => <<'---', # package ::NAME::SUBNAME package ::Simple::Edward; --- [ 'main' ] => <<'---', # package NAME:SUBNAME (fail) package Simple:Edward; --- [ 'main' ] => <<'---', # package NAME' (fail) package Simple'; --- [ 'main' ] => <<'---', # package NAME::SUBNAME' (fail) package Simple::Edward'; --- [ 'main' ] => <<'---', # package NAME''SUBNAME (fail) package Simple''Edward; --- [ 'main' ] => <<'---', # package NAME-SUBNAME (fail) package Simple-Edward; --- ); my %pkg_names = reverse @pkg_names; plan tests => 54 + (2 * keys( %modules )) + (2 * keys( %pkg_names )); require_ok('Module::Metadata'); # class method C my $module = Module::Metadata->find_module_by_name( 'Module::Metadata' ); ok( -e $module, 'find_module_by_name() succeeds' ); ######################### my $tmp = MBTest->tmpdir; use DistGen; my $dist = DistGen->new( dir => $tmp ); $dist->regen; $dist->chdir_in; # fail on invalid module name my $pm_info = Module::Metadata->new_from_module( 'Foo::Bar', inc => [] ); ok( !defined( $pm_info ), 'fail if can\'t find module by module name' ); # fail on invalid filename my $file = File::Spec->catfile( 'Foo', 'Bar.pm' ); $pm_info = Module::Metadata->new_from_file( $file, inc => [] ); ok( !defined( $pm_info ), 'fail if can\'t find module by file name' ); # construct from module filename $file = File::Spec->catfile( 'lib', split( /::/, $dist->name ) ) . '.pm'; $pm_info = Module::Metadata->new_from_file( $file ); ok( defined( $pm_info ), 'new_from_file() succeeds' ); # construct from filehandle my $handle = IO::File->new($file); $pm_info = Module::Metadata->new_from_handle( $handle, $file ); ok( defined( $pm_info ), 'new_from_handle() succeeds' ); $pm_info = Module::Metadata->new_from_handle( $handle ); is( $pm_info, undef, "new_from_handle() without filename returns undef" ); close($handle); # construct from module name, using custom include path $pm_info = Module::Metadata->new_from_module( $dist->name, inc => [ 'lib', @INC ] ); ok( defined( $pm_info ), 'new_from_module() succeeds' ); foreach my $module ( sort keys %modules ) { my $expected = $modules{$module}; SKIP: { skip( "No our() support until perl 5.6", 2 ) if $] < 5.006 && $module =~ /\bour\b/; skip( "No package NAME VERSION support until perl 5.11.1", 2 ) if $] < 5.011001 && $module =~ /package\s+[\w\:\']+\s+v?[0-9._]+/; $dist->change_file( 'lib/Simple.pm', $module ); $dist->regen; my $warnings = ''; local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; my $pm_info = Module::Metadata->new_from_file( $file ); # Test::Builder will prematurely numify objects, so use this form my $errs; my $got = $pm_info->version; if ( defined $expected ) { ok( $got eq $expected, "correct module version (expected '$expected')" ) or $errs++; } else { ok( !defined($got), "correct module version (expected undef)" ) or $errs++; } is( $warnings, '', 'no warnings from parsing' ) or $errs++; diag "Got: '$got'\nModule contents:\n$module" if $errs; } } # revert to pristine state $dist->regen( clean => 1 ); foreach my $pkg_name ( sort keys %pkg_names ) { my $expected = $pkg_names{$pkg_name}; $dist->change_file( 'lib/Simple.pm', $pkg_name ); $dist->regen; my $warnings = ''; local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; my $pm_info = Module::Metadata->new_from_file( $file ); # Test::Builder will prematurely numify objects, so use this form my $errs; my @got = $pm_info->packages_inside(); is_deeply( \@got, $expected, "correct package names (expected '" . join(', ', @$expected) . "')" ) or $errs++; is( $warnings, '', 'no warnings from parsing' ) or $errs++; diag "Got: '" . join(', ', @got) . "'\nModule contents:\n$pkg_name" if $errs; } # revert to pristine state $dist->regen( clean => 1 ); # Find each package only once $dist->change_file( 'lib/Simple.pm', <<'---' ); package Simple; $VERSION = '1.23'; package Error::Simple; $VERSION = '2.34'; package Simple; --- $dist->regen; $pm_info = Module::Metadata->new_from_file( $file ); my @packages = $pm_info->packages_inside; is( @packages, 2, 'record only one occurence of each package' ); # Module 'Simple.pm' does not contain package 'Simple'; # constructor should not complain, no default module name or version $dist->change_file( 'lib/Simple.pm', <<'---' ); package Simple::Not; $VERSION = '1.23'; --- $dist->regen; $pm_info = Module::Metadata->new_from_file( $file ); is( $pm_info->name, undef, 'no default package' ); is( $pm_info->version, undef, 'no version w/o default package' ); # Module 'Simple.pm' contains an alpha version # constructor should report first $VERSION found $dist->change_file( 'lib/Simple.pm', <<'---' ); package Simple; $VERSION = '1.23_01'; $VERSION = eval $VERSION; --- $dist->regen; $pm_info = Module::Metadata->new_from_file( $file ); is( $pm_info->version, '1.23_01', 'alpha version reported'); # NOTE the following test has be done this way because Test::Builder is # too smart for our own good and tries to see if the version object is a # dual-var, which breaks with alpha versions: # Argument "1.23_0100" isn't numeric in addition (+) at # /usr/lib/perl5/5.8.7/Test/Builder.pm line 505. ok( $pm_info->version > 1.23, 'alpha version greater than non'); # revert to pristine state $dist->regen( clean => 1 ); # parse $VERSION lines scripts for package main my @scripts = ( <<'---', # package main declared #!perl -w package main; $VERSION = '0.01'; --- <<'---', # on first non-comment line, non declared package main #!perl -w $VERSION = '0.01'; --- <<'---', # after non-comment line #!perl -w use strict; $VERSION = '0.01'; --- <<'---', # 1st declared package #!perl -w package main; $VERSION = '0.01'; package _private; $VERSION = '999'; --- <<'---', # 2nd declared package #!perl -w package _private; $VERSION = '999'; package main; $VERSION = '0.01'; --- <<'---', # split package #!perl -w package main; package _private; $VERSION = '999'; package main; $VERSION = '0.01'; --- <<'---', # define 'main' version from other package package _private; $::VERSION = 0.01; $VERSION = '999'; --- <<'---', # define 'main' version from other package package _private; $VERSION = '999'; $::VERSION = 0.01; --- ); my ( $i, $n ) = ( 1, scalar( @scripts ) ); foreach my $script ( @scripts ) { $dist->change_file( 'bin/simple.plx', $script ); $dist->regen; $pm_info = Module::Metadata->new_from_file( File::Spec->catfile( 'bin', 'simple.plx' ) ); is( $pm_info->version, '0.01', "correct script version ($i of $n)" ); $i++; } # examine properties of a module: name, pod, etc $dist->change_file( 'lib/Simple.pm', <<'---' ); package Simple; $VERSION = '0.01'; package Simple::Ex; $VERSION = '0.02'; =head1 NAME Simple - It's easy. =head1 AUTHOR Simple Simon You can find me on the IRC channel #simon on irc.perl.org. =cut --- $dist->regen; $pm_info = Module::Metadata->new_from_module( $dist->name, inc => [ 'lib', @INC ] ); is( $pm_info->name, 'Simple', 'found default package' ); is( $pm_info->version, '0.01', 'version for default package' ); # got correct version for secondary package is( $pm_info->version( 'Simple::Ex' ), '0.02', 'version for secondary package' ); my $filename = $pm_info->filename; ok( defined( $filename ) && -e $filename, 'filename() returns valid path to module file' ); @packages = $pm_info->packages_inside; is( @packages, 2, 'found correct number of packages' ); is( $packages[0], 'Simple', 'packages stored in order found' ); # we can detect presence of pod regardless of whether we are collecting it ok( $pm_info->contains_pod, 'contains_pod() succeeds' ); my @pod = $pm_info->pod_inside; is_deeply( \@pod, [qw(NAME AUTHOR)], 'found all pod sections' ); is( $pm_info->pod('NONE') , undef, 'return undef() if pod section not present' ); is( $pm_info->pod('NAME'), undef, 'return undef() if pod section not collected' ); # collect_pod $pm_info = Module::Metadata->new_from_module( $dist->name, inc => [ 'lib', @INC ], collect_pod => 1 ); { my %pod; for my $section (qw(NAME AUTHOR)) { my $content = $pm_info->pod( $section ); if ( $content ) { $content =~ s/^\s+//; $content =~ s/\s+$//; } $pod{$section} = $content; } my %expected = ( NAME => q|Simple - It's easy.|, AUTHOR => <<'EXPECTED' Simple Simon You can find me on the IRC channel #simon on irc.perl.org. EXPECTED ); for my $text (values %expected) { $text =~ s/^\s+//; $text =~ s/\s+$//; } is( $pod{NAME}, $expected{NAME}, 'collected NAME pod section' ); is( $pod{AUTHOR}, $expected{AUTHOR}, 'collected AUTHOR pod section' ); } { # test things that look like POD, but aren't $dist->change_file( 'lib/Simple.pm', <<'---' ); package Simple; =YES THIS STARTS POD our $VERSION = '999'; =cute our $VERSION = '666'; =cut *foo =*no_this_does_not_start_pod; our $VERSION = '1.23'; --- $dist->regen; $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, 'Simple', 'found default package' ); is( $pm_info->version, '1.23', 'version for default package' ); } { # Make sure processing stops after __DATA__ $dist->change_file( 'lib/Simple.pm', <<'---' ); package Simple; $VERSION = '0.01'; __DATA__ *UNIVERSAL::VERSION = sub { foo(); }; --- $dist->regen; $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, 'Simple', 'found default package' ); is( $pm_info->version, '0.01', 'version for default package' ); my @packages = $pm_info->packages_inside; is_deeply(\@packages, ['Simple'], 'packages inside'); } { # Make sure we handle version.pm $VERSIONs well $dist->change_file( 'lib/Simple.pm', <<'---' ); package Simple; $VERSION = version->new('0.60.' . (qw$Revision: 128 $)[1]); package Simple::Simon; $VERSION = version->new('0.61.' . (qw$Revision: 129 $)[1]); --- $dist->regen; $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, 'Simple', 'found default package' ); is( $pm_info->version, '0.60.128', 'version for default package' ); my @packages = $pm_info->packages_inside; is_deeply([sort @packages], ['Simple', 'Simple::Simon'], 'packages inside'); is( $pm_info->version('Simple::Simon'), '0.61.129', 'version for embedded package' ); } # check that package_versions_from_directory works $dist->change_file( 'lib/Simple.pm', <<'---' ); package Simple; $VERSION = '0.01'; package Simple::Ex; $VERSION = '0.02'; { package main; # should ignore this } { package DB; # should ignore this } { package Simple::_private; # should ignore this } =head1 NAME Simple - It's easy. =head1 AUTHOR Simple Simon =cut --- $dist->regen; my $exp_pvfd = { 'Simple' => { 'file' => 'Simple.pm', 'version' => '0.01' }, 'Simple::Ex' => { 'file' => 'Simple.pm', 'version' => '0.02' } }; my $got_pvfd = Module::Metadata->package_versions_from_directory('lib'); is_deeply( $got_pvfd, $exp_pvfd, "package_version_from_directory()" ) or diag explain $got_pvfd; { my $got_provides = Module::Metadata->provides(dir => 'lib', version => 2); my $exp_provides = { 'Simple' => { 'file' => 'lib/Simple.pm', 'version' => '0.01' }, 'Simple::Ex' => { 'file' => 'lib/Simple.pm', 'version' => '0.02' } }; is_deeply( $got_provides, $exp_provides, "provides()" ) or diag explain $got_provides; } { my $got_provides = Module::Metadata->provides(dir => 'lib', prefix => 'other', version => 1.4); my $exp_provides = { 'Simple' => { 'file' => 'other/Simple.pm', 'version' => '0.01' }, 'Simple::Ex' => { 'file' => 'other/Simple.pm', 'version' => '0.02' } }; is_deeply( $got_provides, $exp_provides, "provides()" ) or diag explain $got_provides; } # Check package_versions_from_directory with regard to case-sensitivity { $dist->change_file( 'lib/Simple.pm', <<'---' ); package simple; $VERSION = '0.01'; --- $dist->regen; $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, undef, 'no default package' ); is( $pm_info->version, undef, 'version for default package' ); is( $pm_info->version('simple'), '0.01', 'version for lower-case package' ); is( $pm_info->version('Simple'), undef, 'version for capitalized package' ); $dist->change_file( 'lib/Simple.pm', <<'---' ); package simple; $VERSION = '0.01'; package Simple; $VERSION = '0.02'; package SiMpLe; $VERSION = '0.03'; --- $dist->regen; $pm_info = Module::Metadata->new_from_file('lib/Simple.pm'); is( $pm_info->name, 'Simple', 'found default package' ); is( $pm_info->version, '0.02', 'version for default package' ); is( $pm_info->version('simple'), '0.01', 'version for lower-case package' ); is( $pm_info->version('Simple'), '0.02', 'version for capitalized package' ); is( $pm_info->version('SiMpLe'), '0.03', 'version for mixed-case package' ); } Module-Metadata-1.000019/t/taint.t000644 000767 000024 00000001353 12214113422 016724 0ustar00etherstaff000000 000000 #!/usr/bin/perl -T use strict; use warnings; use 5.008000; # for ${^TAINT} use Test::More tests => 2; use Module::Metadata; use Carp 'croak'; # stolen liberally from Class-Tiny/t/lib/TestUtils.pm - thanks xdg! sub exception(&) { my $code = shift; my $success = eval { $code->(); 1 }; my $err = $@; return undef if $success; # original returned '' croak "Execution died, but the error was lost" unless $@; return $@; } ok(${^TAINT}, 'taint flag is set'); # without the fix, we get: # Insecure dependency in eval while running with -T switch at lib/Module/Metadata.pm line 668, line 15. is( exception { Module::Metadata->new_from_module( "Module::Metadata" )->version }, undef, 'no exception', ); Module-Metadata-1.000019/t/version.t000644 000767 000024 00000000454 12224311206 017274 0ustar00etherstaff000000 000000 use strict; use warnings; use Test::More; use Module::Metadata; use lib "t/lib/0_2"; plan tests => 4; require Foo; is $Foo::VERSION, 0.2; my $meta = Module::Metadata->new_from_module("Foo", inc => [ "t/lib/0_1" ] ); is $meta->version, 0.1; is $Foo::VERSION, 0.2; ok eval "use Foo 0.2; 1"; Module-Metadata-1.000019/t/lib/0_1/000755 000767 000024 00000000000 12224312232 016544 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/t/lib/0_2/000755 000767 000024 00000000000 12224312232 016545 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/t/lib/BOMTest/000755 000767 000024 00000000000 12224312232 017442 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/t/lib/DistGen.pm000644 000767 000024 00000046316 12213137175 020103 0ustar00etherstaff000000 000000 package DistGen; use strict; use warnings; use vars qw( $VERSION $VERBOSE @EXPORT_OK); $VERSION = '0.01'; $VERBOSE = 0; use Carp; use MBTest (); use Cwd (); use File::Basename (); use File::Find (); use File::Path (); use File::Spec (); use IO::File (); use Tie::CPHash; use Data::Dumper; my $vms_mode; my $vms_lower_case; BEGIN { $vms_mode = 0; $vms_lower_case = 0; if( $^O eq 'VMS' ) { # For things like vmsify() require VMS::Filespec; VMS::Filespec->import; $vms_mode = 1; $vms_lower_case = 1; my $vms_efs_case = 0; my $unix_rpt = 0; if (eval { local $SIG{__DIE__}; require VMS::Feature; }) { $unix_rpt = VMS::Feature::current("filename_unix_report"); $vms_efs_case = VMS::Feature::current("efs_case_preserve"); } else { my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; $unix_rpt = $env_unix_rpt =~ /^[ET1]/i; my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || ''; $vms_efs_case = $efs_case =~ /^[ET1]/i; } $vms_mode = 0 if $unix_rpt; $vms_lower_case = 0 if $vms_efs_case; } } BEGIN { require Exporter; *{import} = \&Exporter::import; @EXPORT_OK = qw( undent ); } sub undent { my ($string) = @_; my ($space) = $string =~ m/^(\s+)/; $string =~ s/^$space//gm; return($string); } sub chdir_all ($) { # OS/2 has "current directory per disk", undeletable; # doing chdir() to another disk won't change cur-dir of initial disk... chdir('/') if $^O eq 'os2'; chdir shift; } ######################################################################## END { chdir_all(MBTest->original_cwd); } sub new { my $self = bless {}, shift; $self->reset(@_); } sub reset { my $self = shift; my %options = @_; $options{name} ||= 'Simple'; $options{dir} = File::Spec->rel2abs( defined $options{dir} ? $options{dir} : MBTest->tmpdir ); my %data = ( no_manifest => 0, xs => 0, inc => 0, %options, ); %$self = %data; tie %{$self->{filedata}}, 'Tie::CPHash'; tie %{$self->{pending}{change}}, 'Tie::CPHash'; # start with a fresh, empty directory if ( -d $self->dirname ) { warn "Warning: Removing existing directory '@{[$self->dirname]}'\n"; File::Path::rmtree( $self->dirname ); } File::Path::mkpath( $self->dirname ); $self->_gen_default_filedata(); return $self; } sub remove { my $self = shift; $self->chdir_original if($self->did_chdir); File::Path::rmtree( $self->dirname ); return $self; } sub revert { my ($self, $file) = @_; if ( defined $file ) { delete $self->{filedata}{$file}; delete $self->{pending}{$_}{$file} for qw/change remove/; } else { delete $self->{filedata}{$_} for keys %{ $self->{filedata} }; for my $pend ( qw/change remove/ ) { delete $self->{pending}{$pend}{$_} for keys %{ $self->{pending}{$pend} }; } } $self->_gen_default_filedata; } sub _gen_default_filedata { my $self = shift; # TODO maybe a public method like this (but with a better name?) my $add_unless = sub { my $self = shift; my ($member, $data) = @_; $self->add_file($member, $data) unless($self->{filedata}{$member}); }; if ( ! $self->{inc} ) { $self->$add_unless('Build.PL', undent(<<" ---")); use strict; use Module::Build; my \$builder = Module::Build->new( module_name => '$self->{name}', license => 'perl', ); \$builder->create_build_script(); --- } else { $self->$add_unless('Build.PL', undent(<<" ---")); use strict; use inc::latest 'Module::Build'; my \$builder = Module::Build->new( module_name => '$self->{name}', license => 'perl', ); \$builder->create_build_script(); --- } my $module_filename = join( '/', ('lib', split(/::/, $self->{name})) ) . '.pm'; unless ( $self->{xs} ) { $self->$add_unless($module_filename, undent(<<" ---")); package $self->{name}; use vars qw( \$VERSION ); \$VERSION = '0.01'; use strict; use warnings; 1; __END__ =head1 NAME $self->{name} - Perl extension for blah blah blah =head1 DESCRIPTION Stub documentation for $self->{name}. =head1 AUTHOR A. U. Thor, a.u.thor\@a.galaxy.far.far.away =cut --- $self->$add_unless('t/basic.t', undent(<<" ---")); use Test::More tests => 1; use strict; use warnings; use $self->{name}; ok 1; --- } else { $self->$add_unless($module_filename, undent(<<" ---")); package $self->{name}; \$VERSION = '0.01'; require Exporter; require DynaLoader; \@ISA = qw(Exporter DynaLoader); \@EXPORT_OK = qw( okay ); bootstrap $self->{name} \$VERSION; 1; __END__ =head1 NAME $self->{name} - Perl extension for blah blah blah =head1 DESCRIPTION Stub documentation for $self->{name}. =head1 AUTHOR A. U. Thor, a.u.thor\@a.galaxy.far.far.away =cut --- my $xs_filename = join( '/', ('lib', split(/::/, $self->{name})) ) . '.xs'; $self->$add_unless($xs_filename, undent(<<" ---")); #include "EXTERN.h" #include "perl.h" #include "XSUB.h" MODULE = $self->{name} PACKAGE = $self->{name} SV * okay() CODE: RETVAL = newSVpv( "ok", 0 ); OUTPUT: RETVAL const char * xs_version() CODE: RETVAL = XS_VERSION; OUTPUT: RETVAL const char * version() CODE: RETVAL = VERSION; OUTPUT: RETVAL --- # 5.6 is missing const char * in its typemap $self->$add_unless('typemap', undent(<<" ---")); const char *\tT_PV --- $self->$add_unless('t/basic.t', undent(<<" ---")); use Test::More tests => 2; use strict; use $self->{name}; ok 1; ok( $self->{name}::okay() eq 'ok' ); --- } } sub _gen_manifest { my $self = shift; my $manifest = shift; my $fh = IO::File->new( ">$manifest" ) or do { die "Can't write '$manifest'\n"; }; my @files = ( 'MANIFEST', keys %{$self->{filedata}} ); my $data = join( "\n", sort @files ) . "\n"; print $fh $data; close( $fh ); $self->{filedata}{MANIFEST} = $data; $self->{pending}{change}{MANIFEST} = 1; } sub name { shift()->{name} } sub dirname { my $self = shift; my $dist = $self->{distdir} || join( '-', split( /::/, $self->{name} ) ); return File::Spec->catdir( $self->{dir}, $dist ); } sub _real_filename { my $self = shift; my $filename = shift; return File::Spec->catfile( split( /\//, $filename ) ); } sub regen { my $self = shift; my %opts = @_; my $dist_dirname = $self->dirname; if ( $opts{clean} ) { $self->clean() if -d $dist_dirname; } else { # TODO: This might leave dangling directories; e.g. if the removed file # is 'lib/Simple/Simon.pm', the directory 'lib/Simple' will be left # even if there are no files left in it. However, clean() will remove it. my @files = keys %{$self->{pending}{remove}}; foreach my $file ( @files ) { my $real_filename = $self->_real_filename( $file ); my $fullname = File::Spec->catfile( $dist_dirname, $real_filename ); if ( -e $fullname ) { 1 while unlink( $fullname ); } print "Unlinking pending file '$file'\n" if $VERBOSE; delete( $self->{pending}{remove}{$file} ); } } foreach my $file ( keys( %{$self->{filedata}} ) ) { my $real_filename = $self->_real_filename( $file ); my $fullname = File::Spec->catfile( $dist_dirname, $real_filename ); if ( ! -e $fullname || ( -e $fullname && $self->{pending}{change}{$file} ) ) { print "Changed file '$file'.\n" if $VERBOSE; my $dirname = File::Basename::dirname( $fullname ); unless ( -d $dirname ) { File::Path::mkpath( $dirname ) or do { die "Can't create '$dirname'\n"; }; } if ( -e $fullname ) { 1 while unlink( $fullname ); } my $fh = IO::File->new(">$fullname") or do { die "Can't write '$fullname'\n"; }; print $fh $self->{filedata}{$file}; close( $fh ); } delete( $self->{pending}{change}{$file} ); } my $manifest = File::Spec->catfile( $dist_dirname, 'MANIFEST' ); unless ( $self->{no_manifest} ) { if ( -e $manifest ) { 1 while unlink( $manifest ); } $self->_gen_manifest( $manifest ); } return $self; } sub clean { my $self = shift; my $here = Cwd::abs_path(); my $there = File::Spec->rel2abs( $self->dirname() ); if ( -d $there ) { chdir( $there ) or die "Can't change directory to '$there'\n"; } else { die "Distribution not found in '$there'\n"; } my %names; tie %names, 'Tie::CPHash'; foreach my $file ( keys %{$self->{filedata}} ) { my $filename = $self->_real_filename( $file ); $filename = lc($filename) if $vms_lower_case; my $dirname = File::Basename::dirname( $filename ); $names{$filename} = 0; print "Splitting '$dirname'\n" if $VERBOSE; my @dirs = File::Spec->splitdir( $dirname ); while ( @dirs ) { my $dir = ( scalar(@dirs) == 1 ? $dirname : File::Spec->catdir( @dirs ) ); if (length $dir) { print "Setting directory name '$dir' in \%names\n" if $VERBOSE; $names{$dir} = 0; } pop( @dirs ); } } File::Find::finddepth( sub { my $name = File::Spec->canonpath( $File::Find::name ); if ($vms_mode) { if ($name ne '.') { $name =~ s/\.\z//; $name = vmspath($name) if -d $name; } } if ($^O eq 'VMS') { $name = File::Spec->rel2abs($name) if $name eq File::Spec->curdir(); } if ( not exists $names{$name} ) { print "Removing '$name'\n" if $VERBOSE; File::Path::rmtree( $_ ); } }, ($^O eq 'VMS' ? './' : File::Spec->curdir) ); chdir_all( $here ); return $self; } sub add_file { my $self = shift; $self->change_file( @_ ); } sub remove_file { my $self = shift; my $file = shift; unless ( exists $self->{filedata}{$file} ) { warn "Can't remove '$file': It does not exist.\n" if $VERBOSE; } delete( $self->{filedata}{$file} ); $self->{pending}{remove}{$file} = 1; return $self; } sub change_build_pl { my ($self, @opts) = @_; my $opts = ref $opts[0] eq 'HASH' ? $opts[0] : { @opts }; local $Data::Dumper::Terse = 1; (my $args = Dumper($opts)) =~ s/^\s*\{|\}\s*$//g; $self->change_file( 'Build.PL', undent(<<" ---") ); use strict; use warnings; use Module::Build; my \$b = Module::Build->new( # Some CPANPLUS::Dist::Build versions need to allow mismatches # On logic: thanks to Module::Install, CPAN.pm must set both keys, but # CPANPLUS sets only the one allow_mb_mismatch => ( \$ENV{PERL5_CPANPLUS_IS_RUNNING} && ! \$ENV{PERL5_CPAN_IS_RUNNING} ? 1 : 0 ), $args ); \$b->create_build_script(); --- return $self; } sub change_file { my $self = shift; my $file = shift; my $data = shift; $self->{filedata}{$file} = $data; $self->{pending}{change}{$file} = 1; return $self; } sub get_file { my $self = shift; my $file = shift; exists($self->{filedata}{$file}) or croak("no such entry: '$file'"); return $self->{filedata}{$file}; } sub chdir_in { my $self = shift; $self->{original_dir} ||= Cwd::cwd; # only once! my $dir = $self->dirname; chdir($dir) or die "Can't chdir to '$dir': $!"; return $self; } ######################################################################## sub did_chdir { exists shift()->{original_dir} } ######################################################################## sub chdir_original { my $self = shift; my $dir = delete $self->{original_dir}; chdir_all($dir) or die "Can't chdir to '$dir': $!"; return $self; } ######################################################################## sub new_from_context { my ($self, @args) = @_; require Module::Build; return Module::Build->new_from_context( quiet => 1, @args ); } sub run_build_pl { my ($self, @args) = @_; require Module::Build; return Module::Build->run_perl_script('Build.PL', [], [@args]) } sub run_build { my ($self, @args) = @_; require Module::Build; my $build_script = $^O eq 'VMS' ? 'Build.com' : 'Build'; return Module::Build->run_perl_script($build_script, [], [@args]) } 1; __END__ =head1 NAME DistGen - Creates simple distributions for testing. =head1 SYNOPSIS use DistGen; # create distribution and prepare to test my $dist = DistGen->new(name => 'Foo::Bar'); $dist->chdir_in; # change distribution files $dist->add_file('t/some_test.t', $contents); $dist->change_file('MANIFEST.SKIP', $new_contents); $dist->remove_file('t/some_test.t'); $dist->regen; # undo changes and clean up extraneous files $dist->revert; $dist->clean; # exercise the command-line interface $dist->run_build_pl(); $dist->run_build('test'); # start over as a new distribution $dist->reset( name => 'Foo::Bar', xs => 1 ); $dist->chdir_in; =head1 USAGE A DistGen object manages a set of files in a distribution directory. The C constructor initializes the object and creates an empty directory for the distribution. It does not create files or chdir into the directory. The C method re-initializes the object in a new directory with new parameters. It also does not create files or change the current directory. Some methods only define the target state of the distribution. They do B make any changes to the filesystem: add_file change_file change_build_pl remove_file revert Other methods then change the filesystem to match the target state of the distribution: clean regen remove Other methods are provided for a convenience during testing. The most important is the one to enter the distribution directory: chdir_in Additional methods portably encapsulate running Build.PL and Build: run_build_pl run_build =head1 API =head2 Constructors =head3 new() Create a new object and an empty directory to hold the distribution's files. If no C option is provided, it defaults to MBTest->tmpdir, which sets a different temp directory for Perl core testing and CPAN testing. The C method does not write any files -- see L below. my $dist = DistGen->new( name => 'Foo::Bar', dir => MBTest->tmpdir, xs => 1, no_manifest => 0, ); The parameters are as follows. =over =item name The name of the module this distribution represents. The default is 'Simple'. This should be a "Foo::Bar" (module) name, not a "Foo-Bar" dist name. =item dir The (parent) directory in which to create the distribution directory. The distribution will be created under this according to C parameter below. Defaults to a temporary directory. $dist = DistGen->new( dir => '/tmp/MB-test' ); $dist->regen; # distribution files have been created in /tmp/MB-test/Simple =item distdir The name of the distribution directory to create. Defaults to the dist form of C, e.g. 'Foo-Bar' if C is 'Foo::Bar'. =item xs If true, generates an XS based module. =item no_manifest If true, C will not create a MANIFEST file. =back The following files are added as part of the default distribution: Build.PL lib/Simple.pm # based on name parameter t/basic.t If an XS module is generated, Simple.pm and basic.t are different and the following files are also added: typemap lib/Simple.xs # based on name parameter =head3 reset() The C method re-initializes the object as if it were generated from a fresh call to C. It takes the same optional parameters as C. $dist->reset( name => 'Foo::Bar', xs => 0 ); =head2 Adding and editing files Note that C<$filename> should always be specified with unix-style paths, and are relative to the distribution root directory, e.g. C. No changes are made to the filesystem until the distribution is regenerated. =head3 add_file() Add a $filename containing $content to the distribution. $dist->add_file( $filename, $content ); =head3 change_file() Changes the contents of $filename to $content. No action is performed until the distribution is regenerated. $dist->change_file( $filename, $content ); =head3 change_build_pl() A wrapper around change_file specifically for setting Build.PL. Instead of file C<$content>, it takes a hash-ref of Module::Build constructor arguments: $dist->change_build_pl( { module_name => $dist->name, dist_version => '3.14159265', license => 'perl', create_readme => 1, } ); =head3 get_file Retrieves the target contents of C<$filename>. $content = $dist->get_file( $filename ); =head3 remove_file() Removes C<$filename> from the distribution. $dist->remove_file( $filename ); =head3 revert() Returns the object to its initial state, or given a $filename it returns that file to its initial state if it is one of the built-in files. $dist->revert; $dist->revert($filename); =head2 Changing the distribution directory These methods immediately affect the filesystem. =head3 regen() Regenerate all missing or changed files. Also deletes any files flagged for removal with remove_file(). $dist->regen(clean => 1); If the optional C argument is given, it also calls C. These can also be chained like this, instead: $dist->clean->regen; =head3 clean() Removes any files that are not part of the distribution. $dist->clean; =head3 remove() Changes back to the original directory and removes the distribution directory (but not the temporary directory set during C). $dist = DistGen->new->chdir->regen; # ... do some testing ... $dist->remove->chdir_in->regen; # ... do more testing ... This is like a more aggressive form of C. Generally, calling C and C should be sufficient. =head2 Changing directories =head3 chdir_in Change directory into the dist root. $dist->chdir_in; =head3 chdir_original Returns to whatever directory you were in before chdir_in() (regardless of the cwd.) $dist->chdir_original; =head2 Command-line helpers These use Module::Build->run_perl_script() to ensure that Build.PL or Build are run in a separate process using the current perl interpreter. (Module::Build is loaded on demand). They also ensure appropriate naming for operating systems that require a suffix for Build. =head3 run_build_pl Runs Build.PL using the current perl interpreter. Any arguments are passed on the command line. $dist->run_build_pl('--quiet'); =head3 run_build Runs Build using the current perl interpreter. Any arguments are passed on the command line. $dist->run_build(qw/test --verbose/); =head2 Properties =head3 name() Returns the name of the distribution. $dist->name: # e.g. Foo::Bar =head3 dirname() Returns the directory where the distribution is created. $dist->dirname; # e.g. t/_tmp/Simple =head2 Functions =head3 undent() Removes leading whitespace from a multi-line string according to the amount of whitespace on the first line. my $string = undent(" foo(\n bar => 'baz'\n )"); $string eq "foo( bar => 'baz' )"; =cut # vim:ts=2:sw=2:et:sta Module-Metadata-1.000019/t/lib/ENDPOD.pm000644 000767 000024 00000000142 12141361062 017474 0ustar00etherstaff000000 000000 package ENDPOD; use strict; use warnings; use utf8; 1; __END__ =head1 NAME ENDPOD - End pod. Module-Metadata-1.000019/t/lib/MBTest.pm000644 000767 000024 00000014750 12213137175 017701 0ustar00etherstaff000000 000000 package MBTest; use strict; use warnings; use IO::File (); use File::Spec; use File::Temp (); use File::Path (); # Setup the code to clean out %ENV BEGIN { # Environment variables which might effect our testing my @delete_env_keys = qw( HOME DEVEL_COVER_OPTIONS MODULEBUILDRC PERL_MB_OPT HARNESS_TIMER HARNESS_OPTIONS HARNESS_VERBOSE PREFIX INSTALL_BASE INSTALLDIRS ); # Remember the ENV values because on VMS %ENV is global # to the user, not the process. my %restore_env_keys; sub clean_env { for my $key (@delete_env_keys) { if( exists $ENV{$key} ) { $restore_env_keys{$key} = delete $ENV{$key}; } else { delete $ENV{$key}; } } } END { while( my($key, $val) = each %restore_env_keys ) { $ENV{$key} = $val; } } } BEGIN { clean_env(); # In case the test wants to use our other bundled # modules, make sure they can be loaded. my $t_lib = File::Spec->catdir('t', 'bundled'); push @INC, $t_lib; # Let user's installed version override if ($ENV{PERL_CORE}) { # We change directories, so expand @INC and $^X to absolute paths # Also add . @INC = (map(File::Spec->rel2abs($_), @INC), "."); $^X = File::Spec->rel2abs($^X); } } use Exporter; use Test::More; use Config; use Cwd (); # We pass everything through to Test::More use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); $VERSION = 0.01_01; @ISA = qw(Test::More); # Test::More isa Exporter @EXPORT = @Test::More::EXPORT; %EXPORT_TAGS = %Test::More::EXPORT_TAGS; # We have a few extra exports, but Test::More has a special import() # that won't take extra additions. my @extra_exports = qw( stdout_of stderr_of stdout_stderr_of slurp find_in_path check_compiler have_module blib_load timed_out ); push @EXPORT, @extra_exports; __PACKAGE__->export(scalar caller, @extra_exports); # XXX ^-- that should really happen in import() ######################################################################## # always return to the current directory { my $cwd = File::Spec->rel2abs(Cwd::cwd); sub original_cwd { return $cwd } END { # Go back to where you came from! chdir $cwd or die "Couldn't chdir to $cwd"; } } ######################################################################## { # backwards compatible temp filename recipe adapted from perlfaq my $tmp_count = 0; my $tmp_base_name = sprintf("MB-%d-%d", $$, time()); sub temp_file_name { sprintf("%s-%04d", $tmp_base_name, ++$tmp_count) } } ######################################################################## # Setup a temp directory sub tmpdir { my ($self, @args) = @_; my $dir = $ENV{PERL_CORE} ? MBTest->original_cwd : File::Spec->tmpdir; return File::Temp::tempdir('MB-XXXXXXXX', CLEANUP => 1, DIR => $dir, @args); } BEGIN { $ENV{HOME} = tmpdir; # don't want .modulebuildrc or other things interfering } sub save_handle { my ($handle, $subr) = @_; my $outfile = File::Spec->catfile(File::Spec->tmpdir, temp_file_name()); local *SAVEOUT; open SAVEOUT, ">&" . fileno($handle) or die "Can't save output handle: $!"; open $handle, "> $outfile" or die "Can't create $outfile: $!"; eval {$subr->()}; open $handle, ">&SAVEOUT" or die "Can't restore output: $!"; my $ret = slurp($outfile); 1 while unlink $outfile; return $ret; } sub stdout_of { save_handle(\*STDOUT, @_) } sub stderr_of { save_handle(\*STDERR, @_) } sub stdout_stderr_of { my $subr = shift; my ($stdout, $stderr); $stdout = stdout_of ( sub { $stderr = stderr_of( $subr ) }); return wantarray ? ($stdout, $stderr) : $stdout . $stderr; } sub slurp { my $fh = IO::File->new($_[0]) or die "Can't open $_[0]: $!"; local $/; return scalar <$fh>; } # Some extensions we should know about if we're looking for executables sub exe_exts { if ($^O eq 'MSWin32') { return split($Config{path_sep}, $ENV{PATHEXT} || '.com;.exe;.bat'); } if ($^O eq 'os2') { return qw(.exe .com .pl .cmd .bat .sh .ksh); } return; } sub find_in_path { my $thing = shift; my @exe_ext = exe_exts(); if ( File::Spec->file_name_is_absolute( $thing ) ) { foreach my $ext ( '', @exe_ext ) { return "$thing$ext" if -e "$thing$ext"; } } else { my @path = split $Config{path_sep}, $ENV{PATH}; foreach (@path) { my $fullpath = File::Spec->catfile($_, $thing); foreach my $ext ( '', @exe_ext ) { return "$fullpath$ext" if -e "$fullpath$ext"; } } } return; } sub check_compiler { return (1,1) if $ENV{PERL_CORE}; local $SIG{__WARN__} = sub {}; blib_load('Module::Build'); my $mb = Module::Build->current; $mb->verbose( 0 ); my $have_c_compiler; stderr_of( sub {$have_c_compiler = $mb->have_c_compiler} ); # check noexec tmpdir my $tmp_exec; if ( $have_c_compiler ) { my $dir = MBTest->tmpdir; my $c_file = File::Spec->catfile($dir,'test.c'); open my $fh, ">", $c_file; print {$fh} "int main() { return 0; }\n"; close $fh; my $exe = $mb->cbuilder->link_executable( objects => $mb->cbuilder->compile( source => $c_file ) ); $tmp_exec = 0 == system( $exe ); } return ($have_c_compiler, $tmp_exec); } sub have_module { my $module = shift; return eval "require $module; 1"; } sub blib_load { # Load the given module and ensure it came from blib/, not the larger system my $mod = shift; have_module($mod) or die "Error loading $mod\: $@\n"; (my $path = $mod) =~ s{::}{/}g; $path .= ".pm"; my ($pkg, $file, $line) = caller; unless($ENV{PERL_CORE}) { unless($INC{$path} =~ m/\bblib\b/) { (my $load_from = $INC{$path}) =~ s{$path$}{}; die "$mod loaded from '$load_from'\nIt should have been loaded from blib. \@INC contains:\n ", join("\n ", @INC) . "\nFatal error occured in blib_load() at $file, line $line.\n"; } } } sub timed_out { my ($sub, $timeout) = @_; return unless $sub; $timeout ||= 60; my $saw_alarm = 0; eval { local $SIG{ALRM} = sub { $saw_alarm++; die "alarm\n"; }; # NB: \n required alarm $timeout; $sub->(); alarm 0; }; if ($@) { die unless $@ eq "alarm\n"; # propagate unexpected errors } return $saw_alarm; } sub check_EUI { my $timed_out; stdout_stderr_of( sub { $timed_out = timed_out( sub { ExtUtils::Installed->new(extra_libs => [@INC]) } ); } ); return ! $timed_out; } 1; # vim:ts=2:sw=2:et:sta Module-Metadata-1.000019/t/lib/Tie/000755 000767 000024 00000000000 12224312232 016706 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/t/lib/Tie/CPHash.pm000644 000767 000024 00000011736 12213137175 020373 0ustar00etherstaff000000 000000 #--------------------------------------------------------------------- package Tie::CPHash; # # Copyright 1997 Christopher J. Madsen # # Author: Christopher J. Madsen # Created: 08 Nov 1997 # $Revision$ $Date$ # # This program is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the # GNU General Public License or the Artistic License for more details. # # Case preserving but case insensitive hash #--------------------------------------------------------------------- require 5.000; use strict; use warnings; use vars qw(@ISA $VERSION); @ISA = qw(); #===================================================================== # Package Global Variables: $VERSION = '1.02'; #===================================================================== # Tied Methods: #--------------------------------------------------------------------- # TIEHASH classname # The method invoked by the command `tie %hash, classname'. # Associates a new hash instance with the specified class. sub TIEHASH { bless {}, $_[0]; } # end TIEHASH #--------------------------------------------------------------------- # STORE this, key, value # Store datum *value* into *key* for the tied hash *this*. sub STORE { $_[0]->{lc $_[1]} = [ $_[1], $_[2] ]; } # end STORE #--------------------------------------------------------------------- # FETCH this, key # Retrieve the datum in *key* for the tied hash *this*. sub FETCH { my $v = $_[0]->{lc $_[1]}; ($v ? $v->[1] : undef); } # end FETCH #--------------------------------------------------------------------- # FIRSTKEY this # Return the (key, value) pair for the first key in the hash. sub FIRSTKEY { my $a = scalar keys %{$_[0]}; &NEXTKEY; } # end FIRSTKEY #--------------------------------------------------------------------- # NEXTKEY this, lastkey # Return the next (key, value) pair for the hash. sub NEXTKEY { my $v = (each %{$_[0]})[1]; ($v ? $v->[0] : undef ); } # end NEXTKEY #--------------------------------------------------------------------- # SCALAR this # Return bucket usage information for the hash (0 if empty). sub SCALAR { scalar %{$_[0]}; } # end SCALAR #--------------------------------------------------------------------- # EXISTS this, key # Verify that *key* exists with the tied hash *this*. sub EXISTS { exists $_[0]->{lc $_[1]}; } # end EXISTS #--------------------------------------------------------------------- # DELETE this, key # Delete the key *key* from the tied hash *this*. # Returns the old value, or undef if it didn't exist. sub DELETE { my $v = delete $_[0]->{lc $_[1]}; ($v ? $v->[1] : undef); } # end DELETE #--------------------------------------------------------------------- # CLEAR this # Clear all values from the tied hash *this*. sub CLEAR { %{$_[0]} = (); } # end CLEAR #===================================================================== # Other Methods: #--------------------------------------------------------------------- # Return the case of KEY. sub key { my $v = $_[0]->{lc $_[1]}; ($v ? $v->[0] : undef); } #===================================================================== # Package Return Value: 1; __END__ =head1 NAME Tie::CPHash - Case preserving but case insensitive hash table =head1 SYNOPSIS require Tie::CPHash; tie %cphash, 'Tie::CPHash'; $cphash{'Hello World'} = 'Hi there!'; printf("The key `%s' was used to store `%s'.\n", tied(%cphash)->key('HELLO WORLD'), $cphash{'HELLO world'}); =head1 DESCRIPTION The B module provides a hash table that is case preserving but case insensitive. This means that $cphash{KEY} $cphash{key} $cphash{Key} $cphash{keY} all refer to the same entry. Also, the hash remembers which form of the key was last used to store the entry. The C and C functions will return the key that was used to set the value. An example should make this clear: tie %h, 'Tie::CPHash'; $h{Hello} = 'World'; print $h{HELLO}; # Prints 'World' print keys(%h); # Prints 'Hello' $h{HELLO} = 'WORLD'; print $h{hello}; # Prints 'WORLD' print keys(%h); # Prints 'HELLO' The additional C method lets you fetch the case of a specific key: # When run after the previous example, this prints 'HELLO': print tied(%h)->key('Hello'); (The C function returns the object that C<%h> is tied to.) If you need a case insensitive hash, but don't need to preserve case, just use C<$hash{lc $key}> instead of C<$hash{$key}>. This has a lot less overhead than B. =head1 AUTHOR Christopher J. Madsen EFE =cut # Local Variables: # tmtrack-file-task: "Tie::CPHash.pm" # End: Module-Metadata-1.000019/t/lib/BOMTest/UTF16BE.pm000644 000767 000024 00000000356 12065264365 021040 0ustar00etherstaff000000 000000 þÿpackage Heart; our $VERSION = 1; package BOMTest::UTF16BE; our $VERSION = 4; package CSur; our $VERSION = 2; 1; Module-Metadata-1.000019/t/lib/BOMTest/UTF16LE.pm000644 000767 000024 00000000356 12065264365 021052 0ustar00etherstaff000000 000000 ÿþpackage Heart; our $VERSION = 1; package BOMTest::UTF16LE; our $VERSION = 5; package CSur; our $VERSION = 2; 1; Module-Metadata-1.000019/t/lib/BOMTest/UTF8.pm000644 000767 000024 00000000167 12065264365 020552 0ustar00etherstaff000000 000000 package Heart; our $VERSION = 1; package BOMTest::UTF8; our $VERSION = 3; package CÅ“ur; our $VERSION = 2; 1; Module-Metadata-1.000019/t/lib/0_2/Foo.pm000644 000767 000024 00000000047 12005344566 017643 0ustar00etherstaff000000 000000 package Foo; $Foo::VERSION = '0.2'; 1; Module-Metadata-1.000019/t/lib/0_1/Foo.pm000644 000767 000024 00000000047 12213136072 017632 0ustar00etherstaff000000 000000 package Foo; $Foo::VERSION = '0.1'; 1; Module-Metadata-1.000019/maint/bump-version000755 000767 000024 00000001511 12205323045 020641 0ustar00etherstaff000000 000000 #!/usr/bin/env perl use 5.010; use strict; use warnings FATAL => 'all'; use autodie; chomp(my $LATEST = qx(grep '^[0-9]' Changes | head -1 | awk '{print \$1}')); my @parts = split /\./, $LATEST; splice(@parts, 1, 0, 0) if @parts == 2; my $OLD_DECIMAL = sprintf('%i.%03i%03i', @parts); my %bump_part = (major => 0, minor => 1, bugfix => 2); my $bump_this = $bump_part{$ARGV[0]||'bugfix'} // die "no idea which part to bump - $ARGV[0] means nothing to me"; my @new_parts = @parts; $new_parts[$bump_this]++; my $NEW_DECIMAL = sprintf('%i.%03i%03i', @new_parts); warn "Bumping $OLD_DECIMAL -> $NEW_DECIMAL\n"; my $PM_FILE = 'lib/Module/Metadata.pm'; my $file = do { local (@ARGV, $/) = ($PM_FILE); <> }; $file =~ s/(?<=\$VERSION = ')${\quotemeta $OLD_DECIMAL}/${NEW_DECIMAL}/; open my $out, '>', $PM_FILE; print $out $file; Module-Metadata-1.000019/maint/Makefile.include000644 000767 000024 00000000275 12141361447 021364 0ustar00etherstaff000000 000000 bump: maint/bump-version rm Makefile bumpminor: maint/bump-version minor rm Makefile bumpmajor: maint/bump-version major rm Makefile upload: $(DISTVNAME).tar$(SUFFIX) cpan-upload $< Module-Metadata-1.000019/maint/Makefile.PL.include000644 000767 000024 00000000515 12213666656 021705 0ustar00etherstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar; use ExtUtils::MakeMaker 6.68; # ensure meta-spec v2 compatibility author 'Ken Williams , Randy W. Sims '; manifest_include( 't/smells-of-vcs' => qr{.*}, ); Module-Metadata-1.000019/lib/Module/000755 000767 000024 00000000000 12224312232 017147 5ustar00etherstaff000000 000000 Module-Metadata-1.000019/lib/Module/Metadata.pm000644 000767 000024 00000070000 12224312016 021222 0ustar00etherstaff000000 000000 # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- # vim:ts=8:sw=2:et:sta:sts=2 package Module::Metadata; # Adapted from Perl-licensed code originally distributed with # Module-Build by Ken Williams # This module provides routines to gather information about # perl modules (assuming this may be expanded in the distant # parrot future to look at other types of modules). use strict; use warnings; our $VERSION = '1.000019'; $VERSION = eval $VERSION; use Carp qw/croak/; use File::Spec; use IO::File; use version 0.87; BEGIN { if ($INC{'Log/Contextual.pm'}) { Log::Contextual->import('log_info'); } else { *log_info = sub (&) { warn $_[0]->() }; } } use File::Find qw(find); my $V_NUM_REGEXP = qr{v?[0-9._]+}; # crudely, a v-string or decimal my $PKG_FIRST_WORD_REGEXP = qr{ # the FIRST word in a package name [a-zA-Z_] # the first word CANNOT start with a digit (?: [\w']? # can contain letters, digits, _, or ticks \w # But, NO multi-ticks or trailing ticks )* }x; my $PKG_ADDL_WORD_REGEXP = qr{ # the 2nd+ word in a package name \w # the 2nd+ word CAN start with digits (?: [\w']? # and can contain letters or ticks \w # But, NO multi-ticks or trailing ticks )* }x; my $PKG_NAME_REGEXP = qr{ # match a package name (?: :: )? # a pkg name can start with aristotle $PKG_FIRST_WORD_REGEXP # a package word (?: (?: :: )+ ### aristotle (allow one or many times) $PKG_ADDL_WORD_REGEXP ### a package word )* # ^ zero, one or many times (?: :: # allow trailing aristotle )? }x; my $PKG_REGEXP = qr{ # match a package declaration ^[\s\{;]* # intro chars on a line package # the word 'package' \s+ # whitespace ($PKG_NAME_REGEXP) # a package name \s* # optional whitespace ($V_NUM_REGEXP)? # optional version number \s* # optional whitesapce [;\{] # semicolon line terminator or block start (since 5.16) }x; my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name ([\$*]) # sigil - $ or * ( ( # optional leading package name (?:::|\')? # possibly starting like just :: (Ì la $::VERSION) (?:\w+(?:::|\'))* # Foo::Bar:: ... )? VERSION )\b }x; my $VERS_REGEXP = qr{ # match a VERSION definition (?: \(\s*$VARNAME_REGEXP\s*\) # with parens | $VARNAME_REGEXP # without parens ) \s* =[^=~] # = but not ==, nor =~ }x; sub new_from_file { my $class = shift; my $filename = File::Spec->rel2abs( shift ); return undef unless defined( $filename ) && -f $filename; return $class->_init(undef, $filename, @_); } sub new_from_handle { my $class = shift; my $handle = shift; my $filename = shift; return undef unless defined($handle) && defined($filename); $filename = File::Spec->rel2abs( $filename ); return $class->_init(undef, $filename, @_, handle => $handle); } sub new_from_module { my $class = shift; my $module = shift; my %props = @_; $props{inc} ||= \@INC; my $filename = $class->find_module_by_name( $module, $props{inc} ); return undef unless defined( $filename ) && -f $filename; return $class->_init($module, $filename, %props); } { my $compare_versions = sub { my ($v1, $op, $v2) = @_; $v1 = version->new($v1) unless UNIVERSAL::isa($v1,'version'); my $eval_str = "\$v1 $op \$v2"; my $result = eval $eval_str; log_info { "error comparing versions: '$eval_str' $@" } if $@; return $result; }; my $normalize_version = sub { my ($version) = @_; if ( $version =~ /[=<>!,]/ ) { # logic, not just version # take as is without modification } elsif ( ref $version eq 'version' ) { # version objects $version = $version->is_qv ? $version->normal : $version->stringify; } elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots # normalize string tuples without "v": "1.2.3" -> "v1.2.3" $version = "v$version"; } else { # leave alone } return $version; }; # separate out some of the conflict resolution logic my $resolve_module_versions = sub { my $packages = shift; my( $file, $version ); my $err = ''; foreach my $p ( @$packages ) { if ( defined( $p->{version} ) ) { if ( defined( $version ) ) { if ( $compare_versions->( $version, '!=', $p->{version} ) ) { $err .= " $p->{file} ($p->{version})\n"; } else { # same version declared multiple times, ignore } } else { $file = $p->{file}; $version = $p->{version}; } } $file ||= $p->{file} if defined( $p->{file} ); } if ( $err ) { $err = " $file ($version)\n" . $err; } my %result = ( file => $file, version => $version, err => $err ); return \%result; }; sub provides { my $class = shift; croak "provides() requires key/value pairs \n" if @_ % 2; my %args = @_; croak "provides() takes only one of 'dir' or 'files'\n" if $args{dir} && $args{files}; croak "provides() requires a 'version' argument" unless defined $args{version}; croak "provides() does not support version '$args{version}' metadata" unless grep { $args{version} eq $_ } qw/1.4 2/; $args{prefix} = 'lib' unless defined $args{prefix}; my $p; if ( $args{dir} ) { $p = $class->package_versions_from_directory($args{dir}); } else { croak "provides() requires 'files' to be an array reference\n" unless ref $args{files} eq 'ARRAY'; $p = $class->package_versions_from_directory($args{files}); } # Now, fix up files with prefix if ( length $args{prefix} ) { # check in case disabled with q{} $args{prefix} =~ s{/$}{}; for my $v ( values %$p ) { $v->{file} = "$args{prefix}/$v->{file}"; } } return $p } sub package_versions_from_directory { my ( $class, $dir, $files ) = @_; my @files; if ( $files ) { @files = @$files; } else { find( { wanted => sub { push @files, $_ if -f $_ && /\.pm$/; }, no_chdir => 1, }, $dir ); } # First, we enumerate all packages & versions, # separating into primary & alternative candidates my( %prime, %alt ); foreach my $file (@files) { my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir ); my @path = split( /\//, $mapped_filename ); (my $prime_package = join( '::', @path )) =~ s/\.pm$//; my $pm_info = $class->new_from_file( $file ); foreach my $package ( $pm_info->packages_inside ) { next if $package eq 'main'; # main can appear numerous times, ignore next if $package eq 'DB'; # special debugging package, ignore next if grep /^_/, split( /::/, $package ); # private package, ignore my $version = $pm_info->version( $package ); $prime_package = $package if lc($prime_package) eq lc($package); if ( $package eq $prime_package ) { if ( exists( $prime{$package} ) ) { croak "Unexpected conflict in '$package'; multiple versions found.\n"; } else { $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename); $prime{$package}{file} = $mapped_filename; $prime{$package}{version} = $version if defined( $version ); } } else { push( @{$alt{$package}}, { file => $mapped_filename, version => $version, } ); } } } # Then we iterate over all the packages found above, identifying conflicts # and selecting the "best" candidate for recording the file & version # for each package. foreach my $package ( keys( %alt ) ) { my $result = $resolve_module_versions->( $alt{$package} ); if ( exists( $prime{$package} ) ) { # primary package selected if ( $result->{err} ) { # Use the selected primary package, but there are conflicting # errors among multiple alternative packages that need to be # reported log_info { "Found conflicting versions for package '$package'\n" . " $prime{$package}{file} ($prime{$package}{version})\n" . $result->{err} }; } elsif ( defined( $result->{version} ) ) { # There is a primary package selected, and exactly one # alternative package if ( exists( $prime{$package}{version} ) && defined( $prime{$package}{version} ) ) { # Unless the version of the primary package agrees with the # version of the alternative package, report a conflict if ( $compare_versions->( $prime{$package}{version}, '!=', $result->{version} ) ) { log_info { "Found conflicting versions for package '$package'\n" . " $prime{$package}{file} ($prime{$package}{version})\n" . " $result->{file} ($result->{version})\n" }; } } else { # The prime package selected has no version so, we choose to # use any alternative package that does have a version $prime{$package}{file} = $result->{file}; $prime{$package}{version} = $result->{version}; } } else { # no alt package found with a version, but we have a prime # package so we use it whether it has a version or not } } else { # No primary package was selected, use the best alternative if ( $result->{err} ) { log_info { "Found conflicting versions for package '$package'\n" . $result->{err} }; } # Despite possible conflicting versions, we choose to record # something rather than nothing $prime{$package}{file} = $result->{file}; $prime{$package}{version} = $result->{version} if defined( $result->{version} ); } } # Normalize versions. Can't use exists() here because of bug in YAML::Node. # XXX "bug in YAML::Node" comment seems irrelevant -- dagolden, 2009-05-18 for (grep defined $_->{version}, values %prime) { $_->{version} = $normalize_version->( $_->{version} ); } return \%prime; } } sub _init { my $class = shift; my $module = shift; my $filename = shift; my %props = @_; my $handle = delete $props{handle}; my( %valid_props, @valid_props ); @valid_props = qw( collect_pod inc ); @valid_props{@valid_props} = delete( @props{@valid_props} ); warn "Unknown properties: @{[keys %props]}\n" if scalar( %props ); my %data = ( module => $module, filename => $filename, version => undef, packages => [], versions => {}, pod => {}, pod_headings => [], collect_pod => 0, %valid_props, ); my $self = bless(\%data, $class); if ( $handle ) { $self->_parse_fh($handle); } else { $self->_parse_file(); } unless($self->{module} and length($self->{module})) { my ($v, $d, $f) = File::Spec->splitpath($self->{filename}); if($f =~ /\.pm$/) { $f =~ s/\..+$//; my @candidates = grep /$f$/, @{$self->{packages}}; $self->{module} = shift(@candidates); # punt } else { if(grep /main/, @{$self->{packages}}) { $self->{module} = 'main'; } else { $self->{module} = $self->{packages}[0] || ''; } } } $self->{version} = $self->{versions}{$self->{module}} if defined( $self->{module} ); return $self; } # class method sub _do_find_module { my $class = shift; my $module = shift || croak 'find_module_by_name() requires a package name'; my $dirs = shift || \@INC; my $file = File::Spec->catfile(split( /::/, $module)); foreach my $dir ( @$dirs ) { my $testfile = File::Spec->catfile($dir, $file); return [ File::Spec->rel2abs( $testfile ), $dir ] if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ] if -e "$testfile.pm"; } return; } # class method sub find_module_by_name { my $found = shift()->_do_find_module(@_) or return; return $found->[0]; } # class method sub find_module_dir_by_name { my $found = shift()->_do_find_module(@_) or return; return $found->[1]; } # given a line of perl code, attempt to parse it if it looks like a # $VERSION assignment, returning sigil, full name, & package name sub _parse_version_expression { my $self = shift; my $line = shift; my( $sig, $var, $pkg ); if ( $line =~ /$VERS_REGEXP/o ) { ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 ); if ( $pkg ) { $pkg = ($pkg eq '::') ? 'main' : $pkg; $pkg =~ s/::$//; } } return ( $sig, $var, $pkg ); } sub _parse_file { my $self = shift; my $filename = $self->{filename}; my $fh = IO::File->new( $filename ) or croak( "Can't open '$filename': $!" ); $self->_handle_bom($fh, $filename); $self->_parse_fh($fh); } # Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream. # If there's one, then skip it and set the :encoding layer appropriately. sub _handle_bom { my ($self, $fh, $filename) = @_; my $pos = $fh->getpos; return unless defined $pos; my $buf = ' ' x 2; my $count = $fh->read( $buf, length $buf ); return unless defined $count and $count >= 2; my $encoding; if ( $buf eq "\x{FE}\x{FF}" ) { $encoding = 'UTF-16BE'; } elsif ( $buf eq "\x{FF}\x{FE}" ) { $encoding = 'UTF-16LE'; } elsif ( $buf eq "\x{EF}\x{BB}" ) { $buf = ' '; $count = $fh->read( $buf, length $buf ); if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) { $encoding = 'UTF-8'; } } if ( defined $encoding ) { if ( "$]" >= 5.008 ) { # $fh->binmode requires perl 5.10 binmode( $fh, ":encoding($encoding)" ); } } else { $fh->setpos($pos) or croak( sprintf "Can't reset position to the top of '$filename'" ); } return $encoding; } sub _parse_fh { my ($self, $fh) = @_; my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 ); my( @pkgs, %vers, %pod, @pod ); my $pkg = 'main'; my $pod_sect = ''; my $pod_data = ''; my $in_end = 0; while (defined( my $line = <$fh> )) { my $line_num = $.; chomp( $line ); # From toke.c : any line that begins by "=X", where X is an alphabetic # character, introduces a POD segment. my $is_cut; if ( $line =~ /^=([a-zA-Z].*)/ ) { my $cmd = $1; # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic # character (which includes the newline, but here we chomped it away). $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/; $in_pod = !$is_cut; } if ( $in_pod ) { if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) { push( @pod, $1 ); if ( $self->{collect_pod} && length( $pod_data ) ) { $pod{$pod_sect} = $pod_data; $pod_data = ''; } $pod_sect = $1; } elsif ( $self->{collect_pod} ) { $pod_data .= "$line\n"; } } elsif ( $is_cut ) { if ( $self->{collect_pod} && length( $pod_data ) ) { $pod{$pod_sect} = $pod_data; $pod_data = ''; } $pod_sect = ''; } else { # Skip after __END__ next if $in_end; # Skip comments in code next if $line =~ /^\s*#/; # Would be nice if we could also check $in_string or something too if ($line eq '__END__') { $in_end++; next; } last if $line eq '__DATA__'; # parse $line to see if it's a $VERSION declaration my( $vers_sig, $vers_fullname, $vers_pkg ) = ($line =~ /VERSION/) ? $self->_parse_version_expression( $line ) : (); if ( $line =~ /$PKG_REGEXP/o ) { $pkg = $1; push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs ); $vers{$pkg} = $2 unless exists( $vers{$pkg} ); $need_vers = defined $2 ? 0 : 1; # VERSION defined with full package spec, i.e. $Module::VERSION } elsif ( $vers_fullname && $vers_pkg ) { push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs ); $need_vers = 0 if $vers_pkg eq $pkg; unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) { $vers{$vers_pkg} = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); } # first non-comment line in undeclared package main is VERSION } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) { $need_vers = 0; my $v = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); $vers{$pkg} = $v; push( @pkgs, 'main' ); # first non-comment line in undeclared package defines package main } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) { $need_vers = 1; $vers{main} = ''; push( @pkgs, 'main' ); # only keep if this is the first $VERSION seen } elsif ( $vers_fullname && $need_vers ) { $need_vers = 0; my $v = $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); unless ( defined $vers{$pkg} && length $vers{$pkg} ) { $vers{$pkg} = $v; } } } } if ( $self->{collect_pod} && length($pod_data) ) { $pod{$pod_sect} = $pod_data; } $self->{versions} = \%vers; $self->{packages} = \@pkgs; $self->{pod} = \%pod; $self->{pod_headings} = \@pod; } { my $pn = 0; sub _evaluate_version_line { my $self = shift; my( $sigil, $var, $line ) = @_; # Some of this code came from the ExtUtils:: hierarchy. # We compile into $vsub because 'use version' would cause # compiletime/runtime issues with local() my $vsub; $pn++; # everybody gets their own package my $eval = qq{BEGIN { my \$dummy = q# Hide from _packages_inside() #; package Module::Metadata::_version::p$pn; use version; no strict; no warnings; \$vsub = sub { local $sigil$var; \$$var=undef; $line; \$$var }; }}; $eval = $1 if $eval =~ m{^(.+)}s; local $^W; # Try to get the $VERSION eval $eval; # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't # installed, so we need to hunt in ./lib for it if ( $@ =~ /Can't locate/ && -d 'lib' ) { local @INC = ('lib',@INC); eval $eval; } warn "Error evaling version line '$eval' in $self->{filename}: $@\n" if $@; (ref($vsub) eq 'CODE') or croak "failed to build version sub for $self->{filename}"; my $result = eval { $vsub->() }; croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" if $@; # Upgrade it into a version object my $version = eval { _dwim_version($result) }; croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" unless defined $version; # "0" is OK! return $version; } } # Try to DWIM when things fail the lax version test in obvious ways { my @version_prep = ( # Best case, it just works sub { return shift }, # If we still don't have a version, try stripping any # trailing junk that is prohibited by lax rules sub { my $v = shift; $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b return $v; }, # Activestate apparently creates custom versions like '1.23_45_01', which # cause version.pm to think it's an invalid alpha. So check for that # and strip them sub { my $v = shift; my $num_dots = () = $v =~ m{(\.)}g; my $num_unders = () = $v =~ m{(_)}g; my $leading_v = substr($v,0,1) eq 'v'; if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) { $v =~ s{_}{}g; $num_unders = () = $v =~ m{(_)}g; } return $v; }, # Worst case, try numifying it like we would have before version objects sub { my $v = shift; no warnings 'numeric'; return 0 + $v; }, ); sub _dwim_version { my ($result) = shift; return $result if ref($result) eq 'version'; my ($version, $error); for my $f (@version_prep) { $result = $f->($result); $version = eval { version->new($result) }; $error ||= $@ if $@; # capture first failure last if defined $version; } croak $error unless defined $version; return $version; } } ############################################################ # accessors sub name { $_[0]->{module} } sub filename { $_[0]->{filename} } sub packages_inside { @{$_[0]->{packages}} } sub pod_inside { @{$_[0]->{pod_headings}} } sub contains_pod { 0+@{$_[0]->{pod_headings}} } sub version { my $self = shift; my $mod = shift || $self->{module}; my $vers; if ( defined( $mod ) && length( $mod ) && exists( $self->{versions}{$mod} ) ) { return $self->{versions}{$mod}; } else { return undef; } } sub pod { my $self = shift; my $sect = shift; if ( defined( $sect ) && length( $sect ) && exists( $self->{pod}{$sect} ) ) { return $self->{pod}{$sect}; } else { return undef; } } 1; =head1 NAME Module::Metadata - Gather package and POD information from perl module files =head1 SYNOPSIS use Module::Metadata; # information about a .pm file my $info = Module::Metadata->new_from_file( $file ); my $version = $info->version; # CPAN META 'provides' field for .pm files in a directory my $provides = Module::Metadata->provides( dir => 'lib', version => 2 ); =head1 DESCRIPTION This module provides a standard way to gather metadata about a .pm file through (mostly) static analysis and (some) code execution. When determining the version of a module, the C<$VERSION> assignment is Ced, as is traditional in the CPAN toolchain. =head1 USAGE =head2 Class methods =over 4 =item C<< new_from_file($filename, collect_pod => 1) >> Constructs a C object given the path to a file. Returns undef if the filename does not exist. C is a optional boolean argument that determines whether POD data is collected and stored for reference. POD data is not collected by default. POD headings are always collected. If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then it is skipped before processing, and the content of the file is also decoded appropriately starting from perl 5.8. =item C<< new_from_handle($handle, $filename, collect_pod => 1) >> This works just like C, except that a handle can be provided as the first argument. Note that there is no validation to confirm that the handle is a handle or something that can act like one. Passing something that isn't a handle will cause a exception when trying to read from it. The C argument is mandatory or undef will be returned. You are responsible for setting the decoding layers on C<$handle> if required. =item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >> Constructs a C object given a module or package name. Returns undef if the module cannot be found. In addition to accepting the C argument as described above, this method accepts a C argument which is a reference to an array of directories to search for the module. If none are given, the default is @INC. If the file that contains the module begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then it is skipped before processing, and the content of the file is also decoded appropriately starting from perl 5.8. =item C<< find_module_by_name($module, \@dirs) >> Returns the path to a module given the module or package name. A list of directories can be passed in as an optional parameter, otherwise @INC is searched. Can be called as either an object or a class method. =item C<< find_module_dir_by_name($module, \@dirs) >> Returns the entry in C<@dirs> (or C<@INC> by default) that contains the module C<$module>. A list of directories can be passed in as an optional parameter, otherwise @INC is searched. Can be called as either an object or a class method. =item C<< provides( %options ) >> This is a convenience wrapper around C to generate a CPAN META C data structure. It takes key/value pairs. Valid option keys include: =over =item version B<(required)> Specifies which version of the L should be used as the format of the C output. Currently only '1.4' and '2' are supported (and their format is identical). This may change in the future as the definition of C changes. The C option is required. If it is omitted or if an unsupported version is given, then C will throw an error. =item dir Directory to search recursively for F<.pm> files. May not be specified with C. =item files Array reference of files to examine. May not be specified with C. =item prefix String to prepend to the C field of the resulting output. This defaults to F, which is the common case for most CPAN distributions with their F<.pm> files in F. This option ensures the META information has the correct relative path even when the C or C arguments are absolute or have relative paths from a location other than the distribution root. =back For example, given C of 'lib' and C of 'lib', the return value is a hashref of the form: { 'Package::Name' => { version => '0.123', file => 'lib/Package/Name.pm' }, 'OtherPackage::Name' => ... } =item C<< package_versions_from_directory($dir, \@files?) >> Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks for those files in C<$dir> - and reads each file for packages and versions, returning a hashref of the form: { 'Package::Name' => { version => '0.123', file => 'Package/Name.pm' }, 'OtherPackage::Name' => ... } The C and C
packages are always omitted, as are any "private" packages that have leading underscores in the namespace (e.g. C) Note that the file path is relative to C<$dir> if that is specified. This B be used directly for CPAN META C. See the C method instead. =item C<< log_info (internal) >> Used internally to perform logging; imported from Log::Contextual if Log::Contextual has already been loaded, otherwise simply calls warn. =back =head2 Object methods =over 4 =item C<< name() >> Returns the name of the package represented by this module. If there are more than one packages, it makes a best guess based on the filename. If it's a script (i.e. not a *.pm) the package name is 'main'. =item C<< version($package) >> Returns the version as defined by the $VERSION variable for the package as returned by the C method if no arguments are given. If given the name of a package it will attempt to return the version of that package if it is specified in the file. =item C<< filename() >> Returns the absolute path to the file. =item C<< packages_inside() >> Returns a list of packages. Note: this is a raw list of packages discovered (or assumed, in the case of C
). It is not filtered for C, C
or private packages the way the C method does. Invalid package names are not returned, for example "Foo:Bar". Strange but valid package names are returned, for example "Foo::Bar::", and are left up to the caller on how to handle. =item C<< pod_inside() >> Returns a list of POD sections. =item C<< contains_pod() >> Returns true if there is any POD in the file. =item C<< pod($section) >> Returns the POD data in the given section. =back =head1 AUTHOR Original code from Module::Build::ModuleInfo by Ken Williams , Randy W. Sims Released as Module::Metadata by Matt S Trout (mst) with assistance from David Golden (xdg) . =head1 COPYRIGHT & LICENSE Original code Copyright (c) 2001-2011 Ken Williams. Additional code Copyright (c) 2010-2011 Matt Trout and David Golden. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut