data/qcsrc/server/autocvarize.pl

   1 #!/usr/bin/perl
   2 # this tool generates JUST the autocvar declarations for cvars
   3 use strict;
   4 use warnings;
   5
   6 my @files = @ARGV;
   7
   8 my %cvars = ();
   9 my %old = ();
  10
  11 sub found($$$)
  12 {
  13         my ($name, $type, $force) = @_;
  14         $old{$name} = 1
  15                 if $force;
  16         if(exists $cvars{$name} and $type ne $cvars{$name})
  17         {
  18                 warn "cvar $name used with different types";
  19                 if($force)
  20                 {
  21                         $cvars{$name} = $type;
  22                 }
  23                 else
  24                 {
  25                         undef $cvars{$name}
  26                                 unless $old{$name};
  27                 }
  28                 next;
  29         }
  30         else
  31         {
  32                 $cvars{$name} = $type;
  33         }
  34 }
  35
  36 for my $f(@files)
  37 {
  38         print STDERR "In file $f\n";
  39         open my $fh, "<", $f;
  40         while(<$fh>)
  41         {
  42                 chomp;
  43                 if(/^\/\/#NO AUTOCVARS START/ .. /^\/\/#NO AUTOCVARS END/)
  44                 {
  45                         next;
  46                 }
  47                 s/\/\/.*//;
  48                 if(/^float autocvar_(.*);$/)
  49                 {
  50                         found $1, 'cvar', 1;
  51                         next;
  52                 }
  53                 if(/^string autocvar_(.*);$/)
  54                 {
  55                         found $1, 'cvar_string', 1;
  56                         next;
  57                 }
  58                 if(/^#define autocvar_(.*) cvar("\1")$/)
  59                 {
  60                         found $1, 'cvar', 1;
  61                         next;
  62                 }
  63                 if(/^#define autocvar_(.*) cvar_string("\1")$/)
  64                 {
  65                         found $1, 'cvar_string', 1;
  66                         next;
  67                 }
  68                 while(/\b(cvar|cvar_string)\s*\(\s*"([^"]+)"\s*\)/g)
  69                 {
  70                         found $2, $1, 0;
  71                 }
  72         }
  73 }
  74
  75 for my $name(sort keys %cvars)
  76 {
  77         my $type = $cvars{$name};
  78         next if $old{$name};
  79         if($type eq 'unknown')
  80         {
  81                 print "// cannot declare $name, it is used with different types\n";
  82         }
  83         if($type eq 'cvar')
  84         {
  85                 print "float autocvar_$name;\n";
  86         }
  87         if($type eq 'cvar_string')
  88         {
  89                 print "string autocvar_$name;\n";
  90         }
  91 }
  92
  93 for my $f(@files)
  94 {
  95         print STDERR "In file $f\n";
  96         open my $fh, "<", $f;
  97         my $out = "";
  98         while(<$fh>)
  99         {
 100                 chomp;
 101                 if(/^\/\/#NO AUTOCVARS START/ .. /^\/\/#NO AUTOCVARS END/)
 102                 {
 103                         $out .= "$_\n";
 104                         next;
 105                 }
 106                 if(/^float autocvar_(.*);$/)
 107                 {
 108                         $out .= "$_\n";
 109                         next;
 110                 }
 111                 if(/^string autocvar_(.*);$/)
 112                 {
 113                         $out .= "$_\n";
 114                         next;
 115                 }
 116                 if(/^#define autocvar_(.*) cvar("\1")$/)
 117                 {
 118                         $out .= "$_\n";
 119                         next;
 120                 }
 121                 if(/^#define autocvar_(.*) cvar_string("\1")$/)
 122                 {
 123                         $out .= "$_\n";
 124                         next;
 125                 }
 126                 s{\b(cvar|cvar_string)\s*\(\s*"([^"]+)"\s*\)}{
 127                         my ($type, $name) = ($1, $2);
 128                         my $realtype = $cvars{$name};
 129                         my $r = $&;
 130                         if(defined $realtype)
 131                         {
 132                                 #$r = "$realtype(\"$name\")";
 133                                 $r = "autocvar_$name";
 134                                 if($type eq 'cvar' && $realtype eq 'cvar_string')
 135                                 {
 136                                         $r = "stof($r)";
 137                                 }
 138                                 if($type eq 'cvar_string' && $realtype eq 'cvar')
 139                                 {
 140                                         $r = "ftos($r)";
 141                                 }
 142                         }
 143                         $r;
 144                 }ge;
 145                 $out .= "$_\n";
 146         }
 147         close $fh;
 148         open $fh, ">", $f;
 149         print $fh $out;
 150         close $fh;
 151 }