t/lib/DBICTest/AuthorCheck.pm

   1 package # hide from PAUSE
   2     DBICTest::AuthorCheck;
   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 # Mimic $Module::Install::AUTHOR
 103 sub is_author {
 104
 105   my $root = _find_co_root()
 106     or return undef;
 107
 108   return (
 109     ( not -d $root->subdir ('inc') )
 110       or
 111     ( -e $root->subdir ('inc')->file ($^O eq 'VMS' ? '_author' : '.author') )
 112   );
 113 }
 114
 115 # Try to determine the root of a checkout/untar if possible
 116 # or return undef
 117 sub _find_co_root {
 118
 119     my @mod_parts = split /::/, (__PACKAGE__ . '.pm');
 120     my $rel_path = join ('/', @mod_parts);  # %INC stores paths with / regardless of OS
 121
 122     return undef unless ($INC{$rel_path});
 123
 124     # a bit convoluted, but what we do here essentially is:
 125     #  - get the file name of this particular module
 126     #  - do 'cd ..' as many times as necessary to get to t/lib/../..
 127
 128     my $root = dir ($INC{$rel_path});
 129     for (1 .. @mod_parts + 2) {
 130         $root = $root->parent;
 131     }
 132
 133     return (-f $root->file ('Makefile.PL') )
 134       ? $root
 135       : undef
 136     ;
 137 }
 138
 139 1;