2 ### This version is rather 5.8-centric, because DBIC itself is 5.8
3 ### It certainly can be rewritten to degrade well on 5.6
10 # Pre-5.10 perls pollute %INC on unsuccesfull module
11 # require, making it appear as if the module is already
12 # loaded on subsequent require()s
13 # Can't seem to find the exact RT/perldelta entry
15 # The reason we can't just use a sane, clean loader, is because
16 # if a Module require()s another module the %INC will still
17 # get filled with crap and we are back to square one. A global
18 # fix is really the only way for this test, as we try to load
19 # each available module separately, and have no control (nor
20 # knowledge) over their common dependencies.
22 # we want to do this here, in the very beginning, before even
23 # warnings/strict are loaded
25 unshift @INC, 't/lib';
26 require DBICTest::Util::OverrideRequire;
28 DBICTest::Util::OverrideRequire::override_global_require( sub {
29 my $res = eval { $_[0]->() };
39 # Explicitly add 'lib' to the front of INC - this way we will
40 # know without ambiguity what was loaded from the local untar
41 # and what came from elsewhere
42 use lib qw(lib t/lib);
47 use Test::More 'no_plan';
49 use File::Find 'find';
50 use Module::Runtime 'module_notional_filename';
52 use ExtUtils::MakeMaker;
53 use DBICTest::Util 'visit_namespaces';
55 # load these two to pull in the t/lib armada
58 DBICTest->init_schema;
60 # do !!!NOT!!! use Module::Runtime's require_module - it breaks CORE::require
62 # trap deprecation warnings and whatnot
63 local $SIG{__WARN__} = sub {};
69 print STDERR "\n", @_, "\n";
72 my @lib_display_order = qw(
82 { $Config{$_} ? ( $_ => $Config{"${_}exp"} || $Config{$_} ) : () }
86 # synthetic, for display
93 $lib_paths->{$_} and $fn =~ s/^\Q$lib_paths->{$_}/<<$_>>/ and last
94 for @lib_display_order;
100 # we already checked for -r/-f, just bail if can't open
101 open my $fh, '<:raw', $_[0] or return '';
103 Digest::MD5->new->addfile($fh)->hexdigest;
106 # first run through lib and *try* to load anything we can find
107 # within our own project
112 # can't just `require $fn`, as we need %INC to be
114 my ($mod) = $_ =~ /^ lib [\/\\] (.+) \.pm $/x
117 req_mod join ('::', File::Spec->splitdir($mod));
122 # now run through OptDeps and attempt loading everything else
124 # some things needs to be sorted before other things
125 # positive - load first
126 # negative - load last
128 # Make sure oracle is tried last - some clients (e.g. 10.2) have symbol
129 # clashes with libssl, and will segfault everything coming after them
130 "DBD::Oracle" => -999,
137 { keys %{DBIx::Class::Optional::Dependencies->req_list_for($_)} }
140 keys %{DBIx::Class::Optional::Dependencies->req_group_list}
143 { ($load_weights->{$b}||0) <=> ($load_weights->{$a}||0) }
147 my $has_versionpm = eval { require version };
149 # at this point we've loaded everything we ever could, let's drill through
150 # the *ENTIRE* symtable and build a map of versions
151 my $version_list = { perl => $] };
152 visit_namespaces( action => sub {
155 # keep going, but nothing to see here
156 return 1 if $pkg eq 'main';
158 # private - not interested
159 return 0 if $pkg =~ / (?: ^ | :: ) _ /x;
162 # that would be some synthetic class, or a custom sub VERSION
164 ! defined ${"${pkg}::VERSION"}
166 ${"${pkg}::VERSION"} =~ /\Qset by base.pm/
169 # make sure a version can be extracted, be noisy when it doesn't work
170 # do this even if we are throwing away the result below in lieu of EUMM
171 my $mod_ver = eval { $pkg->VERSION };
175 "Calling `$pkg->VERSION` resulted in an exception, which should never "
176 . "happen - please file a bug with the distribution containing $pkg. "
177 . "Follows the full text of the exception:\n\n$err\n"
180 elsif( ! defined $mod_ver ) {
182 "Calling `$pkg->VERSION` returned 'undef', which should never "
183 . "happen - please file a bug with the distribution containing $pkg."
187 elsif( ! length $mod_ver ) {
189 "Calling `$pkg->VERSION` returned the empty string '', which should never "
190 . "happen - please file a bug with the distribution containing $pkg."
195 # if this is a real file - extract the version via EUMM whenever possible
196 my $fn = $INC{module_notional_filename($pkg)};
198 my $eumm_ver = eval { MM->parse_version( $fn ) }
199 if $fn and -f $fn and -r $fn;
208 $eumm_ver ne $mod_ver
211 ( eval { version->parse( do { (my $v = $eumm_ver) =~ s/_//g; $v } ) } || 0 )
213 ( eval { version->parse( do { (my $v = $mod_ver) =~ s/_//g; $v } ) } || 0 )
217 "Mismatch of versions '$mod_ver' and '$eumm_ver', obtained respectively "
218 . "via `$pkg->VERSION` and parsing the version out of @{[ describe_fn $fn ]} "
219 . "with ExtUtils::MakeMaker\@@{[ ExtUtils::MakeMaker->VERSION ]}. "
220 . "This should never happen - please check whether this is still present "
221 . "in the latest version, and then file a bug with the distribution "
226 if( defined $eumm_ver ) {
227 $version_list->{$pkg} = $eumm_ver;
229 elsif( defined $mod_ver ) {
230 $version_list->{$pkg} = $mod_ver;
236 # compress identical versions as close to the root as we can
237 # unless we are dealing with a smoker - in which case we want
238 # to see every MD5 there is
239 unless ( $ENV{AUTOMATED_TESTING} ) {
240 for my $mod ( sort { length($b) <=> length($a) } keys %$version_list ) {
243 while ( $parent =~ s/ :: (?: . (?! :: ) )+ $ //x ) {
244 $version_list->{$parent}
246 $version_list->{$parent} eq $version_list->{$mod}
248 ( ( delete $version_list->{$mod} ) or 1 )
255 ok 1, (scalar keys %$version_list) . " distinctly versioned modules";
257 exit if ($ENV{TRAVIS}||'') eq 'true';
259 # sort stuff into @INC segments
263 for my $mod ( sort { lc($a) cmp lc($b) } keys %$version_list ) {
264 my $fn = $INC{module_notional_filename($mod)};
268 ( ( $fn && -f $fn && -r $fn ) ? $fn : undef )
273 for my $lib (@lib_display_order, './lib') {
274 if ( $lib_paths->{$lib} and index($fn, $lib_paths->{$lib}) == 0 ) {
275 push @{$segments->{$lib}}, $tuple;
281 # fallthrough for anything without a physical filename, or unknown lib
282 push @{$segments->{''}}, $tuple;
285 # diag the result out
286 my $max_ver_len = max map { length $_ } values %$version_list;
287 my $max_mod_len = max map { length $_ } keys %$version_list;
289 my $diag = "\n\nVersions of all loadable modules within the configure/build/test/runtime dependency chains present on this system (both core and optional)\n\n";
290 for my $seg ( '', @lib_display_order, './lib' ) {
291 next unless $segments->{$seg};
293 $diag .= sprintf "=== %s ===\n\n",
295 ? "Modules found in " . ( $Config{$seg} ? "\$Config{$seg}" : $seg )
301 $max_ver_len => $version_list->{$_->[0]},
302 -$max_mod_len => $_->[0],
304 ? " [ MD5: @{[ md5_of_fn( $_->[1] ) ]} ]"
307 ) for @{$segments->{$seg}};