mm.pm

source of perl for linux application,

                    msg( NO_TESTS_DEFINED->( $captured ), 0 )
                } else {
                    msg( loc( "MAKE TEST passed: %2", $captured ), $verbose );
                }
            
                $dist->status->test(1);
            } else {
                error( loc( "MAKE TEST failed: %1 %2", $!, $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 ) );
    }  
    
    ### 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,
            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;
    }

            
    $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;
}    


1;

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: