Initial Commit
This commit is contained in:
Riley Schneider
2127
database/perl/lib/Module/Build/API.pod
Normal file
2127
database/perl/lib/Module/Build/API.pod
Normal file
File diff suppressed because it is too large
Load Diff
326
database/perl/lib/Module/Build/Authoring.pod
Normal file
326
database/perl/lib/Module/Build/Authoring.pod
Normal file
@@ -0,0 +1,326 @@
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Authoring - Authoring Module::Build modules
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
When creating a C<Build.PL> script for a module, something like the
|
||||
following code will typically be used:
|
||||
|
||||
use Module::Build;
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
requires => {
|
||||
'perl' => '5.6.1',
|
||||
'Some::Module' => '1.23',
|
||||
'Other::Module' => '>= 1.2, != 1.5, < 2.0',
|
||||
},
|
||||
);
|
||||
$build->create_build_script;
|
||||
|
||||
A simple module could get away with something as short as this for its
|
||||
C<Build.PL> script:
|
||||
|
||||
use Module::Build;
|
||||
Module::Build->new(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
)->create_build_script;
|
||||
|
||||
The model used by C<Module::Build> is a lot like the C<MakeMaker>
|
||||
metaphor, with the following correspondences:
|
||||
|
||||
In Module::Build In ExtUtils::MakeMaker
|
||||
--------------------------- ------------------------
|
||||
Build.PL (initial script) Makefile.PL (initial script)
|
||||
Build (a short perl script) Makefile (a long Makefile)
|
||||
_build/ (saved state info) various config text in the Makefile
|
||||
|
||||
Any customization can be done simply by subclassing C<Module::Build>
|
||||
and adding a method called (for example) C<ACTION_test>, overriding
|
||||
the default 'test' action. You could also add a method called
|
||||
C<ACTION_whatever>, and then you could perform the action C<Build
|
||||
whatever>.
|
||||
|
||||
For information on providing compatibility with
|
||||
C<ExtUtils::MakeMaker>, see L<Module::Build::Compat> and
|
||||
L<http://www.makemaker.org/wiki/index.cgi?ModuleBuildConversionGuide>.
|
||||
|
||||
|
||||
=head1 STRUCTURE
|
||||
|
||||
Module::Build creates a class hierarchy conducive to customization.
|
||||
Here is the parent-child class hierarchy in classy ASCII art:
|
||||
|
||||
/--------------------\
|
||||
| Your::Parent | (If you subclass Module::Build)
|
||||
\--------------------/
|
||||
|
|
||||
|
|
||||
/--------------------\ (Doesn't define any functionality
|
||||
| Module::Build | of its own - just figures out what
|
||||
\--------------------/ other modules to load.)
|
||||
|
|
||||
|
|
||||
/-----------------------------------\ (Some values of $^O may
|
||||
| Module::Build::Platform::$^O | define specialized functionality.
|
||||
\-----------------------------------/ Otherwise it's ...::Default, a
|
||||
| pass-through class.)
|
||||
|
|
||||
/--------------------------\
|
||||
| Module::Build::Base | (Most of the functionality of
|
||||
\--------------------------/ Module::Build is defined here.)
|
||||
|
||||
|
||||
=head1 SUBCLASSING
|
||||
|
||||
Right now, there are two ways to subclass Module::Build. The first
|
||||
way is to create a regular module (in a C<.pm> file) that inherits
|
||||
from Module::Build, and use that module's class instead of using
|
||||
Module::Build directly:
|
||||
|
||||
------ in Build.PL: ----------
|
||||
#!/usr/bin/perl
|
||||
|
||||
use lib q(/nonstandard/library/path);
|
||||
use My::Builder; # Or whatever you want to call it
|
||||
|
||||
my $build = My::Builder->new
|
||||
(
|
||||
module_name => 'Foo::Bar', # All the regular args...
|
||||
license => 'perl',
|
||||
dist_author => 'A N Other <me@here.net.au>',
|
||||
requires => { Carp => 0 }
|
||||
);
|
||||
$build->create_build_script;
|
||||
|
||||
This is relatively straightforward, and is the best way to do things
|
||||
if your My::Builder class contains lots of code. The
|
||||
C<create_build_script()> method will ensure that the current value of
|
||||
C<@INC> (including the C</nonstandard/library/path>) is propagated to
|
||||
the Build script, so that My::Builder can be found when running build
|
||||
actions. If you find that you need to C<chdir> into a different directories
|
||||
in your subclass methods or actions, be sure to always return to the original
|
||||
directory (available via the C<base_dir()> method) before returning control
|
||||
to the parent class. This is important to avoid data serialization problems.
|
||||
|
||||
For very small additions, Module::Build provides a C<subclass()>
|
||||
method that lets you subclass Module::Build more conveniently, without
|
||||
creating a separate file for your module:
|
||||
|
||||
------ in Build.PL: ----------
|
||||
#!/usr/bin/perl
|
||||
|
||||
use Module::Build;
|
||||
my $class = Module::Build->subclass
|
||||
(
|
||||
class => 'My::Builder',
|
||||
code => q{
|
||||
sub ACTION_foo {
|
||||
print "I'm fooing to death!\n";
|
||||
}
|
||||
},
|
||||
);
|
||||
|
||||
my $build = $class->new
|
||||
(
|
||||
module_name => 'Foo::Bar', # All the regular args...
|
||||
license => 'perl',
|
||||
dist_author => 'A N Other <me@here.net.au>',
|
||||
requires => { Carp => 0 }
|
||||
);
|
||||
$build->create_build_script;
|
||||
|
||||
Behind the scenes, this actually does create a C<.pm> file, since the
|
||||
code you provide must persist after Build.PL is run if it is to be
|
||||
very useful.
|
||||
|
||||
See also the documentation for the L<Module::Build::API/"subclass()">
|
||||
method.
|
||||
|
||||
|
||||
=head1 PREREQUISITES
|
||||
|
||||
=head2 Types of prerequisites
|
||||
|
||||
To specify what versions of other modules are used by this
|
||||
distribution, several types of prerequisites can be defined with the
|
||||
following parameters:
|
||||
|
||||
=over 3
|
||||
|
||||
=item configure_requires
|
||||
|
||||
Items that must be installed I<before> configuring this distribution
|
||||
(i.e. before running the F<Build.PL> script). This might be a
|
||||
specific minimum version of C<Module::Build> or any other module the
|
||||
F<Build.PL> needs in order to do its stuff. Clients like C<CPAN.pm>
|
||||
or C<CPANPLUS> will be expected to pick C<configure_requires> out of the
|
||||
F<META.yml> file and install these items before running the
|
||||
C<Build.PL>.
|
||||
|
||||
If no configure_requires is specified, the current version of Module::Build
|
||||
is automatically added to configure_requires.
|
||||
|
||||
=item build_requires
|
||||
|
||||
Items that are necessary for building and testing this distribution,
|
||||
but aren't necessary after installation. This can help users who only
|
||||
want to install these items temporarily. It also helps reduce the
|
||||
size of the CPAN dependency graph if everything isn't smooshed into
|
||||
C<requires>.
|
||||
|
||||
=item requires
|
||||
|
||||
Items that are necessary for basic functioning.
|
||||
|
||||
=item recommends
|
||||
|
||||
Items that are recommended for enhanced functionality, but there are
|
||||
ways to use this distribution without having them installed. You
|
||||
might also think of this as "can use" or "is aware of" or "changes
|
||||
behavior in the presence of".
|
||||
|
||||
=item test_requires
|
||||
|
||||
Items that are necessary for testing.
|
||||
|
||||
=item conflicts
|
||||
|
||||
Items that can cause problems with this distribution when installed.
|
||||
This is pretty rare.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Format of prerequisites
|
||||
|
||||
The prerequisites are given in a hash reference, where the keys are
|
||||
the module names and the values are version specifiers:
|
||||
|
||||
requires => {
|
||||
Foo::Module => '2.4',
|
||||
Bar::Module => 0,
|
||||
Ken::Module => '>= 1.2, != 1.5, < 2.0',
|
||||
perl => '5.6.0'
|
||||
},
|
||||
|
||||
The above four version specifiers have different effects. The value
|
||||
C<'2.4'> means that B<at least> version 2.4 of C<Foo::Module> must be
|
||||
installed. The value C<0> means that B<any> version of C<Bar::Module>
|
||||
is acceptable, even if C<Bar::Module> doesn't define a version. The
|
||||
more verbose value C<'E<gt>= 1.2, != 1.5, E<lt> 2.0'> means that
|
||||
C<Ken::Module>'s version must be B<at least> 1.2, B<less than> 2.0,
|
||||
and B<not equal to> 1.5. The list of criteria is separated by commas,
|
||||
and all criteria must be satisfied.
|
||||
|
||||
A special C<perl> entry lets you specify the versions of the Perl
|
||||
interpreter that are supported by your module. The same version
|
||||
dependency-checking semantics are available, except that we also
|
||||
understand perl's new double-dotted version numbers.
|
||||
|
||||
=head2 XS Extensions
|
||||
|
||||
Modules which need to compile XS code should list C<ExtUtils::CBuilder>
|
||||
as a C<build_requires> element.
|
||||
|
||||
|
||||
=head1 SAVING CONFIGURATION INFORMATION
|
||||
|
||||
Module::Build provides a very convenient way to save configuration
|
||||
information that your installed modules (or your regression tests) can
|
||||
access. If your Build process calls the C<feature()> or
|
||||
C<config_data()> methods, then a C<Foo::Bar::ConfigData> module will
|
||||
automatically be created for you, where C<Foo::Bar> is the
|
||||
C<module_name> parameter as passed to C<new()>. This module provides
|
||||
access to the data saved by these methods, and a way to update the
|
||||
values. There is also a utility script called C<config_data>
|
||||
distributed with Module::Build that provides a command line interface
|
||||
to this same functionality. See also the generated
|
||||
C<Foo::Bar::ConfigData> documentation, and the C<config_data>
|
||||
script's documentation, for more information.
|
||||
|
||||
|
||||
=head1 STARTING MODULE DEVELOPMENT
|
||||
|
||||
When starting development on a new module, it's rarely worth your time
|
||||
to create a tree of all the files by hand. Some automatic
|
||||
module-creators are available: the oldest is C<h2xs>, which has
|
||||
shipped with perl itself for a long time. Its name reflects the fact
|
||||
that modules were originally conceived of as a way to wrap up a C
|
||||
library (thus the C<h> part) into perl extensions (thus the C<xs>
|
||||
part).
|
||||
|
||||
These days, C<h2xs> has largely been superseded by modules like
|
||||
C<ExtUtils::ModuleMaker>, and C<Module::Starter>. They have varying
|
||||
degrees of support for C<Module::Build>.
|
||||
|
||||
|
||||
=head1 AUTOMATION
|
||||
|
||||
One advantage of Module::Build is that since it's implemented as Perl
|
||||
methods, you can invoke these methods directly if you want to install
|
||||
a module non-interactively. For instance, the following Perl script
|
||||
will invoke the entire build/install procedure:
|
||||
|
||||
my $build = Module::Build->new(module_name => 'MyModule');
|
||||
$build->dispatch('build');
|
||||
$build->dispatch('test');
|
||||
$build->dispatch('install');
|
||||
|
||||
If any of these steps encounters an error, it will throw a fatal
|
||||
exception.
|
||||
|
||||
You can also pass arguments as part of the build process:
|
||||
|
||||
my $build = Module::Build->new(module_name => 'MyModule');
|
||||
$build->dispatch('build');
|
||||
$build->dispatch('test', verbose => 1);
|
||||
$build->dispatch('install', sitelib => '/my/secret/place/');
|
||||
|
||||
Building and installing modules in this way skips creating the
|
||||
C<Build> script.
|
||||
|
||||
|
||||
=head1 MIGRATION
|
||||
|
||||
Note that if you want to provide both a F<Makefile.PL> and a
|
||||
F<Build.PL> for your distribution, you probably want to add the
|
||||
following to C<WriteMakefile> in your F<Makefile.PL> so that C<MakeMaker>
|
||||
doesn't try to run your F<Build.PL> as a normal F<.PL> file:
|
||||
|
||||
PL_FILES => {},
|
||||
|
||||
You may also be interested in looking at the C<Module::Build::Compat>
|
||||
module, which can automatically create various kinds of F<Makefile.PL>
|
||||
compatibility layers.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
Development questions, bug reports, and patches should be sent to the
|
||||
Module-Build mailing list at <module-build@perl.org>.
|
||||
|
||||
Bug reports are also welcome at
|
||||
<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build>.
|
||||
|
||||
The latest development version is available from the Git
|
||||
repository at <https://github.com/Perl-Toolchain-Gang/Module-Build>
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), L<Module::Build>(3), L<Module::Build::API>(3),
|
||||
L<Module::Build::Cookbook>(3), L<ExtUtils::MakeMaker>(3), L<YAML>(3)
|
||||
|
||||
F<META.yml> Specification:
|
||||
L<CPAN::Meta::Spec>
|
||||
|
||||
L<http://www.dsmit.com/cons/>
|
||||
|
||||
L<http://search.cpan.org/dist/PerlBuildSystem/>
|
||||
|
||||
=cut
|
||||
5700
database/perl/lib/Module/Build/Base.pm
Normal file
5700
database/perl/lib/Module/Build/Base.pm
Normal file
File diff suppressed because it is too large
Load Diff
147
database/perl/lib/Module/Build/Bundling.pod
Normal file
147
database/perl/lib/Module/Build/Bundling.pod
Normal file
@@ -0,0 +1,147 @@
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Bundling - How to bundle Module::Build with a distribution
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# Build.PL
|
||||
use inc::latest 'Module::Build';
|
||||
|
||||
Module::Build->new(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
)->create_build_script;
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
B<WARNING -- THIS IS AN EXPERIMENTAL FEATURE>
|
||||
|
||||
In order to install a distribution using Module::Build, users must
|
||||
have Module::Build available on their systems. There are two ways
|
||||
to do this. The first way is to include Module::Build in the
|
||||
C<configure_requires> metadata field. This field is supported by
|
||||
recent versions L<CPAN> and L<CPANPLUS> and is a standard feature
|
||||
in the Perl core as of Perl 5.10.1. Module::Build now adds itself
|
||||
to C<configure_requires> by default.
|
||||
|
||||
The second way supports older Perls that have not upgraded CPAN or
|
||||
CPANPLUS and involves bundling an entire copy of Module::Build
|
||||
into the distribution's C<inc/> directory. This is the same approach
|
||||
used by L<Module::Install>, a modern wrapper around ExtUtils::MakeMaker
|
||||
for Makefile.PL based distributions.
|
||||
|
||||
The "trick" to making this work for Module::Build is making sure the
|
||||
highest version Module::Build is used, whether this is in C<inc/> or
|
||||
already installed on the user's system. This ensures that all necessary
|
||||
features are available as well as any new bug fixes. This is done using
|
||||
the experimental L<inc::latest> module, available on CPAN.
|
||||
|
||||
A "normal" Build.PL looks like this (with only the minimum required
|
||||
fields):
|
||||
|
||||
use Module::Build;
|
||||
|
||||
Module::Build->new(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
)->create_build_script;
|
||||
|
||||
A "bundling" Build.PL replaces the initial "use" line with a nearly
|
||||
transparent replacement:
|
||||
|
||||
use inc::latest 'Module::Build';
|
||||
|
||||
Module::Build->new(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
)->create_build_script;
|
||||
|
||||
For I<authors>, when "Build dist" is run, Module::Build will be
|
||||
automatically bundled into C<inc> according to the rules for
|
||||
L<inc::latest>.
|
||||
|
||||
For I<users>, inc::latest will load the latest Module::Build, whether
|
||||
installed or bundled in C<inc/>.
|
||||
|
||||
=head1 BUNDLING OTHER CONFIGURATION DEPENDENCIES
|
||||
|
||||
The same approach works for other configuration dependencies -- modules
|
||||
that I<must> be available for Build.PL to run. All other dependencies can
|
||||
be specified as usual in the Build.PL and CPAN or CPANPLUS will install
|
||||
them after Build.PL finishes.
|
||||
|
||||
For example, to bundle the L<Devel::AssertOS::Unix> module (which ensures a
|
||||
"Unix-like" operating system), one could do this:
|
||||
|
||||
use inc::latest 'Devel::AssertOS::Unix';
|
||||
use inc::latest 'Module::Build';
|
||||
|
||||
Module::Build->new(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
)->create_build_script;
|
||||
|
||||
The C<inc::latest> module creates bundled directories based on the packlist
|
||||
file of an installed distribution. Even though C<inc::latest> takes module
|
||||
name arguments, it is better to think of it as bundling and making
|
||||
available entire I<distributions>. When a module is loaded through
|
||||
C<inc::latest>, it looks in all bundled distributions in C<inc/> for a
|
||||
newer module than can be found in the existing C<@INC> array.
|
||||
|
||||
Thus, the module-name provided should usually be the "top-level" module
|
||||
name of a distribution, though this is not strictly required. For example,
|
||||
L<Module::Build> has a number of heuristics to map module names to
|
||||
packlists, allowing users to do things like this:
|
||||
|
||||
use inc::latest 'Devel::AssertOS::Unix';
|
||||
|
||||
even though Devel::AssertOS::Unix is contained within the Devel-CheckOS
|
||||
distribution.
|
||||
|
||||
At the current time, packlists are required. Thus, bundling dual-core
|
||||
modules, I<including Module::Build>, may require a 'forced install' over
|
||||
versions in the latest version of perl in order to create the necessary
|
||||
packlist for bundling. This limitation will hopefully be addressed in a
|
||||
future version of Module::Build.
|
||||
|
||||
=head2 WARNING -- How to Manage Dependency Chains
|
||||
|
||||
Before bundling a distribution you must ensure that all prerequisites are
|
||||
also bundled and load in the correct order. For Module::Build itself, this
|
||||
should not be necessary, but it is necessary for any other distribution.
|
||||
(A future release of Module::Build will hopefully address this deficiency.)
|
||||
|
||||
For example, if you need C<Wibble>, but C<Wibble> depends on C<Wobble>,
|
||||
your Build.PL might look like this:
|
||||
|
||||
use inc::latest 'Wobble';
|
||||
use inc::latest 'Wibble';
|
||||
use inc::latest 'Module::Build';
|
||||
|
||||
Module::Build->new(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
)->create_build_script;
|
||||
|
||||
Authors are strongly suggested to limit the bundling of additional
|
||||
dependencies if at all possible and to carefully test their distribution
|
||||
tarballs on older versions of Perl before uploading to CPAN.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
David Golden <dagolden@cpan.org>
|
||||
|
||||
Development questions, bug reports, and patches should be sent to the
|
||||
Module-Build mailing list at <module-build@perl.org>.
|
||||
|
||||
Bug reports are also welcome at
|
||||
<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Module-Build>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), L<inc::latest>, L<Module::Build>(3), L<Module::Build::API>(3),
|
||||
L<Module::Build::Cookbook>(3),
|
||||
|
||||
=cut
|
||||
|
||||
# vim: tw=75
|
||||
653
database/perl/lib/Module/Build/Compat.pm
Normal file
653
database/perl/lib/Module/Build/Compat.pm
Normal file
@@ -0,0 +1,653 @@
|
||||
package Module::Build::Compat;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
|
||||
use File::Basename ();
|
||||
use File::Spec;
|
||||
use Config;
|
||||
use Module::Build;
|
||||
use Module::Metadata;
|
||||
use version;
|
||||
use Data::Dumper;
|
||||
|
||||
my %convert_installdirs = (
|
||||
PERL => 'core',
|
||||
SITE => 'site',
|
||||
VENDOR => 'vendor',
|
||||
);
|
||||
|
||||
my %makefile_to_build =
|
||||
(
|
||||
TEST_VERBOSE => 'verbose',
|
||||
VERBINST => 'verbose',
|
||||
INC => sub { map {(extra_compiler_flags => $_)} Module::Build->split_like_shell(shift) },
|
||||
POLLUTE => sub { (extra_compiler_flags => '-DPERL_POLLUTE') },
|
||||
INSTALLDIRS => sub { (installdirs => $convert_installdirs{uc shift()}) },
|
||||
LIB => sub {
|
||||
my $lib = shift;
|
||||
my %config = (
|
||||
installprivlib => $lib,
|
||||
installsitelib => $lib,
|
||||
installarchlib => "$lib/$Config{archname}",
|
||||
installsitearch => "$lib/$Config{archname}"
|
||||
);
|
||||
return map { (config => "$_=$config{$_}") } sort keys %config;
|
||||
},
|
||||
|
||||
# Convert INSTALLVENDORLIB and friends.
|
||||
(
|
||||
map {
|
||||
my $name = $_;
|
||||
$name => sub {
|
||||
my @ret = (config => lc($name) . "=" . shift );
|
||||
print STDERR "# Converted to @ret\n";
|
||||
|
||||
return @ret;
|
||||
}
|
||||
} qw(
|
||||
INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH
|
||||
INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB
|
||||
INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN
|
||||
INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT
|
||||
INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR
|
||||
INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR
|
||||
)
|
||||
),
|
||||
|
||||
# Some names they have in common
|
||||
map {$_, lc($_)} qw(DESTDIR PREFIX INSTALL_BASE UNINST),
|
||||
);
|
||||
|
||||
my %macro_to_build = %makefile_to_build;
|
||||
# "LIB=foo make" is not the same as "perl Makefile.PL LIB=foo"
|
||||
delete $macro_to_build{LIB};
|
||||
|
||||
sub _merge_prereq {
|
||||
my ($req, $breq) = @_;
|
||||
$req ||= {};
|
||||
$breq ||= {};
|
||||
|
||||
# validate formats
|
||||
for my $p ( $req, $breq ) {
|
||||
for my $k (sort keys %$p) {
|
||||
next if $k eq 'perl';
|
||||
|
||||
my $v_obj = eval { version->new($p->{$k}) };
|
||||
if ( ! defined $v_obj ) {
|
||||
die "A prereq of the form '$p->{$k}' for '$k' is not supported by Module::Build::Compat ( use a simpler version like '0.05' or 'v1.4.25' )\n";
|
||||
}
|
||||
|
||||
# It seems like a lot of people trip over "0.1.2" stuff, so we help them here...
|
||||
if ( $v_obj->is_qv ) {
|
||||
my $proper_ver = $v_obj->numify;
|
||||
warn "Dotted-decimal prereq '$p->{$k}' for '$k' is not portable - converting it to '$proper_ver'\n";
|
||||
$p->{$k} = $proper_ver;
|
||||
}
|
||||
}
|
||||
}
|
||||
# merge
|
||||
my $merge = { %$req };
|
||||
for my $k ( keys %$breq ) {
|
||||
my $v1 = $merge->{$k} || 0;
|
||||
my $v2 = $breq->{$k};
|
||||
$merge->{$k} = $v1 > $v2 ? $v1 : $v2;
|
||||
}
|
||||
return %$merge;
|
||||
}
|
||||
|
||||
|
||||
sub create_makefile_pl {
|
||||
my ($package, $type, $build, %args) = @_;
|
||||
|
||||
die "Don't know how to build Makefile.PL of type '$type'"
|
||||
unless $type =~ /^(small|passthrough|traditional)$/;
|
||||
|
||||
if ($type eq 'passthrough') {
|
||||
$build->log_warn(<<"HERE");
|
||||
|
||||
IMPORTANT NOTE: The '$type' style of Makefile.PL is deprecated and
|
||||
may be removed in a future version of Module::Build in favor of the
|
||||
'configure_requires' property. See Module::Build::Compat
|
||||
documentation for details.
|
||||
|
||||
HERE
|
||||
}
|
||||
|
||||
my $fh;
|
||||
if ($args{fh}) {
|
||||
$fh = $args{fh};
|
||||
} else {
|
||||
$args{file} ||= 'Makefile.PL';
|
||||
local $build->{properties}{quiet} = 1;
|
||||
$build->delete_filetree($args{file});
|
||||
open($fh, '>', "$args{file}") or die "Can't write $args{file}: $!";
|
||||
}
|
||||
|
||||
print {$fh} "# Note: this file was auto-generated by ", __PACKAGE__, " version $VERSION\n";
|
||||
|
||||
# Minimum perl version should be specified as "require 5.XXXXXX" in
|
||||
# Makefile.PL
|
||||
my $requires = $build->requires;
|
||||
if ( my $minimum_perl = $requires->{perl} ) {
|
||||
my $min_ver = version->new($minimum_perl)->numify;
|
||||
print {$fh} "require $min_ver;\n";
|
||||
}
|
||||
|
||||
# If a *bundled* custom subclass is being used, make sure we add its
|
||||
# directory to @INC. Also, lib.pm always needs paths in Unix format.
|
||||
my $subclass_load = '';
|
||||
if (ref($build) ne "Module::Build") {
|
||||
my $subclass_dir = $package->subclass_dir($build);
|
||||
|
||||
if (File::Spec->file_name_is_absolute($subclass_dir)) {
|
||||
my $base_dir = $build->base_dir;
|
||||
|
||||
if ($build->dir_contains($base_dir, $subclass_dir)) {
|
||||
$subclass_dir = File::Spec->abs2rel($subclass_dir, $base_dir);
|
||||
$subclass_dir = $package->unixify_dir($subclass_dir);
|
||||
$subclass_load = "use lib '$subclass_dir';";
|
||||
}
|
||||
# Otherwise, leave it the empty string
|
||||
|
||||
} else {
|
||||
$subclass_dir = $package->unixify_dir($subclass_dir);
|
||||
$subclass_load = "use lib '$subclass_dir';";
|
||||
}
|
||||
}
|
||||
|
||||
if ($type eq 'small') {
|
||||
printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
|
||||
use Module::Build::Compat 0.02;
|
||||
%s
|
||||
Module::Build::Compat->run_build_pl(args => \@ARGV);
|
||||
require %s;
|
||||
Module::Build::Compat->write_makefile(build_class => '%s');
|
||||
EOF
|
||||
|
||||
} elsif ($type eq 'passthrough') {
|
||||
printf {$fh} <<'EOF', $subclass_load, ref($build), ref($build);
|
||||
|
||||
unless (eval "use Module::Build::Compat 0.02; 1" ) {
|
||||
print "This module requires Module::Build to install itself.\n";
|
||||
|
||||
require ExtUtils::MakeMaker;
|
||||
my $yn = ExtUtils::MakeMaker::prompt
|
||||
(' Install Module::Build now from CPAN?', 'y');
|
||||
|
||||
unless ($yn =~ /^y/i) {
|
||||
die " *** Cannot install without Module::Build. Exiting ...\n";
|
||||
}
|
||||
|
||||
require Cwd;
|
||||
require File::Spec;
|
||||
require CPAN;
|
||||
|
||||
# Save this 'cause CPAN will chdir all over the place.
|
||||
my $cwd = Cwd::cwd();
|
||||
|
||||
CPAN::Shell->install('Module::Build::Compat');
|
||||
CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate
|
||||
or die "Couldn't install Module::Build, giving up.\n";
|
||||
|
||||
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
|
||||
}
|
||||
eval "use Module::Build::Compat 0.02; 1" or die $@;
|
||||
%s
|
||||
Module::Build::Compat->run_build_pl(args => \@ARGV);
|
||||
my $build_script = 'Build';
|
||||
$build_script .= '.com' if $^O eq 'VMS';
|
||||
exit(0) unless(-e $build_script); # cpantesters convention
|
||||
require %s;
|
||||
Module::Build::Compat->write_makefile(build_class => '%s');
|
||||
EOF
|
||||
|
||||
} elsif ($type eq 'traditional') {
|
||||
|
||||
my (%MM_Args, %prereq);
|
||||
if (eval "use Tie::IxHash 1.2; 1") {
|
||||
tie %MM_Args, 'Tie::IxHash'; # Don't care if it fails here
|
||||
tie %prereq, 'Tie::IxHash'; # Don't care if it fails here
|
||||
}
|
||||
|
||||
my %name = ($build->module_name
|
||||
? (NAME => $build->module_name)
|
||||
: (DISTNAME => $build->dist_name));
|
||||
|
||||
my %version = ($build->dist_version_from
|
||||
? (VERSION_FROM => $build->dist_version_from)
|
||||
: (VERSION => $build->dist_version)
|
||||
);
|
||||
%MM_Args = (%name, %version);
|
||||
|
||||
%prereq = _merge_prereq( $build->requires, $build->build_requires );
|
||||
%prereq = map {$_, $prereq{$_}} sort keys %prereq;
|
||||
|
||||
delete $prereq{perl};
|
||||
$MM_Args{PREREQ_PM} = \%prereq;
|
||||
|
||||
$MM_Args{INSTALLDIRS} = $build->installdirs eq 'core' ? 'perl' : $build->installdirs;
|
||||
|
||||
$MM_Args{EXE_FILES} = [ sort keys %{$build->script_files} ] if $build->script_files;
|
||||
|
||||
$MM_Args{PL_FILES} = $build->PL_files || {};
|
||||
|
||||
if ($build->recursive_test_files) {
|
||||
$MM_Args{test} = { TESTS => join q{ }, $package->_test_globs($build) };
|
||||
}
|
||||
|
||||
local $Data::Dumper::Terse = 1;
|
||||
my $args = Data::Dumper::Dumper(\%MM_Args);
|
||||
$args =~ s/\{(.*)\}/($1)/s;
|
||||
|
||||
print $fh <<"EOF";
|
||||
use ExtUtils::MakeMaker;
|
||||
WriteMakefile
|
||||
$args;
|
||||
EOF
|
||||
}
|
||||
}
|
||||
|
||||
sub _test_globs {
|
||||
my ($self, $build) = @_;
|
||||
|
||||
return map { File::Spec->catfile($_, '*.t') }
|
||||
@{$build->rscan_dir('t', sub { -d $File::Find::name })};
|
||||
}
|
||||
|
||||
sub subclass_dir {
|
||||
my ($self, $build) = @_;
|
||||
|
||||
return (Module::Metadata->find_module_dir_by_name(ref $build)
|
||||
|| File::Spec->catdir($build->config_dir, 'lib'));
|
||||
}
|
||||
|
||||
sub unixify_dir {
|
||||
my ($self, $path) = @_;
|
||||
return join '/', File::Spec->splitdir($path);
|
||||
}
|
||||
|
||||
sub makefile_to_build_args {
|
||||
my $class = shift;
|
||||
my @out;
|
||||
foreach my $arg (@_) {
|
||||
next if $arg eq '';
|
||||
|
||||
my ($key, $val) = ($arg =~ /^(\w+)=(.+)/ ? ($1, $2) :
|
||||
die "Malformed argument '$arg'");
|
||||
|
||||
# Do tilde-expansion if it looks like a tilde prefixed path
|
||||
( $val ) = Module::Build->_detildefy( $val ) if $val =~ /^~/;
|
||||
|
||||
if (exists $makefile_to_build{$key}) {
|
||||
my $trans = $makefile_to_build{$key};
|
||||
push @out, $class->_argvify( ref($trans) ? $trans->($val) : ($trans => $val) );
|
||||
} elsif (exists $Config{lc($key)}) {
|
||||
push @out, $class->_argvify( config => lc($key) . "=$val" );
|
||||
} else {
|
||||
# Assume M::B can handle it in lowercase form
|
||||
push @out, $class->_argvify("\L$key" => $val);
|
||||
}
|
||||
}
|
||||
return @out;
|
||||
}
|
||||
|
||||
sub _argvify {
|
||||
my ($self, @pairs) = @_;
|
||||
my @out;
|
||||
while (@pairs) {
|
||||
my ($k, $v) = splice @pairs, 0, 2;
|
||||
push @out, ("--$k", $v);
|
||||
}
|
||||
return @out;
|
||||
}
|
||||
|
||||
sub makefile_to_build_macros {
|
||||
my @out;
|
||||
my %config; # must accumulate and return as a hashref
|
||||
foreach my $macro (sort keys %macro_to_build) {
|
||||
my $trans = $macro_to_build{$macro};
|
||||
# On some platforms (e.g. Cygwin with 'make'), the mere presence
|
||||
# of "EXPORT: FOO" in the Makefile will make $ENV{FOO} defined.
|
||||
# Therefore we check length() too.
|
||||
next unless exists $ENV{$macro} && length $ENV{$macro};
|
||||
my $val = $ENV{$macro};
|
||||
my @args = ref($trans) ? $trans->($val) : ($trans => $val);
|
||||
while (@args) {
|
||||
my ($k, $v) = splice(@args, 0, 2);
|
||||
if ( $k eq 'config' ) {
|
||||
if ( $v =~ /^([^=]+)=(.*)$/ ) {
|
||||
$config{$1} = $2;
|
||||
}
|
||||
else {
|
||||
warn "Couldn't parse config '$v'\n";
|
||||
}
|
||||
}
|
||||
else {
|
||||
push @out, ($k => $v);
|
||||
}
|
||||
}
|
||||
}
|
||||
push @out, (config => \%config) if %config;
|
||||
return @out;
|
||||
}
|
||||
|
||||
sub run_build_pl {
|
||||
my ($pack, %in) = @_;
|
||||
$in{script} ||= 'Build.PL';
|
||||
my @args = $in{args} ? $pack->makefile_to_build_args(@{$in{args}}) : ();
|
||||
print "# running $in{script} @args\n";
|
||||
Module::Build->run_perl_script($in{script}, [], \@args) or die "Couldn't run $in{script}: $!";
|
||||
}
|
||||
|
||||
sub fake_makefile {
|
||||
my ($self, %args) = @_;
|
||||
unless (exists $args{build_class}) {
|
||||
warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
|
||||
$args{build_class} = 'Module::Build';
|
||||
}
|
||||
my $class = $args{build_class};
|
||||
|
||||
my $perl = $class->find_perl_interpreter;
|
||||
|
||||
# VMS MMS/MMK need to use MCR to run the Perl image.
|
||||
$perl = 'MCR ' . $perl if $self->_is_vms_mms;
|
||||
|
||||
my $noop = ($class->is_windowsish ? 'rem>nul' :
|
||||
$self->_is_vms_mms ? 'Continue' :
|
||||
'true');
|
||||
|
||||
my $filetype = $class->is_vmsish ? '.COM' : '';
|
||||
|
||||
my $Build = 'Build' . $filetype . ' --makefile_env_macros 1';
|
||||
my $unlink = $class->oneliner('1 while unlink $ARGV[0]', [], [$args{makefile}]);
|
||||
$unlink =~ s/\$/\$\$/g unless $class->is_vmsish;
|
||||
|
||||
my $maketext = join '', map { "$_=\n" } sort keys %macro_to_build;
|
||||
|
||||
$maketext .= ($^O eq 'os2' ? "SHELL = sh\n\n"
|
||||
: $^O eq 'MSWin32' && $Config{make} =~ /gmake/
|
||||
? "SHELL = $ENV{COMSPEC}\n\n" : "\n\n");
|
||||
|
||||
$maketext .= <<"EOF";
|
||||
all : force_do_it
|
||||
$perl $Build
|
||||
realclean : force_do_it
|
||||
$perl $Build realclean
|
||||
$unlink
|
||||
distclean : force_do_it
|
||||
$perl $Build distclean
|
||||
$unlink
|
||||
|
||||
|
||||
force_do_it :
|
||||
@ $noop
|
||||
EOF
|
||||
|
||||
foreach my $action ($class->known_actions) {
|
||||
next if $action =~ /^(all|distclean|realclean|force_do_it)$/; # Don't double-define
|
||||
$maketext .= <<"EOF";
|
||||
$action : force_do_it
|
||||
$perl $Build $action
|
||||
EOF
|
||||
}
|
||||
|
||||
if ($self->_is_vms_mms) {
|
||||
# Roll our own .EXPORT as MMS/MMK don't honor that directive.
|
||||
$maketext .= "\n.FIRST\n\t\@ $noop\n";
|
||||
for my $macro (sort keys %macro_to_build) {
|
||||
$maketext .= ".IFDEF $macro\n\tDEFINE $macro \"\$($macro)\"\n.ENDIF\n";
|
||||
}
|
||||
$maketext .= "\n";
|
||||
}
|
||||
else {
|
||||
$maketext .= "\n.EXPORT : " . join(' ', sort keys %macro_to_build) . "\n\n";
|
||||
}
|
||||
|
||||
return $maketext;
|
||||
}
|
||||
|
||||
sub fake_prereqs {
|
||||
my $file = File::Spec->catfile('_build', 'prereqs');
|
||||
open(my $fh, '<', "$file") or die "Can't read $file: $!";
|
||||
my $prereqs = eval do {local $/; <$fh>};
|
||||
close $fh;
|
||||
|
||||
my %merged = _merge_prereq( $prereqs->{requires}, $prereqs->{build_requires} );
|
||||
my @prereq;
|
||||
foreach (sort keys %merged) {
|
||||
next if $_ eq 'perl';
|
||||
push @prereq, "$_=>q[$merged{$_}]";
|
||||
}
|
||||
return unless @prereq;
|
||||
return "# PREREQ_PM => { " . join(", ", @prereq) . " }\n\n";
|
||||
}
|
||||
|
||||
|
||||
sub write_makefile {
|
||||
my ($pack, %in) = @_;
|
||||
|
||||
unless (exists $in{build_class}) {
|
||||
warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
|
||||
$in{build_class} = 'Module::Build';
|
||||
}
|
||||
my $class = $in{build_class};
|
||||
$in{makefile} ||= $pack->_is_vms_mms ? 'Descrip.MMS' : 'Makefile';
|
||||
|
||||
open MAKE, "> $in{makefile}" or die "Cannot write $in{makefile}: $!";
|
||||
print MAKE $pack->fake_prereqs;
|
||||
print MAKE $pack->fake_makefile(%in);
|
||||
close MAKE;
|
||||
}
|
||||
|
||||
sub _is_vms_mms {
|
||||
return Module::Build->is_vmsish && ($Config{make} =~ m/MM[SK]/i);
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=for :stopwords passthrough
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Compat - Compatibility with ExtUtils::MakeMaker
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# In a Build.PL :
|
||||
use Module::Build;
|
||||
my $build = Module::Build->new
|
||||
( module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
create_makefile_pl => 'traditional' );
|
||||
...
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Because C<ExtUtils::MakeMaker> has been the standard way to distribute
|
||||
modules for a long time, many tools (CPAN.pm, or your system
|
||||
administrator) may expect to find a working F<Makefile.PL> in every
|
||||
distribution they download from CPAN. If you want to throw them a
|
||||
bone, you can use C<Module::Build::Compat> to automatically generate a
|
||||
F<Makefile.PL> for you, in one of several different styles.
|
||||
|
||||
C<Module::Build::Compat> also provides some code that helps out the
|
||||
F<Makefile.PL> at runtime.
|
||||
|
||||
=head1 WARNING
|
||||
|
||||
Note that C<Module::Build::Compat> more often causes installation issues
|
||||
than solves them, and each of the three F<Makefile.PL> generation styles
|
||||
has unique compatibility or functionality issues that are unlikely to be
|
||||
fixed. Thus, the use of this module and C<create_makefile_pl> is
|
||||
discouraged.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item create_makefile_pl($style, $build)
|
||||
|
||||
Creates a F<Makefile.PL> in the current directory in one of several
|
||||
styles, based on the supplied C<Module::Build> object C<$build>. This is
|
||||
typically controlled by passing the desired style as the
|
||||
C<create_makefile_pl> parameter to C<Module::Build>'s C<new()> method;
|
||||
the F<Makefile.PL> will then be automatically created during the
|
||||
C<distdir> action.
|
||||
|
||||
The currently supported styles are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item traditional
|
||||
|
||||
A F<Makefile.PL> will be created in the "traditional" style, i.e. it will
|
||||
use C<ExtUtils::MakeMaker> and won't rely on C<Module::Build> at all.
|
||||
In order to create the F<Makefile.PL>, we'll include the C<requires> and
|
||||
C<build_requires> dependencies as the C<PREREQ_PM> parameter.
|
||||
|
||||
You don't want to use this style if during the C<perl Build.PL> stage
|
||||
you ask the user questions, or do some auto-sensing about the user's
|
||||
environment, or if you subclass C<Module::Build> to do some
|
||||
customization, because the vanilla F<Makefile.PL> won't do any of that.
|
||||
Many standard C<Module::Build> features such as C<test_requires> are also
|
||||
not supported.
|
||||
|
||||
=item small
|
||||
|
||||
A small F<Makefile.PL> will be created that passes all functionality
|
||||
through to the F<Build.PL> script in the same directory. The user must
|
||||
already have C<Module::Build> installed in order to use this, or else
|
||||
they'll get a module-not-found error.
|
||||
|
||||
This style attempts (with varying success) to translate the F<Makefile.PL>
|
||||
protocol to F<Build.PL>, and is unnecessary on any modern toolchain that
|
||||
recognizes C<configure_requires> metadata described below, as F<Build.PL>
|
||||
will be run by default in this case. See
|
||||
L<https://rt.cpan.org/Public/Bug/Display.html?id=75936> for an example of
|
||||
the issues it may cause.
|
||||
|
||||
=item passthrough (DEPRECATED)
|
||||
|
||||
This is just like the C<small> option above, but if C<Module::Build> is
|
||||
not already installed on the user's system, the script will offer to
|
||||
use C<CPAN.pm> to download it and install it before continuing with
|
||||
the build.
|
||||
|
||||
This option has been deprecated and may be removed in a future version
|
||||
of Module::Build. Modern CPAN.pm and CPANPLUS will recognize the
|
||||
C<configure_requires> metadata property and install Module::Build before
|
||||
running Build.PL if Module::Build is listed and Module::Build now
|
||||
adds itself to configure_requires by default.
|
||||
|
||||
Perl 5.10.1 includes C<configure_requires> support. In the future, when
|
||||
C<configure_requires> support is deemed sufficiently widespread, the
|
||||
C<passthrough> style will be removed.
|
||||
|
||||
=back
|
||||
|
||||
=item run_build_pl(args => \@ARGV)
|
||||
|
||||
This method runs the F<Build.PL> script, passing it any arguments the
|
||||
user may have supplied to the C<perl Makefile.PL> command. Because
|
||||
C<ExtUtils::MakeMaker> and C<Module::Build> accept different arguments, this
|
||||
method also performs some translation between the two.
|
||||
|
||||
C<run_build_pl()> accepts the following named parameters:
|
||||
|
||||
=over 4
|
||||
|
||||
=item args
|
||||
|
||||
The C<args> parameter specifies the parameters that would usually
|
||||
appear on the command line of the C<perl Makefile.PL> command -
|
||||
typically you'll just pass a reference to C<@ARGV>.
|
||||
|
||||
=item script
|
||||
|
||||
This is the filename of the script to run - it defaults to C<Build.PL>.
|
||||
|
||||
=back
|
||||
|
||||
=item write_makefile()
|
||||
|
||||
This method writes a 'dummy' F<Makefile> that will pass all commands
|
||||
through to the corresponding C<Module::Build> actions.
|
||||
|
||||
C<write_makefile()> accepts the following named parameters:
|
||||
|
||||
=over 4
|
||||
|
||||
=item makefile
|
||||
|
||||
The name of the file to write - defaults to the string C<Makefile>.
|
||||
|
||||
=back
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 SCENARIOS
|
||||
|
||||
So, some common scenarios are:
|
||||
|
||||
=over 4
|
||||
|
||||
=item 1.
|
||||
|
||||
Just include a F<Build.PL> script (without a F<Makefile.PL>
|
||||
script), and give installation directions in a F<README> or F<INSTALL>
|
||||
document explaining how to install the module. In particular, explain
|
||||
that the user must install C<Module::Build> before installing your
|
||||
module.
|
||||
|
||||
Note that if you do this, you may make things easier for yourself, but
|
||||
harder for people with older versions of CPAN or CPANPLUS on their
|
||||
system, because those tools generally only understand the
|
||||
F<Makefile.PL>/C<ExtUtils::MakeMaker> way of doing things.
|
||||
|
||||
=item 2.
|
||||
|
||||
Include a F<Build.PL> script and a "traditional" F<Makefile.PL>,
|
||||
created either manually or with C<create_makefile_pl()>. Users won't
|
||||
ever have to install C<Module::Build> if they use the F<Makefile.PL>, but
|
||||
they won't get to take advantage of C<Module::Build>'s extra features
|
||||
either.
|
||||
|
||||
For good measure, of course, test both the F<Makefile.PL> and the
|
||||
F<Build.PL> before shipping.
|
||||
|
||||
=item 3.
|
||||
|
||||
Include a F<Build.PL> script and a "pass-through" F<Makefile.PL>
|
||||
built using C<Module::Build::Compat>. This will mean that people can
|
||||
continue to use the "old" installation commands, and they may never
|
||||
notice that it's actually doing something else behind the scenes. It
|
||||
will also mean that your installation process is compatible with older
|
||||
versions of tools like CPAN and CPANPLUS.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2001-2006 Ken Williams. All rights reserved.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Module::Build>(3), L<ExtUtils::MakeMaker>(3)
|
||||
|
||||
|
||||
=cut
|
||||
59
database/perl/lib/Module/Build/Config.pm
Normal file
59
database/perl/lib/Module/Build/Config.pm
Normal file
@@ -0,0 +1,59 @@
|
||||
package Module::Build::Config;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Config;
|
||||
|
||||
sub new {
|
||||
my ($pack, %args) = @_;
|
||||
return bless {
|
||||
stack => {},
|
||||
values => $args{values} || {},
|
||||
}, $pack;
|
||||
}
|
||||
|
||||
sub get {
|
||||
my ($self, $key) = @_;
|
||||
return $self->{values}{$key} if ref($self) && exists $self->{values}{$key};
|
||||
return $Config{$key};
|
||||
}
|
||||
|
||||
sub set {
|
||||
my ($self, $key, $val) = @_;
|
||||
$self->{values}{$key} = $val;
|
||||
}
|
||||
|
||||
sub push {
|
||||
my ($self, $key, $val) = @_;
|
||||
push @{$self->{stack}{$key}}, $self->{values}{$key}
|
||||
if exists $self->{values}{$key};
|
||||
$self->{values}{$key} = $val;
|
||||
}
|
||||
|
||||
sub pop {
|
||||
my ($self, $key) = @_;
|
||||
|
||||
my $val = delete $self->{values}{$key};
|
||||
if ( exists $self->{stack}{$key} ) {
|
||||
$self->{values}{$key} = pop @{$self->{stack}{$key}};
|
||||
delete $self->{stack}{$key} unless @{$self->{stack}{$key}};
|
||||
}
|
||||
|
||||
return $val;
|
||||
}
|
||||
|
||||
sub values_set {
|
||||
my $self = shift;
|
||||
return undef unless ref($self);
|
||||
return $self->{values};
|
||||
}
|
||||
|
||||
sub all_config {
|
||||
my $self = shift;
|
||||
my $v = ref($self) ? $self->{values} : {};
|
||||
return {%Config, %$v};
|
||||
}
|
||||
|
||||
1;
|
||||
206
database/perl/lib/Module/Build/ConfigData.pm
Normal file
206
database/perl/lib/Module/Build/ConfigData.pm
Normal file
@@ -0,0 +1,206 @@
|
||||
package Module::Build::ConfigData;
|
||||
use strict;
|
||||
my $arrayref = eval do {local $/; <DATA>}
|
||||
or die "Couldn't load ConfigData data: $@";
|
||||
close DATA;
|
||||
my ($config, $features, $auto_features) = @$arrayref;
|
||||
|
||||
sub config { $config->{$_[1]} }
|
||||
|
||||
sub set_config { $config->{$_[1]} = $_[2] }
|
||||
sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
|
||||
|
||||
sub auto_feature_names { sort grep !exists $features->{$_}, keys %$auto_features }
|
||||
|
||||
sub feature_names {
|
||||
my @features = (sort keys %$features, auto_feature_names());
|
||||
@features;
|
||||
}
|
||||
|
||||
sub config_names { sort keys %$config }
|
||||
|
||||
sub write {
|
||||
my $me = __FILE__;
|
||||
|
||||
# Can't use Module::Build::Dumper here because M::B is only a
|
||||
# build-time prereq of this module
|
||||
require Data::Dumper;
|
||||
|
||||
my $mode_orig = (stat $me)[2] & 07777;
|
||||
chmod($mode_orig | 0222, $me); # Make it writeable
|
||||
open(my $fh, '+<', $me) or die "Can't rewrite $me: $!";
|
||||
seek($fh, 0, 0);
|
||||
while (<$fh>) {
|
||||
last if /^__DATA__$/;
|
||||
}
|
||||
die "Couldn't find __DATA__ token in $me" if eof($fh);
|
||||
|
||||
seek($fh, tell($fh), 0);
|
||||
my $data = [$config, $features, $auto_features];
|
||||
print($fh 'do{ my '
|
||||
. Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
|
||||
. '$x; }' );
|
||||
truncate($fh, tell($fh));
|
||||
close $fh;
|
||||
|
||||
chmod($mode_orig, $me)
|
||||
or warn "Couldn't restore permissions on $me: $!";
|
||||
}
|
||||
|
||||
sub feature {
|
||||
my ($package, $key) = @_;
|
||||
return $features->{$key} if exists $features->{$key};
|
||||
|
||||
my $info = $auto_features->{$key} or return 0;
|
||||
|
||||
require Module::Build; # XXX should get rid of this
|
||||
foreach my $type (sort keys %$info) {
|
||||
my $prereqs = $info->{$type};
|
||||
next if $type eq 'description' || $type eq 'recommends';
|
||||
|
||||
foreach my $modname (sort keys %$prereqs) {
|
||||
my $status = Module::Build->check_installed_status($modname, $prereqs->{$modname});
|
||||
if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
|
||||
if ( ! eval "require $modname; 1" ) { return 0; }
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::ConfigData - Configuration for Module::Build
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Module::Build::ConfigData;
|
||||
$value = Module::Build::ConfigData->config('foo');
|
||||
$value = Module::Build::ConfigData->feature('bar');
|
||||
|
||||
@names = Module::Build::ConfigData->config_names;
|
||||
@names = Module::Build::ConfigData->feature_names;
|
||||
|
||||
Module::Build::ConfigData->set_config(foo => $new_value);
|
||||
Module::Build::ConfigData->set_feature(bar => $new_value);
|
||||
Module::Build::ConfigData->write; # Save changes
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module holds the configuration data for the C<Module::Build>
|
||||
module. It also provides a programmatic interface for getting or
|
||||
setting that configuration data. Note that in order to actually make
|
||||
changes, you'll have to have write access to the C<Module::Build::ConfigData>
|
||||
module, and you should attempt to understand the repercussions of your
|
||||
actions.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item config($name)
|
||||
|
||||
Given a string argument, returns the value of the configuration item
|
||||
by that name, or C<undef> if no such item exists.
|
||||
|
||||
=item feature($name)
|
||||
|
||||
Given a string argument, returns the value of the feature by that
|
||||
name, or C<undef> if no such feature exists.
|
||||
|
||||
=item set_config($name, $value)
|
||||
|
||||
Sets the configuration item with the given name to the given value.
|
||||
The value may be any Perl scalar that will serialize correctly using
|
||||
C<Data::Dumper>. This includes references, objects (usually), and
|
||||
complex data structures. It probably does not include transient
|
||||
things like filehandles or sockets.
|
||||
|
||||
=item set_feature($name, $value)
|
||||
|
||||
Sets the feature with the given name to the given boolean value. The
|
||||
value will be converted to 0 or 1 automatically.
|
||||
|
||||
=item config_names()
|
||||
|
||||
Returns a list of all the names of config items currently defined in
|
||||
C<Module::Build::ConfigData>, or in scalar context the number of items.
|
||||
|
||||
=item feature_names()
|
||||
|
||||
Returns a list of all the names of features currently defined in
|
||||
C<Module::Build::ConfigData>, or in scalar context the number of features.
|
||||
|
||||
=item auto_feature_names()
|
||||
|
||||
Returns a list of all the names of features whose availability is
|
||||
dynamically determined, or in scalar context the number of such
|
||||
features. Does not include such features that have later been set to
|
||||
a fixed value.
|
||||
|
||||
=item write()
|
||||
|
||||
Commits any changes from C<set_config()> and C<set_feature()> to disk.
|
||||
Requires write access to the C<Module::Build::ConfigData> module.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
C<Module::Build::ConfigData> was automatically created using C<Module::Build>.
|
||||
C<Module::Build> was written by Ken Williams, but he holds no
|
||||
authorship claim or copyright claim to the contents of C<Module::Build::ConfigData>.
|
||||
|
||||
=cut
|
||||
|
||||
|
||||
__DATA__
|
||||
do{ my $x = [
|
||||
{},
|
||||
{},
|
||||
{
|
||||
'HTML_support' => {
|
||||
'description' => 'Create HTML documentation',
|
||||
'requires' => {
|
||||
'Pod::Html' => 0
|
||||
}
|
||||
},
|
||||
'PPM_support' => {
|
||||
'description' => 'Generate PPM files for distributions'
|
||||
},
|
||||
'dist_authoring' => {
|
||||
'description' => 'Create new distributions',
|
||||
'recommends' => {
|
||||
'Module::Signature' => '0.21',
|
||||
'Pod::Readme' => '0.04'
|
||||
},
|
||||
'requires' => {
|
||||
'Archive::Tar' => '1.09'
|
||||
}
|
||||
},
|
||||
'inc_bundling_support' => {
|
||||
'description' => 'Bundle Module::Build in inc/',
|
||||
'requires' => {
|
||||
'ExtUtils::Install' => '1.54',
|
||||
'ExtUtils::Installed' => '1.999',
|
||||
'inc::latest' => '0.5'
|
||||
}
|
||||
},
|
||||
'license_creation' => {
|
||||
'description' => 'Create licenses automatically in distributions',
|
||||
'requires' => {
|
||||
'Software::License' => '0.103009'
|
||||
}
|
||||
},
|
||||
'manpage_support' => {
|
||||
'description' => 'Create Unix man pages',
|
||||
'requires' => {
|
||||
'Pod::Man' => 0
|
||||
}
|
||||
}
|
||||
}
|
||||
];
|
||||
$x; }
|
||||
529
database/perl/lib/Module/Build/Cookbook.pm
Normal file
529
database/perl/lib/Module/Build/Cookbook.pm
Normal file
@@ -0,0 +1,529 @@
|
||||
package Module::Build::Cookbook;
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Cookbook - Examples of Module::Build Usage
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
C<Module::Build> isn't conceptually very complicated, but examples are
|
||||
always helpful. The following recipes should help developers and/or
|
||||
installers put together the pieces from the other parts of the
|
||||
documentation.
|
||||
|
||||
|
||||
=head1 BASIC RECIPES
|
||||
|
||||
|
||||
=head2 Installing modules that use Module::Build
|
||||
|
||||
In most cases, you can just issue the following commands:
|
||||
|
||||
perl Build.PL
|
||||
./Build
|
||||
./Build test
|
||||
./Build install
|
||||
|
||||
There's nothing complicated here - first you're running a script
|
||||
called F<Build.PL>, then you're running a (newly-generated) script
|
||||
called F<Build> and passing it various arguments.
|
||||
|
||||
The exact commands may vary a bit depending on how you invoke perl
|
||||
scripts on your system. For instance, if you have multiple versions
|
||||
of perl installed, you can install to one particular perl's library
|
||||
directories like so:
|
||||
|
||||
/usr/bin/perl5.8.1 Build.PL
|
||||
./Build
|
||||
./Build test
|
||||
./Build install
|
||||
|
||||
If you're on Windows where the current directory is always searched
|
||||
first for scripts, you'll probably do something like this:
|
||||
|
||||
perl Build.PL
|
||||
Build
|
||||
Build test
|
||||
Build install
|
||||
|
||||
On the old Mac OS (version 9 or lower) using MacPerl, you can
|
||||
double-click on the F<Build.PL> script to create the F<Build> script,
|
||||
then double-click on the F<Build> script to run its C<build>, C<test>,
|
||||
and C<install> actions.
|
||||
|
||||
The F<Build> script knows what perl was used to run F<Build.PL>, so
|
||||
you don't need to re-invoke the F<Build> script with the complete perl
|
||||
path each time. If you invoke it with the I<wrong> perl path, you'll
|
||||
get a warning or a fatal error.
|
||||
|
||||
=head2 Modifying Config.pm values
|
||||
|
||||
C<Module::Build> relies heavily on various values from perl's
|
||||
C<Config.pm> to do its work. For example, default installation paths
|
||||
are given by C<installsitelib> and C<installvendorman3dir> and
|
||||
friends, C linker & compiler settings are given by C<ld>,
|
||||
C<lddlflags>, C<cc>, C<ccflags>, and so on. I<If you're pretty sure
|
||||
you know what you're doing>, you can tell C<Module::Build> to pretend
|
||||
there are different values in F<Config.pm> than what's really there,
|
||||
by passing arguments for the C<--config> parameter on the command
|
||||
line:
|
||||
|
||||
perl Build.PL --config cc=gcc --config ld=gcc
|
||||
|
||||
Inside the C<Build.PL> script the same thing can be accomplished by
|
||||
passing values for the C<config> parameter to C<new()>:
|
||||
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
...
|
||||
config => { cc => 'gcc', ld => 'gcc' },
|
||||
...
|
||||
);
|
||||
|
||||
In custom build code, the same thing can be accomplished by calling
|
||||
the L<Module::Build/config> method:
|
||||
|
||||
$build->config( cc => 'gcc' ); # Set
|
||||
$build->config( ld => 'gcc' ); # Set
|
||||
...
|
||||
my $linker = $build->config('ld'); # Get
|
||||
|
||||
|
||||
=head2 Installing modules using the programmatic interface
|
||||
|
||||
If you need to build, test, and/or install modules from within some
|
||||
other perl code (as opposed to having the user type installation
|
||||
commands at the shell), you can use the programmatic interface.
|
||||
Create a Module::Build object (or an object of a custom Module::Build
|
||||
subclass) and then invoke its C<dispatch()> method to run various
|
||||
actions.
|
||||
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
license => 'perl',
|
||||
requires => { 'Some::Module' => '1.23' },
|
||||
);
|
||||
$build->dispatch('build');
|
||||
$build->dispatch('test', verbose => 1);
|
||||
$build->dispatch('install');
|
||||
|
||||
The first argument to C<dispatch()> is the name of the action, and any
|
||||
following arguments are named parameters.
|
||||
|
||||
This is the interface we use to test Module::Build itself in the
|
||||
regression tests.
|
||||
|
||||
|
||||
=head2 Installing to a temporary directory
|
||||
|
||||
To create packages for package managers like RedHat's C<rpm> or
|
||||
Debian's C<deb>, you may need to install to a temporary directory
|
||||
first and then create the package from that temporary installation.
|
||||
To do this, specify the C<destdir> parameter to the C<install> action:
|
||||
|
||||
./Build install --destdir /tmp/my-package-1.003
|
||||
|
||||
This essentially just prepends all the installation paths with the
|
||||
F</tmp/my-package-1.003> directory.
|
||||
|
||||
|
||||
=head2 Installing to a non-standard directory
|
||||
|
||||
To install to a non-standard directory (for example, if you don't have
|
||||
permission to install in the system-wide directories), you can use the
|
||||
C<install_base> or C<prefix> parameters:
|
||||
|
||||
./Build install --install_base /foo/bar
|
||||
|
||||
See L<Module::Build/"INSTALL PATHS"> for a much more complete
|
||||
discussion of how installation paths are determined.
|
||||
|
||||
|
||||
=head2 Installing in the same location as ExtUtils::MakeMaker
|
||||
|
||||
With the introduction of C<--prefix> in Module::Build 0.28 and
|
||||
C<INSTALL_BASE> in C<ExtUtils::MakeMaker> 6.31 its easy to get them both
|
||||
to install to the same locations.
|
||||
|
||||
First, ensure you have at least version 0.28 of Module::Build
|
||||
installed and 6.31 of C<ExtUtils::MakeMaker>. Prior versions have
|
||||
differing (and in some cases quite strange) installation behaviors.
|
||||
|
||||
The following installation flags are equivalent between
|
||||
C<ExtUtils::MakeMaker> and C<Module::Build>.
|
||||
|
||||
MakeMaker Module::Build
|
||||
PREFIX=... --prefix ...
|
||||
INSTALL_BASE=... --install_base ...
|
||||
DESTDIR=... --destdir ...
|
||||
LIB=... --install_path lib=...
|
||||
INSTALLDIRS=... --installdirs ...
|
||||
INSTALLDIRS=perl --installdirs core
|
||||
UNINST=... --uninst ...
|
||||
INC=... --extra_compiler_flags ...
|
||||
POLLUTE=1 --extra_compiler_flags -DPERL_POLLUTE
|
||||
|
||||
For example, if you are currently installing C<MakeMaker> modules with
|
||||
this command:
|
||||
|
||||
perl Makefile.PL PREFIX=~
|
||||
make test
|
||||
make install UNINST=1
|
||||
|
||||
You can install into the same location with Module::Build using this:
|
||||
|
||||
perl Build.PL --prefix ~
|
||||
./Build test
|
||||
./Build install --uninst 1
|
||||
|
||||
=head3 C<prefix> vs C<install_base>
|
||||
|
||||
The behavior of C<prefix> is complicated and depends on
|
||||
how your Perl is configured. The resulting installation locations
|
||||
will vary from machine to machine and even different installations of
|
||||
Perl on the same machine. Because of this, it's difficult to document
|
||||
where C<prefix> will place your modules.
|
||||
|
||||
In contrast, C<install_base> has predictable, easy to explain
|
||||
installation locations. Now that C<Module::Build> and C<MakeMaker> both
|
||||
have C<install_base> there is little reason to use C<prefix> other
|
||||
than to preserve your existing installation locations. If you are
|
||||
starting a fresh Perl installation we encourage you to use
|
||||
C<install_base>. If you have an existing installation installed via
|
||||
C<prefix>, consider moving it to an installation structure matching
|
||||
C<install_base> and using that instead.
|
||||
|
||||
|
||||
=head2 Running a single test file
|
||||
|
||||
C<Module::Build> supports running a single test, which enables you to
|
||||
track down errors more quickly. Use the following format:
|
||||
|
||||
./Build test --test_files t/mytest.t
|
||||
|
||||
In addition, you may want to run the test in verbose mode to get more
|
||||
informative output:
|
||||
|
||||
./Build test --test_files t/mytest.t --verbose 1
|
||||
|
||||
I run this so frequently that I define the following shell alias:
|
||||
|
||||
alias t './Build test --verbose 1 --test_files'
|
||||
|
||||
So then I can just execute C<t t/mytest.t> to run a single test.
|
||||
|
||||
|
||||
=head1 ADVANCED RECIPES
|
||||
|
||||
|
||||
=head2 Making a CPAN.pm-compatible distribution
|
||||
|
||||
New versions of CPAN.pm understand how to use a F<Build.PL> script,
|
||||
but old versions don't. If authors want to help users who have old
|
||||
versions, some form of F<Makefile.PL> should be supplied. The easiest
|
||||
way to accomplish this is to use the C<create_makefile_pl> parameter to
|
||||
C<< Module::Build->new() >> in the C<Build.PL> script, which can
|
||||
create various flavors of F<Makefile.PL> during the C<dist> action.
|
||||
|
||||
As a best practice, we recommend using the "traditional" style of
|
||||
F<Makefile.PL> unless your distribution has needs that can't be
|
||||
accomplished that way.
|
||||
|
||||
The C<Module::Build::Compat> module, which is part of
|
||||
C<Module::Build>'s distribution, is responsible for creating these
|
||||
F<Makefile.PL>s. Please see L<Module::Build::Compat> for the details.
|
||||
|
||||
|
||||
=head2 Changing the order of the build process
|
||||
|
||||
The C<build_elements> property specifies the steps C<Module::Build>
|
||||
will take when building a distribution. To change the build order,
|
||||
change the order of the entries in that property:
|
||||
|
||||
# Process pod files first
|
||||
my @e = @{$build->build_elements};
|
||||
my ($i) = grep {$e[$_] eq 'pod'} 0..$#e;
|
||||
unshift @e, splice @e, $i, 1;
|
||||
|
||||
Currently, C<build_elements> has the following default value:
|
||||
|
||||
[qw( PL support pm xs pod script )]
|
||||
|
||||
Do take care when altering this property, since there may be
|
||||
non-obvious (and non-documented!) ordering dependencies in the
|
||||
C<Module::Build> code.
|
||||
|
||||
|
||||
=head2 Adding new file types to the build process
|
||||
|
||||
Sometimes you might have extra types of files that you want to install
|
||||
alongside the standard types like F<.pm> and F<.pod> files. For
|
||||
instance, you might have a F<Bar.dat> file containing some data
|
||||
related to the C<Foo::Bar> module and you'd like for it to end up as
|
||||
F<Foo/Bar.dat> somewhere in perl's C<@INC> path so C<Foo::Bar> can
|
||||
access it easily at runtime. The following code from a sample
|
||||
C<Build.PL> file demonstrates how to accomplish this:
|
||||
|
||||
use Module::Build;
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
...other stuff here...
|
||||
);
|
||||
$build->add_build_element('dat');
|
||||
$build->create_build_script;
|
||||
|
||||
This will find all F<.dat> files in the F<lib/> directory, copy them
|
||||
to the F<blib/lib/> directory during the C<build> action, and install
|
||||
them during the C<install> action.
|
||||
|
||||
If your extra files aren't located in the C<lib/> directory in your
|
||||
distribution, you can explicitly say where they are, just as you'd do
|
||||
with F<.pm> or F<.pod> files:
|
||||
|
||||
use Module::Build;
|
||||
my $build = new Module::Build
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
dat_files => {'some/dir/Bar.dat' => 'lib/Foo/Bar.dat'},
|
||||
...other stuff here...
|
||||
);
|
||||
$build->add_build_element('dat');
|
||||
$build->create_build_script;
|
||||
|
||||
If your extra files actually need to be created on the user's machine,
|
||||
or if they need some other kind of special processing, you'll probably
|
||||
want to subclass C<Module::Build> and create a special method to
|
||||
process them, named C<process_${kind}_files()>:
|
||||
|
||||
use Module::Build;
|
||||
my $class = Module::Build->subclass(code => <<'EOF');
|
||||
sub process_dat_files {
|
||||
my $self = shift;
|
||||
... locate and process *.dat files,
|
||||
... and create something in blib/lib/
|
||||
}
|
||||
EOF
|
||||
my $build = $class->new
|
||||
(
|
||||
module_name => 'Foo::Bar',
|
||||
...other stuff here...
|
||||
);
|
||||
$build->add_build_element('dat');
|
||||
$build->create_build_script;
|
||||
|
||||
If your extra files don't go in F<lib/> but in some other place, see
|
||||
L<"Adding new elements to the install process"> for how to actually
|
||||
get them installed.
|
||||
|
||||
Please note that these examples use some capabilities of Module::Build
|
||||
that first appeared in version 0.26. Before that it could
|
||||
still be done, but the simple cases took a bit more work.
|
||||
|
||||
|
||||
=head2 Adding new elements to the install process
|
||||
|
||||
By default, Module::Build creates seven subdirectories of the F<blib>
|
||||
directory during the build process: F<lib>, F<arch>, F<bin>,
|
||||
F<script>, F<bindoc>, F<libdoc>, and F<html> (some of these may be
|
||||
missing or empty if there's nothing to go in them). Anything copied
|
||||
to these directories during the build will eventually be installed
|
||||
during the C<install> action (see L<Module::Build/"INSTALL PATHS">.
|
||||
|
||||
If you need to create a new custom type of installable element, e.g. C<conf>,
|
||||
then you need to tell Module::Build where things in F<blib/conf/>
|
||||
should be installed. To do this, use the C<install_path> parameter to
|
||||
the C<new()> method:
|
||||
|
||||
my $build = Module::Build->new
|
||||
(
|
||||
...other stuff here...
|
||||
install_path => { conf => $installation_path }
|
||||
);
|
||||
|
||||
Or you can call the C<install_path()> method later:
|
||||
|
||||
$build->install_path(conf => $installation_path);
|
||||
|
||||
The user may also specify the path on the command line:
|
||||
|
||||
perl Build.PL --install_path conf=/foo/path/etc
|
||||
|
||||
The important part, though, is that I<somehow> the install path needs
|
||||
to be set, or else nothing in the F<blib/conf/> directory will get
|
||||
installed, and a runtime error during the C<install> action will
|
||||
result.
|
||||
|
||||
See also L<"Adding new file types to the build process"> for how to
|
||||
create the stuff in F<blib/conf/> in the first place.
|
||||
|
||||
|
||||
=head1 EXAMPLES ON CPAN
|
||||
|
||||
Several distributions on CPAN are making good use of various features
|
||||
of Module::Build. They can serve as real-world examples for others.
|
||||
|
||||
|
||||
=head2 SVN-Notify-Mirror
|
||||
|
||||
L<http://search.cpan.org/~jpeacock/SVN-Notify-Mirror/>
|
||||
|
||||
John Peacock, author of the C<SVN-Notify-Mirror> distribution, says:
|
||||
|
||||
=over 4
|
||||
|
||||
=item 1. Using C<auto_features>, I check to see whether two optional
|
||||
modules are available - SVN::Notify::Config and Net::SSH;
|
||||
|
||||
=item 2. If the S::N::Config module is loaded, I automatically
|
||||
generate test files for it during Build (using the C<PL_files>
|
||||
property).
|
||||
|
||||
=item 3. If the C<ssh_feature> is available, I ask if the user wishes
|
||||
to perform the ssh tests (since it requires a little preliminary
|
||||
setup);
|
||||
|
||||
=item 4. Only if the user has C<ssh_feature> and answers yes to the
|
||||
testing, do I generate a test file.
|
||||
|
||||
I'm sure I could not have handled this complexity with EU::MM, but it
|
||||
was very easy to do with M::B.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head2 Modifying an action
|
||||
|
||||
Sometimes you might need an to have an action, say C<./Build install>,
|
||||
do something unusual. For instance, you might need to change the
|
||||
ownership of a file or do something else peculiar to your application.
|
||||
|
||||
You can subclass C<Module::Build> on the fly using the C<subclass()>
|
||||
method and override the methods that perform the actions. You may
|
||||
need to read through C<Module::Build::Authoring> and
|
||||
C<Module::Build::API> to find the methods you want to override. All
|
||||
"action" methods are implemented by a method called "ACTION_" followed
|
||||
by the action's name, so here's an example of how it would work for
|
||||
the C<install> action:
|
||||
|
||||
# Build.PL
|
||||
use Module::Build;
|
||||
my $class = Module::Build->subclass(
|
||||
class => "Module::Build::Custom",
|
||||
code => <<'SUBCLASS' );
|
||||
|
||||
sub ACTION_install {
|
||||
my $self = shift;
|
||||
# YOUR CODE HERE
|
||||
$self->SUPER::ACTION_install;
|
||||
}
|
||||
SUBCLASS
|
||||
|
||||
$class->new(
|
||||
module_name => 'Your::Module',
|
||||
# rest of the usual Module::Build parameters
|
||||
)->create_build_script;
|
||||
|
||||
|
||||
=head2 Adding an action
|
||||
|
||||
You can add a new C<./Build> action simply by writing the method for
|
||||
it in your subclass. Use C<depends_on> to declare that another action
|
||||
must have been run before your action.
|
||||
|
||||
For example, let's say you wanted to be able to write C<./Build
|
||||
commit> to test your code and commit it to Subversion.
|
||||
|
||||
# Build.PL
|
||||
use Module::Build;
|
||||
my $class = Module::Build->subclass(
|
||||
class => "Module::Build::Custom",
|
||||
code => <<'SUBCLASS' );
|
||||
|
||||
sub ACTION_commit {
|
||||
my $self = shift;
|
||||
|
||||
$self->depends_on("test");
|
||||
$self->do_system(qw(svn commit));
|
||||
}
|
||||
SUBCLASS
|
||||
|
||||
|
||||
=head2 Bundling Module::Build
|
||||
|
||||
Note: This section probably needs an update as the technology improves
|
||||
(see contrib/bundle.pl in the distribution).
|
||||
|
||||
Suppose you want to use some new-ish features of Module::Build,
|
||||
e.g. newer than the version of Module::Build your users are likely to
|
||||
already have installed on their systems. The first thing you should
|
||||
do is set C<configure_requires> to your minimum version of
|
||||
Module::Build. See L<Module::Build::Authoring>.
|
||||
|
||||
But not every build system honors C<configure_requires> yet. Here's
|
||||
how you can ship a copy of Module::Build, but still use a newer
|
||||
installed version to take advantage of any bug fixes and upgrades.
|
||||
|
||||
First, install Module::Build into F<Your-Project/inc/Module-Build>.
|
||||
CPAN will not index anything in the F<inc> directory so this copy will
|
||||
not show up in CPAN searches.
|
||||
|
||||
cd Module-Build
|
||||
perl Build.PL --install_base /path/to/Your-Project/inc/Module-Build
|
||||
./Build test
|
||||
./Build install
|
||||
|
||||
You should now have all the Module::Build .pm files in
|
||||
F<Your-Project/inc/Module-Build/lib/perl5>.
|
||||
|
||||
Next, add this to the top of your F<Build.PL>.
|
||||
|
||||
my $Bundled_MB = 0.30; # or whatever version it was.
|
||||
|
||||
# Find out what version of Module::Build is installed or fail quietly.
|
||||
# This should be cross-platform.
|
||||
my $Installed_MB =
|
||||
`$^X -e "eval q{require Module::Build; print Module::Build->VERSION} or exit 1"`;
|
||||
|
||||
# some operating systems put a newline at the end of every print.
|
||||
chomp $Installed_MB;
|
||||
|
||||
$Installed_MB = 0 if $?;
|
||||
|
||||
# Use our bundled copy of Module::Build if it's newer than the installed.
|
||||
unshift @INC, "inc/Module-Build/lib/perl5" if $Bundled_MB > $Installed_MB;
|
||||
|
||||
require Module::Build;
|
||||
|
||||
And write the rest of your F<Build.PL> normally. Module::Build will
|
||||
remember your change to C<@INC> and use it when you run F<./Build>.
|
||||
|
||||
In the future, we hope to provide a more automated solution for this
|
||||
scenario; see C<inc/latest.pm> in the Module::Build distribution for
|
||||
one indication of the direction we're moving.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2001-2008 Ken Williams. All rights reserved.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), L<Module::Build>(3), L<Module::Build::Authoring>(3),
|
||||
L<Module::Build::API>(3)
|
||||
|
||||
=cut
|
||||
19
database/perl/lib/Module/Build/Dumper.pm
Normal file
19
database/perl/lib/Module/Build/Dumper.pm
Normal file
@@ -0,0 +1,19 @@
|
||||
package Module::Build::Dumper;
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
|
||||
# This is just a split-out of a wrapper function to do Data::Dumper
|
||||
# stuff "the right way". See:
|
||||
# http://groups.google.com/group/perl.module.build/browse_thread/thread/c8065052b2e0d741
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
sub _data_dump {
|
||||
my ($self, $data) = @_;
|
||||
return ("do{ my "
|
||||
. Data::Dumper->new([$data],['x'])->Purity(1)->Terse(0)->Sortkeys(1)->Dump()
|
||||
. '$x; }')
|
||||
}
|
||||
|
||||
1;
|
||||
327
database/perl/lib/Module/Build/Notes.pm
Normal file
327
database/perl/lib/Module/Build/Notes.pm
Normal file
@@ -0,0 +1,327 @@
|
||||
package Module::Build::Notes;
|
||||
|
||||
# A class for persistent hashes
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Data::Dumper;
|
||||
use Module::Build::Dumper;
|
||||
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
|
||||
my $self = bless {
|
||||
disk => {},
|
||||
new => {},
|
||||
file => $file,
|
||||
%args,
|
||||
}, $class;
|
||||
}
|
||||
|
||||
sub restore {
|
||||
my $self = shift;
|
||||
|
||||
open(my $fh, '<', $self->{file}) or die "Can't read $self->{file}: $!";
|
||||
$self->{disk} = eval do {local $/; <$fh>};
|
||||
die $@ if $@;
|
||||
close $fh;
|
||||
$self->{new} = {};
|
||||
}
|
||||
|
||||
sub access {
|
||||
my $self = shift;
|
||||
return $self->read() unless @_;
|
||||
|
||||
my $key = shift;
|
||||
return $self->read($key) unless @_;
|
||||
|
||||
my $value = shift;
|
||||
$self->write({ $key => $value });
|
||||
return $self->read($key);
|
||||
}
|
||||
|
||||
sub has_data {
|
||||
my $self = shift;
|
||||
return keys %{$self->read()} > 0;
|
||||
}
|
||||
|
||||
sub exists {
|
||||
my ($self, $key) = @_;
|
||||
return exists($self->{new}{$key}) || exists($self->{disk}{$key});
|
||||
}
|
||||
|
||||
sub read {
|
||||
my $self = shift;
|
||||
|
||||
if (@_) {
|
||||
# Return 1 key as a scalar
|
||||
my $key = shift;
|
||||
return $self->{new}{$key} if exists $self->{new}{$key};
|
||||
return $self->{disk}{$key};
|
||||
}
|
||||
|
||||
# Return all data
|
||||
my $out = (keys %{$self->{new}}
|
||||
? {%{$self->{disk}}, %{$self->{new}}}
|
||||
: $self->{disk});
|
||||
return wantarray ? %$out : $out;
|
||||
}
|
||||
|
||||
sub _same {
|
||||
my ($self, $x, $y) = @_;
|
||||
return 1 if !defined($x) and !defined($y);
|
||||
return 0 if !defined($x) or !defined($y);
|
||||
return $x eq $y;
|
||||
}
|
||||
|
||||
sub write {
|
||||
my ($self, $href) = @_;
|
||||
$href ||= {};
|
||||
|
||||
@{$self->{new}}{ keys %$href } = values %$href; # Merge
|
||||
|
||||
# Do some optimization to avoid unnecessary writes
|
||||
foreach my $key (keys %{ $self->{new} }) {
|
||||
next if ref $self->{new}{$key};
|
||||
next if ref $self->{disk}{$key} or !exists $self->{disk}{$key};
|
||||
delete $self->{new}{$key} if $self->_same($self->{new}{$key}, $self->{disk}{$key});
|
||||
}
|
||||
|
||||
if (my $file = $self->{file}) {
|
||||
my ($vol, $dir, $base) = File::Spec->splitpath($file);
|
||||
$dir = File::Spec->catpath($vol, $dir, '');
|
||||
return unless -e $dir && -d $dir; # The user needs to arrange for this
|
||||
|
||||
return if -e $file and !keys %{ $self->{new} }; # Nothing to do
|
||||
|
||||
@{$self->{disk}}{ keys %{$self->{new}} } = values %{$self->{new}}; # Merge
|
||||
$self->_dump($file, $self->{disk});
|
||||
|
||||
$self->{new} = {};
|
||||
}
|
||||
return $self->read;
|
||||
}
|
||||
|
||||
sub _dump {
|
||||
my ($self, $file, $data) = @_;
|
||||
|
||||
open(my $fh, '>', $file) or die "Can't create '$file': $!";
|
||||
print {$fh} Module::Build::Dumper->_data_dump($data);
|
||||
close $fh;
|
||||
}
|
||||
|
||||
my $orig_template = do { local $/; <DATA> };
|
||||
close DATA;
|
||||
|
||||
sub write_config_data {
|
||||
my ($self, %args) = @_;
|
||||
|
||||
my $template = $orig_template;
|
||||
$template =~ s/NOTES_NAME/$args{config_module}/g;
|
||||
$template =~ s/MODULE_NAME/$args{module}/g;
|
||||
$template =~ s/=begin private\n//;
|
||||
$template =~ s/=end private/=cut/;
|
||||
|
||||
# strip out private POD markers we use to keep pod from being
|
||||
# recognized for *this* source file
|
||||
$template =~ s{$_\n}{} for '=begin private', '=end private';
|
||||
|
||||
open(my $fh, '>', $args{file}) or die "Can't create '$args{file}': $!";
|
||||
print {$fh} $template;
|
||||
print {$fh} "\n__DATA__\n";
|
||||
print {$fh} Module::Build::Dumper->_data_dump([$args{config_data}, $args{feature}, $args{auto_features}]);
|
||||
close $fh;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Notes - Create persistent distribution configuration modules
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module is used internally by Module::Build to create persistent
|
||||
configuration files that can be installed with a distribution. See
|
||||
L<Module::Build::ConfigData> for an example.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2001-2006 Ken Williams. All rights reserved.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), L<Module::Build>(3)
|
||||
|
||||
=cut
|
||||
|
||||
__DATA__
|
||||
package NOTES_NAME;
|
||||
use strict;
|
||||
my $arrayref = eval do {local $/; <DATA>}
|
||||
or die "Couldn't load ConfigData data: $@";
|
||||
close DATA;
|
||||
my ($config, $features, $auto_features) = @$arrayref;
|
||||
|
||||
sub config { $config->{$_[1]} }
|
||||
|
||||
sub set_config { $config->{$_[1]} = $_[2] }
|
||||
sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0
|
||||
|
||||
sub auto_feature_names { sort grep !exists $features->{$_}, keys %$auto_features }
|
||||
|
||||
sub feature_names {
|
||||
my @features = (sort keys %$features, auto_feature_names());
|
||||
@features;
|
||||
}
|
||||
|
||||
sub config_names { sort keys %$config }
|
||||
|
||||
sub write {
|
||||
my $me = __FILE__;
|
||||
|
||||
# Can't use Module::Build::Dumper here because M::B is only a
|
||||
# build-time prereq of this module
|
||||
require Data::Dumper;
|
||||
|
||||
my $mode_orig = (stat $me)[2] & 07777;
|
||||
chmod($mode_orig | 0222, $me); # Make it writeable
|
||||
open(my $fh, '+<', $me) or die "Can't rewrite $me: $!";
|
||||
seek($fh, 0, 0);
|
||||
while (<$fh>) {
|
||||
last if /^__DATA__$/;
|
||||
}
|
||||
die "Couldn't find __DATA__ token in $me" if eof($fh);
|
||||
|
||||
seek($fh, tell($fh), 0);
|
||||
my $data = [$config, $features, $auto_features];
|
||||
print($fh 'do{ my '
|
||||
. Data::Dumper->new([$data],['x'])->Purity(1)->Dump()
|
||||
. '$x; }' );
|
||||
truncate($fh, tell($fh));
|
||||
close $fh;
|
||||
|
||||
chmod($mode_orig, $me)
|
||||
or warn "Couldn't restore permissions on $me: $!";
|
||||
}
|
||||
|
||||
sub feature {
|
||||
my ($package, $key) = @_;
|
||||
return $features->{$key} if exists $features->{$key};
|
||||
|
||||
my $info = $auto_features->{$key} or return 0;
|
||||
|
||||
require Module::Build; # XXX should get rid of this
|
||||
foreach my $type (sort keys %$info) {
|
||||
my $prereqs = $info->{$type};
|
||||
next if $type eq 'description' || $type eq 'recommends';
|
||||
|
||||
foreach my $modname (sort keys %$prereqs) {
|
||||
my $status = Module::Build->check_installed_status($modname, $prereqs->{$modname});
|
||||
if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; }
|
||||
if ( ! eval "require $modname; 1" ) { return 0; }
|
||||
}
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
=begin private
|
||||
|
||||
=head1 NAME
|
||||
|
||||
NOTES_NAME - Configuration for MODULE_NAME
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use NOTES_NAME;
|
||||
$value = NOTES_NAME->config('foo');
|
||||
$value = NOTES_NAME->feature('bar');
|
||||
|
||||
@names = NOTES_NAME->config_names;
|
||||
@names = NOTES_NAME->feature_names;
|
||||
|
||||
NOTES_NAME->set_config(foo => $new_value);
|
||||
NOTES_NAME->set_feature(bar => $new_value);
|
||||
NOTES_NAME->write; # Save changes
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module holds the configuration data for the C<MODULE_NAME>
|
||||
module. It also provides a programmatic interface for getting or
|
||||
setting that configuration data. Note that in order to actually make
|
||||
changes, you'll have to have write access to the C<NOTES_NAME>
|
||||
module, and you should attempt to understand the repercussions of your
|
||||
actions.
|
||||
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=item config($name)
|
||||
|
||||
Given a string argument, returns the value of the configuration item
|
||||
by that name, or C<undef> if no such item exists.
|
||||
|
||||
=item feature($name)
|
||||
|
||||
Given a string argument, returns the value of the feature by that
|
||||
name, or C<undef> if no such feature exists.
|
||||
|
||||
=item set_config($name, $value)
|
||||
|
||||
Sets the configuration item with the given name to the given value.
|
||||
The value may be any Perl scalar that will serialize correctly using
|
||||
C<Data::Dumper>. This includes references, objects (usually), and
|
||||
complex data structures. It probably does not include transient
|
||||
things like filehandles or sockets.
|
||||
|
||||
=item set_feature($name, $value)
|
||||
|
||||
Sets the feature with the given name to the given boolean value. The
|
||||
value will be converted to 0 or 1 automatically.
|
||||
|
||||
=item config_names()
|
||||
|
||||
Returns a list of all the names of config items currently defined in
|
||||
C<NOTES_NAME>, or in scalar context the number of items.
|
||||
|
||||
=item feature_names()
|
||||
|
||||
Returns a list of all the names of features currently defined in
|
||||
C<NOTES_NAME>, or in scalar context the number of features.
|
||||
|
||||
=item auto_feature_names()
|
||||
|
||||
Returns a list of all the names of features whose availability is
|
||||
dynamically determined, or in scalar context the number of such
|
||||
features. Does not include such features that have later been set to
|
||||
a fixed value.
|
||||
|
||||
=item write()
|
||||
|
||||
Commits any changes from C<set_config()> and C<set_feature()> to disk.
|
||||
Requires write access to the C<NOTES_NAME> module.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
C<NOTES_NAME> was automatically created using C<Module::Build>.
|
||||
C<Module::Build> was written by Ken Williams, but he holds no
|
||||
authorship claim or copyright claim to the contents of C<NOTES_NAME>.
|
||||
|
||||
=end private
|
||||
|
||||
186
database/perl/lib/Module/Build/PPMMaker.pm
Normal file
186
database/perl/lib/Module/Build/PPMMaker.pm
Normal file
@@ -0,0 +1,186 @@
|
||||
package Module::Build::PPMMaker;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Config;
|
||||
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
|
||||
# This code is mostly borrowed from ExtUtils::MM_Unix 6.10_03, with a
|
||||
# few tweaks based on the PPD spec at
|
||||
# http://www.xav.com/perl/site/lib/XML/PPD.html
|
||||
|
||||
# The PPD spec is based on <http://www.w3.org/TR/NOTE-OSD>
|
||||
|
||||
sub new {
|
||||
my $package = shift;
|
||||
return bless {@_}, $package;
|
||||
}
|
||||
|
||||
sub make_ppd {
|
||||
my ($self, %args) = @_;
|
||||
my $build = delete $args{build};
|
||||
|
||||
my @codebase;
|
||||
if (exists $args{codebase}) {
|
||||
@codebase = ref $args{codebase} ? @{$args{codebase}} : ($args{codebase});
|
||||
} else {
|
||||
my $distfile = $build->ppm_name . '.tar.gz';
|
||||
print "Using default codebase '$distfile'\n";
|
||||
@codebase = ($distfile);
|
||||
}
|
||||
|
||||
my %dist;
|
||||
foreach my $info (qw(name author abstract version)) {
|
||||
my $method = "dist_$info";
|
||||
$dist{$info} = $build->$method() or die "Can't determine distribution's $info\n";
|
||||
}
|
||||
|
||||
$self->_simple_xml_escape($_) foreach $dist{abstract}, @{$dist{author}};
|
||||
|
||||
# TODO: could add <LICENSE HREF=...> tag if we knew what the URLs were for
|
||||
# various licenses
|
||||
my $ppd = <<"PPD";
|
||||
<SOFTPKG NAME=\"$dist{name}\" VERSION=\"$dist{version}\">
|
||||
<ABSTRACT>$dist{abstract}</ABSTRACT>
|
||||
@{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
|
||||
<IMPLEMENTATION>
|
||||
PPD
|
||||
|
||||
# We don't include recommended dependencies because PPD has no way
|
||||
# to distinguish them from normal dependencies. We don't include
|
||||
# build_requires dependencies because the PPM installer doesn't
|
||||
# build or test before installing. And obviously we don't include
|
||||
# conflicts either.
|
||||
|
||||
foreach my $type (qw(requires)) {
|
||||
my $prereq = $build->$type();
|
||||
foreach my $modname (sort keys %$prereq) {
|
||||
next if $modname eq 'perl';
|
||||
|
||||
my $min_version = '0.0';
|
||||
foreach my $c ($build->_parse_conditions($prereq->{$modname})) {
|
||||
my ($op, $version) = $c =~ /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x;
|
||||
|
||||
# This is a nasty hack because it fails if there is no >= op
|
||||
if ($op eq '>=') {
|
||||
$min_version = $version;
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
# PPM4 spec requires a '::' for top level modules
|
||||
$modname .= '::' unless $modname =~ /::/;
|
||||
|
||||
$ppd .= qq! <REQUIRE NAME="$modname" VERSION="$min_version" />\n!;
|
||||
}
|
||||
}
|
||||
|
||||
# We only include these tags if this module involves XS, on the
|
||||
# assumption that pure Perl modules will work on any OS.
|
||||
if (keys %{$build->find_xs_files}) {
|
||||
my $perl_version = $self->_ppd_version($build->perl_version);
|
||||
$ppd .= sprintf(<<'EOF', $self->_varchname($build->config) );
|
||||
<ARCHITECTURE NAME="%s" />
|
||||
EOF
|
||||
}
|
||||
|
||||
foreach my $codebase (@codebase) {
|
||||
$self->_simple_xml_escape($codebase);
|
||||
$ppd .= sprintf(<<'EOF', $codebase);
|
||||
<CODEBASE HREF="%s" />
|
||||
EOF
|
||||
}
|
||||
|
||||
$ppd .= <<'EOF';
|
||||
</IMPLEMENTATION>
|
||||
</SOFTPKG>
|
||||
EOF
|
||||
|
||||
my $ppd_file = "$dist{name}.ppd";
|
||||
open(my $fh, '>', $ppd_file)
|
||||
or die "Cannot write to $ppd_file: $!";
|
||||
|
||||
binmode($fh, ":utf8")
|
||||
if $] >= 5.008 && $Config{useperlio};
|
||||
print $fh $ppd;
|
||||
close $fh;
|
||||
|
||||
return $ppd_file;
|
||||
}
|
||||
|
||||
sub _ppd_version {
|
||||
my ($self, $version) = @_;
|
||||
|
||||
# generates something like "0,18,0,0"
|
||||
return join ',', (split(/\./, $version), (0)x4)[0..3];
|
||||
}
|
||||
|
||||
sub _varchname { # Copied from PPM.pm
|
||||
my ($self, $config) = @_;
|
||||
my $varchname = $config->{archname};
|
||||
# Append "-5.8" to architecture name for Perl 5.8 and later
|
||||
if ($] >= 5.008) {
|
||||
my $vstring = sprintf "%vd", $^V;
|
||||
$vstring =~ s/\.\d+$//;
|
||||
$varchname .= "-$vstring";
|
||||
}
|
||||
return $varchname;
|
||||
}
|
||||
|
||||
{
|
||||
my %escapes = (
|
||||
"\n" => "\\n",
|
||||
'"' => '"',
|
||||
'&' => '&',
|
||||
'>' => '>',
|
||||
'<' => '<',
|
||||
);
|
||||
my $rx = join '|', keys %escapes;
|
||||
|
||||
sub _simple_xml_escape {
|
||||
$_[1] =~ s/($rx)/$escapes{$1}/go;
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::PPMMaker - Perl Package Manager file creation
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
On the command line, builds a .ppd file:
|
||||
./Build ppd
|
||||
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package contains the code that builds F<.ppd> "Perl Package
|
||||
Description" files, in support of ActiveState's "Perl Package
|
||||
Manager". Details are here:
|
||||
L<http://aspn.activestate.com/ASPN/Downloads/ActivePerl/PPM/>
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Dave Rolsky <autarch@urth.org>, Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
|
||||
=head1 COPYRIGHT
|
||||
|
||||
Copyright (c) 2001-2006 Ken Williams. All rights reserved.
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the same terms as Perl itself.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3)
|
||||
|
||||
=cut
|
||||
32
database/perl/lib/Module/Build/Platform/Default.pm
Normal file
32
database/perl/lib/Module/Build/Platform/Default.pm
Normal file
@@ -0,0 +1,32 @@
|
||||
package Module::Build::Platform::Default;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
our @ISA = qw(Module::Build::Base);
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::Default - Stub class for unknown platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
151
database/perl/lib/Module/Build/Platform/MacOS.pm
Normal file
151
database/perl/lib/Module/Build/Platform/MacOS.pm
Normal file
@@ -0,0 +1,151 @@
|
||||
package Module::Build::Platform::MacOS;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
our @ISA = qw(Module::Build::Base);
|
||||
|
||||
use ExtUtils::Install;
|
||||
|
||||
sub have_forkpipe { 0 }
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $self = $class->SUPER::new(@_);
|
||||
|
||||
# $Config{sitelib} and $Config{sitearch} are, unfortunately, missing.
|
||||
foreach ('sitelib', 'sitearch') {
|
||||
$self->config($_ => $self->config("install$_"))
|
||||
unless $self->config($_);
|
||||
}
|
||||
|
||||
# For some reason $Config{startperl} is filled with a bunch of crap.
|
||||
(my $sp = $self->config('startperl')) =~ s/.*Exit \{Status\}\s//;
|
||||
$self->config(startperl => $sp);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub make_executable {
|
||||
my $self = shift;
|
||||
require MacPerl;
|
||||
foreach (@_) {
|
||||
MacPerl::SetFileInfo('McPL', 'TEXT', $_);
|
||||
}
|
||||
}
|
||||
|
||||
sub dispatch {
|
||||
my $self = shift;
|
||||
|
||||
if( !@_ and !@ARGV ) {
|
||||
require MacPerl;
|
||||
|
||||
# What comes first in the action list.
|
||||
my @action_list = qw(build test install);
|
||||
my %actions = map {+($_, 1)} $self->known_actions;
|
||||
delete @actions{@action_list};
|
||||
push @action_list, sort { $a cmp $b } keys %actions;
|
||||
|
||||
my %toolserver = map {+$_ => 1} qw(test disttest diff testdb);
|
||||
foreach (@action_list) {
|
||||
$_ .= ' *' if $toolserver{$_};
|
||||
}
|
||||
|
||||
my $cmd = MacPerl::Pick("What build command? ('*' requires ToolServer)", @action_list);
|
||||
return unless defined $cmd;
|
||||
$cmd =~ s/ \*$//;
|
||||
$ARGV[0] = ($cmd);
|
||||
|
||||
my $args = MacPerl::Ask('Any extra arguments? (ie. verbose=1)', '');
|
||||
return unless defined $args;
|
||||
push @ARGV, $self->split_like_shell($args);
|
||||
}
|
||||
|
||||
$self->SUPER::dispatch(@_);
|
||||
}
|
||||
|
||||
sub ACTION_realclean {
|
||||
my $self = shift;
|
||||
chmod 0666, $self->{properties}{build_script};
|
||||
$self->SUPER::ACTION_realclean;
|
||||
}
|
||||
|
||||
# ExtUtils::Install has a hard-coded '.' directory in versions less
|
||||
# than 1.30. We use a sneaky trick to turn that into ':'.
|
||||
#
|
||||
# Note that we do it here in a cross-platform way, so this code could
|
||||
# actually go in Module::Build::Base. But we put it here to be less
|
||||
# intrusive for other platforms.
|
||||
|
||||
sub ACTION_install {
|
||||
my $self = shift;
|
||||
|
||||
return $self->SUPER::ACTION_install(@_)
|
||||
if eval {ExtUtils::Install->VERSION('1.30'); 1};
|
||||
|
||||
local $^W = 0; # Avoid a 'redefine' warning
|
||||
local *ExtUtils::Install::find = sub {
|
||||
my ($code, @dirs) = @_;
|
||||
|
||||
@dirs = map { $_ eq '.' ? File::Spec->curdir : $_ } @dirs;
|
||||
|
||||
return File::Find::find($code, @dirs);
|
||||
};
|
||||
|
||||
return $self->SUPER::ACTION_install(@_);
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::MacOS - Builder class for MacOS platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base> and override a few methods. Please see
|
||||
L<Module::Build> for the docs.
|
||||
|
||||
=head2 Overridden Methods
|
||||
|
||||
=over 4
|
||||
|
||||
=item new()
|
||||
|
||||
MacPerl doesn't define $Config{sitelib} or $Config{sitearch} for some
|
||||
reason, but $Config{installsitelib} and $Config{installsitearch} are
|
||||
there. So we copy the install variables to the other location
|
||||
|
||||
=item make_executable()
|
||||
|
||||
On MacOS we set the file type and creator to MacPerl so it will run
|
||||
with a double-click.
|
||||
|
||||
=item dispatch()
|
||||
|
||||
Because there's no easy way to say "./Build test" on MacOS, if
|
||||
dispatch is called with no arguments and no @ARGV a dialog box will
|
||||
pop up asking what action to take and any extra arguments.
|
||||
|
||||
Default action is "test".
|
||||
|
||||
=item ACTION_realclean()
|
||||
|
||||
Need to unlock the Build program before deleting.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Michael G Schwern <schwern@pobox.com>
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
72
database/perl/lib/Module/Build/Platform/Unix.pm
Normal file
72
database/perl/lib/Module/Build/Platform/Unix.pm
Normal file
@@ -0,0 +1,72 @@
|
||||
package Module::Build::Platform::Unix;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
our @ISA = qw(Module::Build::Base);
|
||||
|
||||
sub is_executable {
|
||||
# We consider the owner bit to be authoritative on a file, because
|
||||
# -x will always return true if the user is root and *any*
|
||||
# executable bit is set. The -x test seems to try to answer the
|
||||
# question "can I execute this file", but I think we want "is this
|
||||
# file executable".
|
||||
|
||||
my ($self, $file) = @_;
|
||||
return +(stat $file)[2] & 0100;
|
||||
}
|
||||
|
||||
sub _startperl { "#! " . shift()->perl }
|
||||
|
||||
sub _construct {
|
||||
my $self = shift()->SUPER::_construct(@_);
|
||||
|
||||
# perl 5.8.1-RC[1-3] had some broken %Config entries, and
|
||||
# unfortunately Red Hat 9 shipped it like that. Fix 'em up here.
|
||||
my $c = $self->{config};
|
||||
for (qw(siteman1 siteman3 vendorman1 vendorman3)) {
|
||||
$c->{"install${_}dir"} ||= $c->{"install${_}"};
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
# Open group says username should be portable filename characters,
|
||||
# but some Unix OS working with ActiveDirectory wind up with user-names
|
||||
# with back-slashes in the name. The new code below is very liberal
|
||||
# in what it accepts.
|
||||
sub _detildefy {
|
||||
my ($self, $value) = @_;
|
||||
$value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username
|
||||
[$1 ?
|
||||
(eval{(getpwnam $1)[7]} || "~$1") :
|
||||
($ENV{HOME} || eval{(getpwuid $>)[7]} || glob("~"))
|
||||
]ex;
|
||||
return $value;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::Unix - Builder class for Unix platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
522
database/perl/lib/Module/Build/Platform/VMS.pm
Normal file
522
database/perl/lib/Module/Build/Platform/VMS.pm
Normal file
@@ -0,0 +1,522 @@
|
||||
package Module::Build::Platform::VMS;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
use Config;
|
||||
|
||||
our @ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::VMS - Builder class for VMS platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module inherits from C<Module::Build::Base> and alters a few
|
||||
minor details of its functionality. Please see L<Module::Build> for
|
||||
the general docs.
|
||||
|
||||
=head2 Overridden Methods
|
||||
|
||||
=over 4
|
||||
|
||||
=item _set_defaults
|
||||
|
||||
Change $self->{build_script} to 'Build.com' so @Build works.
|
||||
|
||||
=cut
|
||||
|
||||
sub _set_defaults {
|
||||
my $self = shift;
|
||||
$self->SUPER::_set_defaults(@_);
|
||||
|
||||
$self->{properties}{build_script} = 'Build.com';
|
||||
}
|
||||
|
||||
|
||||
=item cull_args
|
||||
|
||||
'@Build foo' on VMS will not preserve the case of 'foo'. Rather than forcing
|
||||
people to write '@Build "foo"' we'll dispatch case-insensitively.
|
||||
|
||||
=cut
|
||||
|
||||
sub cull_args {
|
||||
my $self = shift;
|
||||
my($action, $args) = $self->SUPER::cull_args(@_);
|
||||
my @possible_actions = grep { lc $_ eq lc $action } $self->known_actions;
|
||||
|
||||
die "Ambiguous action '$action'. Could be one of @possible_actions"
|
||||
if @possible_actions > 1;
|
||||
|
||||
return ($possible_actions[0], $args);
|
||||
}
|
||||
|
||||
|
||||
=item manpage_separator
|
||||
|
||||
Use '__' instead of '::'.
|
||||
|
||||
=cut
|
||||
|
||||
sub manpage_separator {
|
||||
return '__';
|
||||
}
|
||||
|
||||
|
||||
=item prefixify
|
||||
|
||||
Prefixify taking into account VMS' filepath syntax.
|
||||
|
||||
=cut
|
||||
|
||||
# Translated from ExtUtils::MM_VMS::prefixify()
|
||||
|
||||
sub _catprefix {
|
||||
my($self, $rprefix, $default) = @_;
|
||||
|
||||
my($rvol, $rdirs) = File::Spec->splitpath($rprefix);
|
||||
if( $rvol ) {
|
||||
return File::Spec->catpath($rvol,
|
||||
File::Spec->catdir($rdirs, $default),
|
||||
''
|
||||
)
|
||||
}
|
||||
else {
|
||||
return File::Spec->catdir($rdirs, $default);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub _prefixify {
|
||||
my($self, $path, $sprefix, $type) = @_;
|
||||
my $rprefix = $self->prefix;
|
||||
|
||||
return '' unless defined $path;
|
||||
|
||||
$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");
|
||||
|
||||
# Translate $(PERLPREFIX) to a real path.
|
||||
$rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
|
||||
$sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
|
||||
|
||||
$self->log_verbose(" rprefix translated to $rprefix\n".
|
||||
" sprefix translated to $sprefix\n");
|
||||
|
||||
if( length($path) == 0 ) {
|
||||
$self->log_verbose(" no path to prefixify.\n")
|
||||
}
|
||||
elsif( !File::Spec->file_name_is_absolute($path) ) {
|
||||
$self->log_verbose(" path is relative, not prefixifying.\n");
|
||||
}
|
||||
elsif( $sprefix eq $rprefix ) {
|
||||
$self->log_verbose(" no new prefix.\n");
|
||||
}
|
||||
else {
|
||||
my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
|
||||
my $vms_prefix = $self->config('vms_prefix');
|
||||
if( $path_vol eq $vms_prefix.':' ) {
|
||||
$self->log_verbose(" $vms_prefix: seen\n");
|
||||
|
||||
$path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
|
||||
$path = $self->_catprefix($rprefix, $path_dirs);
|
||||
}
|
||||
else {
|
||||
$self->log_verbose(" cannot prefixify.\n");
|
||||
return $self->prefix_relpaths($self->installdirs, $type);
|
||||
}
|
||||
}
|
||||
|
||||
$self->log_verbose(" now $path\n");
|
||||
|
||||
return $path;
|
||||
}
|
||||
|
||||
=item _quote_args
|
||||
|
||||
Command-line arguments (but not the command itself) must be quoted
|
||||
to ensure case preservation.
|
||||
|
||||
=cut
|
||||
|
||||
sub _quote_args {
|
||||
# Returns a string that can become [part of] a command line with
|
||||
# proper quoting so that the subprocess sees this same list of args,
|
||||
# or if we get a single arg that is an array reference, quote the
|
||||
# elements of it and return the reference.
|
||||
my ($self, @args) = @_;
|
||||
my $got_arrayref = (scalar(@args) == 1
|
||||
&& ref $args[0] eq 'ARRAY')
|
||||
? 1
|
||||
: 0;
|
||||
|
||||
# Do not quote qualifiers that begin with '/'.
|
||||
map { if (!/^\//) {
|
||||
$_ =~ s/\"/""/g; # escape C<"> by doubling
|
||||
$_ = q(").$_.q(");
|
||||
}
|
||||
}
|
||||
($got_arrayref ? @{$args[0]}
|
||||
: @args
|
||||
);
|
||||
|
||||
return $got_arrayref ? $args[0]
|
||||
: join(' ', @args);
|
||||
}
|
||||
|
||||
=item have_forkpipe
|
||||
|
||||
There is no native fork(), so some constructs depending on it are not
|
||||
available.
|
||||
|
||||
=cut
|
||||
|
||||
sub have_forkpipe { 0 }
|
||||
|
||||
=item _backticks
|
||||
|
||||
Override to ensure that we quote the arguments but not the command.
|
||||
|
||||
=cut
|
||||
|
||||
sub _backticks {
|
||||
# The command must not be quoted but the arguments to it must be.
|
||||
my ($self, @cmd) = @_;
|
||||
my $cmd = shift @cmd;
|
||||
my $args = $self->_quote_args(@cmd);
|
||||
return `$cmd $args`;
|
||||
}
|
||||
|
||||
=item find_command
|
||||
|
||||
Local an executable program
|
||||
|
||||
=cut
|
||||
|
||||
sub find_command {
|
||||
my ($self, $command) = @_;
|
||||
|
||||
# a lot of VMS executables have a symbol defined
|
||||
# check those first
|
||||
if ( $^O eq 'VMS' ) {
|
||||
require VMS::DCLsym;
|
||||
my $syms = VMS::DCLsym->new;
|
||||
return $command if scalar $syms->getsym( uc $command );
|
||||
}
|
||||
|
||||
$self->SUPER::find_command($command);
|
||||
}
|
||||
|
||||
# _maybe_command copied from ExtUtils::MM_VMS::maybe_command
|
||||
|
||||
=item _maybe_command (override)
|
||||
|
||||
Follows VMS naming conventions for executable files.
|
||||
If the name passed in doesn't exactly match an executable file,
|
||||
appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
|
||||
to check for DCL procedure. If this fails, checks directories in DCL$PATH
|
||||
and finally F<Sys$System:> for an executable file having the name specified,
|
||||
with or without the F<.Exe>-equivalent suffix.
|
||||
|
||||
=cut
|
||||
|
||||
sub _maybe_command {
|
||||
my($self,$file) = @_;
|
||||
return $file if -x $file && ! -d _;
|
||||
my(@dirs) = ('');
|
||||
my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
|
||||
|
||||
if ($file !~ m![/:>\]]!) {
|
||||
for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
|
||||
my $dir = $ENV{"DCL\$PATH;$i"};
|
||||
$dir .= ':' unless $dir =~ m%[\]:]$%;
|
||||
push(@dirs,$dir);
|
||||
}
|
||||
push(@dirs,'Sys$System:');
|
||||
foreach my $dir (@dirs) {
|
||||
my $sysfile = "$dir$file";
|
||||
foreach my $ext (@exts) {
|
||||
return $file if -x "$sysfile$ext" && ! -d _;
|
||||
}
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
=item do_system
|
||||
|
||||
Override to ensure that we quote the arguments but not the command.
|
||||
|
||||
=cut
|
||||
|
||||
sub do_system {
|
||||
# The command must not be quoted but the arguments to it must be.
|
||||
my ($self, @cmd) = @_;
|
||||
$self->log_verbose("@cmd\n");
|
||||
my $cmd = shift @cmd;
|
||||
my $args = $self->_quote_args(@cmd);
|
||||
return !system("$cmd $args");
|
||||
}
|
||||
|
||||
=item oneliner
|
||||
|
||||
Override to ensure that we do not quote the command.
|
||||
|
||||
=cut
|
||||
|
||||
sub oneliner {
|
||||
my $self = shift;
|
||||
my $oneliner = $self->SUPER::oneliner(@_);
|
||||
|
||||
$oneliner =~ s/^\"\S+\"//;
|
||||
|
||||
return "MCR $^X $oneliner";
|
||||
}
|
||||
|
||||
=item rscan_dir
|
||||
|
||||
Inherit the standard version but remove dots at end of name.
|
||||
If the extended character set is in effect, do not remove dots from filenames
|
||||
with Unix path delimiters.
|
||||
|
||||
=cut
|
||||
|
||||
sub rscan_dir {
|
||||
my ($self, $dir, $pattern) = @_;
|
||||
|
||||
my $result = $self->SUPER::rscan_dir( $dir, $pattern );
|
||||
|
||||
for my $file (@$result) {
|
||||
if (!_efs() && ($file =~ m#/#)) {
|
||||
$file =~ s/\.$//;
|
||||
}
|
||||
}
|
||||
return $result;
|
||||
}
|
||||
|
||||
=item dist_dir
|
||||
|
||||
Inherit the standard version but replace embedded dots with underscores because
|
||||
a dot is the directory delimiter on VMS.
|
||||
|
||||
=cut
|
||||
|
||||
sub dist_dir {
|
||||
my $self = shift;
|
||||
|
||||
my $dist_dir = $self->SUPER::dist_dir;
|
||||
$dist_dir =~ s/\./_/g unless _efs();
|
||||
return $dist_dir;
|
||||
}
|
||||
|
||||
=item man3page_name
|
||||
|
||||
Inherit the standard version but chop the extra manpage delimiter off the front if
|
||||
there is one. The VMS version of splitdir('[.foo]') returns '', 'foo'.
|
||||
|
||||
=cut
|
||||
|
||||
sub man3page_name {
|
||||
my $self = shift;
|
||||
|
||||
my $mpname = $self->SUPER::man3page_name( shift );
|
||||
my $sep = $self->manpage_separator;
|
||||
$mpname =~ s/^$sep//;
|
||||
return $mpname;
|
||||
}
|
||||
|
||||
=item expand_test_dir
|
||||
|
||||
Inherit the standard version but relativize the paths as the native glob() doesn't
|
||||
do that for us.
|
||||
|
||||
=cut
|
||||
|
||||
sub expand_test_dir {
|
||||
my ($self, $dir) = @_;
|
||||
|
||||
my @reldirs = $self->SUPER::expand_test_dir( $dir );
|
||||
|
||||
for my $eachdir (@reldirs) {
|
||||
my ($v,$d,$f) = File::Spec->splitpath( $eachdir );
|
||||
my $reldir = File::Spec->abs2rel( File::Spec->catpath( $v, $d, '' ) );
|
||||
$eachdir = File::Spec->catfile( $reldir, $f );
|
||||
}
|
||||
return @reldirs;
|
||||
}
|
||||
|
||||
=item _detildefy
|
||||
|
||||
The home-grown glob() does not currently handle tildes, so provide limited support
|
||||
here. Expect only UNIX format file specifications for now.
|
||||
|
||||
=cut
|
||||
|
||||
sub _detildefy {
|
||||
my ($self, $arg) = @_;
|
||||
|
||||
# Apparently double ~ are not translated.
|
||||
return $arg if ($arg =~ /^~~/);
|
||||
|
||||
# Apparently ~ followed by whitespace are not translated.
|
||||
return $arg if ($arg =~ /^~ /);
|
||||
|
||||
if ($arg =~ /^~/) {
|
||||
my $spec = $arg;
|
||||
|
||||
# Remove the tilde
|
||||
$spec =~ s/^~//;
|
||||
|
||||
# Remove any slash following the tilde if present.
|
||||
$spec =~ s#^/##;
|
||||
|
||||
# break up the paths for the merge
|
||||
my $home = VMS::Filespec::unixify($ENV{HOME});
|
||||
|
||||
# In the default VMS mode, the trailing slash is present.
|
||||
# In Unix report mode it is not. The parsing logic assumes that
|
||||
# it is present.
|
||||
$home .= '/' unless $home =~ m#/$#;
|
||||
|
||||
# Trivial case of just ~ by it self
|
||||
if ($spec eq '') {
|
||||
$home =~ s#/$##;
|
||||
return $home;
|
||||
}
|
||||
|
||||
my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
|
||||
if ($hdir eq '') {
|
||||
# Someone has tampered with $ENV{HOME}
|
||||
# So hfile is probably the directory since this should be
|
||||
# a path.
|
||||
$hdir = $hfile;
|
||||
}
|
||||
|
||||
my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec);
|
||||
|
||||
my @hdirs = File::Spec::Unix->splitdir($hdir);
|
||||
my @dirs = File::Spec::Unix->splitdir($dir);
|
||||
|
||||
unless ($arg =~ m#^~/#) {
|
||||
# There is a home directory after the tilde, but it will already
|
||||
# be present in in @hdirs so we need to remove it by from @dirs.
|
||||
|
||||
shift @dirs;
|
||||
}
|
||||
my $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs);
|
||||
|
||||
$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
|
||||
}
|
||||
return $arg;
|
||||
|
||||
}
|
||||
|
||||
=item find_perl_interpreter
|
||||
|
||||
On VMS, $^X returns the fully qualified absolute path including version
|
||||
number. It's logically impossible to improve on it for getting the perl
|
||||
we're currently running, and attempting to manipulate it is usually
|
||||
lossy.
|
||||
|
||||
=cut
|
||||
|
||||
sub find_perl_interpreter {
|
||||
return VMS::Filespec::vmsify($^X);
|
||||
}
|
||||
|
||||
=item localize_file_path
|
||||
|
||||
Convert the file path to the local syntax
|
||||
|
||||
=cut
|
||||
|
||||
sub localize_file_path {
|
||||
my ($self, $path) = @_;
|
||||
$path = VMS::Filespec::vmsify($path);
|
||||
$path =~ s/\.\z//;
|
||||
return $path;
|
||||
}
|
||||
|
||||
=item localize_dir_path
|
||||
|
||||
Convert the directory path to the local syntax
|
||||
|
||||
=cut
|
||||
|
||||
sub localize_dir_path {
|
||||
my ($self, $path) = @_;
|
||||
return VMS::Filespec::vmspath($path);
|
||||
}
|
||||
|
||||
=item ACTION_clean
|
||||
|
||||
The home-grown glob() expands a bit too aggressively when given a bare name,
|
||||
so default in a zero-length extension.
|
||||
|
||||
=cut
|
||||
|
||||
sub ACTION_clean {
|
||||
my ($self) = @_;
|
||||
foreach my $item (map glob(VMS::Filespec::rmsexpand($_, '.;0')), $self->cleanup) {
|
||||
$self->delete_filetree($item);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
# Need to look up the feature settings. The preferred way is to use the
|
||||
# VMS::Feature module, but that may not be available to dual life modules.
|
||||
|
||||
my $use_feature;
|
||||
BEGIN {
|
||||
if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
|
||||
$use_feature = 1;
|
||||
}
|
||||
}
|
||||
|
||||
# Need to look up the UNIX report mode. This may become a dynamic mode
|
||||
# in the future.
|
||||
sub _unix_rpt {
|
||||
my $unix_rpt;
|
||||
if ($use_feature) {
|
||||
$unix_rpt = VMS::Feature::current("filename_unix_report");
|
||||
} else {
|
||||
my $env_unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
|
||||
$unix_rpt = $env_unix_rpt =~ /^[ET1]/i;
|
||||
}
|
||||
return $unix_rpt;
|
||||
}
|
||||
|
||||
# Need to look up the EFS character set mode. This may become a dynamic
|
||||
# mode in the future.
|
||||
sub _efs {
|
||||
my $efs;
|
||||
if ($use_feature) {
|
||||
$efs = VMS::Feature::current("efs_charset");
|
||||
} else {
|
||||
my $env_efs = $ENV{'DECC$EFS_CHARSET'} || '';
|
||||
$efs = $env_efs =~ /^[ET1]/i;
|
||||
}
|
||||
return $efs;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Michael G Schwern <schwern@pobox.com>
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
Craig A. Berry <craigberry@mac.com>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
__END__
|
||||
33
database/perl/lib/Module/Build/Platform/VOS.pm
Normal file
33
database/perl/lib/Module/Build/Platform/VOS.pm
Normal file
@@ -0,0 +1,33 @@
|
||||
package Module::Build::Platform::VOS;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Base;
|
||||
|
||||
our @ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::VOS - Builder class for VOS platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base>. Please see the L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
234
database/perl/lib/Module/Build/Platform/Windows.pm
Normal file
234
database/perl/lib/Module/Build/Platform/Windows.pm
Normal file
@@ -0,0 +1,234 @@
|
||||
package Module::Build::Platform::Windows;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
|
||||
use Config;
|
||||
use File::Basename;
|
||||
use File::Spec;
|
||||
|
||||
use Module::Build::Base;
|
||||
|
||||
our @ISA = qw(Module::Build::Base);
|
||||
|
||||
|
||||
sub manpage_separator {
|
||||
return '.';
|
||||
}
|
||||
|
||||
sub have_forkpipe { 0 }
|
||||
|
||||
sub _detildefy {
|
||||
my ($self, $value) = @_;
|
||||
$value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x
|
||||
if $ENV{HOME};
|
||||
return $value;
|
||||
}
|
||||
|
||||
sub ACTION_realclean {
|
||||
my ($self) = @_;
|
||||
|
||||
$self->SUPER::ACTION_realclean();
|
||||
|
||||
my $basename = basename($0);
|
||||
$basename =~ s/(?:\.bat)?$//i;
|
||||
|
||||
if ( lc $basename eq lc $self->build_script ) {
|
||||
if ( $self->build_bat ) {
|
||||
$self->log_verbose("Deleting $basename.bat\n");
|
||||
my $full_progname = $0;
|
||||
$full_progname =~ s/(?:\.bat)?$/.bat/i;
|
||||
|
||||
# Voodoo required to have a batch file delete itself without error;
|
||||
# Syntax differs between 9x & NT: the later requires a null arg (???)
|
||||
require Win32;
|
||||
my $null_arg = (Win32::IsWinNT()) ? '""' : '';
|
||||
my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname");
|
||||
|
||||
open(my $fh, '>>', "$basename.bat")
|
||||
or die "Can't create $basename.bat: $!";
|
||||
print $fh $cmd;
|
||||
close $fh ;
|
||||
} else {
|
||||
$self->delete_filetree($self->build_script . '.bat');
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub make_executable {
|
||||
my $self = shift;
|
||||
|
||||
$self->SUPER::make_executable(@_);
|
||||
|
||||
foreach my $script (@_) {
|
||||
|
||||
# Native batch script
|
||||
if ( $script =~ /\.(bat|cmd)$/ ) {
|
||||
$self->SUPER::make_executable($script);
|
||||
next;
|
||||
|
||||
# Perl script that needs to be wrapped in a batch script
|
||||
} else {
|
||||
my %opts = ();
|
||||
if ( $script eq $self->build_script ) {
|
||||
$opts{ntargs} = q(-x -S %0 --build_bat %*);
|
||||
$opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9);
|
||||
}
|
||||
|
||||
my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)};
|
||||
if ( $@ ) {
|
||||
$self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@");
|
||||
} else {
|
||||
$self->SUPER::make_executable($out);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub pl2bat {
|
||||
my $self = shift;
|
||||
my %opts = @_;
|
||||
require ExtUtils::PL2Bat;
|
||||
return ExtUtils::PL2Bat::pl2bat(%opts);
|
||||
}
|
||||
|
||||
|
||||
sub _quote_args {
|
||||
# Returns a string that can become [part of] a command line with
|
||||
# proper quoting so that the subprocess sees this same list of args.
|
||||
my ($self, @args) = @_;
|
||||
|
||||
my @quoted;
|
||||
|
||||
for (@args) {
|
||||
if ( /^[^\s*?!\$<>;|'"\[\]\{\}]+$/ ) {
|
||||
# Looks pretty safe
|
||||
push @quoted, $_;
|
||||
} else {
|
||||
# XXX this will obviously have to improve - is there already a
|
||||
# core module lying around that does proper quoting?
|
||||
s/"/\\"/g;
|
||||
push @quoted, qq("$_");
|
||||
}
|
||||
}
|
||||
|
||||
return join " ", @quoted;
|
||||
}
|
||||
|
||||
|
||||
sub split_like_shell {
|
||||
# As it turns out, Windows command-parsing is very different from
|
||||
# Unix command-parsing. Double-quotes mean different things,
|
||||
# backslashes don't necessarily mean escapes, and so on. So we
|
||||
# can't use Text::ParseWords::shellwords() to break a command string
|
||||
# into words. The algorithm below was bashed out by Randy and Ken
|
||||
# (mostly Randy), and there are a lot of regression tests, so we
|
||||
# should feel free to adjust if desired.
|
||||
|
||||
(my $self, local $_) = @_;
|
||||
|
||||
return @$_ if defined() && ref() eq 'ARRAY';
|
||||
|
||||
my @argv;
|
||||
return @argv unless defined() && length();
|
||||
|
||||
my $length = length;
|
||||
m/\G\s*/gc;
|
||||
|
||||
ARGS: until ( pos == $length ) {
|
||||
my $quote_mode;
|
||||
my $arg = '';
|
||||
CHARS: until ( pos == $length ) {
|
||||
if ( m/\G((?:\\\\)+)(?=\\?(")?)/gc ) {
|
||||
if (defined $2) {
|
||||
$arg .= '\\' x (length($1) / 2);
|
||||
}
|
||||
else {
|
||||
$arg .= $1;
|
||||
}
|
||||
}
|
||||
elsif ( m/\G\\"/gc ) {
|
||||
$arg .= '"';
|
||||
}
|
||||
elsif ( m/\G"/gc ) {
|
||||
if ( $quote_mode && m/\G"/gc ) {
|
||||
$arg .= '"';
|
||||
}
|
||||
$quote_mode = !$quote_mode;
|
||||
}
|
||||
elsif ( !$quote_mode && m/\G\s+/gc ) {
|
||||
last;
|
||||
}
|
||||
elsif ( m/\G(.)/sgc ) {
|
||||
$arg .= $1;
|
||||
}
|
||||
}
|
||||
push @argv, $arg;
|
||||
}
|
||||
|
||||
return @argv;
|
||||
}
|
||||
|
||||
|
||||
# system(@cmd) does not like having double-quotes in it on Windows.
|
||||
# So we quote them and run it as a single command.
|
||||
sub do_system {
|
||||
my ($self, @cmd) = @_;
|
||||
|
||||
my $cmd = $self->_quote_args(@cmd);
|
||||
my $status = system($cmd);
|
||||
if ($status and $! =~ /Argument list too long/i) {
|
||||
my $env_entries = '';
|
||||
foreach (sort keys %ENV) { $env_entries .= "$_=>".length($ENV{$_})."; " }
|
||||
warn "'Argument list' was 'too long', env lengths are $env_entries";
|
||||
}
|
||||
return !$status;
|
||||
}
|
||||
|
||||
# Copied from ExtUtils::MM_Win32
|
||||
sub _maybe_command {
|
||||
my($self,$file) = @_;
|
||||
my @e = exists($ENV{'PATHEXT'})
|
||||
? split(/;/, $ENV{PATHEXT})
|
||||
: qw(.com .exe .bat .cmd);
|
||||
my $e = '';
|
||||
for (@e) { $e .= "\Q$_\E|" }
|
||||
chop $e;
|
||||
# see if file ends in one of the known extensions
|
||||
if ($file =~ /($e)$/i) {
|
||||
return $file if -e $file;
|
||||
}
|
||||
else {
|
||||
for (@e) {
|
||||
return "$file$_" if -e "$file$_";
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::Windows - Builder class for Windows platforms
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
The sole purpose of this module is to inherit from
|
||||
C<Module::Build::Base> and override a few methods. Please see
|
||||
L<Module::Build> for the docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3)
|
||||
|
||||
=cut
|
||||
39
database/perl/lib/Module/Build/Platform/aix.pm
Normal file
39
database/perl/lib/Module/Build/Platform/aix.pm
Normal file
@@ -0,0 +1,39 @@
|
||||
package Module::Build::Platform::aix;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Platform::Unix;
|
||||
|
||||
our @ISA = qw(Module::Build::Platform::Unix);
|
||||
|
||||
# This class isn't necessary anymore, but we can't delete it, because
|
||||
# some people might still have the old copy in their @INC, containing
|
||||
# code we don't want to execute, so we have to make sure an upgrade
|
||||
# will replace it with this empty subclass.
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::aix - Builder class for AIX platform
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides some routines very specific to the AIX
|
||||
platform.
|
||||
|
||||
Please see the L<Module::Build> for the general docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
54
database/perl/lib/Module/Build/Platform/cygwin.pm
Normal file
54
database/perl/lib/Module/Build/Platform/cygwin.pm
Normal file
@@ -0,0 +1,54 @@
|
||||
package Module::Build::Platform::cygwin;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Platform::Unix;
|
||||
|
||||
our @ISA = qw(Module::Build::Platform::Unix);
|
||||
|
||||
sub manpage_separator {
|
||||
'.'
|
||||
}
|
||||
|
||||
# Copied from ExtUtils::MM_Cygwin::maybe_command()
|
||||
# If our path begins with F</cygdrive/> then we use the Windows version
|
||||
# to determine if it may be a command. Otherwise we use the tests
|
||||
# from C<ExtUtils::MM_Unix>.
|
||||
|
||||
sub _maybe_command {
|
||||
my ($self, $file) = @_;
|
||||
|
||||
if ($file =~ m{^/cygdrive/}i) {
|
||||
require Module::Build::Platform::Windows;
|
||||
return Module::Build::Platform::Windows->_maybe_command($file);
|
||||
}
|
||||
|
||||
return $self->SUPER::_maybe_command($file);
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::cygwin - Builder class for Cygwin platform
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides some routines very specific to the cygwin
|
||||
platform.
|
||||
|
||||
Please see the L<Module::Build> for the general docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Initial stub by Yitzchak Scott-Thoennes <sthoenna@efn.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
39
database/perl/lib/Module/Build/Platform/darwin.pm
Normal file
39
database/perl/lib/Module/Build/Platform/darwin.pm
Normal file
@@ -0,0 +1,39 @@
|
||||
package Module::Build::Platform::darwin;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Platform::Unix;
|
||||
|
||||
our @ISA = qw(Module::Build::Platform::Unix);
|
||||
|
||||
# This class isn't necessary anymore, but we can't delete it, because
|
||||
# some people might still have the old copy in their @INC, containing
|
||||
# code we don't want to execute, so we have to make sure an upgrade
|
||||
# will replace it with this empty subclass.
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::darwin - Builder class for Mac OS X platform
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides some routines very specific to the Mac OS X
|
||||
platform.
|
||||
|
||||
Please see the L<Module::Build> for the general docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
48
database/perl/lib/Module/Build/Platform/os2.pm
Normal file
48
database/perl/lib/Module/Build/Platform/os2.pm
Normal file
@@ -0,0 +1,48 @@
|
||||
package Module::Build::Platform::os2;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
use Module::Build::Platform::Unix;
|
||||
|
||||
our @ISA = qw(Module::Build::Platform::Unix);
|
||||
|
||||
sub manpage_separator { '.' }
|
||||
|
||||
sub have_forkpipe { 0 }
|
||||
|
||||
# Copied from ExtUtils::MM_OS2::maybe_command
|
||||
sub _maybe_command {
|
||||
my($self,$file) = @_;
|
||||
$file =~ s,[/\\]+,/,g;
|
||||
return $file if -x $file && ! -d _;
|
||||
return "$file.exe" if -x "$file.exe" && ! -d _;
|
||||
return "$file.cmd" if -x "$file.cmd" && ! -d _;
|
||||
return;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Module::Build::Platform::os2 - Builder class for OS/2 platform
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This module provides some routines very specific to the OS/2
|
||||
platform.
|
||||
|
||||
Please see the L<Module::Build> for the general docs.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Ken Williams <kwilliams@cpan.org>
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
perl(1), Module::Build(3), ExtUtils::MakeMaker(3)
|
||||
|
||||
=cut
|
||||
63
database/perl/lib/Module/Build/PodParser.pm
Normal file
63
database/perl/lib/Module/Build/PodParser.pm
Normal file
@@ -0,0 +1,63 @@
|
||||
package Module::Build::PodParser;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
our $VERSION = '0.4231';
|
||||
$VERSION = eval $VERSION;
|
||||
|
||||
sub new {
|
||||
# Perl is so fun.
|
||||
my $package = shift;
|
||||
|
||||
my $self;
|
||||
$self = bless {have_pod_parser => 0, @_}, $package;
|
||||
|
||||
unless ($self->{fh}) {
|
||||
die "No 'file' or 'fh' parameter given" unless $self->{file};
|
||||
open($self->{fh}, '<', $self->{file}) or die "Couldn't open $self->{file}: $!";
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub parse_from_filehandle {
|
||||
my ($self, $fh) = @_;
|
||||
|
||||
local $_;
|
||||
while (<$fh>) {
|
||||
next unless /^=(?!cut)/ .. /^=cut/; # in POD
|
||||
# Accept Name - abstract or C<Name> - abstract
|
||||
last if ($self->{abstract}) = /^ (?: [a-z_0-9:]+ | [BCIF] < [a-z_0-9:]+ > ) \s+ - \s+ (.*\S) /ix;
|
||||
}
|
||||
|
||||
my @author;
|
||||
while (<$fh>) {
|
||||
next unless /^=head1\s+AUTHORS?/i ... /^=/;
|
||||
next if /^=/;
|
||||
push @author, $_ if /\@/;
|
||||
}
|
||||
return unless @author;
|
||||
s/^\s+|\s+$//g foreach @author;
|
||||
|
||||
$self->{author} = \@author;
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub get_abstract {
|
||||
my $self = shift;
|
||||
return $self->{abstract} if defined $self->{abstract};
|
||||
|
||||
$self->parse_from_filehandle($self->{fh});
|
||||
|
||||
return $self->{abstract};
|
||||
}
|
||||
|
||||
sub get_author {
|
||||
my $self = shift;
|
||||
return $self->{author} if defined $self->{author};
|
||||
|
||||
$self->parse_from_filehandle($self->{fh});
|
||||
|
||||
return $self->{author} || [];
|
||||
}
|
||||
Reference in New Issue
Block a user