[p5sagit/p5-mst-13.2.git] / cpan / CPANPLUS / t / 20_CPANPLUS-Dist-MM.t

### make sure we can find our conf.pl file
BEGIN { 
    use FindBin; 
    require "$FindBin::Bin/inc/conf.pl";
}

use strict;

use CPANPLUS::Configure;
use CPANPLUS::Backend;
use CPANPLUS::Dist;
use CPANPLUS::Dist::MM;
use CPANPLUS::Internals::Constants;

use Test::More 'no_plan';
use Cwd;
use Config;
use Data::Dumper;
use File::Basename ();
use File::Spec ();

my $conf    = gimme_conf();
my $cb      = CPANPLUS::Backend->new( $conf );
my $File    = 'Bar.pm';

### if we need sudo that's no guarantee we can actually run it
### so set $noperms if sudo is required, as that may mean tests
### fail if you're not allowed to execute sudo. This resolves
### #29904: make test should not use sudo
my $noperms = $conf->get_program('sudo')        || #you need sudo
              $conf->get_conf('makemakerflags') || #you set some funky flags
              not -w $Config{installsitelib};      #cant write to install target

#$IPC::Cmd::DEBUG = $Verbose;

### Make sure we get the _EUMM_NOXS_ version
my $ModName = TEST_CONF_MODULE;

### This is the module name that gets /installed/
my $InstName = TEST_CONF_INST_MODULE;

### don't start sending test reports now... ###
$cb->_callbacks->send_test_report( sub { 0 } );
$conf->set_conf( cpantest => 0 );

### Redirect errors to file ###
*STDERR = output_handle() unless $conf->get_conf('verbose');

### dont uncomment this, it screws up where STDOUT goes and makes
### test::harness create test counter mismatches
#*STDOUT                          = output_handle() unless @ARGV;
### for the same test-output counter mismatch, we disable verbose
### mode
$conf->set_conf( allow_build_interactivity => 0 );

### start with fresh sources ###
ok( $cb->reload_indices( update_source => 0 ),
                                "Rebuilding trees" );

### we might need this Some Day when we're going to install into
### our own sandbox dir.. but for now, no dice due to EU::I bug
# $conf->set_program( sudo => '' );
# $conf->set_conf( makemakerflags => TEST_INSTALL_EU_MM_FLAGS );

### set alternate install dir ###
### XXX rather pointless, since we can't uninstall them, due to a bug
### in EU::Installed (6871). And therefor we can't test uninstall() or any of
### the EU::Installed functions. So, let's just install into sitelib... =/
#my $prefix  = File::Spec->rel2abs( File::Spec->catdir(cwd(),'dummy-perl') );
#my $rv = $cb->configure_object->set_conf( makemakerflags => "PREFIX=$prefix" );
#ok( $rv,                        "Alternate install path set" );

my $Mod     = $cb->module_tree( $ModName );
my $InstMod = $cb->module_tree( $InstName );
ok( $Mod,                       "Loaded object for: " . $Mod->name );
ok( $Mod,                       "Loaded object for: " . $InstMod->name );

### format_available tests ###
{   ok( CPANPLUS::Dist::MM->format_available,
                                "Format is available" );

    ### whitebox test!
    {   local $^W;
        local *CPANPLUS::Dist::MM::can_load = sub { 0 };
        ok(!CPANPLUS::Dist::MM->format_available,
                                "   Making format unavailable" );
    }

    ### test if the error got logged ok ###
    like( CPANPLUS::Error->stack_as_string,
          qr/You do not have .+?'CPANPLUS::Dist::MM' not available/s,
                                "   Format failure logged" );

    ### flush the stack ###
    CPANPLUS::Error->flush;
}

ok( $Mod->fetch,                "Fetching module to ".$Mod->status->fetch );
ok( $Mod->extract,              "Extracting module to ".$Mod->status->extract );

### test target => 'init'
{   my $dist = $Mod->dist( target => TARGET_INIT );
    ok( $dist,                  "Dist created with target => " . TARGET_INIT );
    ok( !$dist->status->prepared,
                                "   Prepare was not run" );
}                                

ok( $Mod->test,                 "Testing module" );

ok( $Mod->status->dist_cpan->status->test,
                                "   Test success registered as status" );
ok( $Mod->status->dist_cpan->status->prepared,
                                "   Prepared status registered" );
ok( $Mod->status->dist_cpan->status->created,
                                "   Created status registered" );
is( $Mod->status->dist_cpan->status->distdir, $Mod->status->extract,
                                "   Distdir status registered properly" );

### test the convenience methods
ok( $Mod->prepare,              "Preparing module" );
ok( $Mod->create,               "Creating module" );

ok( $Mod->dist,                 "Building distribution" );
ok( $Mod->status->dist_cpan,    "   Dist registered as status" );
isa_ok( $Mod->status->dist_cpan,    "CPANPLUS::Dist::MM" );

### flush the lib cache
### otherwise, cpanplus thinks the module's already installed
### since the blib is already in @INC
$cb->_flush( list => [qw|lib|] );

SKIP: {

    skip(q[No install tests under core perl],            10) if $ENV{PERL_CORE};
    skip(q[Possibly no permission to install, skipping], 10) if $noperms;

    ### we now say 'no perms' if sudo is configured, as per #29904
    #diag(q[Note: 'sudo' might ask for your password to do the install test])
    #    if $conf->get_program('sudo');

    ### make sure no options are set in PERL5_MM_OPT, as they might
    ### change the installation target and therefor will 1. mess up
    ### the tests and 2. leave an installed copy of our test module
    ### lying around. This addresses bug #29716: 20_CPANPLUS-Dist-MM.t 
    ### fails (and leaves test files installed) when EUMM options 
    ### include INSTALL_BASE
    {   local $ENV{'PERL5_MM_OPT'};
    
        ### add the new dir to the configuration too, so eu::installed tests
        ### work as they should
        $conf->set_conf( lib => [ TEST_CONF_INSTALL_DIR ] );
    
        ok( $Mod->install(  force           => 1, 
                            makemakerflags  => 'PREFIX='.TEST_CONF_INSTALL_DIR, 
                        ),      "Installing module" );
    }                                
                                
    ok( $Mod->status->installed,"   Module installed according to status" );


    SKIP: {   ### EU::Installed tests ###
        ### EU::I sometimes fails. See:
        ### #43292: ~/CPANPLUS-0.85_04 fails t/20_CPANPLUS-Dist-MM.t
        ### #46890: ExtUtils::Installed + EU::MM PREFIX= don't always work
        ### well together
        skip( "ExtUtils::Installed issue #46890 prevents these tests from running reliably", 8 );
    
    
        skip( "Old perl on cygwin detected " .
              "-- tests will fail due to known bugs", 8
        ) if ON_OLD_CYGWIN;

        ### might need it Later when EU::I is fixed..
        #local @INC = ( TEST_INSTALL_DIR_LIB, @INC );

        {   ### validate
            my @missing = $InstMod->validate;

            is_deeply( \@missing, [],
                                    "No missing files" );
        }

        {   ### files
            my @files = $InstMod->files;

            ### number of files may vary from OS to OS
            ok( scalar(@files),     "All files accounted for" );
            ok( grep( /$File/, @files),
                                    "   Found the module" );

            ### XXX does this work on all OSs?
            #ok( grep( /man/, @files ),
            #                        "   Found the manpage" );
        }

        {   ### packlist
            my ($obj) = $InstMod->packlist;
            isa_ok( $obj,           "ExtUtils::Packlist" );
        }

        {   ### directory_tree
            my @dirs = $InstMod->directory_tree;
            ok( scalar(@dirs),      "Directory tree obtained" );

            my $found;
            for my $dir (@dirs) {
                ok( -d $dir,        "   Directory exists" );

                my $file = File::Spec->catfile( $dir, $File );
                $found = $file if -e $file;
            }

            ok( -e $found,          "   Module found" );
        }

        SKIP: {
            skip("Probably no permissions to uninstall", 1)
                if $noperms;

            ok( $InstMod->uninstall,"Uninstalling module" );
        }
    }
}

### test exceptions in Dist::MM->create ###
{   ok( $Mod->status->mk_flush, "Old status info flushed" );
    my $dist = INSTALLER_MM->new( module => $Mod );
    
    ok( $dist,                  "New dist object made" );
    ok(!$dist->prepare,         "   Dist->prepare failed" );
    like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/,
                                "       Failure logged" );

    ### manually set the extract dir,
    $Mod->status->extract($0);

    ok(!$dist->create,          "   Dist->create failed" );
    like( CPANPLUS::Error->stack_as_string, qr/not successfully prepared/s,
                                "       Failure logged" );

    ### pretend we've been prepared ###
    $dist->status->prepared(1);

    ok(!$dist->create,          "   Dist->create failed" );
    like( CPANPLUS::Error->stack_as_string, qr/Could not chdir/s,
                                "       Failure logged" );
}

### writemakefile.pl tests ###
{   ### remove old status info
    ok( $Mod->status->mk_flush, "Old status info flushed" );
    ok( $Mod->fetch,            "Module fetched again" );
    ok( $Mod->extract,          "Module extracted again" );

    ### cheat and add fake prereqs ###
    my $prereq = TEST_CONF_PREREQ;

    $Mod->status->prereqs( { $prereq => 0 } );

    my $makefile_pl = MAKEFILE_PL->( $Mod->status->extract );
    my $makefile    = MAKEFILE->(    $Mod->status->extract );

    my $dist        = $Mod->dist;
    ok( $dist,                  "Dist object built" );

    ### check for a makefile.pl and 'write' one
    ok( -s $makefile_pl,        "   Makefile.PL present" );
    ok( $dist->write_makefile_pl( force => 0 ),
                                "   Makefile.PL written" );
    like( CPANPLUS::Error->stack_as_string, qr/Already created/,
                                "   Prior existance noted" );

    ### ok, unlink the makefile.pl, now really write one
    1 while unlink $makefile;

    ### must do '1 while' for VMS
    {   my $unlink_sts = unlink($makefile_pl);
        1 while unlink $makefile_pl;
        ok( $unlink_sts,        "Deleting Makefile.PL");
    }

    ok( !-s $makefile_pl,       "   Makefile.PL deleted" );
    ok( !-s $makefile,          "   Makefile deleted" );
    ok($dist->write_makefile_pl,"   Makefile.PL written" );

    ### see if we wrote anything sensible
    my $fh = OPEN_FILE->( $makefile_pl );
    ok( $fh,                    "Makefile.PL open for read" );

    my $str = do { local $/; <$fh> };
    like( $str, qr/### Auto-generated .+ by CPANPLUS ###/,
                                "   Autogeneration noted" );
    like( $str, '/'. $Mod->module .'/',
                                "   Contains module name" );
    like( $str, '/'. quotemeta($Mod->version) . '/',
                                "   Contains version" );
    like( $str, '/'. $Mod->author->author .'/',
                                "   Contains author" );
    like( $str, '/PREREQ_PM/',  "   Contains prereqs" );
    like( $str, qr/$prereq.+0/, "   Contains prereqs" );

    close $fh;

    ### seems ok, now delete it again and go via install()
    ### to see if it picks up on the missing makefile.pl and
    ### does the right thing
    ### must do '1 while' for VMS
    {   my $unlink_sts = unlink($makefile_pl);
        1 while unlink $makefile_pl;
        ok( $unlink_sts,        "Deleting Makefile.PL");
    }    
    ok( !-s $makefile_pl,       "   Makefile.PL deleted" );
    ok( $dist->status->mk_flush,"Dist status flushed" );
    ok( $dist->prepare,         "   Dist->prepare run again" );
    ok( $dist->create,          "   Dist->create run again" );
    ok( -s $makefile_pl,        "   Makefile.PL present" );
    like( CPANPLUS::Error->stack_as_string,
          qr/attempting to generate one/,
                                "   Makefile.PL generation attempt logged" );

    ### now let's throw away the makefile.pl, flush the status and not
    ### write a makefile.pl
    {   local $^W;
        local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 };

        1 while unlink $makefile_pl;
        1 while unlink $makefile;

        ok(!-s $makefile_pl,        "Makefile.PL deleted" );
        ok(!-s $makefile,           "Makefile deleted" );
        ok( $dist->status->mk_flush,"Dist status flushed" );
        ok(!$dist->prepare,         "   Dist->prepare failed" );
        like( CPANPLUS::Error->stack_as_string,
              qr/Could not find 'Makefile.PL'/i,
                                    "   Missing Makefile.PL noted" );
        is( $dist->status->makefile, 0,
                                    "   Did not manage to create Makefile" );
    }

    ### now let's write a makefile.pl that just does 'die'
    {   local $^W;
        local *CPANPLUS::Dist::MM::write_makefile_pl = 
            __PACKAGE__->_custom_makefile_pl_sub( "exit 1;" );

        ### there's no makefile.pl now, since the previous test failed
        ### to create one
        #ok( -e $makefile_pl,        "Makefile.PL exists" );
        #ok( unlink($makefile_pl),   "   Deleting Makefile.PL");
        ok(!-s $makefile_pl,        "Makefile.PL deleted" );
        ok( $dist->status->mk_flush,"Dist status flushed" );
        ok(!$dist->prepare,         "   Dist->prepare failed" );
        like( CPANPLUS::Error->stack_as_string, qr/Could not run/s,
                                    "   Logged failed 'perl Makefile.PL'" );
        is( $dist->status->makefile, 0,
                                    "   Did not manage to create Makefile" );
    }

    ### clean up afterwards ###
    ### must do '1 while' for VMS
    {   my $unlink_sts = unlink($makefile_pl);
        1 while unlink $makefile_pl;
        ok( $unlink_sts,        "Deleting Makefile.PL");
    }   
    
    $dist->status->mk_flush;
}

### test ENV setting in Makefile.PL
{   ### use print() not die() -- we're redirecting STDERR in tests!
    my $env     = ENV_CPANPLUS_IS_EXECUTING;
    my $sub     = __PACKAGE__->_custom_makefile_pl_sub(
                                    "print qq[ENV=\$ENV{$env}\n]; exit 1;" );
    
    my $clone   = $Mod->clone;
    $clone->status->fetch( $Mod->status->fetch );
    
    ok( $clone,                 'Testing ENV settings $dist->prepare' );
    ok( $clone->extract,        '   Files extracted' );
    ok( $clone->prepare,        '   $mod->prepare worked first time' );
    
    my $dist        = $clone->status->dist;
    my $makefile_pl = MAKEFILE_PL->( $clone->status->extract );

    ok( $sub->($dist),          "   Custom Makefile.PL written" );
    ok( -e $makefile_pl,        "       File exists" );

    ### clear errors    
    CPANPLUS::Error->flush;

    my $rv = $dist->prepare( force => 1, verbose => 0 );
    ok( !$rv,                   '   $dist->prepare failed' );

    SKIP: {
        skip( "Can't test ENV{$env} -- no buffers available", 1 )
            unless IPC::Cmd->can_capture_buffer;

        my $re = quotemeta( $makefile_pl );
        like( CPANPLUS::Error->stack_as_string, qr/ENV=$re/,
                                "   \$ENV $env set correctly during execution");
    }

    ### and the ENV var should no longer be set now
    ok( !$ENV{$env},            "   ENV var now unset" );
}    

sub _custom_makefile_pl_sub {
    my $pkg = shift;
    my $txt = shift or return;
    
    return sub {
        my $dist = shift; 
        my $self = $dist->parent;
        my $fh   = OPEN_FILE->(
                    MAKEFILE_PL->($self->status->extract), '>' );
        print $fh $txt;
        close $fh;
    
        return 1;
    }
}


# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
Commit	Line	Data
6aaee015	1	### make sure we can find our conf.pl file
	2	BEGIN {
	3	use FindBin;
	4	require "$FindBin::Bin/inc/conf.pl";
	5	}
	6
	7	use strict;
	8
	9	use CPANPLUS::Configure;
	10	use CPANPLUS::Backend;
	11	use CPANPLUS::Dist;
	12	use CPANPLUS::Dist::MM;
	13	use CPANPLUS::Internals::Constants;
	14
	15	use Test::More 'no_plan';
	16	use Cwd;
	17	use Config;
	18	use Data::Dumper;
	19	use File::Basename ();
	20	use File::Spec ();
	21
	22	my $conf = gimme_conf();
	23	my $cb = CPANPLUS::Backend->new( $conf );
6aaee015	24	my $File = 'Bar.pm';
6aaee015	25
5879cbe1	26	### if we need sudo that's no guarantee we can actually run it
	27	### so set $noperms if sudo is required, as that may mean tests
	28	### fail if you're not allowed to execute sudo. This resolves
	29	### #29904: make test should not use sudo
	30	my $noperms = $conf->get_program('sudo') \|\| #you need sudo
	31	$conf->get_conf('makemakerflags') \|\| #you set some funky flags
	32	not -w $Config{installsitelib}; #cant write to install target
	33
6aaee015	34	#$IPC::Cmd::DEBUG = $Verbose;
	35
	36	### Make sure we get the _EUMM_NOXS_ version
	37	my $ModName = TEST_CONF_MODULE;
	38
	39	### This is the module name that gets /installed/
	40	my $InstName = TEST_CONF_INST_MODULE;
	41
	42	### don't start sending test reports now... ###
	43	$cb->_callbacks->send_test_report( sub { 0 } );
	44	$conf->set_conf( cpantest => 0 );
	45
	46	### Redirect errors to file ###
20afcebf	47	*STDERR = output_handle() unless $conf->get_conf('verbose');
6aaee015	48
	49	### dont uncomment this, it screws up where STDOUT goes and makes
	50	### test::harness create test counter mismatches
	51	#*STDOUT = output_handle() unless @ARGV;
	52	### for the same test-output counter mismatch, we disable verbose
	53	### mode
6aaee015	54	$conf->set_conf( allow_build_interactivity => 0 );
	55
	56	### start with fresh sources ###
	57	ok( $cb->reload_indices( update_source => 0 ),
	58	"Rebuilding trees" );
	59
	60	### we might need this Some Day when we're going to install into
	61	### our own sandbox dir.. but for now, no dice due to EU::I bug
	62	# $conf->set_program( sudo => '' );
	63	# $conf->set_conf( makemakerflags => TEST_INSTALL_EU_MM_FLAGS );
	64
	65	### set alternate install dir ###
	66	### XXX rather pointless, since we can't uninstall them, due to a bug
	67	### in EU::Installed (6871). And therefor we can't test uninstall() or any of
	68	### the EU::Installed functions. So, let's just install into sitelib... =/
	69	#my $prefix = File::Spec->rel2abs( File::Spec->catdir(cwd(),'dummy-perl') );
	70	#my $rv = $cb->configure_object->set_conf( makemakerflags => "PREFIX=$prefix" );
	71	#ok( $rv, "Alternate install path set" );
	72
	73	my $Mod = $cb->module_tree( $ModName );
	74	my $InstMod = $cb->module_tree( $InstName );
	75	ok( $Mod, "Loaded object for: " . $Mod->name );
	76	ok( $Mod, "Loaded object for: " . $InstMod->name );
	77
	78	### format_available tests ###
	79	{ ok( CPANPLUS::Dist::MM->format_available,
	80	"Format is available" );
	81
	82	### whitebox test!
	83	{ local $^W;
	84	local *CPANPLUS::Dist::MM::can_load = sub { 0 };
	85	ok(!CPANPLUS::Dist::MM->format_available,
	86	" Making format unavailable" );
	87	}
	88
	89	### test if the error got logged ok ###
	90	like( CPANPLUS::Error->stack_as_string,
	91	qr/You do not have .+?'CPANPLUS::Dist::MM' not available/s,
	92	" Format failure logged" );
	93
	94	### flush the stack ###
	95	CPANPLUS::Error->flush;
	96	}
	97
	98	ok( $Mod->fetch, "Fetching module to ".$Mod->status->fetch );
	99	ok( $Mod->extract, "Extracting module to ".$Mod->status->extract );
	100
8bc57f96	101	### test target => 'init'
	102	{ my $dist = $Mod->dist( target => TARGET_INIT );
	103	ok( $dist, "Dist created with target => " . TARGET_INIT );
	104	ok( !$dist->status->prepared,
	105	" Prepare was not run" );
	106	}
	107
6aaee015	108	ok( $Mod->test, "Testing module" );
	109
	110	ok( $Mod->status->dist_cpan->status->test,
	111	" Test success registered as status" );
	112	ok( $Mod->status->dist_cpan->status->prepared,
	113	" Prepared status registered" );
	114	ok( $Mod->status->dist_cpan->status->created,
	115	" Created status registered" );
	116	is( $Mod->status->dist_cpan->status->distdir, $Mod->status->extract,
	117	" Distdir status registered properly" );
	118
	119	### test the convenience methods
	120	ok( $Mod->prepare, "Preparing module" );
	121	ok( $Mod->create, "Creating module" );
	122
	123	ok( $Mod->dist, "Building distribution" );
	124	ok( $Mod->status->dist_cpan, " Dist registered as status" );
	125	isa_ok( $Mod->status->dist_cpan, "CPANPLUS::Dist::MM" );
	126
	127	### flush the lib cache
	128	### otherwise, cpanplus thinks the module's already installed
	129	### since the blib is already in @INC
	130	$cb->_flush( list => [qw\|lib\|] );
	131
	132	SKIP: {
	133
5879cbe1	134	skip(q[No install tests under core perl], 10) if $ENV{PERL_CORE};
5879cbe1	135	skip(q[Possibly no permission to install, skipping], 10) if $noperms;
6aaee015	136
5879cbe1	137	### we now say 'no perms' if sudo is configured, as per #29904
	138	#diag(q[Note: 'sudo' might ask for your password to do the install test])
	139	# if $conf->get_program('sudo');
6aaee015	140
5bc5f6dc	141	### make sure no options are set in PERL5_MM_OPT, as they might
	142	### change the installation target and therefor will 1. mess up
	143	### the tests and 2. leave an installed copy of our test module
	144	### lying around. This addresses bug #29716: 20_CPANPLUS-Dist-MM.t
	145	### fails (and leaves test files installed) when EUMM options
	146	### include INSTALL_BASE
	147	{ local $ENV{'PERL5_MM_OPT'};
	148
4443dd53	149	### add the new dir to the configuration too, so eu::installed tests
	150	### work as they should
	151	$conf->set_conf( lib => [ TEST_CONF_INSTALL_DIR ] );
	152
	153	ok( $Mod->install( force => 1,
	154	makemakerflags => 'PREFIX='.TEST_CONF_INSTALL_DIR,
	155	), "Installing module" );
5bc5f6dc	156	}
5bc5f6dc	157
6aaee015	158	ok( $Mod->status->installed," Module installed according to status" );
	159
	160
	161	SKIP: { ### EU::Installed tests ###
a0995fd4	162	### EU::I sometimes fails. See:
	163	### #43292: ~/CPANPLUS-0.85_04 fails t/20_CPANPLUS-Dist-MM.t
	164	### #46890: ExtUtils::Installed + EU::MM PREFIX= don't always work
	165	### well together
	166	skip( "ExtUtils::Installed issue #46890 prevents these tests from running reliably", 8 );
	167
6aaee015	168
	169	skip( "Old perl on cygwin detected " .
	170	"-- tests will fail due to known bugs", 8
	171	) if ON_OLD_CYGWIN;
	172
	173	### might need it Later when EU::I is fixed..
	174	#local @INC = ( TEST_INSTALL_DIR_LIB, @INC );
	175
	176	{ ### validate
	177	my @missing = $InstMod->validate;
	178
	179	is_deeply( \@missing, [],
	180	"No missing files" );
	181	}
	182
	183	{ ### files
	184	my @files = $InstMod->files;
	185
	186	### number of files may vary from OS to OS
	187	ok( scalar(@files), "All files accounted for" );
	188	ok( grep( /$File/, @files),
	189	" Found the module" );
	190
	191	### XXX does this work on all OSs?
	192	#ok( grep( /man/, @files ),
	193	# " Found the manpage" );
	194	}
	195
	196	{ ### packlist
	197	my ($obj) = $InstMod->packlist;
	198	isa_ok( $obj, "ExtUtils::Packlist" );
	199	}
	200
	201	{ ### directory_tree
	202	my @dirs = $InstMod->directory_tree;
	203	ok( scalar(@dirs), "Directory tree obtained" );
	204
	205	my $found;
	206	for my $dir (@dirs) {
	207	ok( -d $dir, " Directory exists" );
	208
	209	my $file = File::Spec->catfile( $dir, $File );
	210	$found = $file if -e $file;
	211	}
	212
	213	ok( -e $found, " Module found" );
	214	}
	215
	216	SKIP: {
	217	skip("Probably no permissions to uninstall", 1)
	218	if $noperms;
	219
	220	ok( $InstMod->uninstall,"Uninstalling module" );
	221	}
	222	}
	223	}
	224
	225	### test exceptions in Dist::MM->create ###
	226	{ ok( $Mod->status->mk_flush, "Old status info flushed" );
4443dd53	227	my $dist = INSTALLER_MM->new( module => $Mod );
4443dd53	228
6aaee015	229	ok( $dist, "New dist object made" );
	230	ok(!$dist->prepare, " Dist->prepare failed" );
	231	like( CPANPLUS::Error->stack_as_string, qr/No dir found to operate on/,
	232	" Failure logged" );
	233
	234	### manually set the extract dir,
	235	$Mod->status->extract($0);
	236
	237	ok(!$dist->create, " Dist->create failed" );
	238	like( CPANPLUS::Error->stack_as_string, qr/not successfully prepared/s,
	239	" Failure logged" );
	240
	241	### pretend we've been prepared ###
	242	$dist->status->prepared(1);
	243
	244	ok(!$dist->create, " Dist->create failed" );
	245	like( CPANPLUS::Error->stack_as_string, qr/Could not chdir/s,
	246	" Failure logged" );
	247	}
	248
	249	### writemakefile.pl tests ###
	250	{ ### remove old status info
	251	ok( $Mod->status->mk_flush, "Old status info flushed" );
	252	ok( $Mod->fetch, "Module fetched again" );
	253	ok( $Mod->extract, "Module extracted again" );
	254
	255	### cheat and add fake prereqs ###
	256	my $prereq = TEST_CONF_PREREQ;
	257
	258	$Mod->status->prereqs( { $prereq => 0 } );
	259
	260	my $makefile_pl = MAKEFILE_PL->( $Mod->status->extract );
	261	my $makefile = MAKEFILE->( $Mod->status->extract );
	262
	263	my $dist = $Mod->dist;
	264	ok( $dist, "Dist object built" );
	265
	266	### check for a makefile.pl and 'write' one
	267	ok( -s $makefile_pl, " Makefile.PL present" );
	268	ok( $dist->write_makefile_pl( force => 0 ),
	269	" Makefile.PL written" );
	270	like( CPANPLUS::Error->stack_as_string, qr/Already created/,
	271	" Prior existance noted" );
	272
	273	### ok, unlink the makefile.pl, now really write one
5bc5f6dc	274	1 while unlink $makefile;
	275
	276	### must do '1 while' for VMS
	277	{ my $unlink_sts = unlink($makefile_pl);
	278	1 while unlink $makefile_pl;
	279	ok( $unlink_sts, "Deleting Makefile.PL");
	280	}
6aaee015	281
6aaee015	282	ok( !-s $makefile_pl, " Makefile.PL deleted" );
	283	ok( !-s $makefile, " Makefile deleted" );
	284	ok($dist->write_makefile_pl," Makefile.PL written" );
	285
	286	### see if we wrote anything sensible
	287	my $fh = OPEN_FILE->( $makefile_pl );
	288	ok( $fh, "Makefile.PL open for read" );
	289
	290	my $str = do { local $/; <$fh> };
	291	like( $str, qr/### Auto-generated .+ by CPANPLUS ###/,
	292	" Autogeneration noted" );
	293	like( $str, '/'. $Mod->module .'/',
	294	" Contains module name" );
	295	like( $str, '/'. quotemeta($Mod->version) . '/',
	296	" Contains version" );
	297	like( $str, '/'. $Mod->author->author .'/',
	298	" Contains author" );
	299	like( $str, '/PREREQ_PM/', " Contains prereqs" );
	300	like( $str, qr/$prereq.+0/, " Contains prereqs" );
	301
	302	close $fh;
	303
	304	### seems ok, now delete it again and go via install()
	305	### to see if it picks up on the missing makefile.pl and
	306	### does the right thing
5bc5f6dc	307	### must do '1 while' for VMS
	308	{ my $unlink_sts = unlink($makefile_pl);
	309	1 while unlink $makefile_pl;
	310	ok( $unlink_sts, "Deleting Makefile.PL");
	311	}
6aaee015	312	ok( !-s $makefile_pl, " Makefile.PL deleted" );
	313	ok( $dist->status->mk_flush,"Dist status flushed" );
	314	ok( $dist->prepare, " Dist->prepare run again" );
	315	ok( $dist->create, " Dist->create run again" );
	316	ok( -s $makefile_pl, " Makefile.PL present" );
	317	like( CPANPLUS::Error->stack_as_string,
	318	qr/attempting to generate one/,
	319	" Makefile.PL generation attempt logged" );
	320
	321	### now let's throw away the makefile.pl, flush the status and not
	322	### write a makefile.pl
	323	{ local $^W;
	324	local *CPANPLUS::Dist::MM::write_makefile_pl = sub { 1 };
	325
5bc5f6dc	326	1 while unlink $makefile_pl;
5bc5f6dc	327	1 while unlink $makefile;
6aaee015	328
	329	ok(!-s $makefile_pl, "Makefile.PL deleted" );
	330	ok(!-s $makefile, "Makefile deleted" );
	331	ok( $dist->status->mk_flush,"Dist status flushed" );
	332	ok(!$dist->prepare, " Dist->prepare failed" );
	333	like( CPANPLUS::Error->stack_as_string,
	334	qr/Could not find 'Makefile.PL'/i,
	335	" Missing Makefile.PL noted" );
	336	is( $dist->status->makefile, 0,
	337	" Did not manage to create Makefile" );
	338	}
	339
	340	### now let's write a makefile.pl that just does 'die'
	341	{ local $^W;
	342	local *CPANPLUS::Dist::MM::write_makefile_pl =
	343	__PACKAGE__->_custom_makefile_pl_sub( "exit 1;" );
	344
	345	### there's no makefile.pl now, since the previous test failed
	346	### to create one
	347	#ok( -e $makefile_pl, "Makefile.PL exists" );
	348	#ok( unlink($makefile_pl), " Deleting Makefile.PL");
	349	ok(!-s $makefile_pl, "Makefile.PL deleted" );
	350	ok( $dist->status->mk_flush,"Dist status flushed" );
	351	ok(!$dist->prepare, " Dist->prepare failed" );
	352	like( CPANPLUS::Error->stack_as_string, qr/Could not run/s,
	353	" Logged failed 'perl Makefile.PL'" );
	354	is( $dist->status->makefile, 0,
	355	" Did not manage to create Makefile" );
	356	}
	357
	358	### clean up afterwards ###
5bc5f6dc	359	### must do '1 while' for VMS
	360	{ my $unlink_sts = unlink($makefile_pl);
	361	1 while unlink $makefile_pl;
	362	ok( $unlink_sts, "Deleting Makefile.PL");
	363	}
	364
6aaee015	365	$dist->status->mk_flush;
6aaee015	366	}
	367
	368	### test ENV setting in Makefile.PL
	369	{ ### use print() not die() -- we're redirecting STDERR in tests!
	370	my $env = ENV_CPANPLUS_IS_EXECUTING;
	371	my $sub = __PACKAGE__->_custom_makefile_pl_sub(
	372	"print qq[ENV=\$ENV{$env}\n]; exit 1;" );
	373
	374	my $clone = $Mod->clone;
	375	$clone->status->fetch( $Mod->status->fetch );
	376
	377	ok( $clone, 'Testing ENV settings $dist->prepare' );
	378	ok( $clone->extract, ' Files extracted' );
	379	ok( $clone->prepare, ' $mod->prepare worked first time' );
	380
	381	my $dist = $clone->status->dist;
	382	my $makefile_pl = MAKEFILE_PL->( $clone->status->extract );
	383
	384	ok( $sub->($dist), " Custom Makefile.PL written" );
	385	ok( -e $makefile_pl, " File exists" );
	386
	387	### clear errors
	388	CPANPLUS::Error->flush;
	389
	390	my $rv = $dist->prepare( force => 1, verbose => 0 );
	391	ok( !$rv, ' $dist->prepare failed' );
	392
	393	SKIP: {
	394	skip( "Can't test ENV{$env} -- no buffers available", 1 )
	395	unless IPC::Cmd->can_capture_buffer;
	396
	397	my $re = quotemeta( $makefile_pl );
	398	like( CPANPLUS::Error->stack_as_string, qr/ENV=$re/,
	399	" \$ENV $env set correctly during execution");
	400	}
	401
	402	### and the ENV var should no longer be set now
	403	ok( !$ENV{$env}, " ENV var now unset" );
	404	}
	405
	406	sub _custom_makefile_pl_sub {
	407	my $pkg = shift;
	408	my $txt = shift or return;
	409
	410	return sub {
	411	my $dist = shift;
	412	my $self = $dist->parent;
	413	my $fh = OPEN_FILE->(
	414	MAKEFILE_PL->($self->status->extract), '>' );
	415	print $fh $txt;
	416	close $fh;
	417
	418	return 1;
	419	}
	420	}
	421
	422
	423	# Local variables:
	424	# c-indentation-style: bsd
	425	# c-basic-offset: 4
	426	# indent-tabs-mode: nil
	427	# End:
	428	# vim: expandtab shiftwidth=4:
	429
430