Really fix uninit warning
[dbsrgits/DBIx-Class-Historic.git] / t / lib / DBICTest / AuthorCheck.pm
CommitLineData
ab340f7f 1package # hide from PAUSE
2 DBICTest::AuthorCheck;
3
4use strict;
5use warnings;
6
7use 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#
25sub _check_author_makefile {
26
27 my $root = _find_co_root()
28 or return;
29
7159a456 30 my $optdeps = file('lib/DBIx/Class/Optional/Dependencies.pm');
31
ab340f7f 32 # not using file->stat as it invokes File::stat which in turn breaks stat(_)
7159a456 33 my ($mf_pl_mtime, $mf_mtime, $optdeps_mtime) = ( map
50360f3e 34 { (stat ($root->file ($_)) )[9] || undef } # stat returns () on nonexistent files
7159a456 35 (qw|Makefile.PL Makefile|, $optdeps)
ab340f7f 36 );
37
38 return unless $mf_pl_mtime; # something went wrong during co_root detection ?
39
7159a456 40 my @fail_reasons;
ab340f7f 41
7159a456 42 if(not -d $root->subdir ('inc')) {
43 push @fail_reasons, "Missing ./inc directory";
44 }
ab340f7f 45
a256e995 46 if(not $mf_mtime) {
7159a456 47 push @fail_reasons, "Missing ./Makefile";
48 }
a256e995 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 }
7159a456 56 }
57
58 if (@fail_reasons) {
59 print STDERR <<'EOE';
ab340f7f 60
61
62!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
63======================== FATAL ERROR ===========================
64!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
65
66We have a number of reasons to believe that this is a development
67checkout and that you, the user, did not run `perl Makefile.PL`
68before using this code. You absolutely _must_ perform this step,
dc4600b2 69and ensure you have all required dependencies present. Not doing
70so often results in a lot of wasted time for other contributors
71trying to assit you with spurious "its broken!" problems.
ab340f7f 72
73If you are seeing this message unexpectedly (i.e. you are in fact
dc4600b2 74attempting a regular installation be it through CPAN or manually),
75please report the situation to either the mailing list or to the
76irc channel as described in
ab340f7f 77
78http://search.cpan.org/dist/DBIx-Class/lib/DBIx/Class.pm#GETTING_HELP/SUPPORT
79
ab340f7f 80The DBIC team
81
82
7159a456 83Reasons you received this message:
ab340f7f 84
85EOE
86
7159a456 87 foreach my $r (@fail_reasons) {
88 print STDERR " * $r\n";
89 }
90 print STDERR "\n\n\n";
91
ab340f7f 92 exit 1;
93 }
94}
95
dc4600b2 96# Mimic $Module::Install::AUTHOR
97sub is_author {
98
99 my $root = _find_co_root()
100 or return undef;
101
102 return (
103 ( not -d $root->subdir ('inc') )
104 or
105 ( -e $root->subdir ('inc')->file ($^O eq 'VMS' ? '_author' : '.author') )
106 );
107}
108
ab340f7f 109# Try to determine the root of a checkout/untar if possible
110# or return undef
111sub _find_co_root {
112
113 my @mod_parts = split /::/, (__PACKAGE__ . '.pm');
fd3d890d 114 my $rel_path = join ('/', @mod_parts); # %INC stores paths with / regardless of OS
ab340f7f 115
116 return undef unless ($INC{$rel_path});
117
118 # a bit convoluted, but what we do here essentially is:
119 # - get the file name of this particular module
120 # - do 'cd ..' as many times as necessary to get to t/lib/../..
121
122 my $root = dir ($INC{$rel_path});
fd3d890d 123 for (1 .. @mod_parts + 2) {
ab340f7f 124 $root = $root->parent;
125 }
126
127 return (-f $root->file ('Makefile.PL') )
128 ? $root
129 : undef
130 ;
131}
132
1331;