diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Dist')
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Autobundle.pm | 36 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Base.pm | 74 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build.pm | 132 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build/Constants.pm | 19 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm | 506 |
5 files changed, 407 insertions, 360 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Autobundle.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Autobundle.pm index 9561dd9f325..546f1ba6382 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Autobundle.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Autobundle.pm @@ -10,7 +10,7 @@ use base qw[CPANPLUS::Dist::Base]; =head1 NAME -CPANPLUS::Dist::Autobundle +CPANPLUS::Dist::Autobundle - distribution class for installation snapshots =head1 SYNOPSIS @@ -29,13 +29,13 @@ All modules as mentioned in the snapshot will be installed on your system. sub init { my $dist = shift; my $status = $dist->status; - + $status->mk_accessors( qw[prepared created installed _prepare_args _create_args _install_args] ); - + return 1; -} +} sub prepare { my $dist = shift; @@ -50,11 +50,11 @@ sub prepare { sub create { my $dist = shift; my $self = $dist->parent; - + ### we're also the cpan_dist, since we don't need to have anything - ### prepared - $dist = $self->status->dist_cpan if $self->status->dist_cpan; - $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; + ### prepared + $dist = $self->status->dist_cpan if $self->status->dist_cpan; + $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; my $cb = $self->parent; my $conf = $cb->configure_object; @@ -62,25 +62,25 @@ sub create { my( $force, $verbose, $prereq_target, $prereq_format, $prereq_build); - my $args = do { + my $args = do { local $Params::Check::ALLOW_UNKNOWN = 1; my $tmpl = { - force => { default => $conf->get_conf('force'), + force => { default => $conf->get_conf('force'), store => \$force }, - verbose => { default => $conf->get_conf('verbose'), + verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, - prereq_target => { default => '', store => \$prereq_target }, + prereq_target => { default => '', store => \$prereq_target }, ### don't set the default prereq format to 'makemaker' -- wrong! prereq_format => { #default => $self->status->installer_type, default => '', - store => \$prereq_format }, - prereq_build => { default => 0, store => \$prereq_build }, - }; + store => \$prereq_format }, + prereq_build => { default => 0, store => \$prereq_build }, + }; check( $tmpl, \%hash ) or return; }; - + ### maybe we already ran a create on this object? ### return 1 if $dist->status->created && !$force; @@ -90,7 +90,7 @@ sub create { msg(loc("Resolving prerequisites mentioned in the bundle"), $verbose); ### this will set the directory back to the start - ### dir, so we must chdir /again/ + ### dir, so we must chdir /again/ my $ok = $dist->_resolve_prereqs( format => $prereq_format, verbose => $verbose, @@ -107,7 +107,7 @@ sub create { sub install { my $dist = shift; my %args = @_; - + ### store the arguments, so ->install can use them in recursive loops ### $dist->status->_install_args( \%args ); diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Base.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Base.pm index 904ab172266..8e4e02f1f50 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Base.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Base.pm @@ -19,13 +19,13 @@ CPANPLUS::Dist::Base - Base class for custom distribution classes sub prepare { my $dist = shift; - + ### do the 'standard' things $dist->SUPER::prepare( @_ ) or return; - + ### do MY_IMPLEMENTATION specific things ... - + ### don't forget to set the status! return $dist->status->prepared( $SUCCESS ? 1 : 0 ); } @@ -34,7 +34,7 @@ CPANPLUS::Dist::Base - Base class for custom distribution classes =head1 DESCRIPTION CPANPLUS::Dist::Base functions as a base class for all custom -distribution implementations. It does all the mundane work +distribution implementations. It does all the mundane work CPANPLUS would have done without a custom distribution, so you can override just the parts you need to make your own implementation work. @@ -50,7 +50,7 @@ class are called: $dist->prepare; # find/write meta information $dist->create; # write the distribution file $dist->install; # install the distribution file - + $dist->uninstall; # remove the distribution (OPTIONAL) =head1 METHODS @@ -64,8 +64,8 @@ override. =cut -sub methods { - return qw[format_available init prepare create install uninstall] +sub methods { + return qw[format_available init prepare create install uninstall] } =head2 $bool = $Class->format_available @@ -82,7 +82,7 @@ Simply return true if the request can proceed and false if it can not. The C<CPANPLUS::Dist::Base> implementation always returns true. -=cut +=cut sub format_available { return 1 } @@ -91,21 +91,21 @@ sub format_available { return 1 } This method is called just after the new dist object is set up and before the C<prepare> method is called. This is the time to set up -the object so it can be used with your class. +the object so it can be used with your class. For example, you might want to add extra accessors to the C<status> object, which you might do as follows: $dist->status->mk_accessors( qw[my_implementation_accessor] ); -The C<status> object is implemented as an instance of the -C<Object::Accessor> class. Please refer to its documentation for +The C<status> object is implemented as an instance of the +C<Object::Accessor> class. Please refer to its documentation for details. Return true if the initialization was successful, and false if it was not. -The C<CPANPLUS::Dist::Base> implementation does not alter your object +The C<CPANPLUS::Dist::Base> implementation does not alter your object and always returns true. =cut @@ -116,14 +116,14 @@ sub init { return 1; } This runs the preparation step of your distribution. This step is meant to set up the environment so the C<create> step can create the actual -distribution(file). -A C<prepare> call in the standard C<ExtUtils::MakeMaker> distribution +distribution(file). +A C<prepare> call in the standard C<ExtUtils::MakeMaker> distribution would, for example, run C<perl Makefile.PL> to find the dependencies -for a distribution. For a C<debian> distribution, this is where you +for a distribution. For a C<debian> distribution, this is where you would write all the metafiles required for the C<dpkg-*> tools. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). Sets C<< $dist->status->prepared >> to the return value of this function. @@ -131,7 +131,7 @@ If you override this method, you should make sure to set this value. =cut -sub prepare { +sub prepare { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; @@ -147,18 +147,18 @@ sub prepare { =head2 $bool = $dist->create This runs the creation step of your distribution. This step is meant -to follow up on the C<prepare> call, that set up your environment so -the C<create> step can create the actual distribution(file). -A C<create> call in the standard C<ExtUtils::MakeMaker> distribution +to follow up on the C<prepare> call, that set up your environment so +the C<create> step can create the actual distribution(file). +A C<create> call in the standard C<ExtUtils::MakeMaker> distribution would, for example, run C<make> and C<make test> to build and test -a distribution. For a C<debian> distribution, this is where you +a distribution. For a C<debian> distribution, this is where you would create the actual C<.deb> file using C<dpkg>. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). -Sets C<< $dist->status->dist >> to the location of the created +Sets C<< $dist->status->dist >> to the location of the created distribution. If you override this method, you should make sure to set this value. @@ -167,7 +167,7 @@ If you override this method, you should make sure to set this value. =cut -sub create { +sub create { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; @@ -193,13 +193,13 @@ sub create { This runs the install step of your distribution. This step is meant to follow up on the C<create> call, which prepared a distribution(file) to install. -A C<create> call in the standard C<ExtUtils::MakeMaker> distribution +A C<create> call in the standard C<ExtUtils::MakeMaker> distribution would, for example, run C<make install> to copy the distribution files -to their final destination. For a C<debian> distribution, this is where +to their final destination. For a C<debian> distribution, this is where you would run C<dpkg --install> on the created C<.deb> file. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). Sets C<< $dist->status->installed >> to the return value of this function. @@ -207,12 +207,12 @@ If you override this method, you should make sure to set this value. =cut -sub install { +sub install { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; my $self = $dist->parent; - my $dist_cpan = $self->status->dist_cpan; + my $dist_cpan = $self->status->dist_cpan; my $cb = $self->parent; my $conf = $cb->configure_object; @@ -223,14 +223,14 @@ sub install { =head2 $bool = $dist->uninstall This runs the uninstall step of your distribution. This step is meant -to remove the distribution from the file system. -A C<uninstall> call in the standard C<ExtUtils::MakeMaker> distribution -would, for example, run C<make uninstall> to remove the distribution -files the file system. For a C<debian> distribution, this is where you +to remove the distribution from the file system. +A C<uninstall> call in the standard C<ExtUtils::MakeMaker> distribution +would, for example, run C<make uninstall> to remove the distribution +files the file system. For a C<debian> distribution, this is where you would run C<dpkg --uninstall PACKAGE>. The C<CPANPLUS::Dist::Base> implementation simply calls the underlying -distribution class (Typically C<CPANPLUS::Dist::MM> or +distribution class (Typically C<CPANPLUS::Dist::MM> or C<CPANPLUS::Dist::Build>). Sets C<< $dist->status->uninstalled >> to the return value of this function. @@ -238,12 +238,12 @@ If you override this method, you should make sure to set this value. =cut -sub uninstall { +sub uninstall { ### just in case you already did a create call for this module object ### just via a different dist object my $dist = shift; my $self = $dist->parent; - my $dist_cpan = $self->status->dist_cpan; + my $dist_cpan = $self->status->dist_cpan; my $cb = $self->parent; my $conf = $cb->configure_object; @@ -251,7 +251,7 @@ sub uninstall { $dist->status->uninstalled( $dist_cpan->uninstall( @_ ) ); } -1; +1; # Local variables: # c-indentation-style: bsd diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build.pm index 164bcb0a9ec..702d606115b 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build.pm @@ -10,7 +10,7 @@ use CPANPLUS::Internals::Constants; ### these constants were exported by CPANPLUS::Internals::Constants ### in previous versions.. they do the same though. If we want to have ### a normal 'use' here, up the dependency to CPANPLUS 0.056 or higher -BEGIN { +BEGIN { require CPANPLUS::Dist::Build::Constants; CPANPLUS::Dist::Build::Constants->import() if not __PACKAGE__->can('BUILD') && __PACKAGE__->can('BUILD_DIR'); @@ -30,7 +30,7 @@ use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; local $Params::Check::VERBOSE = 1; -$VERSION = '0.54'; +$VERSION = '0.62'; =pod @@ -44,8 +44,8 @@ CPANPLUS::Dist::Build - CPANPLUS plugin to install packages that use Build.PL format => 'CPANPLUS::Dist::Build', module => $modobj, ); - - $build->prepare; # runs Build.PL + + $build->prepare; # runs Build.PL $build->create; # runs build && build test $build->install; # runs build install @@ -58,7 +58,7 @@ Using this package, you can create, install and uninstall perl modules. It inherits from C<CPANPLUS::Dist>. Normal users won't have to worry about the interface to this module, -as it functions transparently as a plug-in to C<CPANPLUS> and will +as it functions transparently as a plug-in to C<CPANPLUS> and will just C<Do The Right Thing> when it's loaded. =head1 ACCESSORS @@ -104,7 +104,7 @@ This gets set after C<perl Build.PL> =item C<distdir ()> Full path to the directory in which the C<prepare> call took place, -set after a call to C<prepare>. +set after a call to C<prepare>. =item C<created ()> @@ -184,11 +184,11 @@ sub init { =head2 $bool = $dist->prepare([perl => '/path/to/perl', buildflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL]) -C<prepare> prepares a distribution, running C<Build.PL> +C<prepare> prepares a distribution, running C<Build.PL> and establishing any prerequisites this distribution has. -The variable C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path +The variable C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path of the C<Build.PL> that is being executed. This enables any code inside the C<Build.PL> to know that it is being installed via CPANPLUS. @@ -232,9 +232,9 @@ sub prepare { perl => { default => $^X, store => \$perl }, buildflags => { default => $conf->get_conf('buildflags'), store => \$buildflags }, - prereq_target => { default => '', store => \$prereq_target }, + prereq_target => { default => '', store => \$prereq_target }, prereq_format => { default => '', - store => \$prereq_format }, + store => \$prereq_format }, prereq_build => { default => 0, store => \$prereq_build }, }; @@ -269,7 +269,8 @@ sub prepare { my @buildflags = $dist->_buildflags_as_list( $buildflags ); $dist->status->_buildflags( $buildflags ); - my $fail; + my $fail; my $prereq_fail; + my $status = { }; RUN: { # 0.85_01 ### we resolve 'configure requires' here, so we can run the 'perl @@ -281,7 +282,7 @@ sub prepare { ### containing a makefile.pl/build.pl for test purposes? my $safe_ver = version->new('0.85_01'); if ( version->new($CPANPLUS::Internals::VERSION) >= $safe_ver ) - { my $configure_requires = $dist->find_configure_requires; + { my $configure_requires = $dist->find_configure_requires; my $ok = $dist->_resolve_prereqs( format => $prereq_format, verbose => $verbose, @@ -289,18 +290,19 @@ sub prepare { target => $prereq_target, force => $force, prereq_build => $prereq_build, - ); - + ); + unless( $ok ) { - + #### use $dist->flush to reset the cache ### error( loc( "Unable to satisfy '%1' for '%2' " . - "-- aborting install", - 'configure_requires', $self->module ) ); + "-- aborting install", + 'configure_requires', $self->module ) ); $dist->status->prepared(0); - $fail++; + $prereq_fail++; + $fail++; last RUN; - } + } ### end of prereq resolving ### } @@ -310,14 +312,18 @@ sub prepare { my $env = ENV_CPANPLUS_IS_EXECUTING; local $ENV{$env} = BUILD_PL->( $dir ); - my $run_perl = $conf->get_program('perlwrapper'); - my $cmd = [$perl, $run_perl, BUILD_PL->($dir), @buildflags]; + my @run_perl = ( '-e', CPDB_PERL_WRAPPER ); + my $cmd = [$perl, @run_perl, BUILD_PL->($dir), @buildflags]; unless ( scalar run( command => $cmd, buffer => \$prep_output, - verbose => $verbose ) + verbose => $verbose ) ) { error( loc( "Build.PL failed: %1", $prep_output ) ); + if ( $conf->get_conf('cpantest') ) { + $status->{stage} = 'prepare'; + $status->{capture} = $prep_output; + } $fail++; last RUN; } @@ -325,19 +331,20 @@ sub prepare { my $prereqs = $self->status->prereqs; - $prereqs ||= $dist->_find_prereqs( verbose => $verbose, - dir => $dir, + $prereqs ||= $dist->_find_prereqs( verbose => $verbose, + dir => $dir, perl => $perl, buildflags => $buildflags ); } - + ### send out test report? ### - if( $fail and $conf->get_conf('cpantest') ) { - $cb->_send_report( + if( $fail and $conf->get_conf('cpantest') and not $prereq_fail ) { + $cb->_send_report( module => $self, failed => $fail, buffer => CPANPLUS::Error->stack_as_string, + status => $status, verbose => $verbose, force => $force, ) or error(loc("Failed to send test report for '%1'", @@ -370,7 +377,7 @@ sub _find_prereqs { buildflags => { default => $conf->get_conf('buildflags'), store => \$buildflags }, }; - + my $args = check( $tmpl, \%hash ) or return; my $prereqs = {}; @@ -389,11 +396,11 @@ sub _find_prereqs { my @buildflags = $dist->_buildflags_as_list( $buildflags ); # Use the new Build action 'prereq_data' - my $run_perl = $conf->get_program('perlwrapper'); + my @run_perl = ( '-e', CPDB_PERL_WRAPPER ); - unless ( scalar run( command => [$perl, $run_perl, BUILD->($dir), 'prereq_data', @buildflags], + unless ( scalar run( command => [$perl, @run_perl, BUILD->($dir), 'prereq_data', @buildflags], buffer => \$content, - verbose => 0 ) + verbose => 0 ) ) { error( loc( "Build 'prereq_data' failed: %1 %2", $!, $content ) ); #return; @@ -413,7 +420,7 @@ sub _find_prereqs { error( loc( "Cannot open '%1': %2", $file, $! ) ); return; } - + $content = do { local $/; <$fh> }; } @@ -511,7 +518,7 @@ sub create { prereq_format => { #default => $self->status->installer_type, default => '', store => \$prereq_format }, - prereq_build => { default => 0, store => \$prereq_build }, + prereq_build => { default => 0, store => \$prereq_build }, }; $args = check( $tmpl, \%hash ) or return; @@ -567,9 +574,10 @@ sub create { $dist->status->_buildflags( $buildflags ); my $fail; my $prereq_fail; my $test_fail; + my $status = { }; RUN: { - my $run_perl = $conf->get_program('perlwrapper'); + my @run_perl = ( '-e', CPDB_PERL_WRAPPER ); ### this will set the directory back to the start ### dir, so we must chdir /again/ @@ -601,15 +609,19 @@ sub create { $cmd = [$perl, BUILD->($dir), @buildflags]; } else { - $cmd = [$perl, $run_perl, BUILD->($dir), @buildflags]; + $cmd = [$perl, @run_perl, BUILD->($dir), @buildflags]; } unless ( scalar run( command => $cmd, buffer => \$captured, - verbose => $verbose ) + verbose => $verbose ) ) { error( loc( "MAKE failed:\n%1", $captured ) ); $dist->status->build(0); + if ( $conf->get_conf('cpantest') ) { + $status->{stage} = 'build'; + $status->{capture} = $captured; + } $fail++; last RUN; } @@ -620,8 +632,8 @@ sub create { ### add this directory to your lib ### $self->add_to_includepath(); - ### this buffer will not include what tests failed due to a - ### M::B/Test::Harness bug. Reported as #9793 with patch + ### this buffer will not include what tests failed due to a + ### M::B/Test::Harness bug. Reported as #9793 with patch ### against 0.2607 on 26/1/2005 unless( $skiptest ) { my $test_output; @@ -629,13 +641,13 @@ sub create { $cmd = [$perl, BUILD->($dir), "test", @buildflags]; } else { - $cmd = [$perl, $run_perl, BUILD->($dir), "test", @buildflags]; + $cmd = [$perl, @run_perl, BUILD->($dir), "test", @buildflags]; } unless ( scalar run( command => $cmd, buffer => \$test_output, - verbose => $verbose ) + verbose => $verbose ) ) { - error( loc( "MAKE TEST failed:\n%1 ", $test_output ) ); + error( loc( "MAKE TEST failed:\n%1 ", $test_output ), ( $verbose ? 0 : 1 ) ); ### mark specifically *test* failure.. so we dont ### send success on force... @@ -645,16 +657,23 @@ sub create { $self, $@ ) ) { $dist->status->test(0); + if ( $conf->get_conf('cpantest') ) { + $status->{stage} = 'test'; + $status->{capture} = $test_output; + } $fail++; last RUN; } - } + } else { msg( loc( "MAKE TEST passed:\n%1", $test_output ), 0 ); - #msg( $test_output, 0 ); $dist->status->test(1); + if ( $conf->get_conf('cpantest') ) { + $status->{stage} = 'test'; + $status->{capture} = $test_output; + } } - } + } else { msg(loc("Tests skipped"), $verbose); } @@ -670,6 +689,7 @@ sub create { module => $self, failed => $test_fail || $fail, buffer => CPANPLUS::Error->stack_as_string, + status => $status, verbose => $verbose, force => $force, tests_skipped => $skiptest, @@ -702,7 +722,7 @@ sub install { my $conf = $cb->configure_object; my %hash = @_; - + my $verbose; my $perl; my $force; my $buildflags; { local $Params::Check::ALLOW_UNKNOWN = 1; my $tmpl = { @@ -714,7 +734,7 @@ sub install { store => \$buildflags }, perl => { default => $^X, store => \$perl }, }; - + my $args = check( $tmpl, \%hash ) or return; $dist->status->_install_args( $args ); } @@ -733,7 +753,7 @@ sub install { } ### value set and false -- means failure ### - if( defined $self->status->installed && + if( defined $self->status->installed && !$self->status->installed && !$force ) { error( loc( "Module '%1' has failed to install before this session " . @@ -743,7 +763,7 @@ sub install { my $fail; my @buildflags = $dist->_buildflags_as_list( $buildflags ); - my $run_perl = $conf->get_program('perlwrapper'); + my @run_perl = ( '-e', CPDB_PERL_WRAPPER ); ### hmm, how is this going to deal with sudo? ### for now, check effective uid, if it's not root, @@ -758,11 +778,19 @@ sub install { $cmd = [$perl, BUILD->($dir), "install", @buildflags]; } else { - $cmd = [$perl, $run_perl, BUILD->($dir), "install", @buildflags]; + $cmd = [$perl, @run_perl, BUILD->($dir), "install", @buildflags]; } - my $sudo = $conf->get_program('sudo'); - unshift @$cmd, $sudo if $sudo; + ### Detect local::lib type behaviour. Do not use 'sudo' in these cases + my $sudo = $conf->get_program('sudo'); + SUDO: { + ### Actual local::lib in use + last SUDO if defined $ENV{PERL_MB_OPT} and $ENV{PERL_MB_OPT} =~ m!install_base!; + ### 'buildflags' is configured with '--install_base' + last SUDO if scalar grep { m!install_base! } @buildflags; + ### oh well 'sudo make me a sandwich' + unshift @$cmd, $sudo; + } my $buffer; unless( scalar run( command => $cmd, @@ -778,7 +806,7 @@ sub install { $cmd = [$perl, BUILD->($dir), "install", @buildflags]; } else { - $cmd = [$perl, $run_perl, BUILD->($dir), "install", @buildflags]; + $cmd = [$perl, @run_perl, BUILD->($dir), "install", @buildflags]; } unless( scalar run( command => $cmd, buffer => \$install_output, diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build/Constants.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build/Constants.pm index ba1ca8665c0..c0fa040ffc5 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build/Constants.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/Build/Constants.pm @@ -8,28 +8,31 @@ BEGIN { require Exporter; use vars qw[$VERSION @ISA @EXPORT]; - - $VERSION = '0.54'; + + $VERSION = '0.62'; @ISA = qw[Exporter]; - @EXPORT = qw[ BUILD_DIR BUILD ]; + @EXPORT = qw[ BUILD_DIR BUILD CPDB_PERL_WRAPPER]; } use constant BUILD_DIR => sub { return @_ ? File::Spec->catdir($_[0], '_build') : '_build'; - }; + }; use constant BUILD => sub { my $file = @_ ? File::Spec->catfile($_[0], 'Build') : 'Build'; - + ### on VMS, '.com' is appended when ### creating the Build file - $file .= '.com' if $^O eq 'VMS'; - + $file .= '.com' if $^O eq 'VMS'; + return $file; }; - + + +use constant CPDB_PERL_WRAPPER => 'use strict; BEGIN { my $old = select STDERR; $|++; select $old; $|++; $0 = shift(@ARGV); my $rv = do($0); die $@ if $@; }'; + 1; =head1 NAME diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm index b2205e46f0b..cd428691bcf 100644 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm +++ b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm @@ -23,12 +23,12 @@ local $Params::Check::VERBOSE = 1; =head1 NAME -CPANPLUS::Dist::MM +CPANPLUS::Dist::MM - distribution class for MakeMaker related modules =head1 SYNOPSIS $mm = CPANPLUS::Dist::MM->new( module => $modobj ); - + $mm->create; # runs make && make test $mm->install; # runs make install @@ -37,7 +37,7 @@ CPANPLUS::Dist::MM C<CPANPLUS::Dist::MM> is a distribution class for MakeMaker related modules. -Using this package, you can create, install and uninstall perl +Using this package, you can create, install and uninstall perl modules. It inherits from C<CPANPLUS::Dist>. =head1 ACCESSORS @@ -55,7 +55,7 @@ this module. =back -=head1 STATUS ACCESSORS +=head1 STATUS ACCESSORS All accessors can be accessed as follows: $mm->status->ACCESSOR @@ -64,7 +64,7 @@ All accessors can be accessed as follows: =item makefile () -Location of the Makefile (or Build file). +Location of the Makefile (or Build file). Set to 0 explicitly if something went wrong. =item make () @@ -73,7 +73,7 @@ BOOL indicating if the C<make> (or C<Build>) command was successful. =item test () -BOOL indicating if the C<make test> (or C<Build test>) command was +BOOL indicating if the C<make test> (or C<Build test>) command was successful. =item prepared () @@ -84,7 +84,7 @@ This gets set after C<perl Makefile.PL> =item distdir () Full path to the directory in which the C<prepare> call took place, -set after a call to C<prepare>. +set after a call to C<prepare>. =item created () @@ -126,39 +126,39 @@ to create and install modules in your environment. ### check if the format is available ### sub format_available { my $dist = shift; - + ### we might be called as $class->format_available =/ require CPANPLUS::Internals; - my $cb = CPANPLUS::Internals->_retrieve_id( + my $cb = CPANPLUS::Internals->_retrieve_id( CPANPLUS::Internals->_last_id ); my $conf = $cb->configure_object; - + my $mod = "ExtUtils::MakeMaker"; unless( can_load( modules => { $mod => 0.0 } ) ) { error( loc( "You do not have '%1' -- '%2' not available", - $mod, __PACKAGE__ ) ); + $mod, __PACKAGE__ ) ); return; } - + for my $pgm ( qw[make] ) { - unless( $conf->get_program( $pgm ) ) { + unless( $conf->get_program( $pgm ) ) { error(loc( "You do not have '%1' in your path -- '%2' not available\n" . - "Please check your config entry for '%1'", + "Please check your config entry for '%1'", $pgm, __PACKAGE__ , $pgm - )); + )); return; } } - return 1; + return 1; } =pod =head2 $bool = $dist->init(); -Sets up the C<CPANPLUS::Dist::MM> object for use. +Sets up the C<CPANPLUS::Dist::MM> object for use. Effectively creates all the needed status accessors. Called automatically whenever you create a new C<CPANPLUS::Dist> object. @@ -168,24 +168,24 @@ Called automatically whenever you create a new C<CPANPLUS::Dist> object. sub init { my $dist = shift; my $status = $dist->status; - + $status->mk_accessors(qw[makefile make test created installed uninstalled bin_make _prepare_args _create_args _install_args] ); - + return 1; -} +} =pod =head2 $bool = $dist->prepare([perl => '/path/to/perl', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL]) -C<prepare> preps a distribution for installation. This means it will +C<prepare> preps a distribution for installation. This means it will run C<perl Makefile.PL> and determine what prerequisites this distribution declared. -If you set C<force> to true, it will go over all the stages of the -C<prepare> process again, ignoring any previously cached results. +If you set C<force> to true, it will go over all the stages of the +C<prepare> process again, ignoring any previously cached results. When running C<perl Makefile.PL>, the environment variable C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path of the @@ -204,11 +204,11 @@ sub prepare { ### just via a different dist object my $dist = shift; my $self = $dist->parent; - + ### we're also the cpan_dist, since we don't need to have anything - ### prepared - $dist = $self->status->dist_cpan if $self->status->dist_cpan; - $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; + ### prepared + $dist = $self->status->dist_cpan if $self->status->dist_cpan; + $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; my $cb = $self->parent; my $conf = $cb->configure_object; @@ -219,7 +219,7 @@ sub prepare { error( loc( "No dir found to operate on!" ) ); return; } - + my $args; my( $force, $verbose, $perl, @mmflags, $prereq_target, $prereq_format, $prereq_build ); @@ -229,34 +229,34 @@ sub prepare { makemakerflags => { default => $conf->get_conf('makemakerflags') || '', store => \$mmflags[0] }, - force => { default => $conf->get_conf('force'), + force => { default => $conf->get_conf('force'), store => \$force }, - verbose => { default => $conf->get_conf('verbose'), + verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, - prereq_target => { default => '', store => \$prereq_target }, + prereq_target => { default => '', store => \$prereq_target }, prereq_format => { default => '', - store => \$prereq_format }, - prereq_build => { default => 0, store => \$prereq_build }, - }; + store => \$prereq_format }, + prereq_build => { default => 0, store => \$prereq_build }, + }; $args = check( $tmpl, \%hash ) or return; } - - + + ### maybe we already ran a create on this object? ### return 1 if $dist->status->prepared && !$force; - + ### store the arguments, so ->install can use them in recursive loops ### $dist->status->_prepare_args( $args ); - + ### chdir to work directory ### my $orig = cwd(); unless( $cb->_chdir( dir => $dir ) ) { error( loc( "Could not chdir to build directory '%1'", $dir ) ); return; } - - my $fail; + + my $fail; RUN: { ### we resolve 'configure requires' here, so we can run the 'perl @@ -266,7 +266,7 @@ sub prepare { ### on this step or failure ### XXX make a separate tarball to test for this scenario: simply ### containing a makefile.pl/build.pl for test purposes? - { my $configure_requires = $dist->find_configure_requires; + { my $configure_requires = $dist->find_configure_requires; my $ok = $dist->_resolve_prereqs( format => $prereq_format, verbose => $verbose, @@ -274,116 +274,104 @@ sub prepare { target => $prereq_target, force => $force, prereq_build => $prereq_build, - ); - + ); + unless( $ok ) { - + #### use $dist->flush to reset the cache ### error( loc( "Unable to satisfy '%1' for '%2' " . - "-- aborting install", - 'configure_requires', $self->module ) ); + "-- aborting install", + 'configure_requires', $self->module ) ); $dist->status->prepared(0); - $fail++; + $fail++; last RUN; - } + } ### end of prereq resolving ### } - - ### don't run 'perl makefile.pl' again if there's a makefile already + + ### don't run 'perl makefile.pl' again if there's a makefile already if( -e MAKEFILE->() && (-M MAKEFILE->() < -M $dir) && !$force ) { msg(loc("'%1' already exists, not running '%2 %3' again ". " unless you force", MAKEFILE->(), $perl, MAKEFILE_PL->() ), $verbose ); - + } else { unless( -e MAKEFILE_PL->() ) { msg(loc("No '%1' found - attempting to generate one", MAKEFILE_PL->() ), $verbose ); - - $dist->write_makefile_pl( - verbose => $verbose, - force => $force + + $dist->write_makefile_pl( + verbose => $verbose, + force => $force ); - + ### bail out if there's no makefile.pl ### unless( -e MAKEFILE_PL->() ) { - error( loc( "Could not find '%1' - cannot continue", + error( loc( "Could not find '%1' - cannot continue", MAKEFILE_PL->() ) ); - + ### mark that we screwed up ### $dist->status->makefile(0); $fail++; last RUN; } - } - + } + ### you can turn off running this verbose by changing ### the config setting below, although it is really not ### recommended - my $run_verbose = $verbose || + my $run_verbose = $verbose || $conf->get_conf('allow_build_interactivity') || 0; - + ### this makes MakeMaker use defaults if possible, according ### to schwern. See ticket 8047 for details. - local $ENV{PERL_MM_USE_DEFAULT} = 1 unless $run_verbose; - + local $ENV{PERL_MM_USE_DEFAULT} = 1 unless $run_verbose; + ### turn off our PERL5OPT so no modules from CPANPLUS::inc get ### included in the makefile.pl -- it should build without ### also, modules that run in taint mode break if we leave ### our code ref in perl5opt ### XXX we've removed the ENV settings from cp::inc, so only need ### to reset the @INC - #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || ''; - + #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || ''; + ### make sure it's a string, so that mmflags that have more than ### one key value pair are passed as is, rather than as: ### perl Makefile.PL "key=val key=>val" - - + + #### XXX this needs to be the absolute path to the Makefile.PL ### since cpanp-run-perl uses 'do' to execute the file, and do() ### checks your @INC.. so, if there's _another_ makefile.pl in ### your @INC, it will execute that one... my $makefile_pl = MAKEFILE_PL->( $cb->_safe_path( path => $dir ) ); - + ### setting autoflush to true fixes issue from rt #8047 ### XXX this means that we need to keep the path to CPANPLUS ### in @INC, stopping us from resolving dependencies on CPANPLUS ### at bootstrap time properly. - ### XXX this fails under ipc::run due to the extra quotes, - ### but it works in ipc::open3. however, ipc::open3 doesn't work - ### on win32/cygwin. XXX TODO get a windows box and sort this out - # my $cmd = qq[$perl -MEnglish -le ] . - # QUOTE_PERL_ONE_LINER->( - # qq[\$OUTPUT_AUTOFLUSH++,do(q($makefile_pl))] - # ) - # . $mmflags; - - # my $flush = OPT_AUTOFLUSH; - # my $cmd = "$perl $flush $makefile_pl $mmflags"; - - my $run_perl = $conf->get_program('perlwrapper'); - my $cmd = [$perl, $run_perl, $makefile_pl, @mmflags]; + my @run_perl = ( '-e', PERL_WRAPPER ); + my $cmd = [$perl, @run_perl, $makefile_pl, @mmflags]; ### set ENV var to tell underlying code this is what we're ### executing. - my $captured; + my $captured; my $rv = do { my $env = ENV_CPANPLUS_IS_EXECUTING; local $ENV{$env} = $makefile_pl; scalar run( command => $cmd, buffer => \$captured, - verbose => $run_verbose, # may be interactive + verbose => $run_verbose, # may be interactive ); }; - + unless( $rv ) { error( loc( "Could not run '%1 %2': %3 -- cannot continue", $perl, MAKEFILE_PL->(), $captured ) ); - + $dist->status->makefile(0); $fail++; last RUN; } @@ -391,7 +379,7 @@ sub prepare { ### put the output on the stack, don't print it msg( $captured, 0 ); } - + ### so, nasty feature in Module::Build, that when a Makefile.PL ### is a disguised Build.PL, it generates a Build file, not a ### Makefile. this breaks everything :( see rt bug #19741 @@ -407,39 +395,50 @@ sub prepare { "$^X ".MAKEFILE_PL->(), MAKEFILE->(), BUILD_PL->(), 'Module::Build', MAKEFILE_PL->(), 'Build', MAKEFILE->(), 'prefer_makefile', BUILD_PL->() - )); - + )); + $fail++, last RUN; } - + ### if we got here, we managed to make a 'makefile' ### - $dist->status->makefile( MAKEFILE->($dir) ); - + $dist->status->makefile( MAKEFILE->($dir) ); + + ### Make (haha) sure that Makefile.PL is older than the Makefile + ### we just generated. + eval { + my $makestat = ( stat MAKEFILE->( $dir ) )[9]; + my $mplstat = ( stat MAKEFILE_PL->( $cb->_safe_path( path => $dir ) ) )[9]; + if ( $makestat < $mplstat ) { + my $ftime = $makestat - 60; + utime $ftime, $ftime, MAKEFILE_PL->( $cb->_safe_path( path => $dir ) ); + } + }; + ### start resolving prereqs ### my $prereqs = $self->status->prereqs; - + ### a hashref of prereqs on success, undef on failure ### - $prereqs ||= $dist->_find_prereqs( + $prereqs ||= $dist->_find_prereqs( verbose => $verbose, - file => $dist->status->makefile + file => $dist->status->makefile ); - + unless( $prereqs ) { - error( loc( "Unable to scan '%1' for prereqs", + error( loc( "Unable to scan '%1' for prereqs", $dist->status->makefile ) ); $fail++; last RUN; } } - + unless( $cb->_chdir( dir => $orig ) ) { error( loc( "Could not chdir back to start dir '%1'", $orig ) ); - } - + } + ### save where we wrote this stuff -- same as extract dir in normal ### installer circumstances $dist->status->distdir( $self->status->extract ); - + return $dist->status->prepared( $fail ? 0 : 1); } @@ -467,28 +466,28 @@ sub _find_prereqs { verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, file => { required => 1, allow => FILE_READABLE, store => \$file }, }; - - my $args = check( $tmpl, \%hash ) or return; + + my $args = check( $tmpl, \%hash ) or return; ### see if we got prereqs from MYMETA my $prereqs = $dist->find_mymeta_requires(); - + ### we found some prereqs, we'll trust MYMETA ### but we do need to run it through the callback return $cb->_callbacks->filter_prereqs->( $cb, $prereqs ) if keys %$prereqs; - + my $fh = FileHandle->new(); unless( $fh->open( $file ) ) { error( loc( "Cannot open '%1': %2", $file, $! ) ); return; } - + my %p; while( local $_ = <$fh> ) { - my ($found) = m|^[\#]\s+PREREQ_PM\s+=>\s+(.+)|; - + my ($found) = m|^[\#]\s+PREREQ_PM\s+=>\s+(.+)|; + next unless $found; - + while( $found =~ m/(?:\s)([\w\:]+)=>(?:q\[(.*?)\],?|undef)/g ) { if( defined $p{$1} ) { my $ver = $cb->_version_to_number(version => $2); @@ -496,7 +495,7 @@ sub _find_prereqs { if $cb->_vcmp( $ver, $p{$1} ) > 0; } else { - $p{$1} = $cb->_version_to_number(version => $2); + $p{$1} = $cb->_version_to_number(version => $2); } } last; @@ -505,23 +504,23 @@ sub _find_prereqs { my $href = $cb->_callbacks->filter_prereqs->( $cb, \%p ); $self->status->prereqs( $href ); - + ### just to make sure it's not the same reference ### - return { %$href }; -} + return { %$href }; +} =pod =head2 $bool = $dist->create([perl => '/path/to/perl', make => '/path/to/make', makeflags => 'EXTRA=FLAGS', prereq_target => TARGET, skiptest => BOOL, force => BOOL, verbose => BOOL]) -C<create> creates the files necessary for installation. This means -it will run C<make> and C<make test>. This will also scan for and -attempt to satisfy any prerequisites the module may have. +C<create> creates the files necessary for installation. This means +it will run C<make> and C<make test>. This will also scan for and +attempt to satisfy any prerequisites the module may have. If you set C<skiptest> to true, it will skip the C<make test> stage. -If you set C<force> to true, it will go over all the stages of the -C<make> process again, ignoring any previously cached results. It -will also ignore a bad return value from C<make test> and still allow +If you set C<force> to true, it will go over all the stages of the +C<make> process again, ignoring any previously cached results. It +will also ignore a bad return value from C<make test> and still allow the operation to return true. Returns true on success and false on failure. @@ -536,11 +535,11 @@ sub create { ### just via a different dist object my $dist = shift; my $self = $dist->parent; - + ### we're also the cpan_dist, since we don't need to have anything - ### prepared - $dist = $self->status->dist_cpan if $self->status->dist_cpan; - $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; + ### prepared + $dist = $self->status->dist_cpan if $self->status->dist_cpan; + $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; my $cb = $self->parent; my $conf = $cb->configure_object; @@ -551,63 +550,64 @@ sub create { error( loc( "No dir found to operate on!" ) ); return; } - + my $args; - my( $force, $verbose, $make, $makeflags, $skiptest, $prereq_target, $perl, + my( $force, $verbose, $make, $makeflags, $skiptest, $prereq_target, $perl, @mmflags, $prereq_format, $prereq_build); { local $Params::Check::ALLOW_UNKNOWN = 1; my $tmpl = { perl => { default => $^X, store => \$perl }, - force => { default => $conf->get_conf('force'), + force => { default => $conf->get_conf('force'), store => \$force }, - verbose => { default => $conf->get_conf('verbose'), + verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, - make => { default => $conf->get_program('make'), + make => { default => $conf->get_program('make'), store => \$make }, - makeflags => { default => $conf->get_conf('makeflags'), + makeflags => { default => $conf->get_conf('makeflags'), store => \$makeflags }, - skiptest => { default => $conf->get_conf('skiptest'), + skiptest => { default => $conf->get_conf('skiptest'), store => \$skiptest }, - prereq_target => { default => '', store => \$prereq_target }, + prereq_target => { default => '', store => \$prereq_target }, ### don't set the default prereq format to 'makemaker' -- wrong! prereq_format => { #default => $self->status->installer_type, default => '', - store => \$prereq_format }, - prereq_build => { default => 0, store => \$prereq_build }, - }; + store => \$prereq_format }, + prereq_build => { default => 0, store => \$prereq_build }, + }; $args = check( $tmpl, \%hash ) or return; } - + ### maybe we already ran a create on this object? ### make sure we add to include path again, just in case we came from ### ->save_state, at which point we need to restore @INC/$PERL5LIB if( $dist->status->created && !$force ) { $self->add_to_includepath; return 1; - } - + } + ### store the arguments, so ->install can use them in recursive loops ### $dist->status->_create_args( $args ); - + unless( $dist->status->prepared ) { error( loc( "You have not successfully prepared a '%2' distribution ". "yet -- cannot create yet", __PACKAGE__ ) ); return; } - - + + ### chdir to work directory ### my $orig = cwd(); unless( $cb->_chdir( dir => $dir ) ) { error( loc( "Could not chdir to build directory '%1'", $dir ) ); return; } - + my $fail; my $prereq_fail; my $test_fail; + my $status = { }; RUN: { ### this will set the directory back to the start - ### dir, so we must chdir /again/ + ### dir, so we must chdir /again/ my $ok = $dist->_resolve_prereqs( format => $prereq_format, verbose => $verbose, @@ -616,40 +616,44 @@ sub create { force => $force, prereq_build => $prereq_build, ); - + unless( $cb->_chdir( dir => $dir ) ) { error( loc( "Could not chdir to build directory '%1'", $dir ) ); return; - } - + } + unless( $ok ) { - + #### use $dist->flush to reset the cache ### error( loc( "Unable to satisfy prerequisites for '%1' " . - "-- aborting install", $self->module ) ); + "-- aborting install", $self->module ) ); $dist->status->make(0); $fail++; $prereq_fail++; last RUN; - } - ### end of prereq resolving ### - + } + ### end of prereq resolving ### + my $captured; - ### 'make' section ### + ### 'make' section ### if( -d BLIB->($dir) && (-M BLIB->($dir) < -M $dir) && !$force ) { msg(loc("Already ran '%1' for this module [%2] -- " . - "not running again unless you force", + "not running again unless you force", $make, $self->module ), $verbose ); } else { unless(scalar run( command => [$make, $makeflags], buffer => \$captured, - verbose => $verbose ) + verbose => $verbose ) ) { error( loc( "MAKE failed: %1 %2", $!, $captured ) ); + if ( $conf->get_conf('cpantest') ) { + $status->{stage} = 'build'; + $status->{capture} = $captured; + } $dist->status->make(0); $fail++; last RUN; } - + ### put the output on the stack, don't print it msg( $captured, 0 ); @@ -657,12 +661,12 @@ sub create { ### add this directory to your lib ### $self->add_to_includepath(); - + ### dont bail out here, there's a conditional later on #last RUN if $skiptest; } - - ### 'make test' section ### + + ### 'make test' section ### unless( $skiptest ) { ### turn off our PERL5OPT so no modules from CPANPLUS::inc get @@ -673,16 +677,16 @@ sub create { #local $ENV{PERL5OPT} = CPANPLUS::inc->original_perl5opt || ''; ### you can turn off running this verbose by changing - ### the config setting below, although it is really not + ### the config setting below, although it is really not ### recommended - my $run_verbose = - $verbose || + my $run_verbose = + $verbose || $conf->get_conf('allow_build_interactivity') || 0; - ### XXX need to add makeflags here too? + ### XXX need to add makeflags here too? ### yes, but they should really be split out -- see bug #4143 - if( scalar run( + if( scalar run( command => [$make, 'test', $makeflags], buffer => \$captured, verbose => $run_verbose, @@ -695,47 +699,59 @@ sub create { } else { msg( loc( "MAKE TEST passed: %1", $captured ), 0 ); } - + + if ( $conf->get_conf('cpantest') ) { + $status->{stage} = 'test'; + $status->{capture} = $captured; + } + $dist->status->test(1); } else { - error( loc( "MAKE TEST failed: %1", $captured ) ); - + error( loc( "MAKE TEST failed: %1", $captured ), ( $run_verbose ? 0 : 1 ) ); + + if ( $conf->get_conf('cpantest') ) { + $status->{stage} = 'test'; + $status->{capture} = $captured; + } + ### send out error report here? or do so at a higher level? ### --higher level --kane. $dist->status->test(0); - + ### mark specifically *test* failure.. so we dont ### send success on force... $test_fail++; - + if( !$force and !$cb->_callbacks->proceed_on_test_failure->( - $self, $captured ) + $self, $captured ) ) { - $fail++; last RUN; + $fail++; last RUN; } } } } #</RUN> - + unless( $cb->_chdir( dir => $orig ) ) { error( loc( "Could not chdir back to start dir '%1'", $orig ) ); - } - + } + + ### TODO: Add $stage to _send_report() ### send out test report? ### only do so if the failure is this module, not its prereq if( $conf->get_conf('cpantest') and not $prereq_fail) { - $cb->_send_report( + $cb->_send_report( module => $self, failed => $test_fail || $fail, buffer => CPANPLUS::Error->stack_as_string, + status => $status, verbose => $verbose, force => $force, ) or error(loc("Failed to send test report for '%1'", $self->module ) ); - } - + } + return $dist->status->created( $fail ? 0 : 1); -} +} =pod @@ -744,7 +760,7 @@ sub create { C<install> runs the following command: make install -Returns true on success, false on failure. +Returns true on success, false on failure. =cut @@ -754,64 +770,64 @@ sub install { ### to the same module object my $dist = shift(); my $self = $dist->parent; - $dist = $self->status->dist_cpan if $self->status->dist_cpan; - + $dist = $self->status->dist_cpan if $self->status->dist_cpan; + my $cb = $self->parent; my $conf = $cb->configure_object; my %hash = @_; - - + + unless( $dist->status->created ) { error(loc("You have not successfully created a '%2' distribution yet " . "-- cannot install yet", __PACKAGE__ )); return; } - + my $dir; unless( $dir = $self->status->extract ) { error( loc( "No dir found to operate on!" ) ); return; } - + my $args; my($force,$verbose,$make,$makeflags); { local $Params::Check::ALLOW_UNKNOWN = 1; my $tmpl = { - force => { default => $conf->get_conf('force'), + force => { default => $conf->get_conf('force'), store => \$force }, - verbose => { default => $conf->get_conf('verbose'), + verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, - make => { default => $conf->get_program('make'), + make => { default => $conf->get_program('make'), store => \$make }, - makeflags => { default => $conf->get_conf('makeflags'), + makeflags => { default => $conf->get_conf('makeflags'), store => \$makeflags }, - }; - + }; + $args = check( $tmpl, \%hash ) or return; } ### value set and false -- means failure ### - if( defined $self->status->installed && - !$self->status->installed && !$force + if( defined $self->status->installed && + !$self->status->installed && !$force ) { error( loc( "Module '%1' has failed to install before this session " . "-- aborting install", $self->module ) ); return; } - + $dist->status->_install_args( $args ); - + my $orig = cwd(); unless( $cb->_chdir( dir => $dir ) ) { error( loc( "Could not chdir to build directory '%1'", $dir ) ); return; } - + my $fail; my $captured; - + ### 'make install' section ### - ### XXX need makeflags here too? + ### XXX need makeflags here too? ### yes, but they should really be split out.. see bug #4143 my $cmd = [$make, 'install', $makeflags]; my $sudo = $conf->get_program('sudo'); @@ -821,33 +837,33 @@ sub install { unless(scalar run( command => $cmd, verbose => $verbose, buffer => \$captured, - ) ) { + ) ) { error( loc( "MAKE INSTALL failed: %1 %2", $!, $captured ) ); - $fail++; - } + $fail++; + } ### put the output on the stack, don't print it msg( $captured, 0 ); - + unless( $cb->_chdir( dir => $orig ) ) { error( loc( "Could not chdir back to start dir '%1'", $orig ) ); - } - + } + return $dist->status->installed( $fail ? 0 : 1 ); - + } =pod =head2 $bool = $dist->write_makefile_pl([force => BOOL, verbose => BOOL]) -This routine can write a C<Makefile.PL> from the information in a +This routine can write a C<Makefile.PL> from the information in a module object. It is used to write a C<Makefile.PL> when the original author forgot it (!!). Returns 1 on success and false on failure. -The file gets written to the directory the module's been extracted +The file gets written to the directory the module's been extracted to. =cut @@ -857,9 +873,9 @@ sub write_makefile_pl { ### just via a different dist object my $dist = shift; my $self = $dist->parent; - $dist = $self->status->dist_cpan if $self->status->dist_cpan; - $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; - + $dist = $self->status->dist_cpan if $self->status->dist_cpan; + $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; + my $cb = $self->parent; my $conf = $cb->configure_object; my %hash = @_; @@ -869,23 +885,23 @@ sub write_makefile_pl { error( loc( "No dir found to operate on!" ) ); return; } - + my ($force, $verbose); my $tmpl = { - force => { default => $conf->get_conf('force'), + force => { default => $conf->get_conf('force'), store => \$force }, - verbose => { default => $conf->get_conf('verbose'), - store => \$verbose }, - }; + verbose => { default => $conf->get_conf('verbose'), + store => \$verbose }, + }; + + my $args = check( $tmpl, \%hash ) or return; - my $args = check( $tmpl, \%hash ) or return; - my $file = MAKEFILE_PL->($dir); if( -s $file && !$force ) { - msg(loc("Already created '%1' - not doing so again without force", + msg(loc("Already created '%1' - not doing so again without force", $file ), $verbose ); return 1; - } + } ### due to a bug with AS perl 5.8.4 built 810 (and maybe others) ### opening files with content in them already does nasty things; @@ -899,58 +915,58 @@ sub write_makefile_pl { error( loc( "Could not create file '%1': %2", $file, $! ) ); return; } - + my $mf = MAKEFILE_PL->(); my $name = $self->module; my $version = $self->version; my $author = $self->author->author; my $href = $self->status->prereqs; - my $prereqs = join ",\n", map { - (' ' x 25) . "'$_'\t=> '$href->{$_}'" - } keys %$href; - $prereqs ||= ''; # just in case there are none; - + my $prereqs = join ",\n", map { + (' ' x 25) . "'$_'\t=> '$href->{$_}'" + } keys %$href; + $prereqs ||= ''; # just in case there are none; + print $fh qq| ### Auto-generated $mf by CPANPLUS ### - + use ExtUtils::MakeMaker; - + WriteMakefile( NAME => '$name', VERSION => '$version', AUTHOR => '$author', PREREQ_PM => { -$prereqs +$prereqs }, ); - \n|; - + \n|; + $fh->close; return 1; -} - +} + sub dist_dir { ### just in case you already did a call for this module object ### just via a different dist object my $dist = shift; my $self = $dist->parent; - $dist = $self->status->dist_cpan if $self->status->dist_cpan; - $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; - + $dist = $self->status->dist_cpan if $self->status->dist_cpan; + $self->status->dist_cpan( $dist ) unless $self->status->dist_cpan; + my $cb = $self->parent; my $conf = $cb->configure_object; my %hash = @_; - + my $make; my $verbose; { local $Params::Check::ALLOW_UNKNOWN = 1; my $tmpl = { make => { default => $conf->get_program('make'), - store => \$make }, - verbose => { default => $conf->get_conf('verbose'), + store => \$make }, + verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, - }; - - check( $tmpl, \%hash ) or return; + }; + + check( $tmpl, \%hash ) or return; } @@ -959,7 +975,7 @@ sub dist_dir { error( loc( "No dir found to operate on!" ) ); return; } - + ### chdir to work directory ### my $orig = cwd(); unless( $cb->_chdir( dir => $dir ) ) { @@ -968,14 +984,14 @@ sub dist_dir { } my $fail; my $distdir; - TRY: { + TRY: { $dist->prepare( @_ ) or (++$fail, last TRY); - my $captured; + my $captured; unless(scalar run( command => [$make, 'distdir'], buffer => \$captured, - verbose => $verbose ) + verbose => $verbose ) ) { error( loc( "MAKE DISTDIR failed: %1 %2", $!, $captured ) ); ++$fail, last TRY; @@ -998,7 +1014,7 @@ sub dist_dir { return if $fail; return $distdir; -} +} 1; |