script/nextalyzer.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Class::ISA;
   6
   7 my $class = $ARGV[0];
   8
   9 die "usage: nextalyzer Some::Class" unless $class;
  10
  11 eval "use $class;";
  12
  13 die "Error using $class: $@" if $@;
  14
  15 my @path = reverse Class::ISA::super_path($class);
  16
  17 my %provided;
  18 my %overloaded;
  19
  20 my @warnings;
  21
  22 foreach my $super (@path) {
  23   my $file = $super;
  24   $file =~ s/\:\:/\//g;
  25   $file .= '.pm';
  26   my $file_path = $INC{$file};
  27   die "Couldn't get INC for $file, super $super" unless $file_path;
  28   #warn "$super $file $file_path";
  29   open IN, '<', $file_path;
  30   my $in_sub;
  31   my $ws;
  32   my $uses_next;
  33   my @provides;
  34   my @overloads;
  35   while (my $line = <IN>) {
  36     unless ($in_sub) {
  37       ($ws, $in_sub) = ($line =~ /^(\s*)sub (\S+)/);
  38       next unless $in_sub;
  39     }
  40     if ($line =~ /^$ws\}/) {
  41       if ($uses_next) {
  42         push(@overloads, $in_sub);
  43       } else {
  44         push(@provides, $in_sub);
  45       }
  46       undef $in_sub;
  47       undef $uses_next;
  48       undef $ws;
  49       next;
  50     }
  51     $uses_next++ if ($line =~ /\-\>NEXT/);
  52   }
  53   close IN;
  54   foreach (@overloads) {
  55     push(@warnings, "Method $_ overloaded in $class but not yet provided")
  56       unless $provided{$_};
  57     push(@{$overloaded{$_}}, $super);
  58   }
  59   $provided{$_} = $super for @provides;
  60   print "Class $super:\n";
  61   print "Provides: @provides\n";
  62   print "Overloads: @overloads\n";
  63 }
  64
  65 print "\n\n";
  66
  67 print join("\n", @warnings);
  68
  69 foreach my $o (keys %overloaded) {
  70   my $pr = $provided{$o} || "**NEVER**";
  71   print "Method $o: ".join(' ', reverse @{$overloaded{$o}})." ${pr}\n";
  72 }