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