lib/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 it's 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 = CPANPLUS::Dist->new(
  75                             format  => $Module,
  76                             module  => $Mod
  77                         );
  78
  79     ok( $dist,                  "New dist object created" );
  80     isa_ok( $dist,              'CPANPLUS::Dist' );
  81     isa_ok( $dist,              $Module );
  82
  83     my $status = $dist->status;
  84     ok( $status,                "Status object found" );
  85     isa_ok( $status,            "Object::Accessor" );
  86
  87     ok( $dist->prepare,         "Prepare call" );
  88     ok( $dist->status->prepared,"   Status registered OK" );
  89
  90     ok( $dist->create,          "Create call" );
  91     ok( $dist->status->created, "   Status registered OK" );
  92
  93     ok( $dist->install,         "Install call" );
  94     ok( $dist->status->installed,
  95                                 "   Status registered OK" );
  96 }
  97
  98 ### check 'sanity check' option ###
  99 {   local $CPANPLUS::Dist::_Test::Available = 0;
 100
 101     ok( !$Module->format_available,
 102                                 "Format availabillity turned off" );
 103
 104     {   $conf->_set_build('sanity_check' => 0);
 105
 106         my $dist = CPANPLUS::Dist->new(
 107                                 format => $Module,
 108                                 module => $Mod
 109                             );
 110
 111         ok( $dist,              "Dist created with sanity check off" );
 112         isa_ok( $dist,          $Module );
 113
 114     }
 115
 116     {   $conf->_set_build('sanity_check' => 1);
 117         my $dist = CPANPLUS::Dist->new(
 118                                 format => $Module,
 119                                 module => $Mod
 120                             );
 121
 122         ok( !$dist,             "Dist not created with sanity check on" );
 123         like( CPANPLUS::Error->stack_as_string,
 124                 qr/Format '$Module' is not available/,
 125                                 "   Error recorded as expected" );
 126     }
 127 }
 128
 129 ### undef the status hash, make sure it complains ###
 130 {   local $CPANPLUS::Dist::_Test::Init = 0;
 131
 132     my $dist = CPANPLUS::Dist->new(
 133                         format => $Module,
 134                         module => $Mod
 135                     );
 136
 137     ok( !$dist,                 "No dist created by failed init" );
 138     like( CPANPLUS::Error->stack_as_string,
 139             qr/Dist initialization of '$Module' failed for/s,
 140                                 "   Error recorded as expected" );
 141 }
 142
 143 ### test _resolve prereqs, in a somewhat simulated set of circumstances
 144 {   my $old_prereq = $conf->get_conf('prereqs');
 145
 146     my $map = {
 147         0 => {
 148             'Previous install failed' => [
 149                 sub { $cb->module_tree($ModPrereq)->status->installed(0);
 150                                                                 'install' },
 151                 sub { like( CPANPLUS::Error->stack_as_string,
 152                       qr/failed to install before in this session/s,
 153                             "   Previous install failed recorded ok" ) },
 154             ],
 155
 156             "Set $Module->prepare to false" => [
 157                 sub { $CPANPLUS::Dist::_Test::Prepare = 0;       'install' },
 158                 sub { like( CPANPLUS::Error->stack_as_string,
 159                       qr/Unable to create a new distribution object/s,
 160                             "   Dist creation failed recorded ok" ) },
 161                 sub { like( CPANPLUS::Error->stack_as_string,
 162                       qr/Failed to install '$ModPrereq' as prerequisite/s,
 163                             "   Dist creation failed recorded ok" ) },
 164             ],
 165
 166             "Set $Module->create to false" => [
 167                 sub { $CPANPLUS::Dist::_Test::Create = 0;       'install' },
 168                 sub { like( CPANPLUS::Error->stack_as_string,
 169                       qr/Unable to create a new distribution object/s,
 170                             "   Dist creation failed recorded ok" ) },
 171                 sub { like( CPANPLUS::Error->stack_as_string,
 172                       qr/Failed to install '$ModPrereq' as prerequisite/s,
 173                             "   Dist creation failed recorded ok" ) },
 174             ],
 175
 176             "Set $Module->install to false" => [
 177                 sub { $CPANPLUS::Dist::_Test::Install = 0;      'install' },
 178                 sub { like( CPANPLUS::Error->stack_as_string,
 179                       qr/Failed to install '$ModPrereq' as/s,
 180                             "   Dist installation failed recorded ok" ) },
 181             ],
 182
 183             "Set dependency to be perl-core" => [
 184                 sub { $cb->module_tree( $ModPrereq )->package(
 185                                         'perl-5.8.1.tar.gz' );  'install' },
 186                 sub { like( CPANPLUS::Error->stack_as_string,
 187                       qr/Prerequisite '$ModPrereq' is perl-core/s,
 188                             "   Dist installation failed recorded ok" ) },
 189             ],
 190             'Simple ignore'     => [
 191                 sub { 'ignore' },
 192                 sub { ok( !$_[0]->status->prepared,
 193                             "   Module status says not prepared" ) },
 194                 sub { ok( !$_[0]->status->created,
 195                             "   Module status says not created" ) },
 196                 sub { ok( !$_[0]->status->installed,
 197                             "   Module status says not installed" ) },
 198             ],
 199             'Ignore from conf'  => [
 200                 sub { $conf->set_conf(prereqs => PREREQ_IGNORE);    '' },
 201                 sub { ok( !$_[0]->status->prepared,
 202                             "   Module status says not prepared" ) },
 203                 sub { ok( !$_[0]->status->created,
 204                             "   Module status says not created" ) },
 205                 sub { ok( !$_[0]->status->installed,
 206                             "   Module status says not installed" ) },
 207                 ### set the conf back ###
 208                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 209             ],
 210         },
 211         1 => {
 212             'Simple create'     => [
 213                 sub { 'create' },
 214                 sub { ok( $_[0]->status->prepared,
 215                             "   Module status says prepared" ) },
 216                 sub { ok( $_[0]->status->created,
 217                             "   Module status says created" ) },
 218                 sub { ok( !$_[0]->status->installed,
 219                             "   Module status says not installed" ) },
 220             ],
 221             'Simple install'    => [
 222                 sub { 'install' },
 223                 sub { ok( $_[0]->status->prepared,
 224                             "   Module status says prepared" ) },
 225                 sub { ok( $_[0]->status->created,
 226                             "   Module status says created" ) },
 227                 sub { ok( $_[0]->status->installed,
 228                             "   Module status says installed" ) },
 229             ],
 230
 231             'Install from conf' => [
 232                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL);   '' },
 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 installed" ) },
 239             ],
 240             'Create from conf'  => [
 241                 sub { $conf->set_conf(prereqs => PREREQ_BUILD);     '' },
 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 not installed" ) },
 248                 ### set the conf back ###
 249                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 250             ],
 251
 252             'Ask from conf'     => [
 253                 sub { $cb->_register_callback(
 254                             name => 'install_prerequisite',
 255                             code => sub {1} );
 256                       $conf->set_conf(prereqs => PREREQ_ASK);       '' },
 257                 sub { ok( $_[0]->status->prepared,
 258                             "   Module status says prepared" ) },
 259                 sub { ok( $_[0]->status->created,
 260                             "   Module status says created" ) },
 261                 sub { ok( $_[0]->status->installed,
 262                             "   Module status says installed" ) },
 263                 ### set the conf back ###
 264                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 265
 266             ],
 267
 268             'Ask from conf, but decline' => [
 269                 sub { $cb->_register_callback(
 270                             name => 'install_prerequisite',
 271                             code => sub {0} );
 272                       $conf->set_conf( prereqs => PREREQ_ASK);      '' },
 273                 sub { ok( !$_[0]->status->installed,
 274                             "   Module status says not installed" ) },
 275                 sub { like( CPANPLUS::Error->stack_as_string,
 276                       qr/Will not install prerequisite '$ModPrereq' -- Note/,
 277                             "   Install skipped, recorded ok" ) },
 278                 ### set the conf back ###
 279                 sub { $conf->set_conf(prereqs => PREREQ_INSTALL); },
 280             ],
 281
 282             "Set recursive dependency" => [
 283                 sub { $cb->_status->pending_prereqs({ $ModPrereq => 1 });
 284                                                                 'install' },
 285                 sub { like( CPANPLUS::Error->stack_as_string,
 286                       qr/Recursive dependency detected/,
 287                             "   Recursive dependency recorded ok" ) },
 288             ],
 289
 290           },
 291     };
 292
 293     for my $bool ( sort keys %$map ) {
 294
 295         diag("Running ". ($bool?'success':'fail') . " tests") if @ARGV;
 296
 297         my $href = $map->{$bool};
 298         while ( my($txt,$aref) = each %$href ) {
 299
 300             ### reset everything ###
 301             ok( $cb->reload_indices( update_source => 0 ),
 302                                 "Rebuilding trees" );
 303
 304             $CPANPLUS::Dist::_Test::Available   = 1;
 305             $CPANPLUS::Dist::_Test::Prepare     = 1;
 306             $CPANPLUS::Dist::_Test::Create      = 1;
 307             $CPANPLUS::Dist::_Test::Install     = 1;
 308
 309             CPANPLUS::Error->flush;
 310             $cb->_status->mk_flush;
 311
 312             ### get a new dist from Text::Bastardize ###
 313             my $dist = CPANPLUS::Dist->new(
 314                         format => $Module,
 315                         module => $cb->module_tree( $ModName ),
 316                     );
 317
 318             ### first sub returns target ###
 319             my $sub    = shift @$aref;
 320             my $target = $sub->();
 321
 322             my $flag = $dist->_resolve_prereqs(
 323                             format  => $Module,
 324                             force   => 1,
 325                             target  => $target,
 326                             prereqs => $Prereq );
 327
 328             is( !!$flag, !!$bool,   $txt );
 329
 330             ### any extra tests ###
 331             $_->($cb->module_tree($ModPrereq)) for @$aref;
 332
 333         }
 334     }
 335 }
 336
 337
 338 ### prereq satisfied tests
 339 {   my $map = {
 340         # version   regex
 341         0   =>      undef,
 342         1   =>      undef,
 343         2   =>      qr/have to resolve/,
 344     };
 345
 346     my $mod = CPANPLUS::Module::Fake->new(
 347                     module  => $$,
 348                     package => $$,
 349                     path    => $$,
 350                     version => 1 );
 351
 352     ok( $mod,                   "Fake module created" );
 353     is( $mod->version, 1,       "   Version set correctly" );
 354
 355      my $dist = CPANPLUS::Dist->new(
 356                             format  => $Module,
 357                             module  => $Mod
 358                         );
 359
 360     ok( $dist,                  "Dist object created" );
 361     isa_ok( $dist,              $Module );
 362
 363
 364     ### scope it for the locals
 365     {   local $^W;  # quell sub redefined warnings;
 366
 367         ### is_uptodate will need to return false for this test
 368         local *CPANPLUS::Module::Fake::is_uptodate = sub { return };
 369         local *CPANPLUS::Module::Fake::is_uptodate = sub { return };
 370         CPANPLUS::Error->flush;
 371
 372
 373         ### it's satisfied
 374         while( my($ver, $re) = each %$map ) {
 375
 376             my $rv = $dist->prereq_satisfied(
 377                         version => $ver,
 378                         modobj  => $mod );
 379
 380             ok( 1,                  "Testing ver: $ver" );
 381             is( $rv, undef,       "   Return value as expected" );
 382
 383             if( $re ) {
 384                 like( CPANPLUS::Error->stack_as_string, $re,
 385                                     "   Error as expected" );
 386             }
 387
 388             CPANPLUS::Error->flush;
 389         }
 390     }
 391 }
 392
 393
 394 ### dist_types tests
 395 {   can_ok( 'CPANPLUS::Dist',       'dist_types' );
 396
 397     SKIP: {
 398         skip "You do not have Module::Pluggable installed", 2
 399             unless check_install( module => 'Module::Pluggable' );
 400
 401         my @types = CPANPLUS::Dist->dist_types;
 402         ok( scalar(@types),         "   Dist types found" );
 403         ok( grep( /_Test/, @types), "   Found our _Test dist type" );
 404     }
 405 }
 406 1;
 407
 408 # Local variables:
 409 # c-indentation-style: bsd
 410 # c-basic-offset: 4
 411 # indent-tabs-mode: nil
 412 # End:
 413 # vim: expandtab shiftwidth=4: