Permalink
Fetching contributors…
Cannot retrieve contributors at this time
executable file 223 lines (195 sloc) 4.27 KB
#!/usr/bin/perl -w
# this attempts to make sure there are no dependency conflicts.
# run it every once in awhile if you care to.
#
# $Id$
#
sub warner { warn @_ unless $_[0] =~ /(?:Use of uninitialized value|[Ss]ubroutine \S+ redefined)/ }
$SIG{__WARN__} = \&warner;
my %data;
package Slash::Test::Dependencies;
use strict;
use base 'Exporter';
our @EXPORT = ('require');
sub require {
my $caller = caller(0);
$caller = caller(2) if $caller eq 'base';
my $package = my $required = shift;
return if $package =~ /^\d/;
$package =~ s/\.pm$//;
$package =~ s|/|::|g;
# printf "%s called %s (%s)\n", $caller, $required, $package;
push @{$data{$caller}}, $package;
eval {
CORE::require $required;
} or warn $@;
}
# for when we "use base" to get a module
*base::import_new = *base::import{CODE};
*base::import = sub {
my $caller = caller(0);
my $package = $_[1];
# printf "%s called %s (%s)\n", $caller, $required, $package;
push @{$data{$caller}}, $package;
goto &base::import_new;
};
Slash::Test::Dependencies->export('base', 'require');
package main;
use strict;
use File::Find;
#die $0;
my $path = shift @ARGV || '/usr/local/src/slash/main/slash/';
$path .= '/' unless $path =~ m|/$|;
my %pms;
my $skip = qr{(?:Bundle::Slash|Slash::SOAP::WSDL|Slash::Apache(?:::(?:User|Banlist))?)$};
find(sub {
my $file = $File::Find::name;
if ($file =~ /\.pm$/) {
(my $f = $file) =~ s|^\Q$path\E||;
$f =~ s/\.pm$//;
$f =~ s/^plugins/Slash/;
$f =~ s|\b(\w+)/\1$|$1|;
$f =~ s|/|::|g;
return if $f =~ $skip;
$pms{$f} ||= $file;
} else {
return;
}
}, $path);
for my $f (sort keys %pms) {
# next unless $f eq 'Slash::DB::MySQL';
$SIG{__WARN__} = \&warner;
Slash::Test::Dependencies->export($f, 'require');
eval {
require $pms{$f};
} or warn $@;
}
# make sure we get an error, for testing
#push @{$data{'Slash::Utility'}}, 'Slash::DB::MySQL';
#push @{$data{'Slash::DB::MySQL'}}, 'Slash::Utility';
use Data::Dumper;
print Dumper \%data;
for my $class (keys %data) {
my $aref = $data{$class};
$data{$class} = { map { ($_ => 1) } @$aref };
}
my %checked;
for my $class (keys %data) {
for my $sub (keys %{$data{$class}}) {
check($class, $sub, [$class, $sub]);
}
}
print "All OK!\n";
sub check {
my($class, $sub, $trace) = @_;
return if $checked{$class,$sub};
$checked{$class,$sub}++;
for (keys %{$data{$sub}}) {
my $ntrace = [@$trace, $_, $class];
local $" = " =>\n\t";
if (exists $data{$_}{$class}) {
die "damn:\n\t@$ntrace\n";
}
check($class, $_, [@$trace, $_]);
}
}
__END__
my %data = (
'Slash' => [qw(
Slash::Constants
Slash::DB
Slash::Display
Slash::Utility
)],
'Slash::Apache' => [qw(
Slash
Slash::DB
Slash::Display
Slash::Utility
)],
'Slash::Apache::Log' => [qw(
Slash::Utility
)],
'Slash::Apache::User' => [qw(
Slash
Slash::Apache
Slash::Display
Slash::Utility
)],
'Slash::Constants' => [qw(
)],
'Slash::DB' => [qw(
Slash::DB::Utility
)],
'Slash::DB::MySQL' => [qw(
Slash::DB
Slash::DB::Utility
Slash::Utility
)],
'Slash::DB::Static::MySQL' => [qw(
Slash::DB::Utility
Slash::Utility
)],
'Slash::DB::Utility' => [qw(
Slash::Utility
)],
'Slash::Display' => [qw(
Slash::Display::Provider
Slash::Utility::Data
Slash::Utility::Environment
Slash::Utility::System
)],
'Slash::Display::Plugin' => [qw(
Slash
Slash::Utility
)],
'Slash::Display::Provider' => [qw(
Slash::Utility::Environment
)],
'Slash::Install' => [qw(
Slash
Slash::DB
Slash::DB::Utility
)],
'Slash::Test' => [qw(
Slash
Slash::Constants
Slash::Display
Slash::Utility
Slash::XML
)],
'Slash::Utility' => [qw(
Slash::Utility::Access
Slash::Utility::Anchor
Slash::Utility::Data
Slash::Utility::Display
Slash::Utility::Environment
Slash::Utility::System
)],
'Slash::Utility::Access' => [qw(
Slash::Display
Slash::Utility::Data
Slash::Utility::System
Slash::Utility::Environment
)],
'Slash::Utility::Anchor' => [qw(
Slash::Display
Slash::Utility::Data
Slash::Utility::Display
Slash::Utility::Environment
)],
'Slash::Utility::Data' => [qw(
Slash::Constants
Slash::Utility::Environment
)],
'Slash::Utility::Display' => [qw(
Slash::Display
Slash::Utility::Data
Slash::Utility::Environment
)],
'Slash::Utility::Environment' => [qw(
)],
'Slash::Utility::System' => [qw(
Slash::Utility::Environment
)],
);