diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm')
| -rw-r--r-- | Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm | 1044 |
1 files changed, 0 insertions, 1044 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm b/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm deleted file mode 100644 index 35f31b7b089..00000000000 --- a/Master/tlpkg/tlperl/lib/CPANPLUS/Dist/MM.pm +++ /dev/null @@ -1,1044 +0,0 @@ -package CPANPLUS::Dist::MM; -use deprecate; - -use strict; -use warnings; -use vars qw[@ISA $STATUS $VERSION]; -use base 'CPANPLUS::Dist::Base'; -$VERSION = "0.9135"; - -use CPANPLUS::Internals::Constants; -use CPANPLUS::Internals::Constants::Report; -use CPANPLUS::Error; -use FileHandle; -use Cwd; - -use IPC::Cmd qw[run]; -use Params::Check qw[check]; -use File::Basename qw[dirname]; -use Module::Load::Conditional qw[can_load check_install]; -use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; - -local $Params::Check::VERBOSE = 1; - -=pod - -=head1 NAME - -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 - - -=head1 DESCRIPTION - -C<CPANPLUS::Dist::MM> is a distribution class for MakeMaker related -modules. -Using this package, you can create, install and uninstall perl -modules. It inherits from C<CPANPLUS::Dist>. - -=head1 ACCESSORS - -=over 4 - -=item parent() - -Returns the C<CPANPLUS::Module> object that parented this object. - -=item status() - -Returns the C<Object::Accessor> object that keeps the status for -this module. - -=back - -=head1 STATUS ACCESSORS - -All accessors can be accessed as follows: - $mm->status->ACCESSOR - -=over 4 - -=item makefile () - -Location of the Makefile (or Build file). -Set to 0 explicitly if something went wrong. - -=item make () - -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 -successful. - -=item prepared () - -BOOL indicating if the C<prepare> call exited successfully -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>. - -=item created () - -BOOL indicating if the C<create> call exited successfully. This gets -set after C<make> and C<make test>. - -=item installed () - -BOOL indicating if the module was installed. This gets set after -C<make install> (or C<Build install>) exits successfully. - -=item uninstalled () - -BOOL indicating if the module was uninstalled properly. - -=item _create_args () - -Storage of the arguments passed to C<create> for this object. Used -for recursive calls when satisfying prerequisites. - -=item _install_args () - -Storage of the arguments passed to C<install> for this object. Used -for recursive calls when satisfying prerequisites. - -=back - -=cut - -=head1 METHODS - -=head2 $bool = $dist->format_available(); - -Returns a boolean indicating whether or not you can use this package -to create and install modules in your environment. - -=cut - -### 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( - 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__ ) ); - return; - } - - for my $pgm ( qw[make] ) { - 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'", - $pgm, __PACKAGE__ , $pgm - )); - return; - } - } - - return 1; -} - -=pod - -=head2 $bool = $dist->init(); - -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. - -=cut - -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 -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. - -When running C<perl Makefile.PL>, the environment variable -C<PERL5_CPANPLUS_IS_EXECUTING> will be set to the full path of the -C<Makefile.PL> that is being executed. This enables any code inside -the C<Makefile.PL> to know that it is being installed via CPANPLUS. - -Returns true on success and false on failure. - -You may then call C<< $dist->create >> on the object to create the -installable files. - -=cut - -sub prepare { - ### 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; - - ### 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; - - my $cb = $self->parent; - my $conf = $cb->configure_object; - my %hash = @_; - - my $dir; - unless( $dir = $self->status->extract ) { - error( loc( "No dir found to operate on!" ) ); - return; - } - - my $args; - my( $force, $verbose, $perl, $mmflags, $prereq_target, $prereq_format, - $prereq_build ); - { local $Params::Check::ALLOW_UNKNOWN = 1; - my $tmpl = { - perl => { default => $^X, store => \$perl }, - makemakerflags => { default => - $conf->get_conf('makemakerflags') || '', - store => \$mmflags }, - force => { default => $conf->get_conf('force'), - store => \$force }, - verbose => { default => $conf->get_conf('verbose'), - store => \$verbose }, - prereq_target => { default => '', store => \$prereq_target }, - prereq_format => { default => '', - store => \$prereq_format }, - prereq_build => { default => 0, store => \$prereq_build }, - }; - - $args = check( $tmpl, \%hash ) or return; - } - - my @mmflags = $dist->_split_like_shell( $mmflags ); - - ### 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; - RUN: { - - ### we resolve 'configure requires' here, so we can run the 'perl - ### Makefile.PL' command - ### XXX for tests: mock f_c_r to something that *can* resolve and - ### something that *doesn't* resolve. Check the error log for ok - ### 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 $ok = $dist->_resolve_prereqs( - format => $prereq_format, - verbose => $verbose, - prereqs => $configure_requires, - 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 ) ); - $dist->status->prepared(0); - $fail++; - last RUN; - } - ### end of prereq resolving ### - } - - - - ### 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 - ); - - ### bail out if there's no makefile.pl ### - unless( -e MAKEFILE_PL->() ) { - 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 || - $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; - - ### 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 || ''; - - ### 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. - - 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 $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 - ); - }; - - unless( $rv ) { - error( loc( "Could not run '%1 %2': %3 -- cannot continue", - $perl, MAKEFILE_PL->(), $captured ) ); - - $dist->status->makefile(0); - $fail++; last RUN; - } - - ### 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 - if( not -e MAKEFILE->( $dir ) and -e BUILD_PL->( $dir ) ) { - error(loc( - "We just ran '%1' without errors, but no '%2' is ". - "present. However, there is a '%3' file, so this may ". - "be related to bug #19741 in %4, which describes a ". - "fake '%5' which generates a '%6' file instead of a '%7'. ". - "You could try to work around this issue by setting '%8' ". - "to false and trying again. This will attempt to use the ". - "'%9' instead.", - "$^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) ); - - ### 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( - verbose => $verbose, - file => $dist->status->makefile - ); - - unless( $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); -} - -=pod - -=head2 $href = $dist->_find_prereqs( file => '/path/to/Makefile', [verbose => BOOL]) - -Parses a C<Makefile> for C<PREREQ_PM> entries and distills from that -any prerequisites mentioned in the C<Makefile> - -Returns a hash with module-version pairs on success and false on -failure. - -=cut - -sub _find_prereqs { - my $dist = shift; - my $self = $dist->parent; - my $cb = $self->parent; - my $conf = $cb->configure_object; - my %hash = @_; - - my ($verbose, $file); - my $tmpl = { - verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, - file => { required => 1, allow => FILE_READABLE, store => \$file }, - }; - - 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+(.+)|; - - next unless $found; - - while( $found =~ m/(?:\s)([\w\:]+)=>(?:q\[(.*?)\],?|undef)/g ) { - if( defined $p{$1} ) { - my $ver = $cb->_version_to_number(version => $2); - $p{$1} = $ver - if $cb->_vcmp( $ver, $p{$1} ) > 0; - } - else { - $p{$1} = $cb->_version_to_number(version => $2); - } - } - last; - } - - my $href = $cb->_callbacks->filter_prereqs->( $cb, \%p ); - - $self->status->prereqs( $href ); - - ### just to make sure it's not the same reference ### - 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. - -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 -the operation to return true. - -Returns true on success and false on failure. - -You may then call C<< $dist->install >> on the object to actually -install it. - -=cut - -sub create { - ### 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; - - ### 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; - - my $cb = $self->parent; - my $conf = $cb->configure_object; - my %hash = @_; - - my $dir; - unless( $dir = $self->status->extract ) { - error( loc( "No dir found to operate on!" ) ); - return; - } - - my $args; - 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'), - store => \$force }, - verbose => { default => $conf->get_conf('verbose'), - store => \$verbose }, - make => { default => $conf->get_program('make'), - store => \$make }, - makeflags => { default => $conf->get_conf('makeflags'), - store => \$makeflags }, - skiptest => { default => $conf->get_conf('skiptest'), - store => \$skiptest }, - 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 }, - }; - - $args = check( $tmpl, \%hash ) or return; - } - - my @makeflags = $dist->_split_like_shell( $makeflags ); - - ### 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/ - my $ok = $dist->_resolve_prereqs( - format => $prereq_format, - verbose => $verbose, - prereqs => $self->status->prereqs, - target => $prereq_target, - 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 ) ); - $dist->status->make(0); - $fail++; $prereq_fail++; - last RUN; - } - ### end of prereq resolving ### - - my $captured; - - ### '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", - $make, $self->module ), $verbose ); - } else { - unless(scalar run( command => [$make, @makeflags], - buffer => \$captured, - 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 ); - - $dist->status->make(1); - - ### 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 ### - unless( $skiptest ) { - - ### turn off our PERL5OPT so no modules from CPANPLUS::inc get - ### included in make test -- it should build without - ### also, modules that run in taint mode break if we leave - ### our code ref in perl5opt - ### XXX CPANPLUS::inc functionality is now obsolete. - #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 - ### recommended - my $run_verbose = - $verbose || - $conf->get_conf('allow_build_interactivity') || - 0; - - ### XXX need to add makeflags here too? - ### yes, but they should really be split out -- see bug #4143 - if( scalar run( - command => [$make, 'test', @makeflags], - buffer => \$captured, - verbose => $run_verbose, - ) ) { - ### tests might pass because it doesn't have any tests defined - ### log this occasion non-verbosely, so our test reporter can - ### pick up on this - if ( NO_TESTS_DEFINED->( $captured ) ) { - msg( NO_TESTS_DEFINED->( $captured ), 0 ) - } 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 ), ( $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 ) - ) { - $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( - 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 - -=head2 $bool = $dist->install([make => '/path/to/make', makemakerflags => 'EXTRA=FLAGS', force => BOOL, verbose => BOOL]) - -C<install> runs the following command: - make install - -Returns true on success, false on failure. - -=cut - -sub install { - - ### just in case you did the create with ANOTHER dist object linked - ### to the same module object - my $dist = shift(); - my $self = $dist->parent; - $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'), - store => \$force }, - verbose => { default => $conf->get_conf('verbose'), - store => \$verbose }, - make => { default => $conf->get_program('make'), - store => \$make }, - 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 - ) { - error( loc( "Module '%1' has failed to install before this session " . - "-- aborting install", $self->module ) ); - return; - } - - my @makeflags = $dist->_split_like_shell( $makeflags ); - - $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? - ### yes, but they should really be split out.. see bug #4143 - my $cmd = [$make, 'install', @makeflags]; - my $sudo = $conf->get_program('sudo'); - unshift @$cmd, $sudo if $sudo and $>; - - $cb->flush('lib'); - unless(scalar run( command => $cmd, - verbose => $verbose, - buffer => \$captured, - ) ) { - error( loc( "MAKE INSTALL failed: %1 %2", $!, $captured ) ); - $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 -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 -to. - -=cut - -sub write_makefile_pl { - ### 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; - - my $cb = $self->parent; - my $conf = $cb->configure_object; - my %hash = @_; - - my $dir; - unless( $dir = $self->status->extract ) { - error( loc( "No dir found to operate on!" ) ); - return; - } - - my ($force, $verbose); - my $tmpl = { - force => { default => $conf->get_conf('force'), - store => \$force }, - verbose => { default => $conf->get_conf('verbose'), - store => \$verbose }, - }; - - 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", - $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; - ### seek to pos 0 and then print, but not truncating the file - ### bug reported to activestate on 19 sep 2004: - ### http://bugs.activestate.com/show_bug.cgi?id=34051 - unlink $file if $force; - - my $fh = new FileHandle; - unless( $fh->open( ">$file" ) ) { - 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; - - print $fh qq| - ### Auto-generated $mf by CPANPLUS ### - - use ExtUtils::MakeMaker; - - WriteMakefile( - NAME => '$name', - VERSION => '$version', - AUTHOR => '$author', - PREREQ_PM => { -$prereqs - }, - ); - \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; - - 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 => \$verbose }, - }; - - check( $tmpl, \%hash ) or return; - } - - - my $dir; - unless( $dir = $self->status->extract ) { - error( loc( "No dir found to operate on!" ) ); - 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 $distdir; - TRY: { - $dist->prepare( @_ ) or (++$fail, last TRY); - - - my $captured; - unless(scalar run( command => [$make, 'distdir'], - buffer => \$captured, - verbose => $verbose ) - ) { - error( loc( "MAKE DISTDIR failed: %1 %2", $!, $captured ) ); - ++$fail, last TRY; - } - - ### /path/to/Foo-Bar-1.2/Foo-Bar-1.2 - $distdir = File::Spec->catdir( $dir, $self->package_name . '-' . - $self->package_version ); - - unless( -d $distdir ) { - error(loc("Do not know where '%1' got created", 'distdir')); - ++$fail, last TRY; - } - } - - unless( $cb->_chdir( dir => $orig ) ) { - error( loc( "Could not chdir to start directory '%1'", $orig ) ); - return; - } - - return if $fail; - return $distdir; -} - -sub _split_like_shell { - my ($self, $string) = @_; - - return () unless defined($string); - return @$string if ref $string eq 'ARRAY'; - $string =~ s/^\s+|\s+$//g; - return () unless length($string); - - require Text::ParseWords; - return Text::ParseWords::shellwords($string); -} - -1; - -# Local variables: -# c-indentation-style: bsd -# c-basic-offset: 4 -# indent-tabs-mode: nil -# End: -# vim: expandtab shiftwidth=4: |