lib/CPANPLUS/t/20_CPANPLUS-Dist-MM.t

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