tools/winapi/winapi_fixup_editor.pm

   1 #
   2 # Copyright 1999, 2000, 2001 Patrik Stridvall
   3 #
   4 # This library is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU Lesser General Public
   6 # License as published by the Free Software Foundation; either
   7 # version 2.1 of the License, or (at your option) any later version.
   8 #
   9 # This library is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 # Lesser General Public License for more details.
  13 #
  14 # You should have received a copy of the GNU Lesser General Public
  15 # License along with this library; if not, write to the Free Software
  16 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
  17 #
  18
  19 package winapi_fixup_editor;
  20
  21 use strict;
  22
  23 use options qw($options);
  24 use output qw($output);
  25 use winapi qw($win16api $win32api @winapis);
  26
  27 use util;
  28
  29 sub new($$) {
  30     my $proto = shift;
  31     my $class = ref($proto) || $proto;
  32     my $self  = {};
  33     bless ($self, $class);
  34
  35     my $file = \${$self->{FILE}};
  36
  37     $$file = shift;
  38
  39     return $self;
  40 }
  41
  42 sub add_trigger($$$) {
  43     my $self = shift;
  44
  45     my $triggers = \%{$self->{TRIGGERS}};
  46
  47     my $line = shift;
  48     my $action = shift;
  49
  50     if(!defined($$triggers{$line})) {
  51         $$triggers{$line} = [];
  52     }
  53
  54     push @{$$triggers{$line}}, $action;
  55 }
  56
  57 sub replace($$$$$$) {
  58     my $self = shift;
  59
  60     my $begin_line = shift;
  61     my $begin_column = shift;
  62     my $end_line = shift;
  63     my $end_column = shift;
  64     my $replace = shift;
  65
  66     my $file = \${$self->{FILE}};
  67
  68     my $line = $begin_line;
  69     my $action = {};
  70
  71     $self->add_trigger($begin_line, {
  72         type => "replace",
  73         begin_line => $begin_line,
  74         begin_column => $begin_column,
  75         end_line => $end_line,
  76         end_column => $end_column,
  77         replace => $replace
  78     });
  79 }
  80
  81 sub flush($) {
  82     my $self = shift;
  83
  84     my $file = \${$self->{FILE}};
  85     my $triggers = \%{$self->{TRIGGERS}};
  86
  87     my $editor = sub {
  88         local *IN = shift;
  89         local *OUT = shift;
  90
  91         my $modified = 0;
  92
  93         my $again = 0;
  94         my $lookahead = 0;
  95         my $lookahead_count = 0;
  96         LINE: while($again || defined(my $current = <IN>)) {
  97             if(!$again) {
  98                 chomp $current;
  99
 100                 if($lookahead) {
 101                     $lookahead = 0;
 102                     $_ .= "\n" . $current;
 103                     $lookahead_count++;
 104                 } else {
 105                     $_ = $current;
 106                     $lookahead_count = 0;
 107                 }
 108             } else {
 109                 $lookahead_count = 0;
 110                 $again = 0;
 111             }
 112
 113             my $line = $. - $lookahead_count;
 114             foreach my $action (@{$$triggers{$line}}) {
 115                 if($. < $action->{end_line}) {
 116                     $lookahead = 1;
 117                     next LINE;
 118                 }
 119
 120                 my $type = $action->{type};
 121                 my $begin_line = $action->{begin_line};
 122                 my $begin_column = $action->{begin_column};
 123                 my $end_line = $action->{end_line};
 124                 my $end_column = $action->{end_column};
 125
 126                 if($type eq "replace") {
 127                     my $replace = $action->{replace};
 128
 129                     my @lines = split(/\n/, $_);
 130                     if($#lines < 0) {
 131                         @lines = ($_);
 132                     }
 133
 134                     my $begin = "";
 135                     my $column = 0;
 136                     $_ = $lines[0];
 137                     while($column < $begin_column - 1 && s/^.//) {
 138                         $begin .= $&;
 139                         if($& eq "\t") {
 140                             $column = $column + 8 - $column % 8;
 141                         } else {
 142                             $column++;
 143                         }
 144                     }
 145
 146                     my $column2 = 0;
 147                     $_ = $lines[$#lines];
 148                     while($column2 < $end_column && s/^.//) {
 149                         if($& eq "\t") {
 150                             $column2 = $column2 + 8 - $column2 % 8;
 151                         } else {
 152                             $column2++;
 153                         }
 154                     }
 155                     my $end = $_;
 156
 157                     $_ = "$begin$replace$end";
 158                     if($options->modify) {
 159                         $modified = 1;
 160                     } else {
 161                         $output->write("$$file:$begin_line.$begin_column-$end_line.$end_column: $replace\n");
 162                     }
 163                 }
 164             }
 165
 166             print OUT "$_\n";
 167         }
 168
 169         return $modified;
 170     };
 171
 172     my $modified = 0;
 173     if(1) {
 174         $modified = edit_file($$file, $editor);
 175     }
 176
 177     if(!$modified) {
 178         $self->flush_old;
 179     }
 180 }
 181
 182 ########################################################################
 183 # Hack for backward compabillity
 184 #
 185
 186 my %insert_line;
 187 my %substitute_line;
 188 my %delete_line;
 189
 190 my %spec_file;
 191
 192 sub flush_old($) {
 193     my $self = shift;
 194
 195     my $file = ${$self->{FILE}};
 196
 197     my $editor = sub {
 198         local *IN = shift;
 199         local *OUT = shift;
 200
 201         my $modified = 0;
 202         while(<IN>) {
 203             chomp;
 204
 205             my $line;
 206
 207             $line = $insert_line{$.};
 208             if(defined($line)) {
 209                 if($options->modify) {
 210                     $_ = "$line$_";
 211                     $modified = 1;
 212                 } else {
 213                     my $line2 = $line; chomp($line2);
 214                     my @line2 = split(/\n/, $line2);
 215                     if($#line2 > 0) {
 216                         $output->write("$file: $.: insert: \\\n");
 217                         foreach my $line2 (@line2) {
 218                             $output->write("'$line2'\n");
 219                         }
 220                     } else {
 221                         $output->write("$file: $.: insert: '$line2'\n");
 222                     }
 223                 }
 224             }
 225
 226             my $search = $substitute_line{$.}{search};
 227             my $replace = $substitute_line{$.}{replace};
 228
 229             if(defined($search) && defined($replace)) {
 230                 my $modified2 = 0;
 231                 if(s/$search/$replace/) {
 232                     if($options->modify) {
 233                         $modified = 1;
 234                     }
 235                     $modified2 = 1;
 236                 }
 237
 238                 if(!$options->modify || !$modified2) {
 239                     my $search2;
 240                     my $replace2;
 241                     if(!$modified2) {
 242                         $search2 = "unmatched search";
 243                         $replace2 = "unmatched replace";
 244                     } else {
 245                         $search2 = "search";
 246                         $replace2 = "replace";
 247                     }
 248                     $output->write("$file: $.: $search2 : '$search'\n");
 249
 250                     my @replace2 = split(/\n/, $replace);
 251                     if($#replace2 > 0) {
 252                         $output->write("$file: $.: $replace2: \\\n");
 253                         foreach my $replace2 (@replace2) {
 254                             $output->write("'$replace2'\n");
 255                         }
 256                     } else {
 257                         $output->write("$file: $.: $replace2: '$replace'\n");
 258                     }
 259                 }
 260             }
 261
 262             $line = $delete_line{$.};
 263             if(defined($line)) {
 264                 if(/$line/) {
 265                     if($options->modify) {
 266                         $modified = 1;
 267                         next;
 268                     } else {
 269                         $output->write("$file: $.: delete: '$line'\n");
 270                     }
 271                 } else {
 272                     $output->write("$file: $.: unmatched delete: '$line'\n");
 273                 }
 274             }
 275
 276             print OUT "$_\n";
 277         }
 278
 279         return $modified;
 280     };
 281
 282     my $n = 0;
 283     while(defined(each %insert_line)) { $n++; }
 284     while(defined(each %substitute_line)) { $n++; }
 285     while(defined(each %delete_line)) { $n++; }
 286     if($n > 0) {
 287         edit_file($file, $editor);
 288     }
 289
 290     foreach my $module (sort(keys(%spec_file))) {
 291         my $file;
 292         foreach my $winapi (@winapis) {
 293             $file = ($winapi->module_file($module) || $file);
 294         }
 295
 296         if(defined($file)) {
 297             $file = file_normalize($file);
 298         }
 299
 300         my @substitutes = @{$spec_file{$module}};
 301
 302         my $editor = sub {
 303             local *IN = shift;
 304             local *OUT = shift;
 305
 306             my $modified = 0;
 307             while(<IN>) {
 308                 chomp;
 309
 310                 my @substitutes2 = ();
 311                 foreach my $substitute (@substitutes) {
 312                     my $search = $substitute->{search};
 313                     my $replace = $substitute->{replace};
 314
 315                     if(s/$search/$replace/) {
 316                         if($options->modify) {
 317                             $modified = 1;
 318                         } else {
 319                             $output->write("$file: search : '$search'\n");
 320                             $output->write("$file: replace: '$replace'\n");
 321                         }
 322                         next;
 323                     } else {
 324                         push @substitutes2, $substitute;
 325                     }
 326                 }
 327                 @substitutes = @substitutes2;
 328
 329                 print OUT "$_\n";
 330             }
 331
 332             return $modified;
 333         };
 334
 335         if(defined($file)) {
 336             edit_file($file, $editor);
 337         } else {
 338             $output->write("$module: doesn't have any spec file\n");
 339         }
 340
 341         if($#substitutes >= 0) {
 342             foreach my $substitute (@substitutes) {
 343                 my $search = $substitute->{search};
 344                 my $replace = $substitute->{replace};
 345
 346                 $output->write("$file: unmatched search : '$search'\n");
 347                 $output->write("$file: unmatched replace: '$replace'\n");
 348             }
 349         }
 350
 351     }
 352
 353     %insert_line = ();
 354     %substitute_line = ();
 355     %delete_line = ();
 356
 357     %spec_file = ();
 358 }
 359
 360 sub delete_line($$$) {
 361     my $self = shift;
 362
 363     my $line = shift;
 364     my $pattern = shift;
 365
 366     $delete_line{$line} = $pattern;
 367 }
 368
 369 sub insert_line($$$) {
 370     my $self = shift;
 371
 372     my $line = shift;
 373     my $insert = shift;
 374
 375     $insert_line{$line} = $insert;
 376 }
 377
 378 sub substitute_line($$$$) {
 379     my $self = shift;
 380
 381     my $line = shift;
 382     my $search = shift;
 383     my $replace = shift;
 384
 385     $substitute_line{$line}{search} = $search;
 386     $substitute_line{$line}{replace} = $replace;
 387 }
 388
 389 sub replace_spec_file($$$$) {
 390     my $self = shift;
 391
 392     my $module = shift;
 393     my $search = shift;
 394     my $replace = shift;
 395
 396     my $substitute = {};
 397     $substitute->{search} = $search;
 398     $substitute->{replace} = $replace;
 399
 400     if(!defined($spec_file{$module})) {
 401         $spec_file{$module} = [];
 402     }
 403
 404     push @{$spec_file{$module}}, $substitute;
 405 }
 406
 407 1;