* made HasOne::has_one and HasMany::has_many look more similar as a route to possible...
[dbsrgits/DBIx-Class-Historic.git] / 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 }