scripts/regenerate-properties

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Cwd 'abs_path';
   6
   7 @ARGV == 2 or die "Need 2 arguments";
   8
   9 my ($header_file,$source_file) = @ARGV;
  10 @ARGV=();
  11
  12 # Regular expressions for nested brackets (uses perl 5.10 features)
  13 my ($nested_angle_brackets) = qr/(<(?:[^<>]++|(?1))*>)/;
  14 my ($nested_curly_brackets) = qr/({(?:[^{}]++|(?1))*})/;
  15 my ($nested_parentheses) = qr/(\((?:[^()]++|(?1))*\))/;
  16
  17 # Patterns to match generated code blocks
  18 my ($gen_code_start_pat, $gen_code_end_pat, $props_start_pat) =
  19   (qr(/\*.*GENERATED CODE: DO NOT EDIT.*),
  20    qr(/\*.*END OF GENERATED CODE.*\*/),
  21    qr(/\*.*PROPERTIES));
  22 # Actual delimiters to use for generated code blocks
  23 my ($gen_code_start, $gen_code_end) =
  24   ("/* {{{ GENERATED CODE: DO NOT EDIT. Created by \n".
  25    "    $0 $header_file $source_file \n*/\n",
  26    "/* }}} END OF GENERATED CODE */\n");
  27
  28 # Strings to hold text of files
  29 my $header_buffer="";
  30 my $source_buffer="";
  31
  32 # ----------------------------------------------------------------
  33 # Useful routines
  34
  35 # remove leading and trailing whitespace
  36 sub stripws ($) {
  37   my ($s) = @_;
  38   $s =~ s/^\s*//s;
  39   $s =~ s/\s*$//s;
  40   return $s;
  41 }
  42
  43 # split comments and non-comments, returning 2-element array
  44 # of (uncommented part, comments)
  45 my $comment_pat = qr#(/\*[^*]*\*+(?:[^/*][^*]*\*+)*/|//[^\n]*)|("(?:\\.|[^"\\])*"|'(?:\\.|[^'\\])*'|.[^/"'\\]*)#;
  46 sub sepcomment ($) {
  47   my ($c) = @_;
  48   my ($u) = $c;
  49   $u =~ s#$comment_pat#defined $2 ? $2 : ""#gse;
  50   $c =~ s#$comment_pat#defined $1 ? $1 : ""#gse;
  51   return ($u, $c);
  52 }
  53
  54 # Run diff, return output
  55 sub getdiff ($$) {
  56   my ($a,$b) = @_;
  57 my $diff="";
  58 open DIFF, "diff -u \Q$a\E \Q$b\E |"
  59   or die "Couldn't run diff";
  60 while(<DIFF>) {
  61   $diff .= $_;
  62 }
  63 close DIFF;
  64   return $diff;
  65 }
  66
  67 sub myrename ($$) {
  68   my ($a,$b) = @_;
  69   $b = abs_path $b;
  70   rename($a, $b) or die "Couldn't rename $a to $b";
  71 }
  72
  73 sub writefile ($$) {
  74   my ($buf, $f) = @_;
  75   open OUT, ">", $f or die "Couldn't open $f for writing";
  76   print OUT $buf;
  77   close OUT;
  78 }
  79
  80 our ($buffer);
  81
  82 # Step through file, appending lines to buffer
  83 # - Lines which match generated code blocks are omitted
  84 # - Other lines are passed to the subroutine. They are added to buffer
  85 # unless the subroutine returns 1 (e.g. if it has already added them)
  86 sub process_file (&$) {
  87   my ($sub, $file) = @_;
  88   local ($buffer) = "";
  89   # step through lines of file, appending each one to buffer
  90   open IN, "<", $file or die "Couldn't open $file for reading";
  91   while (<IN>) {
  92     # delete anything between GENERATED CODE etc.
  93     if (/$gen_code_end_pat/) {
  94       die "Unmatched generated code block end at $file line $.";
  95     } elsif (/$gen_code_start_pat/) {
  96       my $s = $.;
  97       my $found=0;
  98       while (<IN>) {
  99         chomp;
 100         if (/$gen_code_end_pat/) {
 101           $found=1;
 102           last;
 103         }
 104       }
 105       die "Unterminated generated code block at $file line $s"
 106         unless $found;
 107       next;
 108     } else {
 109       my ($res) = &$sub;
 110       next if $res;
 111     }
 112     $buffer .= $_;
 113   }
 114   close IN;
 115   return $buffer;
 116 }
 117
 118 # Parse a PROPERTIES() block
 119 sub process_properties ($$$) {
 120   my ($file, $start_line, $props_text) = @_;
 121   my ($errline)="$file:$start_line";
 122   $props_text =~ s/^.*PROPERTIES\s*($nested_parentheses)//s
 123     or die "Malformed PROPERTIES, $errline: expected PROPERTIES(args)";
 124   my ($args) = $1;
 125   $args =~ s/^\(//g;
 126   $args =~ s/\)$//g;
 127   my (@args) = split /,/, $args;
 128   @args == 2 or die "PROPERTIES needs two arguments at $errline";
 129   my ($struct_name, $class) = @args;
 130
 131   $props_text =~ m/^\s*($nested_curly_brackets)\s*$/s
 132     or die "Malformed PROPERTIES, $errline: expected {} after PROPERTIES";
 133   my ($body) = $1;
 134   $body =~ s/^{(.*)}$/$1/s; # get rid of curly brackets
 135   my (@stmts) = split /;\s*\n/s, $body; # split on ";"
 136   my (@typedecls) = ();
 137   my (@vars) = ();
 138   foreach my $s (@stmts) {
 139     my ($s, $cmt) = sepcomment $s;
 140     $cmt = stripws $cmt;
 141     if($s =~ /^\s*$/s) { # extra ";"
 142       next;
 143     } elsif($s =~ /DAI_ENUM|typedef/) {
 144       push @typedecls, [stripws $s, $cmt];
 145     } else {
 146       $s =~ /^\s*[a-zA-Z_][\w:]+\s*$nested_angle_brackets?/
 147         or die "Couldn't match statement $s in PROPERTIES at $errline";
 148       my $type = stripws $&;
 149       my $name = stripws $';
 150       my $default = undef;
 151       if($name =~ /^(.*)=(.*)$/) {
 152         $name = stripws $1;
 153         $default = stripws $2;
 154       }
 155       push @vars, [$type, $name, $default, $cmt];
 156     }
 157   }
 158
 159   my ($stext) = "";
 160   my ($text) = <<EOF;
 161         struct Properties {
 162 EOF
 163   my $indent = (' 'x12);
 164   for my $d (@typedecls) {
 165     my ($decl,$cmt) = @$d;
 166     if($cmt ne '') {
 167       $text .= join("\n", map { "$indent$_" } split /\n/s, $cmt)."\n";
 168     }
 169     $text .= "$indent$decl;\n"
 170   }
 171   for my $v (@vars) {
 172     my ($type,$name,$default,$cmt) = @$v;
 173     if($cmt ne '') {
 174       $text .= join("\n", map { "$indent$_" } split /\n/s, $cmt)."\n"
 175     }
 176     $text .= "$indent$type $name;\n";
 177   }
 178
 179   $text .= <<EOF;
 180
 181             /// Set members from PropertySet
 182             void set(const PropertySet &opts);
 183             /// Get members into PropertySet
 184             PropertySet get() const;
 185             /// Convert to a string which can be parsed as a PropertySet
 186             std::string toString() const;
 187         } $struct_name;
 188 EOF
 189
 190   $stext .= <<EOF;
 191 namespace dai {
 192
 193 void ${class}::Properties::set(const PropertySet &opts)
 194 {
 195     const std::set<PropertyKey> &keys = opts.allKeys();
 196     std::set<PropertyKey>::const_iterator i;
 197     for(i=keys.begin(); i!=keys.end(); i++) {
 198 EOF
 199   for my $v (@vars) {
 200     my ($type,$name,$default,$cmt) = @$v;
 201     $stext .= <<EOF;
 202         if(*i == "$name") continue;
 203 EOF
 204   }
 205   $stext .= <<EOF;
 206         DAI_THROWE(UNKNOWN_PROPERTY_TYPE, "$class: Unknown property " + *i);
 207     }
 208 EOF
 209   for my $v (@vars) {
 210     my ($type,$name,$default,$cmt) = @$v;
 211     if(!defined $default) {
 212       $stext .= <<EOF;
 213     if(!opts.hasKey("$name"))
 214         DAI_THROWE(NOT_ALL_PROPERTIES_SPECIFIED,"$class: Missing property \\\"$name\\\" for method \\\"\Q$class\E\\\"");
 215 EOF
 216     }
 217
 218   }
 219   $stext .= <<EOF;
 220 EOF
 221   for my $v (@vars) {
 222     my ($type,$name,$default,$cmt) = @$v;
 223     if(defined $default) {
 224       $stext .= <<EOF;
 225     if(opts.hasKey("$name")) {
 226         $name = opts.getStringAs<$type>("$name");
 227     } else {
 228         $name = $default;
 229     }
 230 EOF
 231     } else {
 232       $stext .= <<EOF;
 233     $name = opts.getStringAs<$type>("$name");
 234 EOF
 235     }
 236   }
 237
 238   $stext .= <<EOF;
 239 }
 240 PropertySet ${class}::Properties::get() const {
 241     PropertySet opts;
 242 EOF
 243
 244   for my $v (@vars) {
 245     my ($type,$name,$default,$cmt) = @$v;
 246 #     $text .= qq{opts.set("$name", $name);};
 247     $stext .= <<EOF;
 248     opts.Set("$name", $name);
 249 EOF
 250
 251   }
 252   $stext .= <<EOF;
 253     return opts;
 254 }
 255 string ${class}::Properties::toString() const {
 256     stringstream s(stringstream::out);
 257     s << "[";
 258 EOF
 259
 260   my ($i)=0;
 261   for my $v (@vars) {
 262     my ($type,$name,$default,$cmt) = @$v;
 263     $i++;
 264     my $c = ($i<@vars)?" << \",\"":"";
 265       $stext .= <<EOF;
 266     s << "$name=" << $name$c;
 267 EOF
 268   }
 269
 270   $stext .= <<EOF;
 271     s << "]";
 272     return s.str();
 273 }
 274 } // end of namespace dai
 275 EOF
 276   return ($gen_code_start.$text.$gen_code_end, $gen_code_start.$stext.$gen_code_end);
 277 }
 278
 279 # ----------------------------------------------------------------
 280 # Main loop
 281
 282 $source_buffer = process_file { return 0; } $source_file;
 283 $source_buffer =~ s/\n+$//s;
 284
 285 $header_buffer = process_file {
 286   if (/$props_start_pat/) {
 287     # when we see something resembling properties, record it, and when we
 288     # get to the end, process and emit the generated code
 289     my $start_line = $.;
 290     my $props_text = $_;
 291     while (<IN>) {
 292       last if(m(\*/));
 293       $props_text .= $_;
 294     }
 295     $buffer .= $props_text;
 296     $buffer .= $_;
 297     my ($htext, $stext) = process_properties($header_file, $start_line, $props_text);
 298     $buffer .= $htext;
 299     $source_buffer .= "\n\n\n".$stext;
 300     return 1;
 301   }
 302   return 0;
 303 } $header_file;
 304
 305 # Write new contents of files to temporary locations
 306 my $header_tmp = "$header_file.new";
 307 my $source_tmp = "$source_file.new";
 308 writefile ($header_buffer, $header_tmp);
 309 writefile ($source_buffer, $source_tmp);
 310
 311 # Get a diff of changes, show it to the user, and ask for confirmation
 312 my ($diff);
 313 $diff = getdiff ($header_file, $header_tmp);
 314 $diff .= getdiff ($source_file, $source_tmp);
 315
 316 if($diff eq '') {
 317   warn "No differences\n";
 318 } else {
 319   my $pager = $ENV{PAGER} || "less";
 320   open PAGER, "|$pager";
 321   print PAGER $diff;
 322   close PAGER;
 323
 324   print STDERR "Replace old with new version? (y|N) ";
 325   $_=<>;
 326   if (/^y/i) {
 327     myrename($header_tmp, $header_file);
 328     myrename($source_tmp, $source_file);
 329   } else {
 330     warn "Aborted\n";
 331   }
 332 }