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 # Mimic $Module::Install::AUTHOR
 114 sub is_author {
 115
 116   my $root = _find_co_root()
 117     or return undef;
 118
 119   return (
 120     ( not -d $root->subdir ('inc') )
 121       or
 122     ( -e $root->subdir ('inc')->subdir ($^O eq 'VMS' ? '_author' : '.author') )
 123   );
 124 }
 125
 126 sub is_smoker {
 127   return ( $ENV{AUTOMATED_TESTING} && ! $ENV{PERL5_CPANM_IS_RUNNING} && ! $ENV{RELEASE_TESTING} )
 128 }
 129
 130 sub is_plain {
 131   return (! __PACKAGE__->is_smoker && ! __PACKAGE__->is_author && ! $ENV{RELEASE_TESTING} )
 132 }
 133
 134 # Try to determine the root of a checkout/untar if possible
 135 # or return undef
 136 sub _find_co_root {
 137
 138     my @mod_parts = split /::/, (__PACKAGE__ . '.pm');
 139     my $rel_path = join ('/', @mod_parts);  # %INC stores paths with / regardless of OS
 140
 141     return undef unless ($INC{$rel_path});
 142
 143     # a bit convoluted, but what we do here essentially is:
 144     #  - get the file name of this particular module
 145     #  - do 'cd ..' as many times as necessary to get to t/lib/../..
 146
 147     my $root = dir ($INC{$rel_path});
 148     for (1 .. @mod_parts + 2) {
 149         $root = $root->parent;
 150     }
 151
 152     return (-f $root->file ('Makefile.PL') )
 153       ? $root
 154       : undef
 155     ;
 156 }
 157
 158 1;