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
9 # Pre-5.10 perls pollute %INC on unsuccesfull module
10 # require, making it appear as if the module is already
11 # loaded on subsequent require()s
12 # Can't seem to find the exact RT/perldelta entry
14 # The reason we can't just use a sane, clean loader, is because
15 # if a Module require()s another module the %INC will still
16 # get filled with crap and we are back to square one. A global
17 # fix is really the only way for this test, as we try to load
18 # each available module separately, and have no control (nor
19 # knowledge) over their common dependencies.
21 # we want to do this here, in the very beginning, before even
22 # warnings/strict are loaded
24 unshift @INC, 't/lib';
25 require DBICTest::Util::OverrideRequire;
27 DBICTest::Util::OverrideRequire::override_global_require( sub {
28 my $res = eval { $_[0]->() };
38 # Explicitly add 'lib' to the front of INC - this way we will
39 # know without ambiguity what was loaded from the local untar
40 # and what came from elsewhere
41 use lib qw(lib t/lib);
46 use Test::More 'no_plan';
48 use File::Find 'find';
49 use Module::Runtime 'module_notional_filename';
50 use List::Util qw(max min);
51 use ExtUtils::MakeMaker;
52 use DBICTest::Util 'visit_namespaces';
54 # load these two to pull in the t/lib armada
59 my $known_libpaths = {
61 config_key => 'sitearch',
64 config_key => 'sitelib',
67 config_key => 'vendorarch',
70 config_key => 'vendorlib',
73 config_key => 'archlib',
76 config_key => 'privlib',
86 full_path => full_path (
87 eval { require File::HomeDir and File::HomeDir->my_home }
96 for my $k (keys %$known_libpaths) {
97 my $v = $known_libpaths->{$k};
99 # never use home as a found-in-dir marker - it is too broad
100 # HOME is only used by the shortener
101 $v->{abbrev} = $k unless $k eq 'HOME';
103 unless ( $v->{full_path} ) {
104 if ( $v->{relpath} ) {
105 $v->{full_path} = full_path( $v->{relpath} );
107 elsif ( $Config{ $v->{config_key} || '' } ) {
108 $v->{full_path} = full_path (
109 $Config{"$v->{config_key}exp"} || $Config{$v->{config_key}}
114 delete $known_libpaths->{$k} unless $v->{full_path} and -d $v->{full_path};
118 # first run through lib/ and *try* to load anything we can find
119 # within our own project
124 # can't just `require $fn`, as we need %INC to be
126 my ($mod) = $_ =~ /^ lib [\/\\] (.+) \.pm $/x
129 try_module_require(join ('::', File::Spec->splitdir($mod)) )
136 # now run through OptDeps and attempt loading everything else
138 # some things needs to be sorted before other things
139 # positive - load first
140 # negative - load last
142 # Make sure oracle is tried last - some clients (e.g. 10.2) have symbol
143 # clashes with libssl, and will segfault everything coming after them
144 "DBD::Oracle" => -999,
146 try_module_require($_) for sort
147 { ($load_weights->{$b}||0) <=> ($load_weights->{$a}||0) }
149 DBIx::Class::Optional::Dependencies->req_list_for([
151 # some DBDs are notoriously problematic to load
152 # hence only show stuff based on test_rdbms which will
153 # take into account necessary ENVs
154 { $_ !~ /^ (?: rdbms | dist )_ /x }
155 keys %{DBIx::Class::Optional::Dependencies->req_group_list}
161 # at this point we've loaded everything we ever could, let's drill through
162 # the *ENTIRE* symtable and build a map of versions
163 my $has_versionpm = eval { require version };
164 my $versioned_modules = {
165 perl => { version => $], full_path => $^X }
168 visit_namespaces( action => sub {
172 # keep going, but nothing to see here
173 return 1 if $pkg eq 'main';
175 # private - not interested, including no further descent
176 return 0 if $pkg =~ / (?: ^ | :: ) _ /x;
178 # not interested in no-VERSION-containing modules, nor synthetic classes
180 ! defined ${"${pkg}::VERSION"}
182 ${"${pkg}::VERSION"} =~ /\Qset by base.pm/
185 # make sure a version can be extracted, be noisy when it doesn't work
186 # do this even if we are throwing away the result below in lieu of EUMM
187 my $mod_ver = eval { $pkg->VERSION };
191 "Calling `$pkg->VERSION` resulted in an exception, which should never "
192 . "happen - please file a bug with the distribution containing $pkg. "
193 . "Complete exception text below:\n\n$err"
196 elsif( ! defined $mod_ver or ! length $mod_ver ) {
197 my $ret = defined $mod_ver
198 ? "the empty string ''"
203 "Calling `$pkg->VERSION` returned $ret, even though \$${pkg}::VERSION "
204 . "is defined, which should never happen - please file a bug with the "
205 . "distribution containing $pkg."
211 # if this is a real file - extract the version via EUMM whenever possible
212 my $fn = $INC{module_notional_filename($pkg)};
223 $full_path = full_path($fn)
225 eval { MM->parse_version( $fn ) }
235 $eumm_ver ne $mod_ver
238 ( eval { version->parse( do { (my $v = $eumm_ver) =~ s/_//g; $v } ) } || 0 )
240 ( eval { version->parse( do { (my $v = $mod_ver) =~ s/_//g; $v } ) } || 0 )
244 "Mismatch of versions '$mod_ver' and '$eumm_ver', obtained respectively "
245 . "via `$pkg->VERSION` and parsing the version out of @{[ shorten_fn( $full_path ) ]} "
246 . "with ExtUtils::MakeMaker\@@{[ ExtUtils::MakeMaker->VERSION ]}. "
247 . "This should never happen - please check whether this is still present "
248 . "in the latest version, and then file a bug with the distribution "
253 if( defined $eumm_ver ) {
254 $versioned_modules->{$pkg} = { version => $eumm_ver };
256 elsif( defined $mod_ver ) {
257 $versioned_modules->{$pkg} = { version => $mod_ver };
260 # add the path and a "where-from" marker if any
261 if ( $full_path and my $slot = $versioned_modules->{$pkg} ) {
262 $slot->{full_path} = $full_path;
264 if ( my $abbr = ( matching_known_lib( $full_path ) || {} )->{abbrev} ) {
265 $slot->{from_known_lib} = $abbr;
266 $seen_known_libs->{$abbr} = 1;
273 # compress identical versions sourced from ./lib as close to the root as we can
274 for my $mod ( sort { length($b) <=> length($a) } keys %$versioned_modules ) {
275 ($versioned_modules->{$mod}{from_known_lib}||'') eq 'LIB'
280 while ( $parent =~ s/ :: (?: . (?! :: ) )+ $ //x ) {
281 $versioned_modules->{$parent}
283 $versioned_modules->{$parent}{version} eq $versioned_modules->{$mod}{version}
285 ($versioned_modules->{$parent}{from_known_lib}||'') eq 'LIB'
287 delete $versioned_modules->{$mod}
293 ok 1, (scalar keys %$versioned_modules) . " distinctly versioned modules found";
295 # do not announce anything under ci - we are watching for STDERR silence
296 exit if DBICTest::RunMode->is_ci;
299 # diag the result out
300 my $max_ver_len = max map
302 ( 'xxx.yyyzzz_bbb', map { $_->{version} } values %$versioned_modules )
304 my $max_mod_len = max map { length $_ } keys %$versioned_modules;
305 my $max_marker_len = max map { length $_ } keys %{ $seen_known_libs || {} };
309 List of loadable modules specifying a version within both the core and *OPTIONAL* dependency chains present on this system
310 Note that *MANY* of these modules will *NEVER* be loaded during normal operation of DBIx::Class
311 (modules sourced from ./lib with versions identical to their parent namespace were omitted for brevity)
316 if ($seen_known_libs) {
317 diag "Sourcing markers:\n";
323 $max_marker_len => $_->{abbrev},
324 ($_->{config_key} ? "\$Config{$_->{config_key}}" : $_->{relpath} )
326 @{$known_libpaths}{ sort keys %$seen_known_libs }
332 diag "=============================\n";
336 $max_marker_len+2 => $versioned_modules->{$_}{from_known_lib} || '',
337 $max_ver_len => $versioned_modules->{$_}{version},
339 ($versioned_modules->{$_}{full_path}
340 ? ' ' x (80 - min(78, $max_mod_len)) . "[ MD5: @{[ get_md5( $versioned_modules->{$_}{full_path} ) ]} ]"
343 ) for sort { lc($a) cmp lc($b) } keys %$versioned_modules;
345 diag "=============================\n$discl\n";
351 sub say_err { print STDERR "\n", @_, "\n" };
353 # do !!!NOT!!! use Module::Runtime's require_module - it breaks CORE::require
354 sub try_module_require {
355 # trap deprecation warnings and whatnot
356 local $SIG{__WARN__} = sub {};
358 eval "require $_[0]";
362 return '' unless ( defined $_[0] and -e $_[0] );
364 my $fn = Cwd::abs_path($_[0]);
366 if ( $^O eq 'MSWin32' and $fn ) {
368 # sometimes we can get a short/longname mix, normalize everything to longnames
369 $fn = Win32::GetLongPathName($fn);
371 # Fixup (native) slashes in Config not matching (unixy) slashes in INC
381 my $l = matching_known_lib( $fn )
385 $fn =~ s/\Q$l->{full_path}\E/$l->{relpath}/;
387 elsif ($l->{config_key}) {
388 $fn =~ s/\Q$l->{full_path}\E/<<$l->{config_key}>>/;
394 sub matching_known_lib {
395 my $fn = full_path( $_[0] )
399 sort { length( $b->{full_path} ) <=> length( $a->{full_path} ) }
400 values %$known_libpaths
402 return { %$l } if 0 == index( $fn, $l->{full_path} );
407 # we already checked for -r/-f, just bail if can't open
408 open my $fh, '<:raw', $_[0] or return '';
410 Digest::MD5->new->addfile($fh)->hexdigest;