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