* made HasOne::has_one and HasMany::has_many look more similar as a route to possible...
[dbsrgits/DBIx-Class-Historic.git] / script / nextalyzer.pl
CommitLineData
4ed0e7a7 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5use Class::ISA;
6
7my $class = $ARGV[0];
8
9die "usage: nextalyzer Some::Class" unless $class;
10
11eval "use $class;";
12
13die "Error using $class: $@" if $@;
14
15my @path = reverse Class::ISA::super_path($class);
16
17my %provided;
18my %overloaded;
19
20my @warnings;
21
22foreach 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
65print "\n\n";
66
67print join("\n", @warnings);
68
69foreach my $o (keys %overloaded) {
70 my $pr = $provided{$o} || "**NEVER**";
71 print "Method $o: ".join(' ', reverse @{$overloaded{$o}})." ${pr}\n";
72}