9 print STDERR "Scanning...\n";
15 if(/^CLASS\(([^)]*)\)(?:\s*EXTENDS\(([^)]*)\))?/)
17 $classes{$1} = defined($2) ? $2 : "Object";
18 $classoffile{$f} = $1;
20 if(/^\s*METHOD\(([^),]*),\s*([^),]*)/)
22 $methods{$1}{$2} = $1;
23 $methodnames{"$1"."_"."$2"} = $f;
24 $old2new{"$2$1"} = "$1"."_"."$2";
26 if(/^\s*ATTRIB(?:ARRAY)?\(([^),]*),\s*([^),]*)/)
34 # propagate down methods etc.
35 print STDERR "Propagating...\n";
36 for my $class(keys %classes)
38 print STDERR "$class";
42 $base = $classes{$base};
43 last if not defined $base;
44 print STDERR " -> $base";
45 while(my ($method, $definingclass) = each %{$methods{$base}})
47 $methods{$class}{$method} = $definingclass
48 if not defined $methods{$class}{$method};
50 while(my ($attr, $definingclass) = each %{$attrs{$base}})
52 $attrs{$class}{$attr} = $definingclass
53 if not defined $attrs{$class}{$attr};
59 # change all calls to base method to super, complain about skipping
60 print STDERR "Fixing...\n";
64 my $s = do { undef local $/; <$fh>; };
68 my $class = $classoffile{$f};
69 my $base = $classes{$class};
70 next if not defined $base;
74 $s =~ s/\b$_\b/$old2new{$_}/g;
77 my @methods_super = map { [ $methods{$base}{$_} . "_" . $_, "SUPER($class).$_" ]; } keys %{$methods{$base}};
80 my ($search, $replace) = @$_;
81 my $n = ($s =~ s/\b$search\b/$replace/g);
82 print STDERR "[$f] $search -> $replace... $n replacements\n"
86 for(grep { $methodnames{$_} ne $f } keys %methodnames)
90 print STDERR "[$f] calls non-super external method directly: $_\n";
96 print STDERR "Rewriting $f...\n";