cpan/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 availability 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             'Simple ignore'     => [
 203                 sub { 'ignore' },
 204                 sub { ok( !$_[0]->status->prepared,
 205                             "   Module status says not prepared" ) },
 206                 sub { ok( !$_[0]->status->created,
 207                             "   Module status says not created" ) },
 208                 sub { ok( !$_[0]->status->installed,
 209                             "   Module status says not installed" ) },
 210             ],
 211             'Ignore from conf'  => [
 212                 sub { $conf->set_conf(prereqs => PREREQ_IGNORE);    '' },
 213                 sub { ok( !$_[0]->status->prepared,
 214                             "   Module status says not prepared" ) },
 215                 sub { ok( !$_[0]->status->created,
 216                             "   Module status says not created" ) },
 217                 sub { ok( !$_[0]->status->installed,
 218                             "   Module status says not installed" ) },
 219                 ### set the conf back ###
 220                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 221             ],
 222             'Perl binary version too low' => [
 223                 sub { $cb->module_tree( $ModName )
 224                         ->status->prereqs({ PERL_CORE, 10000000000 }); '' },
 225                 sub { like( CPANPLUS::Error->stack_as_string,
 226                             qr/needs perl version/,
 227                             "   Perl version not high enough" ) },
 228             ],
 229         },
 230         1 => {
 231             'Simple create'     => [
 232                 sub { 'create' },
 233                 sub { ok( $_[0]->status->prepared,
 234                             "   Module status says prepared" ) },
 235                 sub { ok( $_[0]->status->created,
 236                             "   Module status says created" ) },
 237                 sub { ok( !$_[0]->status->installed,
 238                             "   Module status says not installed" ) },
 239             ],
 240             'Simple install'    => [
 241                 sub { 'install' },
 242                 sub { ok( $_[0]->status->prepared,
 243                             "   Module status says prepared" ) },
 244                 sub { ok( $_[0]->status->created,
 245                             "   Module status says created" ) },
 246                 sub { ok( $_[0]->status->installed,
 247                             "   Module status says installed" ) },
 248             ],
 249
 250             "Set dependency to be perl-core" => [
 251                 sub { $cb->module_tree( $ModPrereq )->package(
 252                                         'perl-5.8.1.tar.gz' );  'install' },
 253                 sub { like( CPANPLUS::Error->stack_as_string,
 254                       qr/Prerequisite '$ModPrereq' is perl-core/s,
 255                             "   Dist installation failed recorded ok" ) },
 256             ],
 257
 258             'Install from conf' => [
 259                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL);   '' },
 260                 sub { ok( $_[0]->status->prepared,
 261                             "   Module status says prepared" ) },
 262                 sub { ok( $_[0]->status->created,
 263                             "   Module status says created" ) },
 264                 sub { ok( $_[0]->status->installed,
 265                             "   Module status says installed" ) },
 266             ],
 267             'Create from conf'  => [
 268                 sub { $conf->set_conf(prereqs => PREREQ_BUILD);     '' },
 269                 sub { ok( $_[0]->status->prepared,
 270                             "   Module status says prepared" ) },
 271                 sub { ok( $_[0]->status->created,
 272                             "   Module status says created" ) },
 273                 sub { ok( !$_[0]->status->installed,
 274                             "   Module status says not installed" ) },
 275                 ### set the conf back ###
 276                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 277             ],
 278
 279             'Ask from conf'     => [
 280                 sub { $cb->_register_callback(
 281                             name => 'install_prerequisite',
 282                             code => sub {1} );
 283                       $conf->set_conf(prereqs => PREREQ_ASK);       '' },
 284                 sub { ok( $_[0]->status->prepared,
 285                             "   Module status says prepared" ) },
 286                 sub { ok( $_[0]->status->created,
 287                             "   Module status says created" ) },
 288                 sub { ok( $_[0]->status->installed,
 289                             "   Module status says installed" ) },
 290                 ### set the conf back ###
 291                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 292
 293             ],
 294
 295             'Ask from conf, but decline' => [
 296                 sub { $cb->_register_callback(
 297                             name => 'install_prerequisite',
 298                             code => sub {0} );
 299                       $conf->set_conf( prereqs => PREREQ_ASK);      '' },
 300                 sub { ok( !$_[0]->status->installed,
 301                             "   Module status says not installed" ) },
 302                 sub { like( CPANPLUS::Error->stack_as_string,
 303                       qr/Will not install prerequisite '$ModPrereq' -- Note/,
 304                             "   Install skipped, recorded ok" ) },
 305                 ### set the conf back ###
 306                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 307             ],
 308
 309             "Set recursive dependency" => [
 310                 sub { $cb->_status->pending_prereqs({ $ModPrereq => 1 });
 311                                                                 'install' },
 312                 sub { like( CPANPLUS::Error->stack_as_string,
 313                       qr/Recursive dependency detected/,
 314                             "   Recursive dependency recorded ok" ) },
 315             ],
 316             'Perl binary version sufficient' => [
 317                 sub { $cb->module_tree( $ModName )
 318                         ->status->prereqs({ PERL_CORE, 1 }); '' },
 319                 sub { unlike( CPANPLUS::Error->stack_as_string,
 320                             qr/needs perl version/,
 321                             "   Perl version sufficient" ) },
 322             ],
 323         },
 324     };
 325
 326     for my $bool ( sort keys %$map ) {
 327
 328         diag("Running ". ($bool?'success':'fail') . " tests") if @ARGV;
 329
 330         my $href = $map->{$bool};
 331         while ( my($txt,$aref) = each %$href ) {
 332
 333             ### reset everything ###
 334             ok( $cb->reload_indices( update_source => 0 ),
 335                                 "Rebuilding trees" );
 336
 337             $CPANPLUS::Dist::_Test::Available   = 1;
 338             $CPANPLUS::Dist::_Test::Prepare     = 1;
 339             $CPANPLUS::Dist::_Test::Create      = 1;
 340             $CPANPLUS::Dist::_Test::Install     = 1;
 341
 342             CPANPLUS::Error->flush;
 343             $cb->_status->mk_flush;
 344
 345             ### get a new dist from Text::Bastardize ###
 346             my $mod  = $cb->module_tree( $ModName );
 347             my $dist = $Module->new( module => $mod );
 348
 349             ### first sub returns target ###
 350             my $sub    = shift @$aref;
 351             my $target = $sub->();
 352
 353             my $flag = $dist->_resolve_prereqs(
 354                             format  => $Module,
 355                             force   => 1,
 356                             target  => $target,
 357                             prereqs => ($mod->status->prereqs || $Prereq) );
 358
 359             is( !!$flag, !!$bool,   $txt );
 360
 361             ### any extra tests ###
 362             $_->($cb->module_tree($ModPrereq)) for @$aref;
 363
 364         }
 365     }
 366 }
 367
 368
 369 ### prereq satisfied tests
 370 {   my $map = {
 371         # version   regex
 372         0   =>      undef,
 373         1   =>      undef,
 374         2   =>      qr/have to resolve/,
 375     };
 376
 377     my $mod = CPANPLUS::Module::Fake->new(
 378                     module  => $$,
 379                     package => $$,
 380                     path    => $$,
 381                     version => 1 );
 382
 383     ok( $mod,                   "Fake module created" );
 384     is( $mod->version, 1,       "   Version set correctly" );
 385
 386      my $dist = $Module->new( module => $Mod );
 387
 388     ok( $dist,                  "Dist object created" );
 389     isa_ok( $dist,              $Module );
 390
 391
 392     ### scope it for the locals
 393     {   local $^W;  # quell sub redefined warnings;
 394
 395         ### is_uptodate will need to return false for this test
 396         local *CPANPLUS::Module::Fake::is_uptodate = sub { return };
 397         local *CPANPLUS::Module::Fake::is_uptodate = sub { return };
 398         CPANPLUS::Error->flush;
 399
 400
 401         ### it's satisfied
 402         while( my($ver, $re) = each %$map ) {
 403
 404             my $rv = $dist->prereq_satisfied(
 405                         version => $ver,
 406                         modobj  => $mod );
 407
 408             ok( 1,                  "Testing ver: $ver" );
 409             is( $rv, undef,       "   Return value as expected" );
 410
 411             if( $re ) {
 412                 like( CPANPLUS::Error->stack_as_string, $re,
 413                                     "   Error as expected" );
 414             }
 415
 416             CPANPLUS::Error->flush;
 417         }
 418     }
 419 }
 420
 421
 422 ### dist_types tests
 423 {   can_ok( 'CPANPLUS::Dist',       'dist_types' );
 424
 425     SKIP: {
 426         skip "You do not have Module::Pluggable installed", 2
 427             unless check_install( module => 'Module::Pluggable' );
 428
 429         my @types = CPANPLUS::Dist->dist_types;
 430         ok( scalar(@types),         "   Dist types found" );
 431         ok( grep( /_Test/, @types), "   Found our _Test dist type" );
 432     }
 433 }
 434 1;
 435
 436 # Local variables:
 437 # c-indentation-style: bsd
 438 # c-basic-offset: 4
 439 # indent-tabs-mode: nil
 440 # End:
 441 # vim: expandtab shiftwidth=4: