t/lib/DBICTest/RunMode.pm

   1 package # hide from PAUSE
   2     DBICTest::RunMode;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Path::Class qw/file dir/;
   8
   9 _check_author_makefile() unless $ENV{DBICTEST_NO_MAKEFILE_VERIFICATION};
  10
  11 # Die if the author did not update his makefile
  12 #
  13 # This is pretty heavy handed, so the check is pretty solid:
  14 #
  15 # 1) Assume that this particular module is loaded from -I <$root>/t/lib
  16 # 2) Make sure <$root>/Makefile.PL exists
  17 # 3) Make sure we can stat() <$root>/Makefile.PL
  18 #
  19 # If all of the above is satisfied
  20 #
  21 # *) die if <$root>/inc does not exist
  22 # *) die if no stat() results for <$root>/Makefile (covers no Makefile)
  23 # *) die if Makefile.PL mtime > Makefile mtime
  24 #
  25 sub _check_author_makefile {
  26
  27   my $root = _find_co_root()
  28     or return;
  29
  30   my $optdeps = file('lib/DBIx/Class/Optional/Dependencies.pm');
  31
  32   # not using file->stat as it invokes File::stat which in turn breaks stat(_)
  33   my ($mf_pl_mtime, $mf_mtime, $optdeps_mtime) = ( map
  34     { (stat ($root->file ($_)) )[9] || undef }  # stat returns () on nonexistent files
  35     (qw|Makefile.PL  Makefile|, $optdeps)
  36   );
  37
  38   return unless $mf_pl_mtime;   # something went wrong during co_root detection ?
  39
  40   my @fail_reasons;
  41
  42   if(not -d $root->subdir ('inc')) {
  43     push @fail_reasons, "Missing ./inc directory";
  44   }
  45
  46   if(not $mf_mtime) {
  47     push @fail_reasons, "Missing ./Makefile";
  48   }
  49   else {
  50     if($mf_mtime < $mf_pl_mtime) {
  51       push @fail_reasons, "./Makefile.PL is newer than ./Makefile";
  52     }
  53     if($mf_mtime < $optdeps_mtime) {
  54       push @fail_reasons, "./$optdeps is newer than ./Makefile";
  55     }
  56   }
  57
  58   if (@fail_reasons) {
  59     print STDERR <<'EOE';
  60
  61
  62 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  63 ======================== FATAL ERROR ===========================
  64 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  65
  66 We have a number of reasons to believe that this is a development
  67 checkout and that you, the user, did not run `perl Makefile.PL`
  68 before using this code. You absolutely _must_ perform this step,
  69 to ensure you have all required dependencies present. Not doing
  70 so often results in a lot of wasted time for other contributors
  71 trying to assit you with spurious "its broken!" problems.
  72
  73 By default DBICs Makefile.PL turns all optional dependenciess into
  74 *HARD REQUIREMENTS*, in order to make sure that the entire test
  75 suite is executed, and no tests are skipped due to missing modules.
  76 If you for some reason need to disable this behavior - supply the
  77 --skip_author_deps option when running perl Makefile.PL
  78
  79 If you are seeing this message unexpectedly (i.e. you are in fact
  80 attempting a regular installation be it through CPAN or manually),
  81 please report the situation to either the mailing list or to the
  82 irc channel as described in
  83
  84 http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT
  85
  86 The DBIC team
  87
  88
  89 Reasons you received this message:
  90
  91 EOE
  92
  93     foreach my $r (@fail_reasons) {
  94       print STDERR "  * $r\n";
  95     }
  96     print STDERR "\n\n\n";
  97
  98     exit 1;
  99   }
 100 }
 101
 102 sub peepeeness {
 103   return ! $ENV{DBICTEST_ALL_LEAKS} if defined $ENV{DBICTEST_ALL_LEAKS};
 104
 105   # don't smoke perls with known issues:
 106   if (__PACKAGE__->is_smoker) {
 107     if ($] == '5.013006') {
 108       # leaky 5.13.6 (fixed in blead/cefd5c7c)
 109       return 1;
 110     }
 111     elsif ($] == '5.013005') {
 112       # not sure why this one leaks, but disable anyway - ANDK seems to make it weep
 113       return 1;
 114     }
 115   }
 116
 117   return 0;
 118 }
 119
 120 # Mimic $Module::Install::AUTHOR
 121 sub is_author {
 122
 123   my $root = _find_co_root()
 124     or return undef;
 125
 126   return (
 127     ( not -d $root->subdir ('inc') )
 128       or
 129     ( -e $root->subdir ('inc')->subdir ($^O eq 'VMS' ? '_author' : '.author') )
 130   );
 131 }
 132
 133 sub is_smoker {
 134   return ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} )
 135 }
 136
 137 sub is_plain {
 138   return (! __PACKAGE__->is_smoker && ! __PACKAGE__->is_author && ! $ENV{RELEASE_TESTING} )
 139 }
 140
 141 # Try to determine the root of a checkout/untar if possible
 142 # or return undef
 143 sub _find_co_root {
 144
 145     my @mod_parts = split /::/, (__PACKAGE__ . '.pm');
 146     my $rel_path = join ('/', @mod_parts);  # %INC stores paths with / regardless of OS
 147
 148     return undef unless ($INC{$rel_path});
 149
 150     # a bit convoluted, but what we do here essentially is:
 151     #  - get the file name of this particular module
 152     #  - do 'cd ..' as many times as necessary to get to t/lib/../..
 153
 154     my $root = dir ($INC{$rel_path});
 155     for (1 .. @mod_parts + 2) {
 156         $root = $root->parent;
 157     }
 158
 159     return (-f $root->file ('Makefile.PL') )
 160       ? $root
 161       : undef
 162     ;
 163 }
 164
 165 1;