@@ -1,61 +1,310 @@
-Revision history for Perl extension Pod::Readme.
+Revision history for Pod-Readme
+
+v1.0.3 2014-11-07 18:58 GMT
+ - Fixed bug with minimum version of Class::Method::Modifiers.
+
+v1.0.2 2014-10-13 22:18 BST
+ - No changes since v1.0.1_08, just a version bump for a release.
+
+ - See the full list of changes since v1.0.0 for more details.
+
+ [Enhancements]
+ - This is a complete rewrite, using modern Perl with Moo.
+
+ - Added support for plugins, along with plugins to insert the module
+ version, prerequisites and the latest changes.
+
+ - Added the ability to generate a README in a variety of formats,
+ such as POD, Markdown, HTML, RTF, etc.
+
+ - Added command-line options to the pod2readme script, including the
+ ability to specify the output format.
+
+ - Switched to semantic versioning.
+
+ - The documentation has been updated accordingly.
+
+ [Incompatabilities]
+ - Perl v5.10.1 is required.
+
+ - This is no longer a subclass of a POD parser, although it has some
+ wrapper methods for compatability with software known to use it.
+
+v1.0.1_08 2014-10-13
+ [Documentation]
+ - More documentation tweaks.
+
+v1.0.1_07 2014-10-10 16:47 BST
+ [Documentation]
+ - More documentation tweaks.
+
+ [Enhancements]
+ - Added a depends_on method that returns a list of files that the
+ README depends on.
+
+ - Added dependencies_updated method to check if dependencies have
+ been updated.
+
+ - The README is only updated if dependencies have been updated.
+
+ - Added a --force option to pod2readme to force updates.
+
+ [Other Changes]
+ - Moved pod2readme tests to xt directory for author tests, due to
+ inconsistent behaviour on different platforms.
+
+v1.0.1_06 2014-10-10
+ [Documentation]
+ - More documentation tweaks.
+
+ - Changed pod2readme usage text to match abstract.
+
+ [Bug Fixes]
+ - Added minimum Perl version to Makefile.PL.
+
+ - Removed use of Path::Class in pod2readme utility.
+
+ [Other Changes]
+ - Added rudimentary tests for pod2readme script.
+
+ [Enhancements]
+ - The requires plugin uses minimum module versions to check if a
+ module is in the core-list.
+
+v1.0.1_05 2014-10-09 19:36 BST
+ [Documentation]
+ - Corrected typos in POD.
+
+ [Bug Fixes]
+ - Disabled use of Test::Kit, since it seems to have problems with
+ Test::Builder 1.301001_056.
+
+v1.0.1_04 2014-10-08 23:27 BST
+ [Documentation]
+ - Changed abstract to make the module's purpose more obvious.
+
+ [Bug Fixes]
+ - Added missing IO::String prereq to tests.
+
+v1.0.1_03 2014-10-08 22:42 BST
+ [Documentation]
+ - Added Acknowledgements section to POD.
+
+ [Bug Fixes]
+ - Added minimum version prereq of Moo to fix issue with undef
+ defaults.
+
+ [Enhancements]
+ - Changed to use Path::Tiny instead of Path::Class.
+
+ - Reverted back to using Exporter, since most core modules already
+ use it.
+
+v1.0.1_02 2014-10-08 00:49 BST
+ [Documentation]
+ - Added missing timestamp to Changes.
+
+ - Updated README.pod.
+
+ [Other Changes]
+ - Changed how versions are defined in modules, to handle quirks of
+ namespace::autoclean.
+
+ - Changed to use Exporter::Lite.
+
+v1.0.1_01 2014-10-08 00:26 BST
+ [Bug Fixes]
+ - Fixed argument name for include command.
+
+ - Changed tests to compare files so they handle different Windows
+ line endings.
+
+ [Documentation]
+ - Fixed POD errors and typos.
+
+ [Enhancements]
+ - Switched to use Type::Tiny-based types, with stricter constraints.
+
+ - Switched to use Moo instead of Moose.
+
+ [Other Changes]
+ - Minor internal code tweaks.
+
+v1.0.0_03 2014-09-24 21:14 BST
+ [Bug Fixes]
+ - The tests for the requires plugin handle non-author builds.
+
+ - Fix for tests on some systems.
+
+ [Enhancements]
+ - Show path of missing META.yml file in requires plugin.
+
+ [Documentation]
+ - Consistent names in POD.
+
+ - Fixed typos in Changes file.
+
+ [Other Changes]
+ - Added hooks for author tests in Makefile.PL.
+
+ - Fixed license metadata error to make CPANTS happy, and to be
+ consistent with license in the POD.
+
+ - Tests use Exporter instead of Exporter::Lite.
+
+ - Tests use Test::Kit rather than Test::Most, and explicitly import
+ the tests modules that they use.
+
+ - Removed redundant prereqs from Makefile.PL.
+
+v1.0.0_02 2014-09-24 14:14 BST
+ [Bug Fixes]
+ - Fixed minimum version of some prerequisites for tests.
+
+ [Enhancements]
+ - Added parse_from_file and parse_from_filehandle methods for
+ backwards compatability.
+
+ [Other Changes]
+ - Added more tests.
+
+ - The bugtracker URL now refers to the GitHub issues list at
+ https://github.com/bigpresh/Pod-Readme/issues
+ instead of RT.
+
+ - Added a version to all modules in the distribution, and a version
+ QA test to the repo.
+
+ [Documentation]
+ - Added missing date to Changes.
+
+ - Fixed typos in POD and README.
+
+ - Added stub POD to Pod::Readme::Filter.
+
+ - Fixed a daft typo in the Changes file.
+
+ - Documented known issue in the requires plugin.
+
+ - The README is now a POD document.
+
+v1.0.0_01 2014-09-23 13:58 BST
+ [Incompatabilities]
+ - Major rewrite, using modern Perl v5.10.1.
+
+ - This module is no longer a subclass of a POD parsing
+ module. Instead, it is a simple POD filter.
+
+ [New Features]
+ - Added support for plugins.
+
+ - Added a "changes" plugin for parsing Changes files.
+
+ - Added a "version" plugin for including the current version.
+
+ - Added a "requires" plugin for listing module requirements.
+
+ - The pod2readme script has been rewritten to take a variety of
+ options, and can generate various formats, such as HTML, Markdown,
+ POD or RTF.
+
+ [Documentation]
+ - Changes rewritten to conform to CPAN::Changes::Spec.
+
+ - README is now in Markdown format.
+
+ [Other Changes]
+ - Switched to semantic versioning.
+
+ - Added MANIFEST.SKIP to distribution.
+
+ - QA tests are no longer part of the distribution.
+
+ - Makefile.PL uses Module::Install.
0.11 2010-12-09
- - Recognise the =encoding directive, rather than dying when it's
- encountered.
- TODO: actually take heed of it.
- Thanks to Ivan Bessarabov for bringing this to my attention!
+
+ - Recognise the =encoding directive, rather than dying when it's
+ encountered.
+ TODO: actually take heed of it.
+ Thanks to Ivan Bessarabov for bringing this to my attention!
0.10 2010-05-19
- - David Precious <davidp@preshweb.co.uk> taking over maintainership
- - Apply POD fix patch from RT #38328, thanks to David A. Desrosiers
-
-0.09 Sat Nov 25 2006
- - uses Regexp::Common for URI parsing for L<> tag
- - added separate check for https, ftps, and svn URIs
- (rt.cpan.org bugs 23585 and 23613)
-
-0.081 Sun May 7 2006
- - released package without signature, due to Module::Signature
- issues
-
-0.08 Mon May 1 2006
- - head3/4 headings not recognized
- - went back to using Pod::PlainText
-
-0.07 Sat Feb 11 2006
- - added min version to use Pod::Text statement in source
- - removed multiple plans from the podcover test
-
-0.06 Thu Feb 9 2006
- - eliminated a warning about uninitialized values
- - recognizes =head3 and =head4 headings (from Pod::Text)
- - uses Pod::Text instead of Pod::PlainText
- - added internal documentation
- - added various QA tests
- - added "test" and "tests" as a rejected format
-
-0.05 Tue Jun 7 2005
- - pod2readme will backup an existing README file
- - minor updates to the documentation
-
-0.04 Wed May 18 2005
- - known other formats such as "html" are rejected
- - added missing prereq IO::File in Build.PL
- - added debug option
- - typos and tweaks for documentation
-
-0.03 Sun May 8 2005
- - added documentation to pod2readme script
- - include file start/stop marks are now Regexps
- - added more tests
- - multiple readme types can be specified in a command
-
-0.02 Fri May 6 2005
- - added tests (much needed!)
- - fixed issue with links being changed to refer to manpages
-
-0.01 Sat Apr 30 19:22:33 2005
- - original version; created by h2xs 1.23 with options
- -X -v 0.01 -b 5.5.0 -n Pod::Readme -P
+ - David Precious <davidp@preshweb.co.uk> taking over maintainership
+
+ - Apply POD fix patch from RT #38328, thanks to David A. Desrosiers
+
+0.09 2006-11-25
+
+ - uses Regexp::Common for URI parsing for L<> tag
+
+ - added separate check for https, ftps, and svn URIs (rt.cpan.org
+ bugs 23585 and 23613)
+
+0.081 2006-05-07
+
+ - released package without signature, due to Module::Signature
+ issues
+
+0.08 2006-05-01
+
+ - head3/4 headings not recognized
+
+ - went back to using Pod::PlainText
+
+0.07 2006-02-11
+
+ - added min version to use Pod::Text statement in source
+
+ - removed multiple plans from the podcover test
+
+0.06 2006-02-09
+
+ - eliminated a warning about uninitialized values
+
+ - recognizes =head3 and =head4 headings (from Pod::Text)
+
+ - uses Pod::Text instead of Pod::PlainText
+
+ - added internal documentation
+
+ - added various QA tests
+
+ - added "test" and "tests" as a rejected format
+
+0.05 2005-06-07
+
+ - pod2readme will backup an existing README file
+
+ - minor updates to the documentation
+
+0.04 2005-05-18
+
+ - known other formats such as "html" are rejected
+
+ - added missing prereq IO::File in Build.PL
+
+ - added debug option
+
+ - typos and tweaks for documentation
+
+0.03 2005-05-08
+
+ - added documentation to pod2readme script
+
+ - include file start/stop marks are now Regexps
+
+ - added more tests
+
+ - multiple readme types can be specified in a command
+
+0.02 2005-05-06
+
+ - added tests (much needed!)
+
+ - fixed issue with links being changed to refer to manpages
+
+0.01 2005-04-20
+
+ - original version
@@ -1,11 +1,39 @@
-Changes
-Makefile.PL
-MANIFEST
-README
-bin/pod2readme
-t/10-basic.t
-t/90-fileport.t
-t/90-pod.t
-t/90-podcover.t
-lib/Pod/Readme.pm
-META.yml Module meta-data (added by MakeMaker)
+bin/pod2readme
+Changes
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AuthorRequires.pm
+inc/Module/Install/AuthorTests.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Scripts.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/Pod/Readme.pm
+lib/Pod/Readme/Filter.pm
+lib/Pod/Readme/Plugin.pm
+lib/Pod/Readme/Plugin/changes.pm
+lib/Pod/Readme/Plugin/requires.pm
+lib/Pod/Readme/Plugin/version.pm
+lib/Pod/Readme/Types.pm
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+META.yml
+README.pod
+t/10-pod-readme-filter.t
+t/20-pod-readme.t
+t/data/META-1.yml
+t/data/README-1.pod
+t/data/README.txt
+t/lib/Pod/Readme/Plugin/noop.pm
+t/lib/Pod/Readme/Test.pm
+t/lib/Pod/Readme/Test/Kit.pm
+t/plugins/changes.t
+t/plugins/requires.t
+t/plugins/version.t
@@ -0,0 +1,38 @@
+.*~$
+.*\.(bak|old|tmp)$
+\.git/.*
+\.gitignore
+
+^Makefile$
+
+^blib/
+^pm_to_blib$
+
+Pod-Readme-.*\.tar\.gz
+Pod-Readme-v\d+\.\d+\.\d+/
+
+^MYMETA\.*
+
+# QA tests not needed for distribution
+
+^xt/
+
+# Travis-CI
+
+\.travis\.yml
+
+# Distzilla etc
+
+\.build/
+
+# Misc
+
+^tmp/
+
+# Module::Install
+
+^inc/\.author/
+
+tags
+TAGS$
+
@@ -1,27 +1,68 @@
---- #YAML:1.0
-name: Pod-Readme
-version: 0.11
-abstract: Convert POD to README file
+---
+abstract: 'Intelligently generate a README file from POD'
author:
- - David Precious <davidp@preshweb.co.uk>
-license: perl
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
+ - 'Robert Rothenberg <rrwo@cpan.org>'
build_requires:
- ExtUtils::MakeMaker: 0
-requires:
- Carp: 0
- File::Copy: 0
- IO::File: 0
- Pod::Text: 3.0
- Regexp::Common: 0
- Test::More: 0
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.56
+ Exporter: 0
+ ExtUtils::MakeMaker: 6.59
+ File::Compare: 0
+ File::Temp: 0
+ IO::String: 0
+ Test::Deep: 0
+ Test::Exception: 0
+ Test::More: 0
+ lib: 0
+configure_requires:
+ ExtUtils::MakeMaker: 6.59
+distribution_type: module
+dynamic_config: 1
+generated_by: 'Module::Install version 1.12'
+license: perl
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Pod-Readme
+no_index:
+ directory:
+ - inc
+ - t
+ - xt
+recommends:
+ Pod::Man: 0
+ Pod::Markdown: 0
+ Pod::Simple::LaTeX: 0
+ Type::Tiny::XS: 0
+requires:
+ CPAN::Changes: '0.30'
+ CPAN::Meta: 0
+ Carp: 0
+ Class::Method::Modifiers: '2.00'
+ Exporter: 0
+ ExtUtils::MakeMaker: 6.56
+ File::Copy: 0
+ File::Slurp: 0
+ Getopt::Long::Descriptive: 0
+ Hash::Util: 0
+ IO: 0
+ List::Util: 1.33
+ Module::CoreList: 0
+ Module::Load: 0
+ Moo: 1.004005
+ Moo::Role: 0
+ MooX::HandlesVia: 0
+ Path::Tiny: 0.018
+ Pod::Simple: 0
+ Role::Tiny: 0
+ Scalar::Util: 0
+ Try::Tiny: 0
+ Type::Tiny: 0
+ Types::Standard: 0
+ namespace::autoclean: 0
+ perl: 5.10.1
+ version: 0.77
+resources:
+ bugtracker: https://github.com/bigpresh/Pod-Readme/issues
+ homepage: https://metacpan.org/pod/Pod::Readme
+ license: http://www.perlfoundation.org/artistic_license_2_0
+ repository: git://github.com/bigpresh/Pod-Readme.git
+version: '1.000003'
@@ -1,27 +1,93 @@
use strict;
-use warnings;
-use ExtUtils::MakeMaker;
-WriteMakefile(
- NAME => 'Pod::Readme',
- AUTHOR => 'David Precious <davidp@preshweb.co.uk>',
- VERSION_FROM => 'lib/Pod/Readme.pm',
- ABSTRACT_FROM => 'lib/Pod/Readme.pm',
- ($ExtUtils::MakeMaker::VERSION >= 6.3002
- ? (LICENSE=> 'perl')
- : ()),
- PREREQ_PM => {
- 'Carp' => '0',
- 'File::Copy' => '0',
- 'IO::File' => '0',
- 'Pod::Text' => '3.0',
- 'Regexp::Common' => '0',
- 'Test::More' => '0'
- },
- INSTALLDIRS => 'site',
- EXE_FILES => [
- 'bin/pod2readme'
- ],
- PL_FILES => {},
- dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' },
- clean => { FILES => 'Pod-Readme-*' },
+use warnings FATAL => 'all';
+use inc::Module::Install;
+
+author 'Robert Rothenberg <rrwo@cpan.org>';
+name 'Pod-Readme';
+all_from 'lib/Pod/Readme.pm';
+license 'perl';
+
+perl_version '5.10.1';
+
+tests_recursive('t');
+
+resources(
+ homepage => 'https://metacpan.org/pod/Pod::Readme',
+ license => 'http://www.perlfoundation.org/artistic_license_2_0',
+ repository => 'git://github.com/bigpresh/Pod-Readme.git',
+ bugtracker => 'https://github.com/bigpresh/Pod-Readme/issues',
);
+
+configure_requires();
+
+build_requires(
+ 'Exporter' => 0,
+ 'File::Compare' => 0,
+ 'File::Temp' => 0, # included in Path::Tiny anyway
+ 'IO::String' => 0,
+ 'Test::Deep' => 0,
+ 'Test::Exception' => 0,
+
+ # 'Test::Kit' => '2.10', # Buggy with Test::Builder 1.301001_056
+ 'Test::More' => 0,
+ 'lib' => 0,
+);
+
+requires(
+ 'Carp' => 0,
+ 'Class::Method::Modifiers' => '2.00',
+ 'CPAN::Changes' => '0.30',
+ 'CPAN::Meta' => 0,
+ 'Exporter' => 0,
+ 'ExtUtils::MakeMaker' => 6.56,
+ 'File::Copy' => 0,
+ 'File::Slurp' => 0,
+ 'Getopt::Long::Descriptive' => 0,
+ 'Hash::Util' => 0,
+ 'IO' => 0,
+ 'List::Util' => 1.33,
+ 'Module::CoreList' => 0,
+ 'Module::Load' => 0,
+ 'Moo' => 1.004005,
+ 'Moo::Role' => 0,
+ 'MooX::HandlesVia' => 0,
+ 'namespace::autoclean' => 0,
+ 'Path::Tiny' => 0.018,
+ 'Pod::Simple' => 0,
+ 'Role::Tiny' => 0,
+ 'Scalar::Util' => 0,
+ 'Try::Tiny' => 0,
+ 'Type::Tiny' => 0,
+ 'Types::Standard' => 0,
+ 'version' => 0.77,
+);
+
+recommends(
+ 'Pod::Simple::LaTeX' => 0,
+ 'Pod::Man' => 0,
+ 'Pod::Markdown' => 0,
+ 'Type::Tiny::XS' => 0,
+);
+
+install_script(qw{ bin/pod2readme });
+
+author_requires(
+ 'Module::Install::AuthorRequires' => 0.02,
+ 'Module::Install::AuthorTests' => 0,
+ 'Test::CPAN::Meta' => 0,
+ 'Test::CheckManifest' => 0.9,
+ 'Test::CleanNamespaces' => 0,
+ 'Test::Command' => 0,
+ 'Test::ConsistentVersion' => 0,
+ 'Test::MinimumVersion' => 0,
+ 'Test::Perl::Critic' => 0,
+ 'Test::Pod' => '1.00',
+ 'Test::Pod::Coverage' => 0,
+ 'Test::Portability::Files' => 0,
+);
+
+recursive_author_tests('xt');
+
+install_as_cpan;
+auto_install;
+WriteAll;
@@ -1,64 +0,0 @@
-NAME
- Pod::Readme - Convert POD to README file
-
-REQUIREMENTS
- This module should run on Perl 5.005 or newer. The following non-core
- modules (depending on your Perl version) are required:
-
- Pod::PlainText
- Test::More
-
-INSTALLATION
- Installation can be done using the traditional Makefile.PL or the newer
- Build.PL methods.
-
- Using Makefile.PL:
-
- perl Makefile.PL
- make test
- make install
-
- (On Windows platforms you should use `nmake' instead.)
-
- Using Build.PL (if you have Module::Build installed):
-
- perl Build.PL
- perl Build test
- perl Build install
-
-SYNOPSIS
- use Pod::Readme;
- my $parser = Pod::Readme->new();
-
- # Read POD from STDIN and write to STDOUT
- $parser->parse_from_filehandle;
-
- # Read POD from Module.pm and write to README
- $parser->parse_from_file('Module.pm', 'README');
-
-DESCRIPTION
- This module is a subclass of Pod::PlainText which provides additional
- POD markup for generating README files.
-
- Why should one bother with this? One can simply use
-
- pod2text Module.pm > README
-
- A problem with doing that is that the default pod2text converter will
- add text to links, so that "L<Module>" is translated to "the Module
- manpage".
-
- Another problem is that the README includes the entirety of the module
- documentation! Most people browsing the README file do not need all of
- this information.
-
- Likewise, including installation and requirement information in the
- module documentation is not necessary either, since the module is
- already installed.
-
- This module allows authors to mark portions of the POD to be included
- only in, or to be excluded from the README file. It also allows you to
- include portions of another file (such as a separate ChangeLog).
-
- See the module documentation for more details.
-
@@ -0,0 +1,163 @@
+=head1 NAME
+
+Pod::Readme - Intelligently generate a README file from POD
+
+=head1 VERSION
+
+v1.0.3
+
+=head1 SYNOPSIS
+
+In a module's POD:
+
+ =head1 NAME
+
+ MyApp - my nifty app
+
+ =for readme plugin version
+
+ =head1 DESCRIPTION
+
+ This is a nifty app.
+
+ =begin :readme
+
+ =for readme plugin requires
+
+ =head1 INSTALLATION
+
+ ...
+
+ =end :readme
+
+ =for readme stop
+
+ =head1 METHODS
+
+ ...
+
+Then from the command-line:
+
+ pod2readme lib/MyModule.pm README
+
+=head1 DESCRIPTION
+
+This module filters POD to generate a F<README> file, by using POD
+commands to specify which parts are included or excluded from the
+F<README> file.
+
+See the L<Pod::Readme> documentation for more details on the POD
+syntax that this module recognizes.
+
+See L<pod2readme> for command-line usage.
+
+=head1 INSTALLATION
+
+See
+L<How to install CPAN modules|http://www.cpan.org/modules/INSTALL.html>.
+
+=head2 Required Modules
+
+This distribution requires Perl v5.10.1.
+
+This distribution requires the following modules:
+
+=over 4
+
+=item * L<Class::Method::Modifiers> (version 2.00)
+
+=item * L<CPAN::Changes> (version 0.30)
+
+=item * L<CPAN::Meta>
+
+=item * L<File::Slurp>
+
+=item * L<Getopt::Long::Descriptive>
+
+=item * L<IO::String>
+
+=item * L<Moo> (version 1.004005)
+
+=item * L<Moo::Role>
+
+=item * L<MooX::HandlesVia>
+
+=item * L<namespace::autoclean>
+
+=item * L<Path::Tiny> (version 0.018)
+
+=item * L<Role::Tiny>
+
+=item * L<Test::Deep>
+
+=item * L<Test::Exception>
+
+=item * L<Try::Tiny>
+
+=item * L<Type::Tiny>
+
+=item * L<Types::Standard>
+
+=back
+
+This distribution recommends the following modules:
+
+=over 4
+
+=item * L<Pod::Man>
+
+=item * L<Pod::Markdown>
+
+=item * L<Pod::Simple::LaTeX>
+
+=item * L<Type::Tiny::XS>
+
+=back
+
+=head1 RECENT CHANGES
+
+=over 4
+
+=item *
+
+Fixed bug with minimum version of Class::Method::Modifiers.
+
+=back
+
+See the F<Changes> file for a longer revision history.
+
+=head1 CAVEATS
+
+This module is intended to be used by module authors for their own
+modules. It is not recommended for generating F<README> files from
+arbitrary Perl modules from untrusted sources.
+
+=head1 SEE ALSO
+
+See L<perlpod>, L<perlpodspec> and L<podlators>.
+
+=head1 AUTHORS
+
+The original version was by Robert Rothenberg <rrwo@cpan.org> until
+2010, when maintenance was taken over by David Precious
+<davidp@preshweb.co.uk>.
+
+In 2014, Robert Rothenberg rewrote the module to use filtering instead
+of subclassing a POD parser.
+
+=head2 Acknowledgements
+
+Thanks to people who gave feedback and suggestions to posts about the
+rewrite of this module on L<http://blogs.perl.org>.
+
+=head2 Suggestions, Bug Reporting and Contributing
+
+This module is developed on GitHub at
+L<http://github.com/bigpresh/Pod-Readme>
+
+=head1 LICENSE
+
+Copyright (c) 2005-2014 Robert Rothenberg. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
@@ -1,76 +1,179 @@
-#!/usr/bin/perl
-
-use strict;
-
-use File::Copy qw( copy );
-use Pod::Readme;
-
-our $VERSION = '0.05';
-
-# TODO
-# - use Getopts::Long with better options
-# - allow for stream conversion
-# - if no input given, parse META.yml and guess
-
-my $input = shift||"";
-
-unless (-r $input) {
- print STDERR << "USAGE";
-Cannot find input file "$input"
-Usage: pod2readme inputfile [outputfile] [type]
-USAGE
- exit(1);
-}
-
-my $output = shift || "README";
-
-my $type = shift || lc($output);
-
-my $parser = Pod::Readme->new( readme_type => $type );
-
-if (-e $output) {
- copy( $output, $output . ".bak" );
-}
-
-$parser->parse_from_file( $input, $output );
-
-__END__
-
-=pod
-
-=head1 NAME
-
-pod2readme - script to convert POD to README file
-
-=head1 SYNOPSIS
-
- pod2readme lib/Some/Module.pm
-
-=head1 DESCRIPTIONS
-
-Converts POD in the specified file to a F<README> text file. If a
-second argument is given, it will use that as the output file and
-assume that is the type of file to export:
-
- pod2readme Module.pm COPYING
-
-If need be, this can be overridden in cases where the output file
-is not the same as the type, using a third argument:
-
- pod2readme Module.pm Module-Install.HOWTO install
-
-=head1 SEE ALSO
-
-L<Pod::Readme>
-
-=head1 AUTHOR
-
-Robert Rothenberg <rrwo at cpan.org>
-
-=head1 LICENSE
-
-Copyright (c) 2005 Robert Rothenberg. All rights reserved.
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
+#!/usr/bin/env perl
+
+use v5.10.1;
+
+use strict;
+use warnings;
+
+use File::Copy qw/ copy /;
+use Getopt::Long::Descriptive;
+use IO::Handle;
+use Pod::Readme;
+
+=head1 NAME
+
+pod2readme - Intelligently generate a README file from POD
+
+=head1 USAGE
+
+ pod2readme [-cfho] [long options...] input-file [output-file] [target]
+
+ Intelligently generate a README file from POD
+
+ -t --target target type (default: 'readme')
+ -f --format output format (default: 'text')
+ -b --backup backup output file
+ -o --output output filename (default based on target)
+ -c --stdout output to stdout (console)
+ -F --force only update if files are changed
+ -h --help print usage and exit
+
+=head1 SYNOPSIS
+
+ pod2readme -f markdown lib/MyApp.pm
+
+=head1 DESCRIPTION
+
+This utility will use L<Pod::Readme> to extract a F<README> file from
+a POD document.
+
+It works by extracting and filtering the POD, and then calling the
+appropriate filter program to convert the POD to another format.
+
+=head1 OPTIONS
+
+=head2 C<--backup>
+
+By default, C<pod2readme> will back up the output file. To disable
+this, use the C<--no-backup> option.
+
+=head2 C<--output>
+
+Specifies the name of the output file. If omitted, it will use the
+second command line argument, or default to the C<--target> plus the
+corresponding extention of the C<--format>.
+
+For all intents, the default is F<README>.
+
+If a format other than "text" is chosen, then the appropriate
+extention will be added, e.g. for "markdown", the default output file
+is F<README.md>.
+
+=head2 C<--target>
+
+The target of the filter, which defaults to "readme".
+
+=head2 C<--format>
+
+The output format, which defaults to "text".
+
+Other supposed formats are "html", "latex", "man", "markdown", "pod",
+"rtf", and "xhtml".
+
+=head2 C<--stdout>
+
+If enabled, it will output to the console instead of C<--output>.
+
+=head2 C<--force>
+
+By default, the F<README> will be generated if the source files have
+been changed. Using C<--force> will force the file to be updated.
+
+Note: POD format files will always be updated.
+
+=head2 C<--help>
+
+Prints the usage and exits.
+
+=head1 SEE ALSO
+
+L<pod2text>, L<pod2markdown>.
+
+=cut
+
+my %FORMATS = (
+ 'html' => { class => 'Pod::Simple::HTML', },
+ 'latex' => { class => 'Pod::Simple::LaTeX' },
+ 'man' => { class => 'Pod::Man' },
+ 'markdown' => { class => 'Pod::Markdown' },
+ 'pod' => { class => undef },
+ 'rtf' => { class => 'Pod::Simple::RTF' },
+ 'text' => { class => 'Pod::Simple::Text' },
+ 'xhtml' => { class => 'Pod::Simple::XHTML' },
+);
+
+sub validate_format {
+ my $value = shift;
+ if ( exists $FORMATS{$value} ) {
+ return $value;
+ }
+ else {
+ die "Invalid format: '${value}'\n";
+ }
+}
+
+my ( $opt, $usage ) = describe_options(
+ '%c %o input-file [output-file] [target]',
+ [],
+ ['Intelligently generate a README file from POD'],
+ [],
+ [ 'target|t=s' => "target type (default: 'readme')" ],
+ [
+ 'format|f=s' => "output format (default: 'text')",
+ {
+ default => 'text',
+ callbacks => { format => \&validate_format },
+ }
+ ],
+ [ 'backup|b!' => "backup output file", { default => 1 } ],
+ [ 'output|o' => "output filename (default based on target)" ],
+ [ 'stdout|c' => "output to stdout (console)" ],
+ [ 'force|F!' => "only update if files are changed" ],
+ [ 'help|h' => "print usage and exit" ],
+);
+
+die $usage if $opt->help;
+
+my %args = ( force => $opt->force );
+
+if ( my $input = shift @ARGV ) {
+ $args{input_file} = $input;
+}
+
+my $format = $FORMATS{ $opt->format };
+unless ($format) {
+ say sprintf( "Unknown format: '\%s'", $opt->format );
+ die $usage;
+}
+
+my $output = $opt->output || shift @ARGV;
+my $target = $opt->target || shift @ARGV || 'readme';
+
+$args{target} = $target;
+
+if ( my $class = $format->{class} ) {
+ $args{translation_class} = $class;
+}
+
+if ( $opt->stdout ) {
+ my $fh = IO::Handle->new;
+ if ( $fh->fdopen( fileno(STDOUT), 'w' ) ) {
+ $args{translate_to_fh} = $fh;
+ }
+ else {
+ die "Cannot get a filehandle for STDOUT";
+ }
+}
+else {
+ $args{translate_to_file} = $output if $output;
+}
+
+my $pr = Pod::Readme->new(%args);
+
+$output ||= $pr->translate_to_file;
+
+if ( $opt->backup && $output && -e $output ) {
+ copy( $output, $output . '.bak' );
+}
+
+$pr->run();
@@ -0,0 +1,934 @@
+#line 1
+package Module::AutoInstall;
+
+use strict;
+use Cwd ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.12';
+}
+
+# special map on pre-defined feature sets
+my %FeatureMap = (
+ '' => 'Core Features', # XXX: deprecated
+ '-core' => 'Core Features',
+);
+
+# various lexical flags
+my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
+my (
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
+ $UpgradeDeps
+);
+my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
+ $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
+ $PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
+
+# See if it's a testing or non-interactive session
+_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
+_init();
+
+sub _accept_default {
+ $AcceptDefault = shift;
+}
+
+sub _installdeps_target {
+ $InstallDepsTarget = shift;
+}
+
+sub missing_modules {
+ return @Missing;
+}
+
+sub do_install {
+ __PACKAGE__->install(
+ [
+ $Config
+ ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ : ()
+ ],
+ @Missing,
+ );
+}
+
+# initialize various flags, and/or perform install
+sub _init {
+ foreach my $arg (
+ @ARGV,
+ split(
+ /[\s\t]+/,
+ $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
+ )
+ )
+ {
+ if ( $arg =~ /^--config=(.*)$/ ) {
+ $Config = [ split( ',', $1 ) ];
+ }
+ elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
+ elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) {
+ $UpgradeDeps = 1;
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
+ elsif ( $arg =~ /^--default(?:deps)?$/ ) {
+ $AcceptDefault = 1;
+ }
+ elsif ( $arg =~ /^--check(?:deps)?$/ ) {
+ $CheckOnly = 1;
+ }
+ elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
+ $SkipInstall = 1;
+ }
+ elsif ( $arg =~ /^--test(?:only)?$/ ) {
+ $TestOnly = 1;
+ }
+ elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+ $AllDeps = 1;
+ }
+ }
+}
+
+# overrides MakeMaker's prompt() to automatically accept the default choice
+sub _prompt {
+ goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
+
+ my ( $prompt, $default ) = @_;
+ my $y = ( $default =~ /^[Yy]/ );
+
+ print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
+ print "$default\n";
+ return $default;
+}
+
+# the workhorse
+sub import {
+ my $class = shift;
+ my @args = @_ or return;
+ my $core_all;
+
+ print "*** $class version " . $class->VERSION . "\n";
+ print "*** Checking for Perl dependencies...\n";
+
+ my $cwd = Cwd::getcwd();
+
+ $Config = [];
+
+ my $maxlen = length(
+ (
+ sort { length($b) <=> length($a) }
+ grep { /^[^\-]/ }
+ map {
+ ref($_)
+ ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
+ : ''
+ }
+ map { +{@args}->{$_} }
+ grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
+ )[0]
+ );
+
+ # We want to know if we're under CPAN early to avoid prompting, but
+ # if we aren't going to try and install anything anyway then skip the
+ # check entirely since we don't want to have to load (and configure)
+ # an old CPAN just for a cosmetic message
+
+ $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;
+
+ while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
+ my ( @required, @tests, @skiptests );
+ my $default = 1;
+ my $conflict = 0;
+
+ if ( $feature =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ # check for a newer version of myself
+ _update_to( $modules, @_ ) and return if $option eq 'version';
+
+ # sets CPAN configuration options
+ $Config = $modules if $option eq 'config';
+
+ # promote every features to core status
+ $core_all = ( $modules =~ /^all$/i ) and next
+ if $option eq 'core';
+
+ next unless $option eq 'core';
+ }
+
+ print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
+
+ $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
+
+ unshift @$modules, -default => &{ shift(@$modules) }
+ if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility
+
+ while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
+ if ( $mod =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ $default = $arg if ( $option eq 'default' );
+ $conflict = $arg if ( $option eq 'conflict' );
+ @tests = @{$arg} if ( $option eq 'tests' );
+ @skiptests = @{$arg} if ( $option eq 'skiptests' );
+
+ next;
+ }
+
+ printf( "- %-${maxlen}s ...", $mod );
+
+ if ( $arg and $arg =~ /^\D/ ) {
+ unshift @$modules, $arg;
+ $arg = 0;
+ }
+
+ # XXX: check for conflicts and uninstalls(!) them.
+ my $cur = _version_of($mod);
+ if (_version_cmp ($cur, $arg) >= 0)
+ {
+ print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
+ push @Existing, $mod => $arg;
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+ else {
+ if (not defined $cur) # indeed missing
+ {
+ print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+ }
+ else
+ {
+ # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
+ print "too old. ($cur < $arg)\n";
+ }
+
+ push @required, $mod => $arg;
+ }
+ }
+
+ next unless @required;
+
+ my $mandatory = ( $feature eq '-core' or $core_all );
+
+ if (
+ !$SkipInstall
+ and (
+ $CheckOnly
+ or ($mandatory and $UnderCPAN)
+ or $AllDeps
+ or $InstallDepsTarget
+ or _prompt(
+ qq{==> Auto-install the }
+ . ( @required / 2 )
+ . ( $mandatory ? ' mandatory' : ' optional' )
+ . qq{ module(s) from CPAN?},
+ $default ? 'y' : 'n',
+ ) =~ /^[Yy]/
+ )
+ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ elsif ( !$SkipInstall
+ and $default
+ and $mandatory
+ and
+ _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
+ =~ /^[Nn]/ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ else {
+ $DisabledTests{$_} = 1 for map { glob($_) } @tests;
+ }
+ }
+
+ if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
+ require Config;
+ my $make = $Config::Config{make};
+ if ($InstallDepsTarget) {
+ print
+"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
+ }
+ else {
+ print
+"*** Dependencies will be installed the next time you type '$make'.\n";
+ }
+
+ # make an educated guess of whether we'll need root permission.
+ print " (You may need to do that as the 'root' user.)\n"
+ if eval '$>';
+ }
+ print "*** $class configuration finished.\n";
+
+ chdir $cwd;
+
+ # import to main::
+ no strict 'refs';
+ *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+
+ return (@Existing, @Missing);
+}
+
+sub _running_under {
+ my $thing = shift;
+ print <<"END_MESSAGE";
+*** Since we're running under ${thing}, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+}
+
+# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
+# if we are, then we simply let it taking care of our dependencies
+sub _check_lock {
+ return unless @Missing or @_;
+
+ if ($ENV{PERL5_CPANM_IS_RUNNING}) {
+ return _running_under('cpanminus');
+ }
+
+ my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
+
+ if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
+ return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
+ }
+
+ require CPAN;
+
+ if ($CPAN::VERSION > '1.89') {
+ if ($cpan_env) {
+ return _running_under('CPAN');
+ }
+ return; # CPAN.pm new enough, don't need to check further
+ }
+
+ # last ditch attempt, this -will- configure CPAN, very sorry
+
+ _load_cpan(1); # force initialize even though it's already loaded
+
+ # Find the CPAN lock-file
+ my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
+ return unless -f $lock;
+
+ # Check the lock
+ local *LOCK;
+ return unless open(LOCK, $lock);
+
+ if (
+ ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
+ and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
+ ) {
+ print <<'END_MESSAGE';
+
+*** Since we're running under CPAN, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+ }
+
+ close LOCK;
+ return;
+}
+
+sub install {
+ my $class = shift;
+
+ my $i; # used below to strip leading '-' from config keys
+ my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
+
+ my ( @modules, @installed, @modules_to_upgrade );
+ while (my ($pkg, $ver) = splice(@_, 0, 2)) {
+
+ # grep out those already installed
+ if (_version_cmp(_version_of($pkg), $ver) >= 0) {
+ push @installed, $pkg;
+ if ($UpgradeDeps) {
+ push @modules_to_upgrade, $pkg, $ver;
+ }
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
+
+ if ($UpgradeDeps) {
+ push @modules, @modules_to_upgrade;
+ @installed = ();
+ @modules_to_upgrade = ();
+ }
+
+ return @installed unless @modules; # nothing to do
+ return @installed if _check_lock(); # defer to the CPAN shell
+
+ print "*** Installing dependencies...\n";
+
+ return unless _connected_to('cpan.org');
+
+ my %args = @config;
+ my %failed;
+ local *FAILED;
+ if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
+ while (<FAILED>) { chomp; $failed{$_}++ }
+ close FAILED;
+
+ my @newmod;
+ while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
+ push @newmod, ( $k => $v ) unless $failed{$k};
+ }
+ @modules = @newmod;
+ }
+
+ if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
+ _install_cpanplus( \@modules, \@config );
+ } else {
+ _install_cpan( \@modules, \@config );
+ }
+
+ print "*** $class installation finished.\n";
+
+ # see if we have successfully installed them
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
+ print FAILED "$pkg\n";
+ }
+ }
+
+ close FAILED if $args{do_once};
+
+ return @installed;
+}
+
+sub _install_cpanplus {
+ my @modules = @{ +shift };
+ my @config = _cpanplus_config( @{ +shift } );
+ my $installed = 0;
+
+ require CPANPLUS::Backend;
+ my $cp = CPANPLUS::Backend->new;
+ my $conf = $cp->configure_object;
+
+ return unless $conf->can('conf') # 0.05x+ with "sudo" support
+ or _can_write($conf->_get_build('base')); # 0.04x
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $conf->get_conf('makeflags') || '';
+ if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
+ # 0.03+ uses a hashref here
+ $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
+
+ } else {
+ # 0.02 and below uses a scalar
+ $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ }
+ $conf->set_conf( makeflags => $makeflags );
+ $conf->set_conf( prereqs => 1 );
+
+
+
+ while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
+ $conf->set_conf( $key, $val );
+ }
+
+ my $modtree = $cp->module_tree;
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ print "*** Installing $pkg...\n";
+
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ my $success;
+ my $obj = $modtree->{$pkg};
+
+ if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $cp->install( modules => [ $obj->{module} ] );
+
+ if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ } else {
+ print "*** $pkg installation cancelled.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ } else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _cpanplus_config {
+ my @config = ();
+ while ( @_ ) {
+ my ($key, $value) = (shift(), shift());
+ if ( $key eq 'prerequisites_policy' ) {
+ if ( $value eq 'follow' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
+ } elsif ( $value eq 'ask' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
+ } elsif ( $value eq 'ignore' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
+ } else {
+ die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
+ }
+ push @config, 'prereqs', $value;
+ } elsif ( $key eq 'force' ) {
+ push @config, $key, $value;
+ } elsif ( $key eq 'notest' ) {
+ push @config, 'skiptest', $value;
+ } else {
+ die "*** Cannot convert option $key to CPANPLUS version.\n";
+ }
+ }
+ return @config;
+}
+
+sub _install_cpan {
+ my @modules = @{ +shift };
+ my @config = @{ +shift };
+ my $installed = 0;
+ my %args;
+
+ _load_cpan();
+ require Config;
+
+ if (CPAN->VERSION < 1.80) {
+ # no "sudo" support, probe for writableness
+ return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
+ and _can_write( $Config::Config{sitelib} );
+ }
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $CPAN::Config->{make_install_arg} || '';
+ $CPAN::Config->{make_install_arg} =
+ join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ # don't show start-up info
+ $CPAN::Config->{inhibit_startup_message} = 1;
+
+ # set additional options
+ while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
+ ( $args{$opt} = $arg, next )
+ if $opt =~ /^(?:force|notest)$/; # pseudo-option
+ $CPAN::Config->{$opt} = $arg;
+ }
+
+ if ($args{notest} && (not CPAN::Shell->can('notest'))) {
+ die "Your version of CPAN is too old to support the 'notest' pragma";
+ }
+
+ local $CPAN::Config->{prerequisites_policy} = 'follow';
+
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ print "*** Installing $pkg...\n";
+
+ my $obj = CPAN::Shell->expand( Module => $pkg );
+ my $success = 0;
+
+ if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = do {
+ if ($args{force}) {
+ CPAN::Shell->force( install => $pkg )
+ } elsif ($args{notest}) {
+ CPAN::Shell->notest( install => $pkg )
+ } else {
+ CPAN::Shell->install($pkg)
+ }
+ };
+
+ $rv ||= eval {
+ $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
+ ->{install}
+ if $CPAN::META;
+ };
+
+ if ( $rv eq 'YES' ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation failed.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _has_cpanplus {
+ return (
+ $HasCPANPLUS = (
+ $INC{'CPANPLUS/Config.pm'}
+ or _load('CPANPLUS::Shell::Default')
+ )
+ );
+}
+
+# make guesses on whether we're under the CPAN installation directory
+sub _under_cpan {
+ require Cwd;
+ require File::Spec;
+
+ my $cwd = File::Spec->canonpath( Cwd::getcwd() );
+ my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
+
+ return ( index( $cwd, $cpan ) > -1 );
+}
+
+sub _update_to {
+ my $class = __PACKAGE__;
+ my $ver = shift;
+
+ return
+ if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade
+
+ if (
+ _prompt( "==> A newer version of $class ($ver) is required. Install?",
+ 'y' ) =~ /^[Nn]/
+ )
+ {
+ die "*** Please install $class $ver manually.\n";
+ }
+
+ print << ".";
+*** Trying to fetch it from CPAN...
+.
+
+ # install ourselves
+ _load($class) and return $class->import(@_)
+ if $class->install( [], $class, $ver );
+
+ print << '.'; exit 1;
+
+*** Cannot bootstrap myself. :-( Installation terminated.
+.
+}
+
+# check if we're connected to some host, using inet_aton
+sub _connected_to {
+ my $site = shift;
+
+ return (
+ ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
+ qq(
+*** Your host cannot resolve the domain name '$site', which
+ probably means the Internet connections are unavailable.
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+ );
+}
+
+# check if a directory is writable; may create it on demand
+sub _can_write {
+ my $path = shift;
+ mkdir( $path, 0755 ) unless -e $path;
+
+ return 1 if -w $path;
+
+ print << ".";
+*** You are not allowed to write to the directory '$path';
+ the installation may fail due to insufficient permissions.
+.
+
+ if (
+ eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
+ qq(
+==> Should we try to re-execute the autoinstall process with 'sudo'?),
+ ((-t STDIN) ? 'y' : 'n')
+ ) =~ /^[Yy]/
+ )
+ {
+
+ # try to bootstrap ourselves from sudo
+ print << ".";
+*** Trying to re-execute the autoinstall process with 'sudo'...
+.
+ my $missing = join( ',', @Missing );
+ my $config = join( ',',
+ UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ return
+ unless system( 'sudo', $^X, $0, "--config=$config",
+ "--installdeps=$missing" );
+
+ print << ".";
+*** The 'sudo' command exited with error! Resuming...
+.
+ }
+
+ return _prompt(
+ qq(
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/;
+}
+
+# load a module and return the version it reports
+sub _load {
+ my $mod = pop; # method/function doesn't matter
+ my $file = $mod;
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+ local $@;
+ return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
+}
+
+# report version without loading a module
+sub _version_of {
+ my $mod = pop; # method/function doesn't matter
+ my $file = $mod;
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+ foreach my $dir ( @INC ) {
+ next if ref $dir;
+ my $path = File::Spec->catfile($dir, $file);
+ next unless -e $path;
+ require ExtUtils::MM_Unix;
+ return ExtUtils::MM_Unix->parse_version($path);
+ }
+ return undef;
+}
+
+# Load CPAN.pm and it's configuration
+sub _load_cpan {
+ return if $CPAN::VERSION and $CPAN::Config and not @_;
+ require CPAN;
+
+ # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
+ # CPAN::HandleConfig->load. CPAN reports that the redirection
+ # is deprecated in a warning printed at the user.
+
+ # CPAN-1.81 expects CPAN::HandleConfig->load, does not have
+ # $CPAN::HandleConfig::VERSION but cannot handle
+ # CPAN::Config->load
+
+ # Which "versions expect CPAN::Config->load?
+
+ if ( $CPAN::HandleConfig::VERSION
+ || CPAN::HandleConfig->can('load')
+ ) {
+ # Newer versions of CPAN have a HandleConfig module
+ CPAN::HandleConfig->load;
+ } else {
+ # Older versions had the load method in Config directly
+ CPAN::Config->load;
+ }
+}
+
+# compare two versions, either use Sort::Versions or plain comparison
+# return values same as <=>
+sub _version_cmp {
+ my ( $cur, $min ) = @_;
+ return -1 unless defined $cur; # if 0 keep comparing
+ return 1 unless $min;
+
+ $cur =~ s/\s+$//;
+
+ # check for version numbers that are not in decimal format
+ if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
+ if ( ( $version::VERSION or defined( _load('version') )) and
+ version->can('new')
+ ) {
+
+ # use version.pm if it is installed.
+ return version->new($cur) <=> version->new($min);
+ }
+ elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
+ {
+
+ # use Sort::Versions as the sorting algorithm for a.b.c versions
+ return Sort::Versions::versioncmp( $cur, $min );
+ }
+
+ warn "Cannot reliably compare non-decimal formatted versions.\n"
+ . "Please install version.pm or Sort::Versions.\n";
+ }
+
+ # plain comparison
+ local $^W = 0; # shuts off 'not numeric' bugs
+ return $cur <=> $min;
+}
+
+# nothing; this usage is deprecated.
+sub main::PREREQ_PM { return {}; }
+
+sub _make_args {
+ my %args = @_;
+
+ $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
+ if $UnderCPAN or $TestOnly;
+
+ if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
+ require ExtUtils::Manifest;
+ my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
+
+ $args{EXE_FILES} =
+ [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
+ }
+
+ $args{test}{TESTS} ||= 't/*.t';
+ $args{test}{TESTS} = join( ' ',
+ grep { !exists( $DisabledTests{$_} ) }
+ map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
+
+ my $missing = join( ',', @Missing );
+ my $config =
+ join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ $PostambleActions = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ my $deps_list = join( ',', @Missing, @Existing );
+
+ $PostambleActionsUpgradeDeps =
+ "\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
+
+ my $config_notest =
+ join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
+ 'notest', 1 )
+ if $Config;
+
+ $PostambleActionsNoTest = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ $PostambleActionsUpgradeDepsNoTest =
+ "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
+
+ $PostambleActionsListDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
+
+ my @all = (@Missing, @Existing);
+
+ $PostambleActionsListAllDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
+
+ return %args;
+}
+
+# a wrapper to ExtUtils::MakeMaker::WriteMakefile
+sub Write {
+ require Carp;
+ Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+ if ($CheckOnly) {
+ print << ".";
+*** Makefile not written in check-only mode.
+.
+ return;
+ }
+
+ my %args = _make_args(@_);
+
+ no strict 'refs';
+
+ $PostambleUsed = 0;
+ local *MY::postamble = \&postamble unless defined &MY::postamble;
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ print << "." unless $PostambleUsed;
+*** WARNING: Makefile written with customized MY::postamble() without
+ including contents from Module::AutoInstall::postamble() --
+ auto installation features disabled. Please contact the author.
+.
+
+ return 1;
+}
+
+sub postamble {
+ $PostambleUsed = 1;
+ my $fragment;
+
+ $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
+
+config :: installdeps
+\t\$(NOECHO) \$(NOOP)
+AUTO_INSTALL
+
+ $fragment .= <<"END_MAKE";
+
+checkdeps ::
+\t\$(PERL) $0 --checkdeps
+
+installdeps ::
+\t$PostambleActions
+
+installdeps_notest ::
+\t$PostambleActionsNoTest
+
+upgradedeps ::
+\t$PostambleActionsUpgradeDeps
+
+upgradedeps_notest ::
+\t$PostambleActionsUpgradeDepsNoTest
+
+listdeps ::
+\t$PostambleActionsListDeps
+
+listalldeps ::
+\t$PostambleActionsListAllDeps
+
+END_MAKE
+
+ return $fragment;
+}
+
+1;
+
+__END__
+
+#line 1197
@@ -0,0 +1,38 @@
+#line 1
+use strict;
+use warnings;
+
+package Module::Install::AuthorRequires;
+
+use base 'Module::Install::Base';
+
+# cargo cult
+BEGIN {
+ our $VERSION = '0.02';
+ our $ISCORE = 1;
+}
+
+sub author_requires {
+ my $self = shift;
+
+ return $self->{values}->{author_requires}
+ unless @_;
+
+ my @added;
+ while (@_) {
+ my $mod = shift or last;
+ my $version = shift || 0;
+ push @added, [$mod => $version];
+ }
+
+ push @{ $self->{values}->{author_requires} }, @added;
+ $self->admin->author_requires(@added);
+
+ return map { @$_ } @added;
+}
+
+1;
+
+__END__
+
+#line 92
@@ -0,0 +1,59 @@
+#line 1
+package Module::Install::AuthorTests;
+
+use 5.005;
+use strict;
+use Module::Install::Base;
+use Carp ();
+
+#line 16
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.002';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+#line 42
+
+sub author_tests {
+ my ($self, @dirs) = @_;
+ _add_author_tests($self, \@dirs, 0);
+}
+
+#line 56
+
+sub recursive_author_tests {
+ my ($self, @dirs) = @_;
+ _add_author_tests($self, \@dirs, 1);
+}
+
+sub _wanted {
+ my $href = shift;
+ sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 }
+}
+
+sub _add_author_tests {
+ my ($self, $dirs, $recurse) = @_;
+ return unless $Module::Install::AUTHOR;
+
+ my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';
+
+ # XXX: pick a default, later -- rjbs, 2008-02-24
+ my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
+ @dirs = grep { -d } @dirs;
+
+ if ($recurse) {
+ require File::Find;
+ my %test_dir;
+ File::Find::find(_wanted(\%test_dir), @dirs);
+ $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
+ } else {
+ $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
+ }
+}
+
+#line 107
+
+1;
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::AutoInstall;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.12';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub AutoInstall { $_[0] }
+
+sub run {
+ my $self = shift;
+ $self->auto_install_now(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->auto_install(@_);
+}
+
+sub auto_install {
+ my $self = shift;
+ return if $self->{done}++;
+
+ # Flatten array of arrays into a single array
+ my @core = map @$_, map @$_, grep ref,
+ $self->build_requires, $self->requires;
+
+ my @config = @_;
+
+ # We'll need Module::AutoInstall
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ my @features_require = Module::AutoInstall->import(
+ (@config ? (-config => \@config) : ()),
+ (@core ? (-core => \@core) : ()),
+ $self->features,
+ );
+
+ my %seen;
+ my @requires = map @$_, map @$_, grep ref, $self->requires;
+ while (my ($mod, $ver) = splice(@requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
+ while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
+ while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+
+ my @deduped;
+ while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
+ push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
+ }
+
+ $self->requires(@deduped);
+
+ $self->makemaker_args( Module::AutoInstall::_make_args() );
+
+ my $class = ref($self);
+ $self->postamble(
+ "# --- $class section:\n" .
+ Module::AutoInstall::postamble()
+ );
+}
+
+sub installdeps_target {
+ my ($self, @args) = @_;
+
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ Module::AutoInstall::_installdeps_target(1);
+
+ $self->auto_install(@args);
+}
+
+sub auto_install_now {
+ my $self = shift;
+ $self->auto_install(@_);
+ Module::AutoInstall::do_install();
+}
+
+1;
@@ -0,0 +1,83 @@
+#line 1
+package Module::Install::Base;
+
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.12';
+}
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+#line 42
+
+sub new {
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
+}
+
+#line 61
+
+sub AUTOLOAD {
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
+}
+
+#line 75
+
+sub _top {
+ $_[0]->{_top};
+}
+
+#line 90
+
+sub admin {
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
+}
+
+#line 106
+
+sub is_admin {
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 159
@@ -0,0 +1,154 @@
+#line 1
+package Module::Install::Can;
+
+use strict;
+use Config ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.12';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# check if we can load some module
+### Upgrade this to not have to load the module if possible
+sub can_use {
+ my ($self, $mod, $ver) = @_;
+ $mod =~ s{::|\\}{/}g;
+ $mod .= '.pm' unless $mod =~ /\.pm$/i;
+
+ my $pkg = $mod;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+
+ local $@;
+ eval { require $mod; $pkg->VERSION($ver || 0); 1 };
+}
+
+# Check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ next if $dir eq '';
+ require File::Spec;
+ my $abs = File::Spec->catfile($dir, $cmd);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+# Can our C compiler environment build XS files
+sub can_xs {
+ my $self = shift;
+
+ # Ensure we have the CBuilder module
+ $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+ # Do we have the configure_requires checker?
+ local $@;
+ eval "require ExtUtils::CBuilder;";
+ if ( $@ ) {
+ # They don't obey configure_requires, so it is
+ # someone old and delicate. Try to avoid hurting
+ # them by falling back to an older simpler test.
+ return $self->can_cc();
+ }
+
+ # Do we have a working C compiler
+ my $builder = ExtUtils::CBuilder->new(
+ quiet => 1,
+ );
+ unless ( $builder->have_compiler ) {
+ # No working C compiler
+ return 0;
+ }
+
+ # Write a C file representative of what XS becomes
+ require File::Temp;
+ my ( $FH, $tmpfile ) = File::Temp::tempfile(
+ "compilexs-XXXXX",
+ SUFFIX => '.c',
+ );
+ binmode $FH;
+ print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+ return 0;
+}
+
+int boot_sanexs() {
+ return 1;
+}
+
+END_C
+ close $FH;
+
+ # Can the C compiler access the same headers XS does
+ my @libs = ();
+ my $object = undef;
+ eval {
+ local $^W = 0;
+ $object = $builder->compile(
+ source => $tmpfile,
+ );
+ @libs = $builder->link(
+ objects => $object,
+ module_name => 'sanexs',
+ );
+ };
+ my $result = $@ ? 0 : 1;
+
+ # Clean up all the build files
+ foreach ( $tmpfile, $object, @libs ) {
+ next unless defined $_;
+ 1 while unlink;
+ }
+
+ return $result;
+}
+
+# Can we locate a (the) C compiler
+sub can_cc {
+ my $self = shift;
+ my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+# Fix Cygwin bug on maybe_command();
+if ( $^O eq 'cygwin' ) {
+ require ExtUtils::MM_Cygwin;
+ require ExtUtils::MM_Win32;
+ if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+ *ExtUtils::MM_Cygwin::maybe_command = sub {
+ my ($self, $file) = @_;
+ if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+ ExtUtils::MM_Win32->maybe_command($file);
+ } else {
+ ExtUtils::MM_Unix->maybe_command($file);
+ }
+ }
+ }
+}
+
+1;
+
+__END__
+
+#line 236
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::Fetch;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.12';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
+ $args{url} = $args{ftp_url}
+ or (warn("LWP support unavailable!\n"), return);
+ ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+ }
+
+ $|++;
+ print "Fetching '$file' from $host... ";
+
+ unless (eval { require Socket; Socket::inet_aton($host) }) {
+ warn "'$host' resolve failed!\n";
+ return;
+ }
+
+ return unless $scheme eq 'ftp' or $scheme eq 'http';
+
+ require Cwd;
+ my $dir = Cwd::getcwd();
+ chdir $args{local_dir} or return if exists $args{local_dir};
+
+ if (eval { require LWP::Simple; 1 }) {
+ LWP::Simple::mirror($args{url}, $file);
+ }
+ elsif (eval { require Net::FTP; 1 }) { eval {
+ # use Net::FTP to get past firewall
+ my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
+ $ftp->login("anonymous", 'anonymous@example.com');
+ $ftp->cwd($path);
+ $ftp->binary;
+ $ftp->get($file) or (warn("$!\n"), return);
+ $ftp->quit;
+ } }
+ elsif (my $ftp = $self->can_run('ftp')) { eval {
+ # no Net::FTP, fallback to ftp.exe
+ require FileHandle;
+ my $fh = FileHandle->new;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ($fh->open("|$ftp -n")) {
+ warn "Couldn't open ftp: $!\n";
+ chdir $dir; return;
+ }
+
+ my @dialog = split(/\n/, <<"END_FTP");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+END_FTP
+ foreach (@dialog) { $fh->print("$_\n") }
+ $fh->close;
+ } }
+ else {
+ warn "No working 'ftp' program available!\n";
+ chdir $dir; return;
+ }
+
+ unless (-f $file) {
+ warn "Fetching failed: $@\n";
+ chdir $dir; return;
+ }
+
+ return if exists $args{size} and -s $file != $args{size};
+ system($args{run}) if exists $args{run};
+ unlink($file) if $args{remove};
+
+ print(((!exists $args{check_for} or -e $args{check_for})
+ ? "done!" : "failed! ($!)"), "\n");
+ chdir $dir; return !$?;
+}
+
+1;
@@ -0,0 +1,34 @@
+#line 1
+package Module::Install::Include;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.12';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub include {
+ shift()->admin->include(@_);
+}
+
+sub include_deps {
+ shift()->admin->include_deps(@_);
+}
+
+sub auto_include {
+ shift()->admin->auto_include(@_);
+}
+
+sub auto_include_deps {
+ shift()->admin->auto_include_deps(@_);
+}
+
+sub auto_include_dependent_dists {
+ shift()->admin->auto_include_dependent_dists(@_);
+}
+
+1;
@@ -0,0 +1,418 @@
+#line 1
+package Module::Install::Makefile;
+
+use strict 'vars';
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.12';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub Makefile { $_[0] }
+
+my %seen = ();
+
+sub prompt {
+ shift;
+
+ # Infinite loop protection
+ my @c = caller();
+ if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
+ die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
+ }
+
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ local $ENV{PERL_MM_USE_DEFAULT} = 1;
+ goto &ExtUtils::MakeMaker::prompt;
+ } else {
+ goto &ExtUtils::MakeMaker::prompt;
+ }
+}
+
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
+sub makemaker_args {
+ my ($self, %new_args) = @_;
+ my $args = ( $self->{makemaker_args} ||= {} );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key}) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
+ return $args;
+}
+
+# For mm args that take multiple space-separated args,
+# append an argument to the current list.
+sub makemaker_append {
+ my $self = shift;
+ my $name = shift;
+ my $args = $self->makemaker_args;
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
+ : join( ' ', @_ );
+}
+
+sub build_subdirs {
+ my $self = shift;
+ my $subdirs = $self->makemaker_args->{DIR} ||= [];
+ for my $subdir (@_) {
+ push @$subdirs, $subdir;
+ }
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
+ );
+}
+
+sub realclean_files {
+ my $self = shift;
+ my $realclean = $self->makemaker_args->{realclean} ||= {};
+ %$realclean = (
+ %$realclean,
+ FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
+ );
+}
+
+sub libs {
+ my $self = shift;
+ my $libs = ref $_[0] ? shift : [ shift ];
+ $self->makemaker_args( LIBS => $libs );
+}
+
+sub inc {
+ my $self = shift;
+ $self->makemaker_args( INC => shift );
+}
+
+sub _wanted_t {
+}
+
+sub tests_recursive {
+ my $self = shift;
+ my $dir = shift || 't';
+ unless ( -d $dir ) {
+ die "tests_recursive dir '$dir' does not exist";
+ }
+ my %tests = map { $_ => 1 } split / /, ($self->tests || '');
+ require File::Find;
+ File::Find::find(
+ sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+ $dir
+ );
+ $self->tests( join ' ', sort keys %tests );
+}
+
+sub write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ # Check the current Perl version
+ my $perl_version = $self->perl_version;
+ if ( $perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ # Make sure we have a new enough MakeMaker
+ require ExtUtils::MakeMaker;
+
+ if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
+ # This previous attempted to inherit the version of
+ # ExtUtils::MakeMaker in use by the module author, but this
+ # was found to be untenable as some authors build releases
+ # using future dev versions of EU:MM that nobody else has.
+ # Instead, #toolchain suggests we use 6.59 which is the most
+ # stable version on CPAN at time of writing and is, to quote
+ # ribasushi, "not terminally fucked, > and tested enough".
+ # TODO: We will now need to maintain this over time to push
+ # the version up as new versions are released.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ } else {
+ # Allow legacy-compatibility with 5.005 by depending on the
+ # most recent EU:MM that supported 5.005.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ }
+
+ # Generate the MakeMaker params
+ my $args = $self->makemaker_args;
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name;
+ $args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
+ if ( $self->tests ) {
+ my @tests = split ' ', $self->tests;
+ my %seen;
+ $args->{test} = {
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+ };
+ } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+ # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+ # So, just ignore our xt tests here.
+ } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ $args->{test} = {
+ TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+ };
+ }
+ if ( $] >= 5.005 ) {
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
+ }
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
+ }
+ if ( $self->makemaker(6.17) and $self->sign ) {
+ $args->{SIGN} = 1;
+ }
+ unless ( $self->is_admin ) {
+ delete $args->{SIGN};
+ }
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
+
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->requires)
+ );
+
+ # Remove any reference to perl, PREREQ_PM doesn't support it
+ delete $args->{PREREQ_PM}->{perl};
+
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+ delete $args->{BUILD_REQUIRES}->{perl};
+
+ # Delete bundled dists from prereq_pm, add it to Makefile DIR
+ my $subdirs = ($args->{DIR} || []);
+ if ($self->bundles) {
+ my %processed;
+ foreach my $bundle (@{ $self->bundles }) {
+ my ($mod_name, $dist_dir) = @$bundle;
+ delete $prereq->{$mod_name};
+ $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+ if (not exists $processed{$dist_dir}) {
+ if (-d $dist_dir) {
+ # List as sub-directory to be processed by make
+ push @$subdirs, $dist_dir;
+ }
+ # Else do nothing: the module is already present on the system
+ $processed{$dist_dir} = undef;
+ }
+ }
+ }
+
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
+ }
+
+ if ( my $perl_version = $self->perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
+ }
+
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $args->{INSTALLDIRS} = $self->installdirs;
+ }
+
+ my %args = map {
+ ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+ } keys %$args;
+
+ my $user_preop = delete $args{dist}->{PREOP};
+ if ( my $preop = $self->admin->preop($user_preop) ) {
+ foreach my $key ( keys %$preop ) {
+ $args{dist}->{$key} = $preop->{$key};
+ }
+ }
+
+ my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
+ $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
+}
+
+sub fix_up_makefile {
+ my $self = shift;
+ my $makefile_name = shift;
+ my $top_class = ref($self->_top) || '';
+ my $top_version = $self->_top->VERSION || '';
+
+ my $preamble = $self->preamble
+ ? "# Preamble by $top_class $top_version\n"
+ . $self->preamble
+ : '';
+ my $postamble = "# Postamble by $top_class $top_version\n"
+ . ($self->postamble || '');
+
+ local *MAKEFILE;
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
+ my $makefile = do { local $/; <MAKEFILE> };
+
+ $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
+ $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
+ $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
+ $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
+ $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
+
+ # Module::Install will never be used to build the Core Perl
+ # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
+ # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
+ $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
+ #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
+
+ # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
+ $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
+
+ # XXX - This is currently unused; not sure if it breaks other MM-users
+ # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
+
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
+ print MAKEFILE "$preamble$makefile$postamble" or die $!;
+ close MAKEFILE or die $!;
+
+ 1;
+}
+
+sub preamble {
+ my ($self, $text) = @_;
+ $self->{preamble} = $text . $self->{preamble} if defined $text;
+ $self->{preamble};
+}
+
+sub postamble {
+ my ($self, $text) = @_;
+ $self->{postamble} ||= $self->admin->postamble;
+ $self->{postamble} .= $text if defined $text;
+ $self->{postamble}
+}
+
+1;
+
+__END__
+
+#line 544
@@ -0,0 +1,722 @@
+#line 1
+package Module::Install::Metadata;
+
+use strict 'vars';
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.12';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+my @boolean_keys = qw{
+ sign
+};
+
+my @scalar_keys = qw{
+ name
+ module_name
+ abstract
+ version
+ distribution_type
+ tests
+ installdirs
+};
+
+my @tuple_keys = qw{
+ configure_requires
+ build_requires
+ requires
+ recommends
+ bundles
+ resources
+};
+
+my @resource_keys = qw{
+ homepage
+ bugtracker
+ repository
+};
+
+my @array_keys = qw{
+ keywords
+ author
+};
+
+*authors = \&author;
+
+sub Meta { shift }
+sub Meta_BooleanKeys { @boolean_keys }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+sub Meta_ResourceKeys { @resource_keys }
+sub Meta_ArrayKeys { @array_keys }
+
+foreach my $key ( @boolean_keys ) {
+ *$key = sub {
+ my $self = shift;
+ if ( defined wantarray and not @_ ) {
+ return $self->{values}->{$key};
+ }
+ $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
+ return $self;
+ };
+}
+
+foreach my $key ( @scalar_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key ( @array_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} ||= [];
+ push @{$self->{values}->{$key}}, @_;
+ return $self;
+ };
+}
+
+foreach my $key ( @resource_keys ) {
+ *$key = sub {
+ my $self = shift;
+ unless ( @_ ) {
+ return () unless $self->{values}->{resources};
+ return map { $_->[1] }
+ grep { $_->[0] eq $key }
+ @{ $self->{values}->{resources} };
+ }
+ return $self->{values}->{resources}->{$key} unless @_;
+ my $uri = shift or die(
+ "Did not provide a value to $key()"
+ );
+ $self->resources( $key => $uri );
+ return 1;
+ };
+}
+
+foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} unless @_;
+ my @added;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @added, [ $module, $version ];
+ }
+ push @{ $self->{values}->{$key} }, @added;
+ return map {@$_} @added;
+ };
+}
+
+# Resource handling
+my %lc_resource = map { $_ => 1 } qw{
+ homepage
+ license
+ bugtracker
+ repository
+};
+
+sub resources {
+ my $self = shift;
+ while ( @_ ) {
+ my $name = shift or last;
+ my $value = shift or next;
+ if ( $name eq lc $name and ! $lc_resource{$name} ) {
+ die("Unsupported reserved lowercase resource '$name'");
+ }
+ $self->{values}->{resources} ||= [];
+ push @{ $self->{values}->{resources} }, [ $name, $value ];
+ }
+ $self->{values}->{resources};
+}
+
+# Aliases for build_requires that will have alternative
+# meanings in some future version of META.yml.
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
+
+# Aliases for installdirs options
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
+
+sub dynamic_config {
+ my $self = shift;
+ my $value = @_ ? shift : 1;
+ if ( $self->{values}->{dynamic_config} ) {
+ # Once dynamic we never change to static, for safety
+ return 0;
+ }
+ $self->{values}->{dynamic_config} = $value ? 1 : 0;
+ return 1;
+}
+
+# Convenience command
+sub static_config {
+ shift->dynamic_config(0);
+}
+
+sub perl_version {
+ my $self = shift;
+ return $self->{values}->{perl_version} unless @_;
+ my $version = shift or die(
+ "Did not provide a value to perl_version()"
+ );
+
+ # Normalize the version
+ $version = $self->_perl_version($version);
+
+ # We don't support the really old versions
+ unless ( $version >= 5.005 ) {
+ die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
+ }
+
+ $self->{values}->{perl_version} = $version;
+}
+
+sub all_from {
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name or die(
+ "all_from called with no args without setting name() first"
+ );
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ unless ( -e $file ) {
+ die("all_from cannot find $file from $name");
+ }
+ }
+ unless ( -f $file ) {
+ die("The path '$file' does not exist, or is not a file");
+ }
+
+ $self->{values}{all_from} = $file;
+
+ # Some methods pull from POD instead of code.
+ # If there is a matching .pod, use that instead
+ my $pod = $file;
+ $pod =~ s/\.pm$/.pod/i;
+ $pod = $file unless -e $pod;
+
+ # Pull the different values
+ $self->name_from($file) unless $self->name;
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+ $self->author_from($pod) unless @{$self->author || []};
+ $self->license_from($pod) unless $self->license;
+ $self->abstract_from($pod) unless $self->abstract;
+
+ return 1;
+}
+
+sub provides {
+ my $self = shift;
+ my $provides = ( $self->{values}->{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
+}
+
+sub auto_provides {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+ # Avoid spurious warnings as we are not checking manifest here.
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides( %{ $build->find_dist_packages || {} } );
+}
+
+sub feature {
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}->{features} ||= [] );
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
+}
+
+sub features {
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
+ : ();
+}
+
+sub no_index {
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+ return $self->{values}->{no_index};
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML::Tiny', 0 );
+
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ } else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
+}
+
+sub version_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+ # for version integrity check
+ $self->makemaker_args( VERSION_FROM => $file );
+}
+
+sub abstract_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
+}
+
+# Add both distribution and module name
+sub name_from {
+ my ($self, $file) = @_;
+ if (
+ Module::Install::_read($file) =~ m/
+ ^ \s*
+ package \s*
+ ([\w:]+)
+ [\s|;]*
+ /ixms
+ ) {
+ my ($name, $module_name) = ($1, $1);
+ $name =~ s{::}{-}g;
+ $self->name($name);
+ unless ( $self->module_name ) {
+ $self->module_name($module_name);
+ }
+ } else {
+ die("Cannot determine name from $file\n");
+ }
+}
+
+sub _extract_perl_version {
+ if (
+ $_[0] =~ m/
+ ^\s*
+ (?:use|require) \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ ) {
+ my $perl_version = $1;
+ $perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
+ $self->perl_version($perl_version);
+ } else {
+ warn "Cannot determine perl version info from $_[0]\n";
+ return;
+ }
+}
+
+sub author_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
+ $self->author($author);
+ } else {
+ warn "Cannot determine author info from $_[0]\n";
+ }
+}
+
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
+ my $self = shift;
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $license = __extract_license($license) || lc $license;
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
+sub _extract_license {
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
+ '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'GNU Free Documentation license' => 'unrestricted', 1,
+ 'GNU Affero General Public License' => 'open_source', 1,
+ '(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license 2\.0' => 'artistic_2', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'Apache (?:Software )?license' => 'apache', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'Mozilla Public License' => 'mozilla', 1,
+ 'Q Public License' => 'open_source', 1,
+ 'OpenSSL License' => 'unrestricted', 1,
+ 'SSLeay License' => 'unrestricted', 1,
+ 'zlib License' => 'open_source', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
+ }
+ }
+ return '';
+}
+
+sub license_from {
+ my $self = shift;
+ if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+ $self->license($license);
+ } else {
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+ }
+}
+
+sub _extract_bugtracker {
+ my @links = $_[0] =~ m#L<(
+ https?\Q://rt.cpan.org/\E[^>]+|
+ https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
+ https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
+ my %links;
+ @links{@links}=();
+ @links=keys %links;
+ return @links;
+}
+
+sub bugtracker_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ my @links = _extract_bugtracker($content);
+ unless ( @links ) {
+ warn "Cannot determine bugtracker info from $_[0]\n";
+ return 0;
+ }
+ if ( @links > 1 ) {
+ warn "Found more than one bugtracker link in $_[0]\n";
+ return 0;
+ }
+
+ # Set the bugtracker
+ bugtracker( $links[0] );
+ return 1;
+}
+
+sub requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->requires( $module => $version );
+ }
+}
+
+sub test_requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->test_requires( $module => $version );
+ }
+}
+
+# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
+# numbers (eg, 5.006001 or 5.008009).
+# Also, convert double-part versions (eg, 5.8)
+sub _perl_version {
+ my $v = $_[-1];
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
+ $v =~ s/(\.\d\d\d)000$/$1/;
+ $v =~ s/_.+$//;
+ if ( ref($v) ) {
+ # Numify
+ $v = $v + 0;
+ }
+ return $v;
+}
+
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
+
+
+######################################################################
+# MYMETA Support
+
+sub WriteMyMeta {
+ die "WriteMyMeta has been deprecated";
+}
+
+sub write_mymeta_yaml {
+ my $self = shift;
+
+ # We need YAML::Tiny to write the MYMETA.yml file
+ unless ( eval { require YAML::Tiny; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
+ }
+
+ # Merge the perl version into the dependencies
+ my $val = $self->Meta->{values};
+ my $perl = delete $val->{perl_version};
+ if ( $perl ) {
+ $val->{requires} ||= [];
+ my $requires = $val->{requires};
+
+ # Canonize to three-dot version after Perl 5.6
+ if ( $perl >= 5.006 ) {
+ $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
+ }
+ unshift @$requires, [ perl => $perl ];
+ }
+
+ # Load the advisory META.yml file
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
+ my $meta = $yaml[0];
+
+ # Overwrite the non-configure dependency hashes
+ delete $meta->{requires};
+ delete $meta->{build_requires};
+ delete $meta->{recommends};
+ if ( exists $val->{requires} ) {
+ $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
+ }
+ if ( exists $val->{build_requires} ) {
+ $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
+ }
+
+ return $meta;
+}
+
+1;
@@ -0,0 +1,29 @@
+#line 1
+package Module::Install::Scripts;
+
+use strict 'vars';
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.12';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub install_script {
+ my $self = shift;
+ my $args = $self->makemaker_args;
+ my $exe = $args->{EXE_FILES} ||= [];
+ foreach ( @_ ) {
+ if ( -f $_ ) {
+ push @$exe, $_;
+ } elsif ( -d 'script' and -f "script/$_" ) {
+ push @$exe, "script/$_";
+ } else {
+ die("Cannot find script '$_'");
+ }
+ }
+}
+
+1;
@@ -0,0 +1,64 @@
+#line 1
+package Module::Install::Win32;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.12';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# determine if the user needs nmake, and download it if needed
+sub check_nmake {
+ my $self = shift;
+ $self->load('can_run');
+ $self->load('get_file');
+
+ require Config;
+ return unless (
+ $^O eq 'MSWin32' and
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ ! $self->can_run('nmake')
+ );
+
+ print "The required 'nmake' executable not found, fetching it...\n";
+
+ require File::Basename;
+ my $rv = $self->get_file(
+ url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
+ ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
+ local_dir => File::Basename::dirname($^X),
+ size => 51928,
+ run => 'Nmake15.exe /o > nul',
+ check_for => 'Nmake.exe',
+ remove => 1,
+ );
+
+ die <<'END_MESSAGE' unless $rv;
+
+-------------------------------------------------------------------------------
+
+Since you are using Microsoft Windows, you will need the 'nmake' utility
+before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
+ or
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
+
+Please download the file manually, save it to a directory in %PATH% (e.g.
+C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
+that directory, and run "Nmake15.exe" from there; that will create the
+'nmake.exe' file needed by this module.
+
+You may then resume the installation process described in README.
+
+-------------------------------------------------------------------------------
+END_MESSAGE
+
+}
+
+1;
@@ -0,0 +1,63 @@
+#line 1
+package Module::Install::WriteAll;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.12';
+ @ISA = qw{Module::Install::Base};
+ $ISCORE = 1;
+}
+
+sub WriteAll {
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_,
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->admin->WriteAll(%args) if $self->is_admin;
+
+ $self->check_nmake if $args{check_nmake};
+ unless ( $self->makemaker_args->{PL_FILES} ) {
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
+ }
+
+ # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
+ # we clean it up properly ourself.
+ $self->realclean_files('MYMETA.yml');
+
+ if ( $args{inline} ) {
+ $self->Inline->write;
+ } else {
+ $self->Makefile->write;
+ }
+
+ # The Makefile write process adds a couple of dependencies,
+ # so write the META.yml files after the Makefile.
+ if ( $args{meta} ) {
+ $self->Meta->write;
+ }
+
+ # Experimental support for MYMETA
+ if ( $ENV{X_MYMETA} ) {
+ if ( $ENV{X_MYMETA} eq 'JSON' ) {
+ $self->Meta->write_mymeta_json;
+ } else {
+ $self->Meta->write_mymeta_yaml;
+ }
+ }
+
+ return 1;
+}
+
+1;
@@ -0,0 +1,470 @@
+#line 1
+package Module::Install;
+
+# For any maintainers:
+# The load order for Module::Install is a bit magic.
+# It goes something like this...
+#
+# IF ( host has Module::Install installed, creating author mode ) {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
+# 3. The installed version of inc::Module::Install loads
+# 4. inc::Module::Install calls "require Module::Install"
+# 5. The ./inc/ version of Module::Install loads
+# } ELSE {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
+# 3. The ./inc/ version of Module::Install loads
+# }
+
+use 5.006;
+use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+
+use vars qw{$VERSION $MAIN};
+BEGIN {
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # This is not enforced yet, but will be some time in the next few
+ # releases once we can make sure it won't clash with custom
+ # Module::Install extensions.
+ $VERSION = '1.12';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
+
+ *inc::Module::Install::VERSION = *VERSION;
+ @inc::Module::Install::ISA = __PACKAGE__;
+
+}
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # Whether or not inc::Module::Install is actually loaded, the
+ # $INC{inc/Module/Install.pm} is what will still get set as long as
+ # the caller loaded module this in the documented manner.
+ # If not set, the caller may NOT have loaded the bundled version, and thus
+ # they may not have a MI version that works with the Makefile.PL. This would
+ # result in false errors or unexpected behaviour. And we don't want that.
+ my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+ unless ( $INC{$file} ) { die <<"END_DIE" }
+
+Please invoke ${\__PACKAGE__} with:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+END_DIE
+
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+
+ # If the script that is loading Module::Install is from the future,
+ # then make will detect this and cause it to re-run over and over
+ # again. This is bad. Rather than taking action to touch it (which
+ # is unreliable on some platforms and requires write permissions)
+ # for now we should catch this and refuse to run.
+ if ( -f $0 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
+
+Your installer $0 has a modification time in the future ($s > $t).
+
+This is known to create infinite loops in make.
+
+Please correct this, then run $0 again.
+
+END_DIE
+ }
+
+
+ # Build.PL was formerly supported, but no longer is due to excessive
+ # difficulty in implementing every single feature twice.
+ if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+
+Module::Install no longer supports Build.PL.
+
+It was impossible to maintain duel backends, and has been deprecated.
+
+Please remove all Build.PL files and only use the Makefile.PL installer.
+
+END_DIE
+
+ #-------------------------------------------------------------
+
+ # To save some more typing in Module::Install installers, every...
+ # use inc::Module::Install
+ # ...also acts as an implicit use strict.
+ $^H |= strict::bits(qw(refs subs vars));
+
+ #-------------------------------------------------------------
+
+ unless ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
+ }
+
+ local $^W;
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ local $^W;
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{'inc/Module/Install.pm'};
+ delete $INC{'Module/Install.pm'};
+
+ # Save to the singleton
+ $MAIN = $self;
+
+ return 1;
+}
+
+sub autoload {
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::getcwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::getcwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # Delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ unless ($$sym =~ s/([^:]+)$//) {
+ # XXX: it looks like we can't retrieve the missing function
+ # via $$sym (usually $main::AUTOLOAD) in this case.
+ # I'm still wondering if we should slurp Makefile.PL to
+ # get some context or not ...
+ my ($package, $file, $line) = caller;
+ die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+ }
+ my $method = $1;
+ if ( uc($method) eq $method ) {
+ # Do nothing
+ return;
+ } elsif ( $method =~ /^_/ and $self->can($method) ) {
+ # Dispatch to the root M:I class
+ return $self->$method(@_);
+ }
+
+ # Dispatch to the appropriate plugin
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')};
+ };
+}
+
+sub preload {
+ my $self = shift;
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ @exts = $self->{admin}->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ local $^W;
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
+
+ # ignore the prefix on extension modules built from top level.
+ my $base_path = Cwd::abs_path($FindBin::Bin);
+ unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
+ delete $args{prefix};
+ }
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+ $args{wrote} = 0;
+
+ bless( \%args, $class );
+}
+
+sub call {
+ my ($self, $method) = @_;
+ my $obj = $self->load($method) or return;
+ splice(@_, 0, 2, $obj);
+ goto &{$obj->can($method)};
+}
+
+sub load {
+ my ($self, $method) = @_;
+
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
+
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
+
+ my $admin = $self->{admin} or die <<"END_DIE";
+The '$method' method does not exist in the '$self->{prefix}' path!
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
+END_DIE
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+sub load_extensions {
+ my ($self, $path, $top) = @_;
+
+ my $should_reload = 0;
+ unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ $should_reload = 1;
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
+}
+
+sub find_extensions {
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ my $content = Module::Install::_read($subpath . '.pm');
+ my $in_pod = 0;
+ foreach ( split /\n/, $content ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
+}
+
+
+
+
+
+#####################################################################
+# Common Utility Functions
+
+sub _caller {
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _read {
+ local *FH;
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
+
+sub _readperl {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+ $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+ return $string;
+}
+
+sub _readpod {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ return $string if $_[0] =~ /\.pod\z/;
+ $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+ $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/^\n+//s;
+ return $string;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _write {
+ local *FH;
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_NEW
+sub _write {
+ local *FH;
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_OLD
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version {
+ my $s = shift || 0;
+ my $d =()= $s =~ /(\.)/g;
+ if ( $d >= 2 ) {
+ # Normalise multipart versions
+ $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+ }
+ $s =~ s/^(\d+)\.?//;
+ my $l = $1 || 0;
+ my @v = map {
+ $_ . '0' x (3 - length $_)
+ } $s =~ /(\d{1,3})\D?/g;
+ $l = $l . '.' . join '', @v if @v;
+ return $l + 0;
+}
+
+sub _cmp {
+ _version($_[1]) <=> _version($_[2]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS {
+ (
+ defined $_[0]
+ and
+ ! ref $_[0]
+ and
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+ ) ? $_[0] : undef;
+}
+
+1;
+
+# Copyright 2008 - 2012 Adam Kennedy.
@@ -0,0 +1,438 @@
+package Pod::Readme::Filter;
+
+use v5.10.1;
+
+use Moo;
+
+{
+ use version 0.77;
+ $Pod::Readme::Filter::VERSION = version->declare('v1.0.3');
+}
+
+use MooX::HandlesVia;
+with 'Pod::Readme::Plugin';
+
+use Carp;
+use File::Slurp qw/ read_file /;
+use IO qw/ File Handle /;
+use Module::Load qw/ load /;
+use Path::Tiny;
+use Try::Tiny;
+use Types::Standard qw/ Bool Int RegexpRef Str /;
+
+use Pod::Readme::Types qw/ Dir File ReadIO WriteIO TargetName /;
+
+=head1 NAME
+
+Pod::Readme::Filter - Filter README from POD
+
+=head1 SYNOPSIS
+
+ use Pod::Readme::Filter;
+
+ my $prf = Pod::Readme::Filter->new(
+ target => 'readme',
+ base_dir => '.',
+ input_file => 'lib/MyApp.pm',
+ output_file => 'README.pod',
+ );
+
+=head1 DESCRIPTION
+
+This module provides the basic filtering and minimal processing to
+extract a F<README.pod> from a module's POD. It is used internally by
+L<Pod::Readme>.
+
+=cut
+
+has encoding => (
+ is => 'ro',
+ isa => Str,
+ default => ':utf8',
+);
+
+has base_dir => (
+ is => 'ro',
+ isa => Dir,
+ coerce => sub { Dir->coerce(@_) },
+ default => '.',
+);
+
+has input_file => (
+ is => 'ro',
+ isa => File,
+ required => 0,
+ coerce => sub { File->coerce(@_) },
+);
+
+has output_file => (
+ is => 'ro',
+ isa => File,
+ required => 0,
+ coerce => sub { File->coerce(@_) },
+);
+
+has input_fh => (
+ is => 'ro',
+ isa => ReadIO,
+ lazy => 1,
+ builder => '_build_input_fh',
+ coerce => sub { ReadIO->coerce(@_) },
+);
+
+sub _build_input_fh {
+ my ($self) = @_;
+ if ( $self->input_file ) {
+ $self->input_file->openr;
+ }
+ else {
+ my $fh = IO::Handle->new;
+ if ( $fh->fdopen( fileno(STDIN), 'r' ) ) {
+ return $fh;
+ }
+ else {
+ croak "Cannot get a filehandle for STDIN";
+ }
+ }
+}
+
+has output_fh => (
+ is => 'ro',
+ isa => WriteIO,
+ lazy => 1,
+ builder => '_build_output_fh',
+ coerce => sub { WriteIO->coerce(@_) },
+);
+
+sub _build_output_fh {
+ my ($self) = @_;
+ if ( $self->output_file ) {
+ $self->output_file->openw;
+ }
+ else {
+ my $fh = IO::Handle->new;
+ if ( $fh->fdopen( fileno(STDOUT), 'w' ) ) {
+ return $fh;
+ }
+ else {
+ croak "Cannot get a filehandle for STDOUT";
+ }
+ }
+}
+
+has target => (
+ is => 'ro',
+ isa => TargetName,
+ default => 'readme',
+);
+
+has in_target => (
+ is => 'ro',
+ isa => Bool,
+ init_arg => undef,
+ default => 1,
+ writer => '_set_in_target',
+);
+
+has _target_regex => (
+ is => 'ro',
+ isa => RegexpRef,
+ init_arg => undef,
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ my $target = $self->target;
+ qr/^[:]?${target}$/;
+ },
+);
+
+has mode => (
+ is => 'rw',
+ isa => Str,
+ default => 'default',
+ init_arg => undef,
+);
+
+has _line_no => (
+ is => 'ro',
+ isa => Int,
+ default => 0,
+ writer => '_set_line_no',
+);
+
+sub _inc_line_no {
+ my ($self) = @_;
+ $self->_set_line_no( 1 + $self->_line_no );
+}
+
+sub depends_on {
+ my ($self) = @_;
+ my @files;
+ push @files, $self->input_file if $self->input_file;
+ return @files;
+}
+
+sub write {
+ my ( $self, $line ) = @_;
+ my $fh = $self->output_fh;
+ print {$fh} $line;
+}
+
+sub in_pod {
+ my ($self) = @_;
+ $self->mode eq 'pod';
+}
+
+has _for_buffer => (
+ is => 'rw',
+ isa => Str,
+ init_arg => undef,
+ default => '',
+ handles_via => 'String',
+ handles => {
+ _append_for_buffer => 'append',
+ _clear_for_buffer => 'clear',
+ },
+);
+
+has _begin_args => (
+ is => 'rw',
+ isa => Str,
+ init_arg => undef,
+ default => '',
+ handles_via => 'String',
+ handles => { _clear_begin_args => 'clear', },
+);
+
+sub process_for {
+ my ( $self, $data ) = @_;
+
+ my ( $target, @args ) = $self->_parse_arguments($data);
+
+ if ( $target && $target =~ $self->_target_regex ) {
+ if ( my $cmd = shift @args ) {
+ $cmd =~ s/-/_/g;
+ if ( my $method = $self->can("cmd_${cmd}") ) {
+ try {
+ $self->$method(@args);
+ }
+ catch {
+ s/\n$//;
+ die
+ sprintf( "\%s at input line \%d\n", $_, $self->_line_no );
+ };
+ }
+ else {
+ die sprintf( "Unknown command: '\%s' at input line \%d\n",
+ $cmd, $self->_line_no );
+ }
+
+ }
+
+ }
+ $self->_clear_for_buffer;
+}
+
+sub filter_line {
+ my ( $self, $line ) = @_;
+
+ # Modes:
+ #
+ # pod = POD mode
+ #
+ # pod:for = buffering text for =for command
+ #
+ # pod:begin = don't print this line, skip next line
+ #
+ # target:* = begin block for something other than readme
+ #
+ # default = code
+ #
+
+ state $blank = qr/^\s*\n$/;
+
+ my $mode = $self->mode;
+
+ if ( $mode eq 'pod:for' ) {
+ if ( $line =~ $blank ) {
+ $self->process_for( $self->_for_buffer );
+ $mode = $self->mode('pod');
+ }
+ else {
+ $self->_append_for_buffer($line);
+ }
+ return 1;
+ }
+ elsif ( $mode eq 'pod:begin' ) {
+
+ unless ( $line =~ $blank ) {
+ die sprintf( "Expected new paragraph after command at line \%d\n",
+ $self->_line_no );
+ }
+
+ $self->mode('pod');
+ return 1;
+ }
+
+ if ( my ($cmd) = ( $line =~ /^=(\w+)\s/ ) ) {
+ $mode = $self->mode( $cmd eq 'cut' ? 'default' : 'pod' );
+
+ if ( $self->in_pod ) {
+
+ if ( $cmd eq 'for' ) {
+
+ $self->mode('pod:for');
+ $self->_for_buffer( substr( $line, 4 ) );
+
+ }
+ elsif ( $cmd eq 'begin' ) {
+
+ my ( $target, @args ) =
+ $self->_parse_arguments( substr( $line, 6 ) );
+
+ if ( $target =~ $self->_target_regex ) {
+
+ if (@args) {
+
+ my $buffer = join( ' ', @args );
+
+ if ( substr( $target, 0, 1 ) eq ':' ) {
+ die sprintf( "Can only target POD at line \%d\n",
+ $self->_line_no + 1 );
+ }
+
+ $self->write_begin( $self->_begin_args($buffer) );
+ }
+
+ $self->mode('pod:begin');
+
+ }
+ else {
+ $self->mode( 'target:' . $target );
+ }
+
+ }
+ elsif ( $cmd eq 'end' ) {
+
+ my ( $target, @args ) =
+ $self->_parse_arguments( substr( $line, 4 ) );
+
+ if ( $target =~ $self->_target_regex ) {
+ my $buffer = $self->_begin_args;
+ if ( $buffer ne '' ) {
+ $self->write_end($buffer);
+ $self->_clear_begin_args;
+ }
+ }
+
+ $self->mode('pod:begin');
+ }
+ }
+
+ }
+
+ $self->write($line) if $self->in_target && $self->in_pod;
+
+ return 1;
+}
+
+sub filter_file {
+ my ($self) = @_;
+
+ foreach
+ my $line ( read_file( $self->input_fh, binmode => $self->encoding ) )
+ {
+ $self->filter_line($line)
+ or last;
+ $self->_inc_line_no;
+ }
+}
+
+sub run {
+ my ($self) = @_;
+ $self->filter_file;
+}
+
+sub cmd_continue {
+ my ($self) = @_;
+ $self->cmd_start;
+}
+
+sub cmd_include {
+ my ( $self, @args ) = @_;
+
+ my $res = $self->parse_cmd_args( [qw/ file type start stop /], @args );
+
+ my $start = $res->{start};
+ $start = qr/${start}/ if $start;
+ my $stop = $res->{stop};
+ $stop = qr/${stop}/ if $stop;
+
+ my $type = $res->{type} // 'pod';
+ unless ( $type =~ /^(?:text|pod)$/ ) {
+ die "Unsupported include type: '${type}'\n";
+ }
+
+ my $file = $res->{file};
+ my $fh = IO::File->new( $file, 'r' )
+ or die "Unable to open file '${file}': $!\n";
+
+ $self->write("\n");
+
+ while ( my $line = <$fh> ) {
+
+ next if ( $start && $line !~ $start );
+ last if ( $stop && $line =~ $stop );
+
+ $start = undef;
+
+ if ( $type eq 'text' ) {
+ $self->write_verbatim($line);
+ }
+ else {
+ $self->write($line);
+ }
+
+ }
+
+ $self->write("\n");
+
+ close $fh;
+
+}
+
+sub cmd_start {
+ my ($self) = @_;
+ $self->_set_in_target(1);
+}
+
+sub cmd_stop {
+ my ($self) = @_;
+ $self->_set_in_target(0);
+}
+
+sub _load_plugin {
+ my ( $self, $plugin ) = @_;
+ try {
+ my $module = "Pod::Readme::Plugin::${plugin}";
+ load $module;
+ require Role::Tiny;
+ Role::Tiny->apply_roles_to_object( $self, $module );
+ }
+ catch {
+ die "Unable to locate plugin '${plugin}'\n";
+ };
+}
+
+sub cmd_plugin {
+ my ( $self, $plugin, @args ) = @_;
+ my $name = "cmd_${plugin}";
+ $self->_load_plugin($plugin) unless $self->can($name);
+ if ( my $method = $self->can($name) ) {
+ $self->$method(@args);
+ }
+}
+
+use namespace::autoclean;
+
+1;
@@ -0,0 +1,172 @@
+package Pod::Readme::Plugin::changes;
+
+use Moo::Role;
+
+{
+ use version 0.77;
+ $Pod::Readme::Plugin::changes::VERSION = version->declare('v1.0.3');
+}
+
+use CPAN::Changes 0.30;
+use Path::Tiny;
+use Types::Standard qw/ Bool Str /;
+
+use Pod::Readme::Types qw/ File HeadingLevel /;
+
+=head1 NAME
+
+Pod::Readme::Plugin::changes - Include latest Changes in README
+
+=head1 SYNOPSIS
+
+ =for readme plugin changes
+
+=head1 DESCRIPTION
+
+This is a plugin for L<Pod::Readme> that includes the latest release
+of a F<Changes> file that conforms to the L<CPAN::Changes::Spec>.
+
+=head1 ARGUMENTS
+
+Defaults can be overridden with optional arguments.
+
+Note that changing arguments may change later calls to this plugin.
+
+=head2 C<file>
+
+ =for readme plugin changes file='Changes'
+
+If the F<Changes> file has a non-standard name or location in the
+distribution, you can specify an alternative name. But note that it
+I<must> conform the the L<CPAN::Changes::Spec>.
+
+=head2 C<heading-level>
+
+ =for readme plugin changes heading-level=1
+
+This changes the heading level. (The default is 1.)
+
+=head2 C<title>
+
+ =for readme plugin changes title='RECENT CHANGES'
+
+This option allows you to change the title of the heading.
+
+=head2 C<verbatim>
+
+ =for readme plugin changes verbatim
+
+If you prefer, you can display a verbatim section of the F<Changes>
+file.
+
+By default, the F<Changes> file will be parsed and reformatted as POD
+(equivalent to the C<no-verbatim> option).
+
+=cut
+
+requires 'parse_cmd_args';
+
+has 'changes_file' => (
+ is => 'rw',
+ isa => File,
+ coerce => sub { File->coerce(@_) },
+ default => 'Changes',
+ lazy => 1,
+);
+
+has 'changes_title' => (
+ is => 'rw',
+ isa => Str,
+ default => 'RECENT CHANGES',
+ lazy => 1,
+);
+
+has 'changes_verbatim' => (
+ is => 'rw',
+ isa => Bool,
+ default => 0,
+ lazy => 1,
+);
+
+has 'changes_heading_level' => (
+ is => 'rw',
+ isa => HeadingLevel,
+ default => 1,
+ lazy => 1,
+);
+
+has 'changes_run' => (
+ is => 'rw',
+ isa => Bool,
+ default => 0,
+ lazy => 1,
+);
+
+around 'depends_on' => sub {
+ my ($orig, $self) = @_;
+ return ($self->changes_file, $self->$orig);
+};
+
+sub cmd_changes {
+ my ( $self, @args ) = @_;
+
+ die "The changes plugin can only be used once" if $self->changes_run;
+
+ my $res = $self->parse_cmd_args(
+ [qw/ file title verbatim no-verbatim heading-level /], @args );
+ foreach my $key ( keys %{$res} ) {
+ ( my $name = "changes_${key}" ) =~ s/-/_/g;
+ if ( my $method = $self->can($name) ) {
+ $self->$method( $res->{$key} );
+ }
+ else {
+ die "Invalid key: '${key}'";
+ }
+ }
+
+ my $file = path( $self->base_dir, $self->changes_file );
+
+ my $changes = CPAN::Changes->load($file);
+ my $latest = ( $changes->releases )[-1];
+
+ my $heading = $self->can( "write_head" . $self->changes_heading_level )
+ or die "Invalid heading level: " . $self->changes_heading_level;
+
+ $self->$heading( $self->changes_title );
+
+ if ( $self->changes_verbatim ) {
+
+ $self->write_verbatim( $latest->serialize );
+
+ }
+ else {
+
+ foreach my $group ( $latest->groups ) {
+
+ $self->write_head2($group)
+ if ( $group ne '' );
+
+ $self->write_over(4);
+ foreach my $items ( $latest->get_group($group)->changes ) {
+ foreach my $item ( @{$items} ) {
+ $self->write_item('* ');
+ $self->write_para($item);
+ }
+ }
+ $self->write_back();
+
+ }
+
+ }
+
+ $self->write_para(
+ sprintf( 'See the F<%s> file for a longer revision history.',
+ $file->basename )
+ );
+
+ $self->changes_run(1);
+}
+
+use namespace::autoclean;
+
+1;
@@ -0,0 +1,213 @@
+package Pod::Readme::Plugin::requires;
+
+use Moo::Role;
+
+{
+ use version 0.77;
+ $Pod::Readme::Plugin::requires::VERSION = version->declare('v1.0.3');
+}
+
+use CPAN::Meta;
+use Module::CoreList;
+use Path::Tiny;
+use Types::Standard qw/ Bool Str /;
+
+use Pod::Readme::Types qw/ File HeadingLevel /;
+
+=head1 NAME
+
+Pod::Readme::Plugin::requires - Include requirements in README
+
+=head1 SYNOPSIS
+
+ =for readme plugin requires
+
+=head1 DESCRIPTION
+
+This is a plugin for L<Pod::Readme> that includes module requirements
+from the F<META.yml> file.
+
+Because this depends on the F<META.yml> file, the F<README> should be
+generated after that file has been updated.
+
+=head1 ARGUMENTS
+
+=head2 C<file>
+
+ =for readme plugin version file='MYMETA.yml'
+
+By default, it will extract the version from the F<META.yml> file. If,
+for some reason, this file is in a non-standard location, then you
+should specify it here.
+
+=head2 C<no-omit-coree>
+
+By default, core modules for the version of Perl specified in the
+F<META.yml> file are omitted from this list. If you prefer to lise
+all requirements, then specify this option.
+
+=head2 C<title>
+
+ =for readme plugin version title='REQUIREMENTS'
+
+This argument allows you to change the title of the heading.
+
+=head1 KNOWN ISSUES
+
+=over
+
+=item *
+
+Trailing zeros in module versions may be dropped.
+
+If you specify a minimum version of a module with a trailing zero,
+e.g. "0.30", then it may be shown as "0.3". A workaround is to
+specify the module version in your F<Makefile.PL> as a string instead
+of number:
+
+ requires(
+ 'CPAN::Changes' => '0.30',
+ ...
+ );
+
+=back
+
+=cut
+
+requires 'parse_cmd_args';
+
+has 'requires_from_file' => (
+ is => 'rw',
+ isa => File,
+ coerce => sub { File->coerce(@_) },
+ default => 'META.yml',
+ lazy => 1,
+);
+
+has 'requires_title' => (
+ is => 'rw',
+ isa => Str,
+ default => 'REQUIREMENTS',
+ lazy => 1,
+);
+
+has 'requires_omit_core' => (
+ is => 'rw',
+ isa => Bool,
+ default => 1,
+ lazy => 1,
+);
+
+has 'requires_heading_level' => (
+ is => 'rw',
+ isa => HeadingLevel,
+ default => 1,
+ lazy => 1,
+);
+
+has 'requires_run' => (
+ is => 'rw',
+ isa => Bool,
+ default => 0,
+ lazy => 1,
+);
+
+around 'depends_on' => sub {
+ my ($orig, $self) = @_;
+ return ($self->requires_from_file, $self->$orig);
+};
+
+sub cmd_requires {
+ my ( $self, @args ) = @_;
+
+ die "The requires plugin can only be used once" if $self->requires_run;
+
+ my $res = $self->parse_cmd_args(
+ [qw/ from-file title omit-core no-omit-core heading-level /], @args );
+ foreach my $key ( keys %{$res} ) {
+ ( my $name = "requires_${key}" ) =~ s/-/_/g;
+ if ( my $method = $self->can($name) ) {
+ $self->$method( $res->{$key} );
+ }
+ else {
+ die "Invalid key: '${key}'";
+ }
+ }
+
+ my $file = path( $self->base_dir, $self->requires_from_file )->stringify;
+ unless ( -e $file ) {
+ die "Cannot find META.yml file at '${file}";
+ }
+
+ my $meta = CPAN::Meta->load_file($file);
+
+ my ( $prereqs, $perl ) = $self->_get_prereqs( $meta, 'requires' );
+ if ( %{$prereqs} ) {
+
+ my $heading = $self->can( "write_head" . $self->requires_heading_level )
+ or die "Invalid heading level: " . $self->requires_heading_level;
+
+ $self->$heading( $self->requires_title );
+
+ if ($perl) {
+ $self->write_para(
+ sprintf( 'This distribution requires Perl %s.',
+ version->parse($perl)->normal )
+ );
+ }
+
+ $self->write_para('This distribution requires the following modules:');
+
+ $self->_write_modules($prereqs);
+
+ my ($recommends) = $self->_get_prereqs( $meta, 'recommends' );
+ if ( %{$recommends} ) {
+
+ $self->write_para(
+ 'This distribution recommends the following modules:');
+
+ $self->_write_modules($recommends);
+
+ }
+
+ }
+
+ $self->requires_run(1);
+}
+
+sub _get_prereqs {
+ my ( $self, $meta, $key ) = @_;
+
+ my %prereqs;
+ foreach my $type ( values %{ $meta->prereqs } ) {
+
+ # TODO: max version
+ $prereqs{$_} = $type->{$key}->{$_} for ( keys %{ $type->{$key} } );
+ }
+ my $perl = delete $prereqs{perl};
+ if ( $self->requires_omit_core && $perl ) {
+ foreach ( keys %prereqs ) {
+ my $ver = $prereqs{$_};
+ delete $prereqs{$_}
+ if Module::CoreList->first_release( $_, $prereqs{$ver} )
+ && version->parse( Module::CoreList->first_release($_) ) <=
+ version->parse($perl);
+ }
+ }
+ return ( \%prereqs, $perl );
+}
+
+sub _write_modules {
+ my ( $self, $prereqs ) = @_;
+ $self->write_over(4);
+ foreach my $module ( sort { lc($a) cmp lc($b) } keys %{$prereqs} ) {
+ my $version = $prereqs->{$module};
+ my $text = $version ? " (version ${version})" : '';
+ $self->write_item( sprintf( '* L<%s>', $module ) . $text );
+ }
+ $self->write_back;
+}
+
+use namespace::autoclean;
+
+1;
@@ -0,0 +1,121 @@
+package Pod::Readme::Plugin::version;
+
+use Moo::Role;
+
+{
+ use version 0.77;
+ $Pod::Readme::Plugin::version::VERSION = version->declare('v1.0.3');
+}
+
+use ExtUtils::MakeMaker;
+use Types::Standard qw/ Bool Str /;
+
+use Pod::Readme::Types qw/ File HeadingLevel /;
+
+=head1 NAME
+
+Pod::Readme::Plugin::version - Include version in README
+
+=head1 SYNOPSIS
+
+ =for readme plugin version
+
+=head1 DESCRIPTION
+
+This is a plugin for L<Pod::Readme> that includes the release version.
+
+=head1 ARGUMENTS
+
+=head2 C<file>
+
+ =for readme plugin version file='lib/My/App.pm'
+
+By default, it will extract the version from the same file that the
+F<README> is being extracted from. If this is a different file, then
+it should be specified.
+
+=head2 C<title>
+
+ =for readme plugin version title='VERSION'
+
+This argument allows you to change the title of the heading.
+
+=cut
+
+requires 'parse_cmd_args';
+
+has 'version_file' => (
+ is => 'rw',
+ isa => File,
+ required => 0,
+ coerce => sub { File->coerce(@_) },
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+ $self->input_file;
+ },
+);
+
+has 'version_title' => (
+ is => 'rw',
+ isa => Str,
+ default => 'VERSION',
+ lazy => 1,
+);
+
+has 'version_heading_level' => (
+ is => 'rw',
+ isa => HeadingLevel,
+ default => 1,
+ lazy => 1,
+);
+
+has 'version_run' => (
+ is => 'rw',
+ isa => Bool,
+ default => 0,
+ lazy => 1,
+);
+
+around 'depends_on' => sub {
+ my ($orig, $self) = @_;
+ return ($self->version_file, $self->$orig);
+};
+
+sub cmd_version {
+ my ( $self, @args ) = @_;
+
+ die "The version plugin can only be used once" if $self->version_run;
+
+ my $res = $self->parse_cmd_args( [qw/ file title heading-level /], @args );
+ foreach my $key ( keys %{$res} ) {
+ ( my $name = "version_${key}" ) =~ s/-/_/g;
+ if ( my $method = $self->can($name) ) {
+ $self->$method( $res->{$key} );
+ }
+ else {
+ die "Invalid key: '${key}'";
+ }
+ }
+
+ if ( my $file = $self->version_file ) {
+
+ my $heading = $self->can( "write_head" . $self->version_heading_level )
+ or die "Invalid heading level: " . $self->version_heading_level;
+
+ $self->$heading( $self->version_title );
+ $self->write_para( MM->parse_version($file) );
+
+ $self->version_run(1);
+
+ }
+ else {
+
+ die "Don't know what file to determine the version from";
+
+ }
+}
+
+use namespace::autoclean;
+
+1;
@@ -0,0 +1,355 @@
+package Pod::Readme::Plugin;
+
+use v5.10.1;
+
+use Moo::Role;
+
+{
+ use version 0.77;
+ $Pod::Readme::Plugin::VERSION = version->declare('v1.0.3');
+}
+
+use Class::Method::Modifiers qw/ fresh /;
+use Hash::Util qw/ lock_keys /;
+use Try::Tiny;
+
+use Pod::Readme::Types qw/ Indentation /;
+
+=head1 NAME
+
+Pod::Readme::Plugin - Plugin role for Pod::Readme
+
+=head1 DESCRIPTION
+
+L<Pod::Readme> v1.0 and later supports plugins that extend the
+capabilities of the module.
+
+=head1 WRITING PLUGINS
+
+Writing plugins is straightforward. Plugins are L<Moo::Role> modules
+in the C<Pod::Readme::Plugin> namespace. For example,
+
+ package Pod::Readme::Plugin::myplugin;
+
+ use Moo::Role;
+
+ sub cmd_myplugin {
+ my ($self, @args) = @_;
+ my $res = $self->parse_cmd_args( [qw/ arg1 arg2 /], @args );
+
+ ...
+ }
+
+When L<Pod::Readme> encounters POD with
+
+ =for readme plugin myplugin arg1 arg2
+
+the plugin role will be loaded, and the C<cmd_myplugin> method will be
+run.
+
+Note that you do not need to specify a C<cmd_myplugin> method.
+
+Any method prefixed with "cmd_" will be a command that can be called
+using the C<=for readme command> syntax.
+
+A plugin parses arguments using the L</parse_cmd_arguments> method and
+writes output using the write methods noted above.
+
+See some of the included plugins, such as
+L<Pod::Readme::Plugin::version> for examples.
+
+Any attributes in the plugin should be prefixed with the name of the
+plugin, to avoid any conflicts with attribute and method names from
+other plugins, e.g.
+
+ use Types::Standard qw/ Int /;
+
+ has 'myplugin_heading_level' => (
+ is => 'rw',
+ isa => Int,
+ default => 1,
+ lazy => 1,
+ );
+
+Attributes should be lazy to ensure that their defaults are properly
+set.
+
+Be aware that changing default values of an attribute based on
+arguments means that the next time a plugin method is run, the
+defaults will be changed.
+
+Custom types in L<Pod::Readme::Types> may be useful for attributes
+when writing plugins, e.g.
+
+ use Pod::Readme::Types qw/ File HeadingLevel /;
+
+ has 'myplugin_file' => (
+ is => 'rw',
+ isa => File,
+ coerce => sub { File->coerce(@_) },
+ default => 'Changes',
+ lazy => 1,
+ );
+
+ # We add this file to the list of dependencies
+
+ around 'depends_on' => sub {
+ my ($orig, $self) = @_;
+ return ($self->myplugin_file, $self->$orig);
+ };
+
+=head1 ATTRIBUTES
+
+=head2 C<verbatim_indent>
+
+The number of columns to indent a verbatim paragraph.
+
+=cut
+
+has verbatim_indent => (
+ is => 'ro',
+ isa => Indentation,
+ default => 2,
+);
+
+=head1 METHODS
+
+=cut
+
+sub _parse_arguments {
+ my ( $self, $line ) = @_;
+ my @args = ();
+
+ my $i = 0;
+ my $prev;
+ my $in_quote = '';
+ my $arg_buff = '';
+ while ( $i < length($line) ) {
+
+ my $curr = substr( $line, $i, 1 );
+ if ( $curr !~ m/\s/ || $in_quote ) {
+ $arg_buff .= $curr;
+ if ( $curr =~ /["']/ && $prev ne "\\" ) {
+ $in_quote = ( $curr eq $in_quote ) ? '' : $curr;
+ }
+ }
+ elsif ( $arg_buff ne '' ) {
+ push @args, $arg_buff;
+ $arg_buff = '';
+ }
+ $prev = $curr;
+ $i++;
+ }
+
+ if ( $arg_buff ne '' ) {
+ push @args, $arg_buff;
+ }
+
+ return @args;
+}
+
+=head2 C<parse_cmd_args>
+
+ my $hash_ref = $self->parse_cmd_args( \@allowed_keys, @args);
+
+This command parses arguments for a plugin and returns a hash
+reference containing the argument values.
+
+The C<@args> parameter is a list of arguments passed to the command
+method by L<Pod::Readme::Filter>.
+
+If an argument contains an equals sign, then it is assumed to take a
+string. (Strings containing whitespace should be surrounded by
+quotes.)
+
+Otherwise, an argument is assumed to be boolean, which defaults to
+true. If the argument is prefixed by "no-" or "no_" then it is given a
+false value.
+
+If the C<@allowed_keys> parameter is given, then it will reject
+argument keys that are not in that list.
+
+For example,
+
+ my $res = $self->parse_cmd_args(
+ undef,
+ 'arg1',
+ 'no-arg2',
+ 'arg3="This is a string"',
+ 'arg4=value',
+ );
+
+will return a hash reference containing
+
+ {
+ arg1 => 1,
+ arg2 => 0,
+ arg3 => 'This is a string',
+ arg4 => 'value',
+ }
+
+=cut
+
+sub parse_cmd_args {
+ my ( $self, $allowed, @args ) = @_;
+
+ my ( $key, $val, %res );
+ while ( my $arg = shift @args ) {
+
+ state $eq = qr/=/;
+
+ if ( $arg =~ $eq ) {
+ ( $key, $val ) = split $eq, $arg;
+
+ # TODO - better way to remove surrounding quotes
+ if ( ( $val =~ /^(['"])(.*)(['"])$/ ) && ( $1 eq $3 ) ) {
+ $val = $2 // '';
+ }
+
+ }
+ else {
+ $val = 1;
+ if ( ($key) = ( $arg =~ /^no[_-](\w+(?:[-_]\w+)*)$/ ) ) {
+ $val = 0;
+ }
+ else {
+ $key = $arg;
+ }
+ }
+
+ $res{$key} = $val;
+ }
+
+ if ($allowed) {
+ try {
+ lock_keys( %res, @{$allowed} );
+ }
+ catch {
+ if (/Hash has key '(.+)' which is not in the new key set/) {
+ die sprintf( "Invalid argument key '\%s'\n", $1 );
+ }
+ else {
+ die "Unknown error checking argument keys\n";
+ }
+ };
+ }
+
+ return \%res;
+}
+
+=head2 C<write_verbatim>
+
+ $self->write_verbatim($text);
+
+A utility method to write verbatim text, indented by
+L</verbatim_indent>.
+
+=cut
+
+sub write_verbatim {
+ my ( $self, $text ) = @_;
+
+ my $indent = ' ' x ( $self->verbatim_indent );
+ $text =~ s/^/${indent}/mg;
+ $text =~ s/([^\n])\n?$/$1\n\n/;
+
+ $self->write($text);
+}
+
+=begin :internal
+
+=head2 C<_write_cmd>
+
+ $self->_write_cmd('=head1 SECTION');
+
+An internal utility method to write a command line.
+
+=end :internal
+
+=cut
+
+sub _write_cmd {
+ my ( $self, $text ) = @_;
+ $text =~ s/([^\n])\n?$/$1\n\n/;
+
+ $self->write($text);
+}
+
+=head2 C<write_para>
+
+ $self->write_para('This is a paragraph');
+
+Utility method to write a POD paragraph.
+
+=cut
+
+sub write_para {
+ my ( $self, $text ) = @_;
+ $text //= '';
+ $self->write( $text . "\n\n" );
+}
+
+=head2 C<write_head1>
+
+=head2 C<write_head2>
+
+=head2 C<write_head3>
+
+=head2 C<write_head4>
+
+=head2 C<write_over>
+
+=head2 C<write_item>
+
+=head2 C<write_back>
+
+=head2 C<write_begin>
+
+=head2 C<write_end>
+
+=head2 C<write_for>
+
+=head2 C<write_encoding>
+
+=head2 C<write_cut>
+
+=head2 C<write_pod>
+
+ $self->write_head1($text);
+
+Utility methods to write POD specific commands to the C<output_file>.
+
+These methods ensure the POD commands have extra newlines for
+compatability with older POD parsers.
+
+=cut
+
+{
+ foreach my $cmd (
+ qw/ head1 head2 head3 head4
+ over item begin end for encoding /
+ )
+ {
+ fresh(
+ "write_${cmd}" => sub {
+ my ( $self, $text ) = @_;
+ $text //= '';
+ $self->_write_cmd( '=' . $cmd . ' ' . $text );
+ }
+ );
+ }
+
+ foreach my $cmd (qw/ pod back cut /) {
+ fresh(
+ "write_${cmd}" => sub {
+ my ($self) = @_;
+ $self->_write_cmd( '=' . $cmd );
+ }
+ );
+ }
+
+}
+
+use namespace::autoclean;
+
+1;
@@ -0,0 +1,177 @@
+package Pod::Readme::Types;
+
+use v5.10.1;
+
+use feature 'state';
+
+use strict;
+use warnings;
+
+{
+ use version 0.77;
+ $Pod::Readme::Types::VERSION = version->declare('v1.0.3');
+}
+
+use Exporter qw/ import /;
+use IO qw/ Handle /;
+use Path::Tiny;
+use Scalar::Util qw/ blessed /;
+use Type::Tiny;
+use Types::Standard qw/ FileHandle Str /;
+
+our @EXPORT_OK =
+ qw/ Dir File Indentation IO ReadIO WriteIO HeadingLevel TargetName /;
+
+=head1 NAME
+
+Pod::Readme::Types - Types used by Pod::Readme
+
+=head1 SYNOPSIS
+
+ use Pod::Readme::Types qw/ Indentation /;
+
+ has verbatim_indent => (
+ is => 'ro',
+ isa => Indentation,
+ default => 2,
+ );
+
+=head1 DESCRIPTION
+
+This module provides types for use with the modules in L<Pod::Readme>.
+
+It is intended for internal use, although some of these may be useful
+for writing plugins (see L<Pod::Readme::Plugin>).
+
+=head1 EXPORTS
+
+None by default. All functions must be explicitly exported.
+
+=head2 C<Indentation>
+
+The indentation level used for verbatim text. Must be an integer
+greater than or equal to 2.
+
+=cut
+
+sub Indentation {
+ state $type = Type::Tiny->new(
+ name => 'Indentation',
+ constraint => sub { $_ =~ /^\d+$/ && $_ >= 2 },
+ message => sub { 'must be an integer >= 2' },
+ );
+ return $type;
+}
+
+=head2 C<HeadingLevel>
+
+A heading level, used for plugin headings.
+
+Must be either 1, 2 or 3. (Note that C<=head4> is not allowed, since
+some plugins use subheadings.)
+
+=cut
+
+sub HeadingLevel {
+ state $type = Type::Tiny->new(
+ name => 'HeadingLevel',
+ constraint => sub { $_ =~ /^[123]$/ },
+ message => sub { 'must be an integer between 1 and 3' },
+ );
+ return $type;
+}
+
+=head2 C<TargetName>
+
+A name of a target, e.g. "readme".
+
+=cut
+
+sub TargetName {
+ state $type = Type::Tiny->new(
+ name => 'TargetName',
+ constraint => sub { $_ =~ /^\w+$/ },
+ message => sub { 'must be an alphanumeric string' },
+ );
+ return $type;
+}
+
+=head2 C<Dir>
+
+A directory. Can be a string or L<Path::Tiny> object.
+
+=cut
+
+sub Dir {
+ state $type = Type::Tiny->new(
+ name => 'Dir',
+ constraint => sub {
+ blessed($_)
+ && $_->isa('Path::Tiny')
+ && -d $_;
+ },
+ message => sub { "$_ must be be a directory" },
+ );
+ return $type->plus_coercions( Str, sub { path($_) }, );
+}
+
+=head2 C<File>
+
+A file. Can be a string or L<Path::Tiny> object.
+
+=cut
+
+sub File {
+ state $type = Type::Tiny->new(
+ name => 'File',
+ constraint => sub {
+ blessed($_)
+ && $_->isa('Path::Tiny');
+ },
+ message => sub { "$_ must be be a file" },
+ );
+ return $type->plus_coercions( Str, sub { path($_) }, );
+}
+
+=head2 C<IO>
+
+An L<IO::Handle> or L<IO::String> object.
+
+=cut
+
+sub IO {
+ state $type = Type::Tiny->new(
+ name => 'IO',
+ constraint => sub {
+ blessed($_)
+ && ( $_->isa('IO::Handle') || $_->isa('IO::String') );
+ },
+ message => sub { 'must be be an IO::Handle or IO::String' },
+ );
+ return $type;
+}
+
+=head2 C<ReadIO>
+
+=head2 C<WriteIO>
+
+L</IO> types, which coerce filehandles to read/write L<IO:Handles>,
+respectively.
+
+=cut
+
+sub ReadIO {
+ state $type = IO->plus_coercions( #
+ FileHandle, sub { IO::Handle->new_from_fd( $_, 'r' ) },
+ );
+ return $type;
+}
+
+sub WriteIO {
+ state $type = IO->plus_coercions( #
+ FileHandle, sub { IO::Handle->new_from_fd( $_, 'w' ) },
+ );
+ return $type;
+}
+
+1;
@@ -1,541 +1,521 @@
+package Pod::Readme;
+
=head1 NAME
-Pod::Readme - Convert POD to README file
+Pod::Readme - Intelligently generate a README file from POD
-=begin readme
+=for readme plugin version
-=head1 REQUIREMENTS
+=head1 SYNOPSIS
-This module should run on Perl 5.005 or newer. The following non-core
-modules (depending on your Perl version) are required:
+In a module's POD:
- Pod::PlainText
- Test::More
+ =head1 NAME
-=head1 INSTALLATION
+ MyApp - my nifty app
-Installation can be done using the traditional Makefile.PL or the newer
-Build.PL methods.
+ =for readme plugin version
-Using Makefile.PL:
+ =head1 DESCRIPTION
- perl Makefile.PL
- make test
- make install
+ This is a nifty app.
-(On Windows platforms you should use C<nmake> instead.)
+ =begin :readme
-Using Build.PL (if you have Module::Build installed):
+ =for readme plugin requires
- perl Build.PL
- perl Build test
- perl Build install
+ =head1 INSTALLATION
-=end readme
+ ...
-=head1 SYNOPSIS
+ =end :readme
- use Pod::Readme;
- my $parser = Pod::Readme->new();
+ =for readme stop
- # Read POD from STDIN and write to STDOUT
- $parser->parse_from_filehandle;
+ =head1 METHODS
- # Read POD from Module.pm and write to README
- $parser->parse_from_file('Module.pm', 'README');
+ ...
-=cut
+Then from the command-line:
-package Pod::Readme;
+ pod2readme lib/MyModule.pm README
-use 5.005;
-use strict;
+=for readme stop
-use Carp;
-use IO::File;
-use Pod::PlainText;
-use Regexp::Common qw( URI );
+From within Perl:
-use vars qw( @ISA $VERSION );
+ use Pod::Readme;
-@ISA = qw( Pod::PlainText );
+ my $prf = Pod::Readme->new(
+ input_file => 'lib/MyModule.pm',
+ translate_to_file => $dest,
+ translation_class => 'Pod::Simple::Text',
+ );
-$VERSION = '0.11';
+ $prf->run();
-=begin internal
+=for readme start
-=over 12
+=head1 DESCRIPTION
-=item initialize
+This module filters POD to generate a F<README> file, by using POD
+commands to specify which parts are included or excluded from the
+F<README> file.
-Override adds the C<readme_type> and <debug> options, and initializes
-the "README_SKIP" flag.
+=begin :readme
-=back
+See the L<Pod::Readme> documentation for more details on the POD
+syntax that this module recognizes.
-=end internal
+See L<pod2readme> for command-line usage.
-=cut
-
-{
- my %INVALID_TYPES = map { $_ => 1, } (qw(
- test testing tests
- html xhtml xml docbook rtf man nroff dsr rno latex tex code
- ));
+=head1 INSTALLATION
- sub initialize {
- my $self = shift;
+See
+L<How to install CPAN modules|http://www.cpan.org/modules/INSTALL.html>.
- $$self{README_SKIP} ||= 0;
- $$self{readme_type} ||= "readme";
+=for readme plugin requires heading-level=2 title="Required Modules"
- $$self{debug} ||= 0;
+=for readme plugin changes
- $self->SUPER::initialize;
+=end :readme
- croak "$$self{readme_type} is an invalid readme_type",
- if ($INVALID_TYPES{ $$self{readme_type} });
- }
-}
+=for readme stop
-=begin internal
+=head1 POD COMMANDS
-=over 12
+=head2 C<=for readme stop>
-=item output
+Stop including the POD that follows in the F<README>.
-Override does not output anything if the "README_SKIP" flag is enabled.
+=head2 C<=for readme start>
-=back
+=head2 C<=for readme continue>
-=end internal
+Start (or continue to) include the POD that follows in the F<README>.
-=cut
+Note that the C<start> command was added as a synonym in version
+1.0.0.
-sub output {
- my $self = shift;
- return if $$self{README_SKIP};
- $self->SUPER::output(@_);
-}
+=head2 C<=for readme include>
+ =for readme include file="INSTALL" type="text"
-=begin internal
+Include a text or POD file in the F<README>. It accepts the following
+options:
=over
-=item _parse_args
+=item C<file>
-Parses destination and name="value" arguments passed for L</cmd_for>.
+Required. This is the file name to include.
+
+=item C<type>
+
+Can be "text" or "pod" (default).
+
+=item C<start>
+
+An optional regex of where to start including the file.
+
+=item C<stop>
+
+An optional regex of where to stop including the file.
=back
-=end internal
+=head2 C<=for readme plugin>
-=cut
+Loads a plugin, e.g.
-sub _parse_args {
- my $self = shift;
- my $string = shift;
- my @values = ( );
-
- my $arg = "";
- my $in_quote = 0;
- my $last;
- foreach (split //, $string) {
- if (/\s/) {
- if ($in_quote) {
- $arg .= $_;
- }
- else {
- if ($arg ne "") {
- push @values, $arg;
- $arg = "";
- }
- }
- }
- else {
- $arg .= $_;
- if (/\"/) {
- if ($in_quote) {
- $in_quote = 0 unless ($last eq "\\");
- }
- else {
- # croak "expected \"name=\" before quotes" unless ($last eq "=");
- $in_quote = 1;
- }
- }
- }
- $last = $_;
- }
- push @values, $arg if ($arg ne "");
- return @values;
-}
+ =for readme plugin version
+Note that specific plugins may add options, e.g.
+ =for readme plugin changes title='CHANGES'
-=begin internal
+See L<Pod::Readme::Plugin> for more information.
-=over
+Note that the C<plugin> command was added in version 1.0.0.
-=item cmd_begin
+=head2 C<=begin :readme>
-Overrides support for "begin" command.
+=head2 C<=end :readme>
-=back
+Specify a block of POD to include only in the F<README>.
-=end internal
+You can also specify a block in another format:
-=cut
+ =begin readme text
-sub cmd_begin {
- my $self = shift;
- my $sec = $$self{readme_type} || "readme";
- my @fmt = $self->_parse_args($_[0]);
- my %secs = map { $_ => 1, } split /,/, $fmt[0];
- if ($secs{$sec}) {
- $$self{README_SKIP} = 0;
- if (($fmt[1]||"pod") eq "pod") {
- }
- elsif ($fmt[1] eq "text") {
- $$self{VERBATIM} = 1;
- }
- else {
- # TODO - return error
- $$self{EXCLUDE} = 1;
- }
- }
- else {
- carp "Ignoring document type(s) \"$fmt[0]\" in POD line $_[1]"
- if ($$self{debug});
- $self->SUPER::cmd_begin(@_);
- }
-}
+ ...
+ =end readme text
-=begin internal
+This will be translated into
-=over
+ =begin text
-=item cmd_for
+ ...
-Overrides support for "for" command.
+ =end text
-=back
+and will only be included in F<README> files of that format.
+
+Note: earlier versions of this module suggested using
-=end internal
+ =begin readme
+
+ ...
+
+ =end readme
+
+While this version supports that syntax for backwards compatability,
+it is not standard POD.
=cut
-sub cmd_for {
- my $self = shift;
- my $sec = $$self{readme_type} || "readme";
- my @fmt = $self->_parse_args($_[0]);
- my %secs = map { $_ => 1, } split /,/, $fmt[0];
- if ($secs{$sec}) {
- my $cmd = $fmt[1] || "continue";
- if ($cmd eq "stop") {
- $$self{README_SKIP} = 1;
- } elsif ($cmd eq "continue") {
- $$self{README_SKIP} = 0;
- } elsif ($cmd eq "include") {
-
- my %arg = map {
- s/\"//g;
- my ($k,$v) = split /\=/;
- $k => $v;
- } @fmt[2..$#fmt];
- $arg{type} ||= "pod";
-
- my $text =
- $self->_include_file( map { $arg{$_} } (qw( type file start stop )) );
- if ($arg{type} eq "text") {
- $self->verbatim($text, $_[1], $_[2]);
- } else {
- $self->textblock($text, $_[1], $_[2]);
- }
- } else {
- croak "Don\'t know how to \"$cmd\" in POD line $_[1]";
- }
- }
- else {
- carp "Ignoring document type(s) \"$fmt[0]\" in POD line $_[1]"
- if ($$self{debug});
- $self->SUPER::cmd_for(@_);
- }
+use v5.10.1;
+
+use Moo;
+extends 'Pod::Readme::Filter';
+
+{
+ use version 0.77;
+ $Pod::Readme::VERSION = version->declare('v1.0.3');
}
-=begin internal
+use Carp;
+use IO qw/ File Handle /;
+use List::Util qw/ any /;
+use Module::Load qw/ load /;
+use Path::Tiny qw/ path tempfile /;
+use Types::Standard qw/ Bool Maybe Str /;
-=over
+use Pod::Readme::Types qw/ File WriteIO /;
-=item cmd_encoding
+=head1 ATTRIBUTES
-Handle =encoding directive.
+This module extends L<Pod::Readme::Filter> with the following
+attributes:
-TODO: actually change the encoding of the output file.
+=head2 C<translation_class>
-=back
+The class used to translate the filtered POD into another format,
+e.g. L<Pod::Simple::Text>.
+
+If it is C<undef>, then there is no translation.
+
+Only subclasses of L<Pod::Simple> are supported.
+
+=cut
+
+has translation_class => (
+ is => 'ro',
+ isa => Maybe [Str],
+ default => undef,
+);
-=end internal
+=head2 C<translate_to_fh>
+
+The L<IO::Handle> to save the translated file to.
=cut
-sub cmd_encoding {
- my $self = shift;
- my $encoding = (split /\s+/, shift)[0];
- if ($self->{_encoding}) {
- die "=encoding option must occur only once!";
+has translate_to_fh => (
+ is => 'ro',
+ isa => WriteIO,
+ lazy => 1,
+ builder => '_build_translate_to_fh',
+ coerce => sub { WriteIO->coerce(@_) },
+);
+
+sub _build_translate_to_fh {
+ my ($self) = @_;
+ if ( $self->translate_to_file ) {
+ $self->translate_to_file->openw;
+ }
+ else {
+ my $fh = IO::Handle->new;
+ if ( $fh->fdopen( fileno(STDOUT), 'w' ) ) {
+ return $fh;
+ }
+ else {
+ croak "Cannot get a filehandle for STDOUT";
+ }
}
- $self->{_encoding} = $encoding;
- # TODO: Need to actually do something with this option
- # At least recognising it and not dying is a step in the right direction.
}
-=begin internal
+=head2 C<translate_to_file>
-=over
+The L<Path::Tiny> filename to save the translated file to. If omitted,
+then it will be saved to C<STDOUT>.
-=item _include_file
+=cut
-Includes a file.
+has translate_to_file => (
+ is => 'ro',
+ isa => File,
+ coerce => sub { File->coerce(@_) },
+ lazy => 1,
+ builder => 'default_readme_file',
+);
-=back
+=head2 C<output_file>
-=end internal
+The L<Pod::Readme::Filter> C<output_file> will default to a temporary
+file.
=cut
-sub _include_file {
- my $self = shift;
- my $type = shift || "pod";
- my $file = shift;
- my $mark = shift || "";
- my $stop = shift || "";
-
- my $fh = IO::File->new("<$file")
- || croak "Unable to open file \"$file\"";
-
- my $buffer = "";
- while (my $line = <$fh>) {
- next if (($mark ne "") && ($line !~ /$mark/));
- $mark = "" if ($mark ne "");
- last if (($stop ne "") && ($line =~ /$stop/));
- $buffer .= $line;
- }
- close $fh;
-
- if ($type ne "pod") {
- my $indent = " " x $$self{MARGIN};
- $buffer =~ s/([\r\n]+)(\t)?/$1 . $indent x (1+length($2||""))/ge;
- $buffer =~ s/($indent)+$//;
- }
-
- return $buffer;
-}
+has '+output_file' => (
+ lazy => 1,
+ default => sub { tempfile( SUFFIX => '.pod', UNLINK => 1 ); },
+);
+around '_build_output_fh' => sub {
+ my ( $orig, $self ) = @_;
+ if ( defined $self->translation_class ) {
+ $self->$orig();
+ }
+ else {
+ $self->translate_to_fh;
+ }
+};
-=begin internal
+=head2 C<force>
-=over
+For a new F<README> to be generated, even if the dependencies have not
+been updated.
-=item seq_l
+See L</dependencies_updated>.
-Overrides support for "L" markup.
+=cut
-=back
+has 'force' => (
+ is => 'ro',
+ isa => Bool,
+ default => 0,
+);
+
+=head1 METHODS
+
+This module extends L<Pod::Readme::Filter> with the following methods:
-=end internal
+=head2 C<default_readme_file>
+
+The default name of the F<README> file, which depends on the
+L</translation_class>.
=cut
-# This code is based on code from Pod::PlainText 2.02
-
-sub seq_l {
- my $self = shift;
- local $_ = shift;
- # Smash whitespace in case we were split across multiple lines.
- s/\s+/ /g;
-
- # If we were given any explicit text, just output it.
- if (/^([^|]+)\|/) { return $1 }
-
- # Okay, leading and trailing whitespace isn't important; get rid of it.
- s/^\s+//;
- s/\s+$//;
-
- # Default to using the whole content of the link entry as a section
- # name. Note that L<manpage/> forces a manpage interpretation, as does
- # something looking like L<manpage(section)>. The latter is an
- # enhancement over the original Pod::Text.
-
-
- my ($manpage, $section) = ('', $_);
- if (/$RE{URI}/ || /^(?:https?|ftps?|svn):/) {
- # a URL
- return $_;
- } elsif (/^"\s*(.*?)\s*"$/) {
- $section = '"' . $1 . '"';
- } elsif (m/^[-:.\w]+(?:\(\S+\))?$/) {
- ($manpage, $section) = ($_, '');
- } elsif (m%/%) {
- ($manpage, $section) = split (/\s*\/\s*/, $_, 2);
+sub default_readme_file {
+ my ($self) = @_;
+
+ my $name = uc( $self->target );
+
+ state $extensions = {
+ 'Pod::Man' => '.1',
+ 'Pod::Markdown' => '.md',
+ 'Pod::Simple::HTML' => '.html',
+ 'Pod::Simple::LaTeX' => '.tex',
+ 'Pod::Simple::RTF' => '.rtf',
+ 'Pod::Simple::Text' => '',
+ 'Pod::Simple::XHTML' => '.xhtml',
+ };
+
+ my $class = $self->translation_class;
+ if ( defined $class ) {
+ if ( my $ext = $extensions->{$class} ) {
+ $name .= $ext;
+ }
}
-
- if (length $manpage) {
- return $manpage;
- } else {
- return $section;
+ else {
+ $name .= '.pod';
}
-}
-=head1 DESCRIPTION
+ path( $self->base_dir, $name );
+}
-This module is a subclass of L<Pod::PlainText> which provides additional
-POD markup for generating F<README> files.
+=head2 C<translate_file>
-Why should one bother with this? One can simply use
+This method runs translates the resulting POD from C<filter_file>.
- pod2text Module.pm > README
+=cut
-A problem with doing that is that the default L<pod2text> converter will
-add text to links, so that "LZ<><Module>" is translated to
-"the Module manpage".
+sub translate_file {
+ my ($self) = @_;
-Another problem is that the F<README> includes the entirety of
-the module documentation! Most people browsing the F<README> file do not
-need all of this information.
+ if ( my $class = $self->translation_class ) {
-Likewise, including installation and requirement information in the
-module documentation is not necessary either, since the module is already
-installed.
+ load $class;
+ my $converter = $class->new()
+ or croak "Cannot instantiate a ${class} object";
-This module allows authors to mark portions of the POD to be included only
-in, or to be excluded from the F<README> file. It also allows you to
-include portions of another file (such as a separate F<ChangeLog>).
+ if ( $converter->isa('Pod::Simple') ) {
-=begin readme
+ my $tmp_file = $self->output_file->stringify;
-See the module documentation for more details.
+ close $self->output_fh
+ or croak "Unable to close file ${tmp_file}";
-=end readme
+ $converter->output_fh( $self->translate_to_fh );
+ $converter->parse_file($tmp_file);
-=for readme stop
+ }
+ else {
-=head2 Markup
+ croak "Don't know how to translate POD using ${class}";
-Special POD markup options are described below:
+ }
-=over
+ }
+}
-=item begin/end
+=head2 C<dependencies_updated>
- =begin readme
+Used to determine when the dependencies have been updated, and a
+translation can be run.
- =head1 README ONLY
+Note that this only returns a meaningful value after the POD has been
+processed, since plugins may add to the dependencies. A side-effect
+of this is that when generating a POD formatted F<README> is that it
+will always be updated, even when L</force> is false.
- This section will only show up in the README file.
+=cut
- =end readme
+sub dependencies_updated {
+ my ($self) = @_;
-Delineates a POD section that is only available in README file. If
-you prefer to include plain text instead, add the C<text> modifier:
+ my $dest = $self->translate_to_file;
- =begin readme text
+ if ( $dest and $self->input_file) {
- README ONLY (PLAINTEXT)
+ return 1 unless -e $dest;
- This section will only show up in the README file.
+ my $stat = $dest->stat;
+ return 1 unless $stat;
- =end readme
+ my $time = $stat->mtime;
+ return any { $_->mtime > $time } ( map { $_->stat } $self->depends_on );
-Note that placing a colon before the section to indicate that it is
-POD (e.g. C<begin :readme>) is not supported in this version.
+ }
+ else {
+ return 1;
+ }
+}
-=item stop/continue
+=head2 C<run>
- =for readme stop
+This method runs C<filter_file> and then L</translate_file>.
-All POD that follows will not be included in the README, until
-a C<continue> command occurs:
+=cut
- =for readme continue
+around 'run' => sub {
+ my ( $orig, $self ) = @_;
+ $self->$orig();
+ if ( $self->force or $self->dependencies_updated ) {
+ $self->translate_file();
+ }
+};
-=item include
+=head2 C<parse_from_file>
- =for readme include file=filename type=type start=Regexp stop=Regexp
+ my $parser = Pod::Readme->new();
+ $parser->parse_from_file( 'README.pod', 'README' );
- =for readme include file=Changes start=^0.09 stop=^0.081 type=text
+ Pod::Readme->parse_from_file( 'README.pod', 'README' );
-Includes a plaintext file named F<filename>, starting with the line
-that contains the start C<Regexp> and ending at the line that begins
-with the stop C<Regexp>. (The start and stop Regexps are optional: one
-or both may be omitted.)
+This is a class method that acts as a L<Pod::Select> compatability
+shim for software that is designed for versions of L<Pod::Readme>
+prior to v1.0.
-Type may be C<text> or C<pod>. If omitted, C<pod> will be assumed.
+Its use is deprecated, and will be deleted in later versions.
-Quotes may be used when the filename or marks contains spaces:
+=cut
- =for readme include file="another file.pod"
+sub parse_from_file {
+ my ( $self, $source, $dest ) = @_;
+
+ my $class = ref($self) || __PACKAGE__;
+ my $prf = $class->new(
+ input_file => $source,
+ translate_to_file => $dest,
+ translation_class => 'Pod::Simple::Text',
+ force => 1,
+ );
+ $prf->run();
+}
-=back
+=head2 C<parse_from_filehandle>
-One can also using maintain multiple file types (such as including F<TODO>,
-or F<COPYING>) by using a modified constructor:
+Like L</parse_from_file>, this exists as a compatability shim.
- $parser = Pod::Readme->new( readme_type => "copying" );
+Its use is deprecated, and will be deleted in later versions.
-In the above L</Markup> commands replace "readme" with the tag specified
-instead (such as "copying"):
+=cut
- =begin copying
+sub parse_from_filehandle {
+ my ( $self, $source_fh, $dest_fh ) = @_;
-As of version 0.03 you can specify multiple sections by separating them
-with a comma:
+ my $class = ref($self) || __PACKAGE__;
- =begin copying,readme
+ my $src_io =
+ IO::Handle->new_from_fd( ( defined $source_fh ) ? fileno($source_fh) : 0,
+ 'r' );
-There is also no standard list of type names. Some names might be recognized
-by other POD processors (such as "testing" or "html"). L<Pod::Readme> will
-reject the following "known" type names when they are specified in the
-constructor:
+ my $dest_io =
+ IO::Handle->new_from_fd( ( defined $dest_fh ) ? fileno($dest_fh) : 1,
+ 'w' );
- testing html xhtml xml docbook rtf man nroff dsr rno latex tex code
+ my $prf = $class->new(
+ input_fh => $src_io,
+ translate_to_fh => $dest_io,
+ translation_class => 'Pod::Simple::Text',
+ force => 1,
+ );
+ $prf->run();
+}
-You can also use a "debug" mode to diagnose any problems, such as mistyped
-format names:
+use namespace::autoclean;
- $parser = Pod::Readme->new( debug => 1 );
+1;
-Warnings will be issued for any ignored formatting commands.
+=for readme start
-=head2 Example
+=head1 CAVEATS
-For an example, see the F<Readme.pm> file in this distribution.
+This module is intended to be used by module authors for their own
+modules. It is not recommended for generating F<README> files from
+arbitrary Perl modules from untrusted sources.
=head1 SEE ALSO
See L<perlpod>, L<perlpodspec> and L<podlators>.
-=head1 AUTHOR
+=head1 AUTHORS
-Originally by Robert Rothenberg <rrwo at cpan.org>
+The original version was by Robert Rothenberg <rrwo@cpan.org> until
+2010, when maintenance was taken over by David Precious
+<davidp@preshweb.co.uk>.
-Now maintained by David Precious <davidp@preshweb.co.uk>
+In 2014, Robert Rothenberg rewrote the module to use filtering instead
+of subclassing a POD parser.
+=head2 Acknowledgements
-=head2 Suggestions, Bug Reporting and Contributing
+Thanks to people who gave feedback and suggestions to posts about the
+rewrite of this module on L<http://blogs.perl.org>.
-This module is developed on GitHub at:
-
-http://github.com/bigpresh/Pod-Readme
+=head2 Suggestions, Bug Reporting and Contributing
+This module is developed on GitHub at
+L<http://github.com/bigpresh/Pod-Readme>
=head1 LICENSE
-Copyright (c) 2005,2006 Robert Rothenberg. All rights reserved.
+Copyright (c) 2005-2014 Robert Rothenberg. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
-Some portions are based on L<Pod::PlainText> 2.02.
-
=cut
@@ -1,126 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-
-use Test::More;
-
-my %L_ARGS = (
- 'http://www.example.com/' => undef,
- 'https://www.example.com/' => undef,
- 'http://www.example.com/some/page?query=foo&bar=baz' => undef,
- 'ftp://ftp.example.com/some/file' => undef,
- # 'news://news.example.com/group.name' => undef,
- 'svn://svn.cpan.org/foo/bar' => undef,
- 'Some::Module' => undef,
- 'Some::Module/section' => 'Some::Module',
- 'Module' => undef,
- 'Module/section' => 'Module',
- '/Section' => 'Section',
- 'Text|Module' => 'Text',
- 'Text|Module/section' => 'Text',
- 'Text|http://www.cpan.org/' => 'Text',
- 'Text|ftp://www.cpan.org/' => 'Text',
- 'Text|news://www.cpan.org/' => 'Text',
-);
-
-my @TYPES = qw( readme copying install hacking todo license );
-my @INVALID = qw(
- test tests testing
- html xhtml xml docbook rtf man nroff dsr rno latex tex code
-);
-
-# These are methods supported by Pod::Text but not Pod::PlainText
-
-my @METHODS = qw( cmd_head3 cmd_head4 );
-
-plan tests => 2 + (19 * scalar(@TYPES)) + scalar(keys %L_ARGS) +
- (2 * scalar(@INVALID)) +
- (1 * scalar(@METHODS));
-
-use_ok("Pod::Readme", 0.06);
-
-foreach my $type (@INVALID) {
- my $p;
- $@ = undef;
- eval { $p = Pod::Readme->new( readme_type => $type ); };
- ok($@, "new $type failed");
- ok(!defined $p, "undefined invalid type");
-}
-
-# TODO - test other document types than "readme"
-
-foreach my $type (@TYPES) {
- my $p = Pod::Readme->new( readme_type => $type );
- ok(defined $p, "new $type");
-
- ok($p->{readme_type} eq $type, "readme_type");
- ok(!$p->{README_SKIP}, "README_SKIP");
-
- # TODO - test output method
-
- $p->cmd_for("$type stop");
- ok($p->{README_SKIP}, "$type stop");
- $p->cmd_for("$type continue");
- ok(!$p->{README_SKIP}, "$type continue");
-
- $p->cmd_for("$type stop");
- ok($p->{README_SKIP}, "$type stop");
- $p->cmd_for("$type");
- ok(!$p->{README_SKIP}, "$type");
-
- $p->cmd_for("$type stop");
- ok($p->{README_SKIP}, "$type stop");
- $p->cmd_begin("$type");
- ok(!$p->{README_SKIP}, "begin $type");
- $p->cmd_end("$type");
-
- $p->cmd_for("foobar stop");
- ok(!$p->{README_SKIP}, "foobar stop");
- $p->cmd_for("foobar continue");
- ok(!$p->{README_SKIP}, "foobar continue");
- $p->cmd_for("foobar stop");
- ok(!$p->{README_SKIP}, "foobar stop");
- $p->cmd_for("foobar");
- ok(!$p->{README_SKIP}, "foobar");
-
- $p->cmd_for("$type,foobar stop");
- ok($p->{README_SKIP}, "$type,foobar stop");
- $p->cmd_for("$type,foobar continue");
- ok(!$p->{README_SKIP}, "$type,foobar continue");
-
- $p->cmd_for("$type,foobar stop");
- ok($p->{README_SKIP}, "$type,foobar stop");
- $p->cmd_for("$type,foobar");
- ok(!$p->{README_SKIP}, "$type,foobar");
-
- $p->cmd_for("$type,foobar stop");
- ok($p->{README_SKIP}, "$type,foobar stop");
- $p->cmd_begin("$type,foobar");
- ok(!$p->{README_SKIP}, "begin $type,foobar");
- $p->cmd_end("$type,foobar");
-
-}
-
-# TODO - test for readme include
-
-{
- my $p = Pod::Readme->new();
- ok(defined $p, "new");
-
- foreach my $arg (sort keys %L_ARGS) {
- my $exp = $L_ARGS{$arg} || $arg;
- my $r = $p->seq_l($arg);
- ok($r eq $exp, "L<$arg>");
- # print STDERR "\x23 $r\n";
- };
-
-}
-
-{
- local $TODO = "unimplemented methods";
- my $p = Pod::Readme->new();
- foreach my $method (@METHODS) {
- ok($p->can($method), "method $method supported");
- }
-}
-
@@ -0,0 +1,217 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+
+use Cwd;
+use File::Compare qw/ compare_text /;
+use File::Temp qw/ tempfile /;
+use Path::Tiny qw/ path /;
+
+use lib 't/lib';
+use Pod::Readme::Test;
+
+# use Pod::Readme::Test::Kit;
+
+my $class = 'Pod::Readme::Filter';
+use_ok $class;
+
+isa_ok $prf = $class->new( output_fh => $io, ), 'Pod::Readme::Filter';
+
+{
+ can_ok( $prf, "cmd_" . $_ ) for qw/ stop start continue plugin /;
+
+ ok $prf->in_target, 'default in target';
+ is $prf->mode, 'default', 'mode';
+
+ is $prf->base_dir->stringify, '.', 'base_dir';
+}
+
+{
+ ok !$prf->cmd_stop, 'cmd_stop';
+ ok !$prf->in_target, 'not in target';
+
+ ok $prf->cmd_start, 'cmd_start';
+ ok $prf->in_target, 'in target';
+
+ ok !$prf->cmd_stop, 'cmd_stop';
+ ok !$prf->in_target, 'not in target';
+
+ ok $prf->cmd_continue, 'cmd_continue';
+ ok $prf->in_target, 'in target';
+};
+
+{
+ filter_lines('=pod');
+ is $out, "=pod\n", 'expected output';
+ is $prf->mode, 'pod', 'mode';
+ ok $prf->in_target, 'in target';
+ reset_out();
+};
+
+{
+ filter_lines('=for readme stop');
+ is $prf->mode, 'pod:for', 'mode';
+
+ filter_lines('');
+ is $prf->mode, 'pod', 'mode';
+
+ is $out, '', 'no output';
+ ok !$prf->in_target, 'not in target';
+
+ filter_lines( 'This should not be copied.', '', 'Boop!', '' );
+
+ is $out, '', 'no output';
+
+ filter_lines('=for readme continue');
+ is $prf->mode, 'pod:for', 'mode';
+
+ filter_lines('');
+ is $prf->mode, 'pod', 'mode';
+ ok $prf->in_target, 'in target';
+
+ is $out, '', 'no output';
+};
+
+{
+ filter_lines('=for readme stop');
+ is $prf->mode, 'pod:for', 'mode';
+
+ filter_lines('');
+ is $prf->mode, 'pod', 'mode';
+
+ is $out, '', 'no output';
+
+ ok !$prf->in_target, 'not in target';
+
+ filter_lines( 'This should not be copied.', '', 'Boop!', '' );
+
+ is $out, '', 'no output';
+
+ filter_lines('=for readme start');
+ is $prf->mode, 'pod:for', 'mode';
+
+ filter_lines('');
+ is $prf->mode, 'pod', 'mode';
+ ok $prf->in_target, 'in target';
+
+ is $out, '', 'no output';
+};
+
+{
+ throws_ok {
+ filter_lines('=for readme plugin noop::invalid');
+ is $prf->mode, 'pod:for', 'mode';
+ filter_lines('');
+ }
+ qr/Unable to locate plugin 'noop::invalid'/, 'bad plugin';
+
+ is $prf->mode('pod'), 'pod', 'mode reset';
+};
+
+{
+ filter_lines('=cut');
+ is $prf->mode, 'default', 'default mode';
+ filter_lines('');
+
+ is $out, '', 'no content';
+
+ filter_lines('=head1 TEST');
+ is $prf->mode, 'pod', 'pod mode';
+ filter_lines('');
+
+ is $out, "=head1 TEST\n\n", 'expected content';
+ reset_out();
+};
+
+{
+ filter_lines( "This should be copied.", '' );
+
+ is $out, "This should be copied.\n\n", 'output';
+ reset_out();
+};
+
+{
+ filter_lines('=begin text');
+ is $prf->mode, 'target:text', 'mode';
+ filter_lines( '', 'Something', '', '=end text', '' );
+ is $out, '', 'no content';
+ reset_out();
+}
+
+{
+ filter_lines('=begin readme');
+ is $prf->mode, 'pod:begin', 'mode';
+ filter_lines( '', 'Something', '', '=end readme', '' );
+
+ like $out, qr/^Something\n/, 'expected content (minimal)';
+ TODO: {
+ local $TODO = 'extra newline';
+ is $out, "Something\n", 'expected content';
+ }
+ reset_out();
+}
+
+{
+ filter_lines('=begin readme text');
+ is $prf->mode, 'pod:begin', 'mode';
+ filter_lines( '', 'Something', '', '=end readme', '' );
+
+ TODO: {
+ is $out, "=begin text\n\nSomething\n\n=end text\n\n",
+ 'expected content';
+ }
+ reset_out();
+}
+
+{
+ filter_lines('=begin :readme');
+ is $prf->mode, 'pod:begin', 'mode';
+ filter_lines( '', 'Something', '', '=end :readme', '' );
+
+ like $out, qr/^Something\n/, 'expected content (minimal)';
+ TODO: {
+ local $TODO = 'extra newline';
+ is $out, "Something\n", 'expected content';
+ }
+ reset_out();
+}
+
+{
+ can_ok $prf, qw/ parse_cmd_args /;
+
+ lives_ok {
+ my $res = $prf->parse_cmd_args( undef, 'arg1', 'no-arg2',
+ 'arg3="This is a string"', 'arg4=value', );
+
+ note( explain $res);
+
+ is_deeply $res,
+ {
+ 'arg1' => 1,
+ 'arg2' => 0,
+ 'arg3' => 'This is a string',
+ 'arg4' => 'value'
+ },
+ 'expected parsing of arguments list';
+
+ }
+ 'parse_cmd_args';
+
+ throws_ok {
+ my $res =
+ $prf->parse_cmd_args( [qw/ arg1 arg2 arg3 /], 'arg1', 'no-arg2',
+ 'arg3="This is a string"', 'arg4=value', );
+ }
+ qr/Invalid argument key 'arg4'/, 'bad arguments';
+
+}
+
+{
+ can_ok $prf, qw/ depends_on /;
+ is_deeply [ $prf->depends_on ], [], 'depends_on';
+}
+
+done_testing;
@@ -0,0 +1,127 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+
+use Cwd;
+use File::Compare qw/ compare_text /;
+use File::Temp qw/ tempfile /;
+use Path::Tiny qw/ path /;
+
+use lib 't/lib';
+use Pod::Readme::Test;
+
+# use Pod::Readme::Test::Kit;
+
+my $class = 'Pod::Readme';
+use_ok $class;
+
+isa_ok $prf = $class->new( output_fh => $io, ), $class;
+
+{
+ ok !$prf->can('cmd_noop'), 'no noop';
+
+ filter_lines('=for readme plugin noop');
+ is $prf->mode, 'pod:for', 'mode';
+
+ filter_lines('');
+ is $prf->mode, 'pod', 'mode';
+ ok $prf->in_target, 'in target';
+
+ is $out, '', 'no output';
+
+ can_ok( $prf, 'cmd_noop' );
+ isa_ok( $prf, 'Pod::Readme::Filter' );
+
+ throws_ok {
+ filter_lines('=for readme plugin noop::invalid');
+ is $prf->mode, 'pod:for', 'mode';
+ filter_lines('');
+ }
+ qr/Unable to locate plugin 'noop::invalid'/, 'bad plugin';
+
+ is $prf->mode('pod'), 'pod', 'mode reset';
+
+ filter_lines( '=for readme plugin noop', '' );
+
+ can_ok( $prf, qw/ noop_bool noop_str / );
+ ok !$prf->noop_bool, 'plugin accessor default';
+ is $prf->noop_str, '', 'plugin accessor default';
+
+ filter_lines( '=for readme plugin noop bool', '' );
+ ok $prf->noop_bool, 'plugin accessor set';
+ filter_lines( '=for readme plugin noop no-bool str="Isn\'t this nice?"',
+ '' );
+ ok !$prf->noop_bool, 'plugin accessor unset';
+ is $prf->noop_str, "Isn\'t this nice?", 'plugin accessor set';
+
+ throws_ok {
+ filter_lines( '=for readme plugin noop no-bool bad-attr="this"', '' );
+ }
+ qr/Invalid argument key 'bad-attr' at input line \d+/;
+};
+
+{
+ my $source = 't/data/README-1.pod';
+
+ lives_ok {
+
+ my $dest = ( tempfile( UNLINK => 1 ) )[1];
+ note $dest;
+
+ ok my $parser = Pod::Readme->new, 'new (no args)';
+ $parser->parse_from_file( $source, $dest );
+
+ ok !compare_text( $dest, 't/data/README.txt' ), 'expected output';
+
+ }
+ 'parse_from_file';
+
+ lives_ok {
+
+ my $dest = ( tempfile( UNLINK => 1 ) )[1];
+ note $dest;
+
+ Pod::Readme->parse_from_file( $source, $dest );
+
+ ok !compare_text( $dest, 't/data/README.txt' ), 'expected output';
+
+ }
+ 'parse_from_file (class method)';
+
+ lives_ok {
+
+ open my $source_fh, '<', $source;
+ my ( $dest_fh, $dest ) = tempfile( UNLINK => 1 );
+ note $dest;
+
+ ok my $parser = Pod::Readme->new, 'new (no args)';
+ $parser->parse_from_filehandle( $source_fh, $dest_fh );
+
+ ok !compare_text( $dest, 't/data/README.txt' ), 'expected output';
+
+ close $source_fh;
+
+ }
+ 'parse_from_filehandle';
+
+ lives_ok {
+
+ open my $source_fh, '<', $source;
+ my ( $dest_fh, $dest ) = tempfile( UNLINK => 1 );
+ note $dest;
+
+ Pod::Readme->parse_from_filehandle( $source_fh, $dest_fh );
+
+ ok !compare_text( $dest, 't/data/README.txt' ), 'expected output';
+
+ close $source_fh;
+
+ }
+ 'parse_from_filehandle (class method)';
+
+}
+
+done_testing;
@@ -1,12 +0,0 @@
-#!/usr/bin/perl
-
-use Test::More;
-
-plan skip_all => "Enable DEVEL_TESTS environent variable"
- unless ($ENV{DEVEL_TESTS});
-
-eval "use Test::Portability::Files";
-
-plan skip_all => "Test::Portability::Files required for testing filenames portability" if $@;
-
-run_tests();
@@ -1,16 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use Test::More;
-
-plan skip_all => "Enable DEVEL_TESTS environent variable"
- unless ($ENV{DEVEL_TESTS});
-
-eval "use Test::Pod 1.00";
-
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
-
-all_pod_files_ok();
-
@@ -1,16 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use Test::More;
-
-plan skip_all => "Enable DEVEL_TESTS environent variable"
- unless ($ENV{DEVEL_TESTS});
-
-eval "use Test::Pod::Coverage";
-
-plan skip_all => "Test::Pod::Coverage required" if $@;
-
-plan tests => 1;
-
-pod_coverage_ok("Pod::Readme");
-
@@ -0,0 +1,45 @@
+---
+abstract: 'generate README files from POD'
+author:
+ - 'Robert Rothenberg <rrwo@cpan.org>'
+build_requires:
+ Exporter::Lite: 0
+ ExtUtils::MakeMaker: 6.59
+ Test::Most: 0
+configure_requires:
+ ExtUtils::MakeMaker: 6.59
+distribution_type: module
+dynamic_config: 1
+generated_by: 'Module::Install version 1.06'
+license: artistic2
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Pod-Readme
+no_index:
+ directory:
+ - inc
+ - t
+ - xt
+requires:
+ CPAN::Changes: 0
+ CPAN::Meta: 0
+ ExtUtils::MakeMaker: 6.56
+ File::Slurp: 0
+ Hash::Util: 0
+ IO: 0
+ Module::CoreList: 0
+ Moose: 0
+ MooseX::Object::Pluggable: 0
+ MooseX::Types::IO: 0
+ MooseX::Types::Path::Class: 0
+ Path::Class: 0
+ Try::Tiny: 0
+ namespace::autoclean: 0
+ perl: 5.10.1
+ version: 0.77
+resources:
+ bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Pod-Readme
+ license: http://www.perlfoundation.org/artistic_license_2_0
+ repository: git://github.com/bigpresh/Pod-Readme.git
+version: 1.000000_001
@@ -0,0 +1,11 @@
+=head1 NAME
+
+Test - this is a test
+
+=head1 DESCRIPTION
+
+This is a sample file for testing. Please ignore.
+
+=head2 A heading
+
+Nothing to see here.
@@ -0,0 +1,12 @@
+NAME
+
+ Test - this is a test
+
+DESCRIPTION
+
+ This is a sample file for testing. Please ignore.
+
+ A heading
+
+ Nothing to see here.
+
@@ -0,0 +1,54 @@
+package Pod::Readme::Plugin::noop;
+
+use Moo::Role;
+use Types::Standard qw/ Bool Str /;
+
+=head1 NAME
+
+Pod::Readme::Plugin::noop - do nothing
+
+=head1 SYNOPSIS
+
+ =pod
+
+ =for readme plugin noop
+
+=head1 DESCRIPTION
+
+This is a no-op plugin.
+
+=cut
+
+requires 'parse_cmd_args';
+
+has noop_bool => (
+ is => 'rw',
+ isa => Bool,
+ lazy => 1,
+ default => 0,
+);
+
+has noop_str => (
+ is => 'rw',
+ isa => Str,
+ lazy => 1,
+ default => '',
+);
+
+sub cmd_noop {
+ my ( $self, @args ) = @_;
+
+ my $res = $self->parse_cmd_args( [qw/ bool str /], @args );
+ foreach my $key ( keys %{$res} ) {
+ if ( my $method = $self->can("noop_${key}") ) {
+ $self->$method( $res->{$key} );
+ }
+ else {
+ die "Invalid key: '${key}'";
+ }
+ }
+}
+
+use namespace::autoclean;
+
+1;
@@ -0,0 +1,21 @@
+package Pod::Readme::Test::Kit;
+
+use Test::Kit;
+
+include 'strict';
+include 'warnings';
+
+include 'Test::More';
+include 'Test::Deep';
+include 'Test::Exception';
+
+include 'Cwd';
+
+include 'File::Temp' => { import => [qw/ tempfile /], };
+
+include 'File::Compare' => { import => [qw/ compare_text /], };
+
+include 'Path::Tiny';
+include 'Pod::Readme::Test';
+
+1;
@@ -0,0 +1,29 @@
+package Pod::Readme::Test;
+
+use Exporter qw/ import /;
+use IO::String;
+
+require Test::More;
+
+our $out;
+our $io = IO::String->new($out);
+our $prf;
+
+our @EXPORT = qw/ $prf $out $io filter_lines reset_out /;
+our @EXPORT_OK = @EXPORT;
+
+sub filter_lines {
+ my @lines = @_;
+ foreach my $line (@lines) {
+ Test::More::note $line if $line =~ /^=(?:\w+)/;
+ $prf->filter_line( $line . "\n" );
+ }
+}
+
+sub reset_out {
+ $io->close;
+ $out = '';
+ $io->open($out);
+}
+
+1;
@@ -0,0 +1,47 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+
+use Cwd;
+use File::Compare qw/ compare_text /;
+use File::Temp qw/ tempfile /;
+use Path::Tiny qw/ path /;
+
+use lib 't/lib';
+use Pod::Readme::Test;
+
+# use Pod::Readme::Test::Kit;
+
+my $class = 'Pod::Readme';
+use_ok $class;
+
+isa_ok $prf = $class->new(
+ input_file => $0,
+ output_fh => $io,
+), $class;
+
+{
+ filter_lines( '=for readme plugin changes', '' );
+
+ is_deeply [ $prf->depends_on ], [ $prf->changes_file, $prf->input_file ],
+ 'depends_on';
+
+ lives_ok { $prf->dependencies_updated } 'dependencies_updated';
+
+ note $out;
+
+ like $out, qr/=head1 RECENT CHANGES\n\n/, '=head1';
+
+ # TODO: test content:
+ # - Changes file with sections (using alternative file)
+ # - Changes file without sections (using alternative file)
+ # - verbatim mode
+ # - changed title
+
+ reset_out();
+}
+
+done_testing;
@@ -0,0 +1,85 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+
+use Cwd;
+use File::Compare qw/ compare_text /;
+use File::Temp qw/ tempfile /;
+use Path::Tiny qw/ path /;
+
+use lib 't/lib';
+use Pod::Readme::Test;
+
+# use Pod::Readme::Test::Kit;
+
+my $class = 'Pod::Readme';
+use_ok $class;
+
+isa_ok $prf = $class->new(
+ input_file => $0,
+ output_fh => $io,
+ base_dir => cwd,
+), $class;
+
+SKIP: {
+
+ # Workaround a possible bug in Travis-CI's build system, where
+ # running Makefile.PL no longer generates the META.yml file
+ # because the inc dir is present, but it is not in author mode.
+
+ skip "cannot find default META.yml", 3
+ unless -e path($prf->base_dir, 'META.yml') ;
+
+ lives_ok {
+ filter_lines( '=for readme plugin requires', '' );
+ } 'run requires plugin';
+
+ like $out, qr/=head1 REQUIREMENTS\n\n/, '=head1';
+ like $out, qr/\nThis distribution requires the following modules:\n\n/,
+ 'description';
+
+ is_deeply [ $prf->depends_on ], [ $prf->requires_from_file, $prf->input_file ],
+ 'depends_on';
+
+ lives_ok { $prf->dependencies_updated } 'dependencies_updated';
+
+ reset_out();
+
+ $prf->requires_run(0);
+}
+
+{
+ filter_lines(
+ '=for readme plugin requires from-file="t/data/META-1.yml" title="PREREQS"',
+ ''
+ );
+
+ note $out;
+
+ like $out, qr/=head1 PREREQS\n\n/, '=head1';
+
+ like $out, qr/\nThis distribution requires Perl v5\.10\.1\.\n\n/,
+ 'minimum perl';
+
+ # TODO: test content
+ # - test no-omit-core option
+
+ reset_out();
+
+ $prf->requires_run(0);
+}
+
+{
+ dies_ok {
+ filter_lines( '=for readme plugin requires file=nonexistent', '' );
+ } 'die on bad filename';
+
+ reset_out();
+
+ $prf->requires_run(0);
+}
+
+done_testing;
@@ -0,0 +1,55 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+
+use Cwd;
+use File::Compare qw/ compare_text /;
+use File::Temp qw/ tempfile /;
+use Path::Tiny qw/ path /;
+
+use lib 't/lib';
+use Pod::Readme::Test;
+
+# use Pod::Readme::Test::Kit;
+
+our $VERSION = '1.23'; # for testing
+
+my $class = 'Pod::Readme';
+use_ok $class;
+
+isa_ok $prf = $class->new(
+ input_file => $0,
+ output_fh => $io,
+ ), $class;
+
+{
+ filter_lines('=for readme plugin version', '');
+ is $out, "=head1 VERSION\n\n${VERSION}\n\n";
+
+ is_deeply [ $prf->depends_on ], [ $prf->version_file, $prf->input_file ],
+ 'depends_on';
+
+ lives_ok { $prf->dependencies_updated } 'dependencies_updated';
+
+ reset_out();
+ $prf->version_run(0);
+}
+
+{
+ filter_lines("=for readme plugin version file=${0} title='THIS VER'", '');
+ is $out, "=head1 THIS VER\n\n${VERSION}\n\n";
+ reset_out();
+ $prf->version_run(0);
+}
+
+{
+ filter_lines('=for readme plugin version heading-level=2 title="Version"', '');
+ is $out, "=head2 Version\n\n${VERSION}\n\n";
+ reset_out();
+ $prf->version_run(0);
+}
+
+done_testing;