Merge branch 'master' into terencehill/slider_anim_improvements
[xonotic/xonotic-data.pk3dir.git] / qcsrc / menu / auto-super.pl
1 my %classoffile = ();
2 my %classes = ();
3 my %baseclass = ();
4 my %methods = ();
5 my %attrs = ();
6 my %methodnames = ();
7 my %old2new = ();
8
9 print STDERR "Scanning...\n";
10 for my $f(@ARGV)
11 {
12         open my $fh, '<', $f;
13         while(<$fh>)
14         {
15                 if(/^CLASS\(([^)]*)\)(?:\s*EXTENDS\(([^)]*)\))?/)
16                 {
17                         $classes{$1} = defined($2) ? $2 : "Object";
18                         $classoffile{$f} = $1;
19                 }
20                 if(/^\s*METHOD\(([^),]*),\s*([^),]*)/)
21                 {
22                         $methods{$1}{$2} = $1;
23                         $methodnames{"$1"."_"."$2"} = $f;
24                         $old2new{"$2$1"} = "$1"."_"."$2";
25                 }
26                 if(/^\s*ATTRIB(?:ARRAY)?\(([^),]*),\s*([^),]*)/)
27                 {
28                         $attrs{$1}{$2} = $1;
29                 }
30         }
31         close $fh;
32 }
33
34 # propagate down methods etc.
35 print STDERR "Propagating...\n";
36 for my $class(keys %classes)
37 {
38         print STDERR "$class";
39         my $base = $class;
40         for(;;)
41         {
42                 $base = $classes{$base};
43                 last if not defined $base;
44                 print STDERR " -> $base";
45                 while(my ($method, $definingclass) = each %{$methods{$base}})
46                 {
47                         $methods{$class}{$method} = $definingclass
48                                 if not defined $methods{$class}{$method};
49                 }
50                 while(my ($attr, $definingclass) = each %{$attrs{$base}})
51                 {
52                         $attrs{$class}{$attr} = $definingclass
53                                 if not defined $attrs{$class}{$attr};
54                 }
55         }
56         print STDERR "\n";
57 }
58
59 # change all calls to base method to super, complain about skipping
60 print STDERR "Fixing...\n";
61 for my $f(@ARGV)
62 {
63         open my $fh, '<', $f;
64         my $s = do { undef local $/; <$fh>; };
65         my $s0 = $s;
66         close $fh;
67
68         my $class = $classoffile{$f};
69         my $base = $classes{$class};
70         next if not defined $base;
71
72         for(keys %old2new)
73         {
74                 $s =~ s/\b$_\b/$old2new{$_}/g;
75         }
76
77         my @methods_super = map { [ $methods{$base}{$_} . "_" . $_, "SUPER($class).$_" ]; } keys %{$methods{$base}};
78         for(@methods_super)
79         {
80                 my ($search, $replace) = @$_;
81                 my $n = ($s =~ s/\b$search\b/$replace/g);
82                 print STDERR "[$f] $search -> $replace... $n replacements\n"
83                         if $n;
84         }
85
86         for(grep { $methodnames{$_} ne $f } keys %methodnames)
87         {
88                 if($s =~ /\b$_\b/)
89                 {
90                         print STDERR "[$f] calls non-super external method directly: $_\n";
91                 }
92         }
93
94         if($s ne $s0)
95         {
96                 print STDERR "Rewriting $f...\n";
97                 open my $fh, '>', $f;
98                 print $fh $s;
99                 close $fh;
100         }
101 }