Cleanup #includes

[xonotic/xonotic-data.pk3dir.git] / qcsrc / tools / auto-super.pl

diff --git a/qcsrc/tools/auto-super.pl b/qcsrc/tools/auto-super.pl
new file mode 100644 (file)
index 0000000..00926d0
--- /dev/null
+++ b/qcsrc/tools/auto-super.pl
@@ -0,0 +1,101 @@
+my %classoffile = ();
+my %classes = ();
+my %baseclass = ();
+my %methods = ();
+my %attrs = ();
+my %methodnames = ();
+my %old2new = ();
+
+print STDERR "Scanning...\n";
+for my $f(@ARGV)
+{
+       open my $fh, '<', $f;
+       while(<$fh>)
+       {
+               if(/^CLASS\(([^)]*)\)(?:\s*EXTENDS\(([^)]*)\))?/)
+               {
+                       $classes{$1} = defined($2) ? $2 : "Object";
+                       $classoffile{$f} = $1;
+               }
+               if(/^\s*METHOD\(([^),]*),\s*([^),]*)/)
+               {
+                       $methods{$1}{$2} = $1;
+                       $methodnames{"$1"."_"."$2"} = $f;
+                       $old2new{"$2$1"} = "$1"."_"."$2";
+               }
+               if(/^\s*ATTRIB(?:ARRAY)?\(([^),]*),\s*([^),]*)/)
+               {
+                       $attrs{$1}{$2} = $1;
+               }
+       }
+       close $fh;
+}
+
+# propagate down methods etc.
+print STDERR "Propagating...\n";
+for my $class(keys %classes)
+{
+       print STDERR "$class";
+       my $base = $class;
+       for(;;)
+       {
+               $base = $classes{$base};
+               last if not defined $base;
+               print STDERR " -> $base";
+               while(my ($method, $definingclass) = each %{$methods{$base}})
+               {
+                       $methods{$class}{$method} = $definingclass
+                               if not defined $methods{$class}{$method};
+               }
+               while(my ($attr, $definingclass) = each %{$attrs{$base}})
+               {
+                       $attrs{$class}{$attr} = $definingclass
+                               if not defined $attrs{$class}{$attr};
+               }
+       }
+       print STDERR "\n";
+}
+
+# change all calls to base method to super, complain about skipping
+print STDERR "Fixing...\n";
+for my $f(@ARGV)
+{
+       open my $fh, '<', $f;
+       my $s = do { undef local $/; <$fh>; };
+       my $s0 = $s;
+       close $fh;
+
+       my $class = $classoffile{$f};
+       my $base = $classes{$class};
+       next if not defined $base;
+
+       for(keys %old2new)
+       {
+               $s =~ s/\b$_\b/$old2new{$_}/g;
+       }
+
+       my @methods_super = map { [ $methods{$base}{$_} . "_" . $_, "SUPER($class).$_" ]; } keys %{$methods{$base}};
+       for(@methods_super)
+       {
+               my ($search, $replace) = @$_;
+               my $n = ($s =~ s/\b$search\b/$replace/g);
+               print STDERR "[$f] $search -> $replace... $n replacements\n"
+                       if $n;
+       }
+
+       for(grep { $methodnames{$_} ne $f } keys %methodnames)
+       {
+               if($s =~ /\b$_\b/)
+               {
+                       print STDERR "[$f] calls non-super external method directly: $_\n";
+               }
+       }
+
+       if($s ne $s0)
+       {
+               print STDERR "Rewriting $f...\n";
+               open my $fh, '>', $f;
+               print $fh $s;
+               close $fh;
+       }
+}