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 = <FILE>) {
        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 = <FILE>) {
        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 u
+se;
        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";
}
[download]