mm.pm

source of perl for linux application,

package CPANPLUS::Dist::MM;

use strict;
use vars    qw[@ISA $STATUS];
@ISA =      qw[CPANPLUS::Dist];


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

=head1 SYNOPSIS

    my $mm = CPANPLUS::Dist->new( 
                                format  => 'makemaker',
                                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 succesfully
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 succesfully. 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 $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 $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 );
    {   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 },
        };                                            

        $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; 
    RUN: {
        ### 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.

            ### 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->(