use strict; our $exclude = { map({ $_ => $_ } qw ( strict constant warnings )), }; use Data::Dumper; if (0) { print Dumper $exclude; } while (my $file = shift) { if (!open(FILE, "<$file")) { print("Could not open $file\n"); next; } print "Checking $file\n"; my @imported = (); my @modules = (); my $module = {}; my $imports = {}; while (my $line = ) { chomp $line; if ($line =~ /^\s*use\s+/) { if (my ($package, $list) = ($line =~ /^\s*use\s+([^\s]+)\s+(.*);/)) { my @export; eval { @export = eval('('. $list . ')'); }; if ($@) { print "Could not evaluate $list\n"; } next if ($exclude->{$package}); if (defined($module->{$package})) { printf("Package $package `use'd more than once\n"); } else { push(@modules, $package); $module->{$package} = 0; } for my $key (@export) { if (defined($imports->{$key})) { printf("Subroutine $key imported more than once.\n"); } $imports->{$key} = $package; } push(@imported, @export); } elsif (my ($package) = ($line =~ /^\s*use\s+([^\s]+)\s*;/)) { next if ($exclude->{$package}); if (defined($module->{$package})) { printf("Package $package `use'd more than once\n"); } else { push(@modules, $package); $module->{$package} = 0; } } else { print "Could not parse '$line'\n"; next; } } print "I don't handle requires yet\n" if $line =~ /^\s*require/; } seek(FILE, 0, 0); # I have a dual personality, so I wrote a 2 pass checker. unless (@modules || @imported) { print "No modules in $file\n"; next; } my $temp = join('|', grep({ !$exclude->{$_} } @modules)); my $reg1 = $temp ? qr/\b($temp)[^:]/ : undef; my $temp = join('\|', grep({ !$exclude->{$_} } @imported)); my $reg2 = $temp ? qr/($temp)/ : undef; while (my $line = ) { chomp $line; next if $line =~ /^\s*use\s+.*;/; # don't look at the use; next if $line =~ /^\s*require\s+.*;/; # don't look at the use; if (defined($reg1) && (my ($module_name) = ($line =~ $reg1))) { # print "$line [$module_name]\n"; $module->{$module_name}++; } if (defined($reg2) && (my ($import) = ($line =~ $reg2))) { if (my $module_name = $imports->{$import}) { $module->{$module_name}++; # print "$line ($import) [$module_name]\n"; } else { die; } } } for my $key (keys %$module) { if ($module->{$key}) { printf "Module $key used %d times.\n", $module->{$key}; } else { print "Module $key not used.\n" unless $module->{$key}; } } print "\n"; }