lib/CPANPLUS/t/04_CPANPLUS-Module.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::Module::Fake;
  12 use CPANPLUS::Module::Author::Fake;
  13 use CPANPLUS::Internals::Constants;
  14
  15 use Test::More 'no_plan';
  16 use Data::Dumper;
  17 use File::Spec;
  18 use File::Path ();
  19
  20 my $Conf    = gimme_conf();
  21 my $CB      = CPANPLUS::Backend->new( $Conf );
  22
  23 ### start with fresh sources ###
  24 ok( $CB->reload_indices( update_source => 0 ),  "Rebuilding trees" );
  25
  26 my $AuthName    = TEST_CONF_AUTHOR;
  27 my $Auth        = $CB->author_tree( $AuthName );
  28 my $ModName     = TEST_CONF_MODULE;
  29 my $Mod         = $CB->module_tree( $ModName );
  30 my $CoreName    = TEST_CONF_PREREQ;
  31 my $CoreMod     = $CB->module_tree( $CoreName );
  32
  33 isa_ok( $Auth,                  'CPANPLUS::Module::Author' );
  34 isa_ok( $Mod,                   'CPANPLUS::Module' );
  35 isa_ok( $CoreMod,               'CPANPLUS::Module' );
  36
  37 ### author accessors ###
  38 is( $Auth->author, 'ExtUtils::MakeMaker No XS Code',
  39                                 "Author name: "     . $Auth->author );
  40 is( $Auth->cpanid, $AuthName,   "Author CPANID: "   . $Auth->cpanid );
  41 is( $Auth->email, DEFAULT_EMAIL,"Author email: "    . $Auth->email );
  42 isa_ok( $Auth->parent,          'CPANPLUS::Backend' );
  43
  44 ### module accessors ###
  45 {   my %map = (
  46         ### method      ### result
  47         module      =>  $ModName,
  48         name        =>  $ModName,
  49         comment     =>  undef,
  50         package     =>  'Foo-Bar-0.01.tar.gz',
  51         path        =>  'authors/id/EUNOXS',
  52         version     =>  '0.01',
  53         dslip       =>  'cdpO ',
  54         description =>  'CPANPLUS Test Package',
  55         mtime       =>  '',
  56         author      =>  $Auth,
  57     );
  58
  59     my @acc = $Mod->accessors;
  60     ok( scalar(@acc),           "Retrieved module accessors" );
  61
  62     ### remove private accessors
  63     is_deeply( [ sort keys %map ], [ sort grep { $_ !~ /^_/ } @acc ],
  64                                 "   About to test all accessors" );
  65
  66     ### check all the accessors
  67     while( my($meth,$res) = each %map ) {
  68         is( $Mod->$meth, $res,  "   Mod->$meth: " . ($res || '<empty>') );
  69     }
  70
  71     ### check accessor objects ###
  72     isa_ok( $Mod->parent,       'CPANPLUS::Backend' );
  73     isa_ok( $Mod->author,       'CPANPLUS::Module::Author' );
  74     is( $Mod->author->author, $Auth->author,
  75                                 "Module eq Author" );
  76 }
  77
  78 ### convenience methods ###
  79 {   ok( 1,                                          "Convenience functions" );
  80     is( $Mod->package_name,      'Foo-Bar',         "   Package name");
  81     is( $Mod->package_version,   '0.01',            "   Package version");
  82     is( $Mod->package_extension, 'tar.gz',          "   Package extension");
  83     ok( !$Mod->package_is_perl_core,                "   Package not core");
  84     ok( !$Mod->module_is_supplied_with_perl_core,   "   Module not core" );
  85     ok( !$Mod->is_bundle,                           "   Package not bundle");
  86 }
  87
  88 ### clone & status tests
  89 {   my $clone = $Mod->clone;
  90     ok( $clone,                 "Module cloned" );
  91     isa_ok( $clone,             'CPANPLUS::Module' );
  92
  93     for my $acc ( $Mod->accessors ) {
  94         is( $clone->$acc, $Mod->$acc,
  95                                 "   Clone->$acc matches Mod->$acc " );
  96     }
  97
  98     ### XXX whitebox test
  99     ok( !$clone->_status,      "Status object empty on start" );
 100
 101     my $status = $clone->status;
 102     ok( $status,                "   Status object defined after query" );
 103     is( $status, $clone->_status,
 104                                 "   Object stored as expected" );
 105     isa_ok( $status,            'Object::Accessor' );
 106 }
 107
 108 {   ### extract + error test ###
 109     ok( !$Mod->extract(),   "Cannot extract unfetched file" );
 110     like( CPANPLUS::Error->stack_as_string, qr/You have not fetched/,
 111                             "   Error properly logged" );
 112 }
 113
 114 {   ### fetch tests ###
 115     ### enable signature checks for checksums ###
 116     my $old = $Conf->get_conf('signature');
 117     $Conf->set_conf(signature => 1);
 118
 119     my $where = $Mod->fetch( force => 1 );
 120     ok( $where,             "Module fetched" );
 121     ok( -f $where,          "   Module is a file" );
 122     ok( -s $where,          "   Module has size" );
 123
 124     $Conf->set_conf( signature => $old );
 125 }
 126
 127 {   ### extract tests ###
 128     my $dir = $Mod->extract( force => 1 );
 129     ok( $dir,               "Module extracted" );
 130     ok( -d $dir,            "   Dir exsits" );
 131 }
 132
 133
 134 {   ### readme tests ###
 135     my $readme = $Mod->readme;
 136     ok( length $readme,     "Readme found" );
 137     is( $readme, $Mod->status->readme,
 138                             "   Readme stored in module object" );
 139 }
 140
 141 {   ### checksums tests ###
 142     SKIP: {
 143         skip(q[You chose not to enable checksum verification], 5)
 144             unless $Conf->get_conf('md5');
 145
 146         my $cksum_file = $Mod->checksums;
 147         ok( $cksum_file,    "Checksum file found" );
 148         is( $cksum_file, $Mod->status->checksums,
 149                             "   File stored in module object" );
 150         ok( -e $cksum_file, "   File exists" );
 151         ok( -s $cksum_file, "   File has size" );
 152
 153         ### XXX test checksum_value if there's digest::md5 + config wants it
 154         ok( $Mod->status->checksum_ok,
 155                             "   Checksum is ok" );
 156
 157         ### check ttl code for checksums; fetching it now means the cache
 158         ### should kick in
 159         {   CPANPLUS::Error->flush;
 160             ok( $Mod->checksums,
 161                             "   Checksums re-fetched" );
 162             like( CPANPLUS::Error->stack_as_string, qr/Using cached file/,
 163                             "       Cached file used" );
 164         }
 165     }
 166 }
 167
 168
 169 {   ### installer type tests ###
 170     my $installer  = $Mod->get_installer_type;
 171     ok( $installer,         "Installer found" );
 172     is( $installer, INSTALLER_MM,
 173                             "   Proper installer found" );
 174 }
 175
 176 {   ### check signature tests ###
 177     SKIP: {
 178         skip(q[You chose not to enable signature checks], 1)
 179             unless $Conf->get_conf('signature');
 180
 181         ok( $Mod->check_signature,
 182                             "Signature check OK" );
 183     }
 184 }
 185
 186 ### dslip & related
 187 {   my $dslip = $Mod->dslip;
 188     ok( $dslip,             "Got dslip information from $ModName ($dslip)" );
 189
 190     ### now find it for a submodule
 191     {   my $submod = $CB->module_tree( TEST_CONF_MODULE_SUB );
 192         ok( $submod,        "   Found submodule " . $submod->name );
 193         ok( $submod->dslip, "   Got dslip info (".$submod->dslip.")" );
 194         is( $submod->dslip, $dslip,
 195                             "   It's identical to $ModName" );
 196     }
 197 }
 198
 199 {   ### details() test ###
 200     my $href = {
 201         'Support Level'     => 'Developer',
 202         'Package'           => $Mod->package,
 203         'Description'       => $Mod->description,
 204         'Development Stage' =>
 205                 'under construction but pre-alpha (not yet released)',
 206         'Author'            => sprintf("%s (%s)", $Auth->author, $Auth->email),
 207         'Version on CPAN'   => $Mod->version,
 208         'Language Used'     =>
 209                 'Perl-only, no compiler needed, should be platform independent',
 210         'Interface Style'   =>
 211                 'Object oriented using blessed references and/or inheritance',
 212         'Public License'    => 'Unknown',
 213         ### XXX we can't really know what you have installed ###
 214         #'Version Installed' => '0.06',
 215     };
 216
 217     my $res = $Mod->details;
 218
 219     ### delete they key of which we don't know the value ###
 220     delete $res->{'Version Installed'};
 221
 222     is_deeply( $res, $href, "Details OK" );
 223 }
 224
 225 {   ### contians() test ###
 226     ### XXX ->contains works based on package name. in our sourcefiles
 227     ### we use 4x the same package name for different modules. So use
 228     ### the only unique package name here, which is the one for the core mod
 229     my @list = $CoreMod->contains;
 230
 231     ok( scalar(@list),          "Found modules contained in this one" );
 232     is_deeply( \@list, [$CoreMod],
 233                                 "   Found all modules expected" );
 234 }
 235
 236 {   ### testing distributions() ###
 237     my @mdists = $Mod->distributions;
 238     is( scalar @mdists, 1, "Distributions found via module" );
 239
 240     my @adists = $Auth->distributions;
 241     is( scalar @adists, 3,  "Distributions found via author" );
 242 }
 243
 244 {   ### test status->flush ###
 245     ok( $Mod->status->mk_flush,
 246                             "Status flushed" );
 247     ok(!$Mod->status->fetch,"   Fetch status empty" );
 248     ok(!$Mod->status->extract,
 249                             "   Extract status empty" );
 250     ok(!$Mod->status->checksums,
 251                             "   Checksums status empty" );
 252     ok(!$Mod->status->readme,
 253                             "   Readme status empty" );
 254 }
 255
 256 {   ### testing bundles ###
 257     my $bundle = $CB->module_tree('Bundle::Foo::Bar');
 258     isa_ok( $bundle,            'CPANPLUS::Module' );
 259
 260     ok( $bundle->is_bundle,     "   It's a Bundle:: module" );
 261     ok( $bundle->fetch,         "   Fetched the bundle" );
 262     ok( $bundle->extract,       "   Extracted the bundle" );
 263
 264     my @objs = $bundle->bundle_modules;
 265     is( scalar(@objs), 5,       "   Found all prerequisites" );
 266
 267     for( @objs ) {
 268         isa_ok( $_, 'CPANPLUS::Module',
 269                                 "   Prereq " . $_->module  );
 270         ok( defined $bundle->status->prereqs->{$_->module},
 271                                 "       Prereq was registered" );
 272     }
 273 }
 274
 275 {   ### testing autobundles
 276     my $file    = File::Spec->catfile(
 277                         dummy_cpan_dir(),
 278                         $Conf->_get_build('autobundle'),
 279                         'Snapshot.pm'
 280                     );
 281     my $uri     = $CB->_host_to_uri( scheme => 'file', path => $file );
 282     my $bundle  = $CB->parse_module( module => $uri );
 283
 284     ok( -e $file,               "Creating bundle from '$file'" );
 285     ok( $bundle,                "   Object created" );
 286     isa_ok( $bundle, 'CPANPLUS::Module',
 287                                 "   Object" );
 288     ok( $bundle->is_bundle,     "   Recognized as bundle" );
 289     ok( $bundle->is_autobundle, "   Recognized as autobundle" );
 290
 291     my $type = $bundle->get_installer_type;
 292     ok( $type,                  "   Found installer type" );
 293     is( $type, INSTALLER_AUTOBUNDLE,
 294                                 "       Installer type is $type" );
 295
 296     my $where = $bundle->fetch;
 297     ok( $where,                 "   Autobundle fetched" );
 298     ok( -e $where,              "       File exists" );
 299
 300
 301     my @list = $bundle->bundle_modules;
 302     ok( scalar(@list),          "   Prereqs found" );
 303     is( scalar(@list), 1,       "       Right number of prereqs" );
 304     isa_ok( $list[0], 'CPANPLUS::Module',
 305                                 "       Object" );
 306
 307     ### skiptests to make sure we don't get any test header mismatches
 308     my $rv = $bundle->create( prereq_target => 'create', skiptest => 1 );
 309     ok( $rv,                    "   Tested prereqs" );
 310
 311 }
 312
 313 ### test module from perl core ###
 314 {   isa_ok( $CoreMod, 'CPANPLUS::Module',
 315                                 "Core module " . $CoreName );
 316     ok( $CoreMod->package_is_perl_core,
 317                                 "   Package found in perl core" );
 318
 319     ### check if it's core with 5.6.1
 320     {   local $] = '5.006001';
 321         ok( $CoreMod->module_is_supplied_with_perl_core,
 322                                 "   Module also found in perl core");
 323     }
 324
 325     ok( !$CoreMod->install,     "   Package not installed" );
 326     like( CPANPLUS::Error->stack_as_string, qr/core Perl/,
 327                                 "   Error properly logged" );
 328 }
 329
 330 ### test third-party modules
 331 SKIP: {
 332     skip "Module::ThirdParty not installed", 10
 333         unless eval { require Module::ThirdParty; 1 };
 334
 335     ok( !$Mod->is_third_party,
 336                                 "Not a 3rd party module: ". $Mod->name );
 337
 338     my $fake = $CB->parse_module( module => 'LOCAL/SVN-Core-1.0' );
 339     ok( $fake,                  "Created module object for ". $fake->name );
 340     ok( $fake->is_third_party,
 341                                 "   It is a 3rd party module" );
 342
 343     my $info = $fake->third_party_information;
 344     ok( $info,                  "Got 3rd party package information" );
 345     isa_ok( $info,              'HASH' );
 346
 347     for my $item ( qw[name url author author_url] ) {
 348         ok( length($info->{$item}),
 349                                 "   $item field is filled" );
 350     }
 351 }
 352
 353 ### testing EU::Installed methods in Dist::MM tests ###
 354
 355 # Local variables:
 356 # c-indentation-style: bsd
 357 # c-basic-offset: 4
 358 # indent-tabs-mode: nil
 359 # End:
 360 # vim: expandtab shiftwidth=4: