lib/Module/Build/t/install.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
   5 use MBTest tests => 34;
   6
   7 use Cwd ();
   8 my $cwd = Cwd::cwd;
   9 my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' );
  10
  11 use DistGen;
  12 my $dist = DistGen->new( dir => $tmp );
  13 $dist->regen;
  14
  15 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
  16
  17 #########################
  18
  19 use Module::Build;
  20 use Config;
  21
  22
  23 $dist->add_file( 'script', <<'---' );
  24 #!perl -w
  25 print "Hello, World!\n";
  26 ---
  27 $dist->change_file( 'Build.PL', <<"---" );
  28 use Module::Build;
  29
  30 my \$build = new Module::Build(
  31   module_name => @{[$dist->name]},
  32   scripts     => [ 'script' ],
  33   license     => 'perl',
  34   requires    => { 'File::Spec' => 0 },
  35 );
  36 \$build->create_build_script;
  37 ---
  38 $dist->regen;
  39
  40
  41 use File::Spec::Functions qw( catdir );
  42
  43 my $mb = Module::Build->new_from_context(
  44   # need default install paths to ensure manpages & HTML get generated
  45   installdirs => 'site',
  46   config => {
  47     installman1dir  => catdir($tmp, 'man', 'man1'),
  48     installman3dir  => catdir($tmp, 'man', 'man3'),
  49     installhtml1dir => catdir($tmp, 'html'),
  50     installhtml3dir => catdir($tmp, 'html'),
  51
  52     installsiteman1dir  => catdir($tmp, 'site', 'man', 'man1'),
  53     installsiteman3dir  => catdir($tmp, 'site', 'man', 'man3'),
  54     installsitehtml1dir => catdir($tmp, 'site', 'html'),
  55     installsitehtml3dir => catdir($tmp, 'site', 'html'),
  56   }
  57
  58 );
  59
  60 ok $mb;
  61
  62
  63 my $destdir = File::Spec->catdir($cwd, 't', 'install_test');
  64 $mb->add_to_cleanup($destdir);
  65
  66 {
  67   eval {$mb->dispatch('install', destdir => $destdir)};
  68   is $@, '';
  69
  70   my @libdir = strip_volume( $mb->install_destination('lib') );
  71   my $install_to = File::Spec->catfile($destdir, @libdir, $dist->name ) . '.pm';
  72   file_exists($install_to);
  73
  74   local @INC = (@INC, File::Spec->catdir($destdir, @libdir));
  75   eval "require @{[$dist->name]}";
  76   is $@, '';
  77
  78   # Make sure there's a packlist installed
  79   my $archdir = $mb->install_destination('arch');
  80   my @dirs = strip_volume($archdir);
  81   my $packlist = File::Spec->catfile
  82                             ($destdir, @dirs, 'auto', $dist->name, '.packlist');
  83   is -e $packlist, 1, "$packlist should be written";
  84 }
  85
  86 {
  87   eval {$mb->dispatch('install', installdirs => 'core', destdir => $destdir)};
  88   is $@, '';
  89   my @libdir = strip_volume( $Config{installprivlib} );
  90   my $install_to = File::Spec->catfile($destdir, @libdir, $dist->name ) . '.pm';
  91   file_exists($install_to);
  92 }
  93
  94 {
  95   my $libdir = File::Spec->catdir(File::Spec->rootdir, 'foo', 'bar');
  96   eval {$mb->dispatch('install', install_path => {lib => $libdir}, destdir => $destdir)};
  97   is $@, '';
  98   my @dirs = strip_volume($libdir);
  99   my $install_to = File::Spec->catfile($destdir, @dirs, $dist->name ) . '.pm';
 100   file_exists($install_to);
 101 }
 102
 103 {
 104   my $libdir = File::Spec->catdir(File::Spec->rootdir, 'foo', 'base');
 105   eval {$mb->dispatch('install', install_base => $libdir, destdir => $destdir)};
 106   is $@, '';
 107   my @dirs = strip_volume($libdir);
 108   my $install_to = File::Spec->catfile($destdir, @dirs, 'lib', 'perl5', $dist->name ) . '.pm';
 109   file_exists($install_to);
 110 }
 111
 112 {
 113   # Test the ConfigData stuff
 114
 115   $mb->config_data(foo => 'bar');
 116   $mb->features(baz => 1);
 117   $mb->auto_features(auto_foo => {requires => {'File::Spec' => 0}});
 118   eval {$mb->dispatch('install', destdir => $destdir)};
 119   is $@, '';
 120
 121   my @libdir = strip_volume( $mb->install_destination('lib') );
 122   local @INC = (@INC, File::Spec->catdir($destdir, @libdir));
 123   eval "require @{[$dist->name]}::ConfigData";
 124
 125   is $mb->feature('auto_foo'), 1;
 126
 127   SKIP: {
 128     skip $@, 5 if @_;
 129
 130     # Make sure the values are present
 131     my $config = $dist->name . '::ConfigData';
 132     is( $config->config('foo'), 'bar' );
 133     ok( $config->feature('baz') );
 134     ok( $config->feature('auto_foo') );
 135     ok( not $config->feature('nonexistent') );
 136
 137     # Add a new value to the config set
 138     $config->set_config(floo => 'bhlar');
 139     is( $config->config('floo'), 'bhlar' );
 140
 141     # Make sure it actually got written
 142     $config->write;
 143     delete $INC{"@{[$dist->name]}/ConfigData.pm"};
 144     {
 145       local $^W;  # Avoid warnings for subroutine redefinitions
 146       eval "require $config";
 147     }
 148     is( $config->config('floo'), 'bhlar' );
 149   }
 150 }
 151
 152
 153 eval {$mb->dispatch('realclean')};
 154 is $@, '';
 155
 156 {
 157   # Try again by running the script rather than with programmatic interface
 158   my $libdir = File::Spec->catdir('', 'foo', 'lib');
 159   eval {$mb->run_perl_script('Build.PL', [], ['--install_path', "lib=$libdir"])};
 160   is $@, '';
 161
 162   my $cmd = 'Build';
 163      $cmd .= ".COM" if $^O eq 'VMS';
 164   eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir])};
 165   is $@, '';
 166   my $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) . '.pm';
 167   file_exists($install_to);
 168
 169   my $basedir = File::Spec->catdir('', 'bar');
 170   eval {$mb->run_perl_script($cmd, [], ['install', '--destdir', $destdir,
 171                                               '--install_base', $basedir])};
 172   is $@, '';
 173
 174   $install_to = File::Spec->catfile($destdir, $libdir, $dist->name ) . '.pm';
 175   is -e $install_to, 1, "Look for file at $install_to";
 176
 177   eval {$mb->dispatch('realclean')};
 178   is $@, '';
 179 }
 180
 181 {
 182   # Make sure 'install_path' overrides 'install_base'
 183   my $mb = Module::Build->new( module_name  => $dist->name,
 184                                install_base => File::Spec->catdir('', 'foo'),
 185                                install_path => {
 186                                  lib => File::Spec->catdir('', 'bar')
 187                                }
 188                              );
 189   ok $mb;
 190   is $mb->install_destination('lib'), File::Spec->catdir('', 'bar');
 191 }
 192
 193 {
 194   $dist->add_file( 'lib/Simple/Docs.pod', <<'---' );
 195 =head1 NAME
 196
 197 Simple::Docs - Simple pod
 198
 199 =head1 AUTHOR
 200
 201 Simple Man <simple@example.com>
 202
 203 =cut
 204 ---
 205   $dist->regen;
 206
 207   # _find_file_by_type() isn't a public method, but this is currently
 208   # the only easy way to test that it works properly.
 209   my $pods = $mb->_find_file_by_type('pod', 'lib');
 210   is keys %$pods, 1;
 211   my $expect = $mb->localize_file_path('lib/Simple/Docs.pod');
 212
 213   # TODO:
 214   # True for traditional VMS, but will need to be changed when ODS-5 support
 215   # for case preserved filenames is active.
 216   # The issue is that the keys to the $pods hash are currently being set to
 217   # lowercase on VMS so can not be found in exact case.
 218
 219   $expect = lc($expect) if $^O eq 'VMS';
 220
 221   is $pods->{$expect}, $expect;
 222
 223   my $pms = $mb->_find_file_by_type('awefawef', 'lib');
 224   ok $pms;
 225   is keys %$pms, 0;
 226
 227   $pms = $mb->_find_file_by_type('pod', 'awefawef');
 228   ok $pms;
 229   is keys %$pms, 0;
 230
 231   # revert to pristine state
 232   chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 233   $dist->remove;
 234   $dist = DistGen->new( dir => $tmp );
 235   $dist->regen;
 236   chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
 237 }
 238
 239 sub strip_volume {
 240   my $dir = shift;
 241   (undef, $dir) = File::Spec->splitpath( $dir, 1 );
 242   my @dirs = File::Spec->splitdir($dir);
 243   return @dirs;
 244 }
 245
 246 sub file_exists {
 247   my $file = shift;
 248   ok -e $file or diag("Expected $file to exist, but it doesn't");
 249 }
 250
 251
 252 # cleanup
 253 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 254 $dist->remove;
 255
 256 use File::Path;
 257 rmtree( $tmp );