ext/CPANPLUS/t/19_CPANPLUS-Dist.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 ### dummy class for testing dist api ###
   8 BEGIN {
   9
  10     package CPANPLUS::Dist::_Test;
  11     use strict;
  12     use vars qw[$Available $Create $Install $Init $Prepare @ISA];
  13
  14     @ISA        = qw[CPANPLUS::Dist];
  15     $Available  = 1;
  16     $Create     = 1;
  17     $Install    = 1;
  18     $Init       = 1;
  19     $Prepare    = 1;
  20
  21     require CPANPLUS::Dist;
  22     CPANPLUS::Dist->_add_dist_types( __PACKAGE__ );
  23
  24     sub init                { $_[0]->status->mk_accessors(
  25                                 qw[prepared created installed
  26                                    _prepare_args _install_args _create_args]);
  27                               return $Init };
  28     sub format_available    { return $Available }
  29     sub prepare             { return shift->status->prepared(  $Prepare ) }
  30     sub create              { return shift->status->created(   $Create  ) }
  31     sub install             { return shift->status->installed( $Install ) }
  32 }
  33
  34 use strict;
  35
  36 use CPANPLUS::Configure;
  37 use CPANPLUS::Backend;
  38 use CPANPLUS::Internals::Constants;
  39
  40 use Test::More 'no_plan';
  41 use Cwd;
  42 use Data::Dumper;
  43 use File::Basename ();
  44 use File::Spec ();
  45 use Module::Load::Conditional qw[check_install];
  46
  47 my $conf = gimme_conf();
  48 my $cb   = CPANPLUS::Backend->new( $conf );
  49
  50 ### obsolete
  51 #my $Format = '_test';
  52 my $Module      = 'CPANPLUS::Dist::_Test';
  53 my $ModName     = TEST_CONF_MODULE;
  54 my $ModPrereq   = TEST_CONF_INST_MODULE;
  55 ### XXX this version doesn't exist, but we don't check for it either ###
  56 my $Prereq      = { $ModPrereq => '1000' };
  57
  58 ### since it's in this file, not in its own module file,
  59 ### make M::L::C think it already was loaded
  60 $Module::Load::Conditional::CACHE->{$Module}->{usable} = 1;
  61
  62
  63 use_ok('CPANPLUS::Dist');
  64
  65 ### start with fresh sources ###
  66 ok( $cb->reload_indices( update_source => 0 ),
  67                                 "Rebuilding trees" );
  68
  69 my $Mod  = $cb->module_tree( $ModName );
  70 ok( $Mod,                       "Got module object" );
  71
  72
  73 ### straight forward dist build - prepare, create, install
  74 {   my $dist = $Module->new( module => $Mod );
  75
  76     ok( $dist,                  "New dist object created" );
  77     isa_ok( $dist,              'CPANPLUS::Dist' );
  78     isa_ok( $dist,              $Module );
  79
  80     my $status = $dist->status;
  81     ok( $status,                "Status object found" );
  82     isa_ok( $status,            "Object::Accessor" );
  83
  84     ok( $dist->prepare,         "Prepare call" );
  85     ok( $dist->status->prepared,"   Status registered OK" );
  86
  87     ok( $dist->create,          "Create call" );
  88     ok( $dist->status->created, "   Status registered OK" );
  89
  90     ok( $dist->install,         "Install call" );
  91     ok( $dist->status->installed,
  92                                 "   Status registered OK" );
  93 }
  94
  95 ### check 'sanity check' option ###
  96 {   local $CPANPLUS::Dist::_Test::Available = 0;
  97
  98     ok( !$Module->format_available,
  99                                 "Format availabillity turned off" );
 100
 101     {   $conf->_set_build('sanity_check' => 0);
 102
 103         my $dist = $Module->new( module => $Mod );
 104
 105         ok( $dist,              "Dist created with sanity check off" );
 106         isa_ok( $dist,          $Module );
 107
 108     }
 109
 110     {   $conf->_set_build('sanity_check' => 1);
 111
 112         my $dist = $Module->new( module => $Mod );
 113
 114         ok( !$dist,             "Dist not created with sanity check on" );
 115         like( CPANPLUS::Error->stack_as_string,
 116                 qr/Format '$Module' is not available/,
 117                                 "   Error recorded as expected" );
 118     }
 119 }
 120
 121 ### undef the status hash, make sure it complains ###
 122 {   local $CPANPLUS::Dist::_Test::Init = 0;
 123
 124     my $dist = $Module->new( module => $Mod );
 125
 126     ok( !$dist,                 "No dist created by failed init" );
 127     like( CPANPLUS::Error->stack_as_string,
 128             qr/Dist initialization of '$Module' failed for/s,
 129                                 "   Error recorded as expected" );
 130 }
 131
 132 ### configure_requires tests
 133 {   my $meta    = META->( $Mod );
 134     ok( $meta,                  "Reading 'configure_requires' from '$meta'" );
 135
 136     my $clone   = $Mod->clone;
 137     ok( $clone,                 "   Package cloned" );
 138
 139     ### set the new location to fetch from
 140     $clone->package( $meta );
 141
 142     my $file = $clone->fetch;
 143     ok( $file,                  "   Meta file fetched" );
 144     ok( -e $file,               "       File '$file' exits" );
 145
 146     my $dist = $Module->new( module => $Mod );
 147
 148     ok( $dist,                  "   Dist object created" );
 149
 150     my $meth = 'find_configure_requires';
 151     can_ok( $dist,              $meth );
 152
 153     my $href = $dist->$meth( file => $file );
 154     ok( $href,                  "   '$meth' returned hashref" );
 155
 156     ok( scalar(keys(%$href)),   "       Contains entries" );
 157     ok( $href->{ +TEST_CONF_PREREQ },
 158                                 "       Contains the right prereq" );
 159 }
 160
 161
 162 ### test _resolve prereqs, in a somewhat simulated set of circumstances
 163 {   my $old_prereq = $conf->get_conf('prereqs');
 164
 165     my $map = {
 166         0 => {
 167             'Previous install failed' => [
 168                 sub { $cb->module_tree($ModPrereq)->status->installed(0);
 169                                                                 'install' },
 170                 sub { like( CPANPLUS::Error->stack_as_string,
 171                       qr/failed to install before in this session/s,
 172                             "   Previous install failed recorded ok" ) },
 173             ],
 174
 175             "Set $Module->prepare to false" => [
 176                 sub { $CPANPLUS::Dist::_Test::Prepare = 0;       'install' },
 177                 sub { like( CPANPLUS::Error->stack_as_string,
 178                       qr/Unable to create a new distribution object/s,
 179                             "   Dist creation failed recorded ok" ) },
 180                 sub { like( CPANPLUS::Error->stack_as_string,
 181                       qr/Failed to install '$ModPrereq' as prerequisite/s,
 182                             "   Dist creation failed recorded ok" ) },
 183             ],
 184
 185             "Set $Module->create to false" => [
 186                 sub { $CPANPLUS::Dist::_Test::Create = 0;       'install' },
 187                 sub { like( CPANPLUS::Error->stack_as_string,
 188                       qr/Unable to create a new distribution object/s,
 189                             "   Dist creation failed recorded ok" ) },
 190                 sub { like( CPANPLUS::Error->stack_as_string,
 191                       qr/Failed to install '$ModPrereq' as prerequisite/s,
 192                             "   Dist creation failed recorded ok" ) },
 193             ],
 194
 195             "Set $Module->install to false" => [
 196                 sub { $CPANPLUS::Dist::_Test::Install = 0;      'install' },
 197                 sub { like( CPANPLUS::Error->stack_as_string,
 198                       qr/Failed to install '$ModPrereq' as/s,
 199                             "   Dist installation failed recorded ok" ) },
 200             ],
 201
 202             "Set dependency to be perl-core" => [
 203                 sub { $cb->module_tree( $ModPrereq )->package(
 204                                         'perl-5.8.1.tar.gz' );  'install' },
 205                 sub { like( CPANPLUS::Error->stack_as_string,
 206                       qr/Prerequisite '$ModPrereq' is perl-core/s,
 207                             "   Dist installation failed recorded ok" ) },
 208             ],
 209             'Simple ignore'     => [
 210                 sub { 'ignore' },
 211                 sub { ok( !$_[0]->status->prepared,
 212                             "   Module status says not prepared" ) },
 213                 sub { ok( !$_[0]->status->created,
 214                             "   Module status says not created" ) },
 215                 sub { ok( !$_[0]->status->installed,
 216                             "   Module status says not installed" ) },
 217             ],
 218             'Ignore from conf'  => [
 219                 sub { $conf->set_conf(prereqs => PREREQ_IGNORE);    '' },
 220                 sub { ok( !$_[0]->status->prepared,
 221                             "   Module status says not prepared" ) },
 222                 sub { ok( !$_[0]->status->created,
 223                             "   Module status says not created" ) },
 224                 sub { ok( !$_[0]->status->installed,
 225                             "   Module status says not installed" ) },
 226                 ### set the conf back ###
 227                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 228             ],
 229             'Perl binary version too low' => [
 230                 sub { $cb->module_tree( $ModName )
 231                         ->status->prereqs({ PERL_CORE, 10000000000 }); '' },
 232                 sub { like( CPANPLUS::Error->stack_as_string,
 233                             qr/needs perl version/,
 234                             "   Perl version not high enough" ) },
 235             ],
 236         },
 237         1 => {
 238             'Simple create'     => [
 239                 sub { 'create' },
 240                 sub { ok( $_[0]->status->prepared,
 241                             "   Module status says prepared" ) },
 242                 sub { ok( $_[0]->status->created,
 243                             "   Module status says created" ) },
 244                 sub { ok( !$_[0]->status->installed,
 245                             "   Module status says not installed" ) },
 246             ],
 247             'Simple install'    => [
 248                 sub { 'install' },
 249                 sub { ok( $_[0]->status->prepared,
 250                             "   Module status says prepared" ) },
 251                 sub { ok( $_[0]->status->created,
 252                             "   Module status says created" ) },
 253                 sub { ok( $_[0]->status->installed,
 254                             "   Module status says installed" ) },
 255             ],
 256
 257             'Install from conf' => [
 258                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL);   '' },
 259                 sub { ok( $_[0]->status->prepared,
 260                             "   Module status says prepared" ) },
 261                 sub { ok( $_[0]->status->created,
 262                             "   Module status says created" ) },
 263                 sub { ok( $_[0]->status->installed,
 264                             "   Module status says installed" ) },
 265             ],
 266             'Create from conf'  => [
 267                 sub { $conf->set_conf(prereqs => PREREQ_BUILD);     '' },
 268                 sub { ok( $_[0]->status->prepared,
 269                             "   Module status says prepared" ) },
 270                 sub { ok( $_[0]->status->created,
 271                             "   Module status says created" ) },
 272                 sub { ok( !$_[0]->status->installed,
 273                             "   Module status says not installed" ) },
 274                 ### set the conf back ###
 275                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 276             ],
 277
 278             'Ask from conf'     => [
 279                 sub { $cb->_register_callback(
 280                             name => 'install_prerequisite',
 281                             code => sub {1} );
 282                       $conf->set_conf(prereqs => PREREQ_ASK);       '' },
 283                 sub { ok( $_[0]->status->prepared,
 284                             "   Module status says prepared" ) },
 285                 sub { ok( $_[0]->status->created,
 286                             "   Module status says created" ) },
 287                 sub { ok( $_[0]->status->installed,
 288                             "   Module status says installed" ) },
 289                 ### set the conf back ###
 290                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 291
 292             ],
 293
 294             'Ask from conf, but decline' => [
 295                 sub { $cb->_register_callback(
 296                             name => 'install_prerequisite',
 297                             code => sub {0} );
 298                       $conf->set_conf( prereqs => PREREQ_ASK);      '' },
 299                 sub { ok( !$_[0]->status->installed,
 300                             "   Module status says not installed" ) },
 301                 sub { like( CPANPLUS::Error->stack_as_string,
 302                       qr/Will not install prerequisite '$ModPrereq' -- Note/,
 303                             "   Install skipped, recorded ok" ) },
 304                 ### set the conf back ###
 305                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 306             ],
 307
 308             "Set recursive dependency" => [
 309                 sub { $cb->_status->pending_prereqs({ $ModPrereq => 1 });
 310                                                                 'install' },
 311                 sub { like( CPANPLUS::Error->stack_as_string,
 312                       qr/Recursive dependency detected/,
 313                             "   Recursive dependency recorded ok" ) },
 314             ],
 315             'Perl binary version sufficient' => [
 316                 sub { $cb->module_tree( $ModName )
 317                         ->status->prereqs({ PERL_CORE, 1 }); '' },
 318                 sub { unlike( CPANPLUS::Error->stack_as_string,
 319                             qr/needs perl version/,
 320                             "   Perl version sufficient" ) },
 321             ],
 322         },
 323     };
 324
 325     for my $bool ( sort keys %$map ) {
 326
 327         diag("Running ". ($bool?'success':'fail') . " tests") if @ARGV;
 328
 329         my $href = $map->{$bool};
 330         while ( my($txt,$aref) = each %$href ) {
 331
 332             ### reset everything ###
 333             ok( $cb->reload_indices( update_source => 0 ),
 334                                 "Rebuilding trees" );
 335
 336             $CPANPLUS::Dist::_Test::Available   = 1;
 337             $CPANPLUS::Dist::_Test::Prepare     = 1;
 338             $CPANPLUS::Dist::_Test::Create      = 1;
 339             $CPANPLUS::Dist::_Test::Install     = 1;
 340
 341             CPANPLUS::Error->flush;
 342             $cb->_status->mk_flush;
 343
 344             ### get a new dist from Text::Bastardize ###
 345             my $mod  = $cb->module_tree( $ModName );
 346             my $dist = $Module->new( module => $mod );
 347
 348             ### first sub returns target ###
 349             my $sub    = shift @$aref;
 350             my $target = $sub->();
 351
 352             my $flag = $dist->_resolve_prereqs(
 353                             format  => $Module,
 354                             force   => 1,
 355                             target  => $target,
 356                             prereqs => ($mod->status->prereqs || $Prereq) );
 357
 358             is( !!$flag, !!$bool,   $txt );
 359
 360             ### any extra tests ###
 361             $_->($cb->module_tree($ModPrereq)) for @$aref;
 362
 363         }
 364     }
 365 }
 366
 367
 368 ### prereq satisfied tests
 369 {   my $map = {
 370         # version   regex
 371         0   =>      undef,
 372         1   =>      undef,
 373         2   =>      qr/have to resolve/,
 374     };
 375
 376     my $mod = CPANPLUS::Module::Fake->new(
 377                     module  => $$,
 378                     package => $$,
 379                     path    => $$,
 380                     version => 1 );
 381
 382     ok( $mod,                   "Fake module created" );
 383     is( $mod->version, 1,       "   Version set correctly" );
 384
 385      my $dist = $Module->new( module => $Mod );
 386
 387     ok( $dist,                  "Dist object created" );
 388     isa_ok( $dist,              $Module );
 389
 390
 391     ### scope it for the locals
 392     {   local $^W;  # quell sub redefined warnings;
 393
 394         ### is_uptodate will need to return false for this test
 395         local *CPANPLUS::Module::Fake::is_uptodate = sub { return };
 396         local *CPANPLUS::Module::Fake::is_uptodate = sub { return };
 397         CPANPLUS::Error->flush;
 398
 399
 400         ### it's satisfied
 401         while( my($ver, $re) = each %$map ) {
 402
 403             my $rv = $dist->prereq_satisfied(
 404                         version => $ver,
 405                         modobj  => $mod );
 406
 407             ok( 1,                  "Testing ver: $ver" );
 408             is( $rv, undef,       "   Return value as expected" );
 409
 410             if( $re ) {
 411                 like( CPANPLUS::Error->stack_as_string, $re,
 412                                     "   Error as expected" );
 413             }
 414
 415             CPANPLUS::Error->flush;
 416         }
 417     }
 418 }
 419
 420
 421 ### dist_types tests
 422 {   can_ok( 'CPANPLUS::Dist',       'dist_types' );
 423
 424     SKIP: {
 425         skip "You do not have Module::Pluggable installed", 2
 426             unless check_install( module => 'Module::Pluggable' );
 427
 428         my @types = CPANPLUS::Dist->dist_types;
 429         ok( scalar(@types),         "   Dist types found" );
 430         ok( grep( /_Test/, @types), "   Found our _Test dist type" );
 431     }
 432 }
 433 1;
 434
 435 # Local variables:
 436 # c-indentation-style: bsd
 437 # c-basic-offset: 4
 438 # indent-tabs-mode: nil
 439 # End:
 440 # vim: expandtab shiftwidth=4: