t/lib/DBICTest/RunMode.pm

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