TAO/bin/rm_exception_macros.pl

   1 eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
   2     & eval 'exec perl -w -S $0 $argv:q'
   3     if 0;
   4
   5 # ******************************************************************
   6 #      Author: Chad Elliott
   7 #        Date: 1/24/2007
   8 # Description: This script attempts to remove the ACE related exception
   9 #              macros from source code provided on the command line.  It
  10 #              is not perfect, but does handle a large number of cases.
  11 #              You may need to hand edit files after running this
  12 #              script.
  13 # ******************************************************************
  14
  15 # ******************************************************************
  16 # Pragma Section
  17 # ******************************************************************
  18
  19 use strict;
  20 use FileHandle;
  21 use File::Basename;
  22
  23 # ******************************************************************
  24 # Data Section
  25 # ******************************************************************
  26
  27 my(%macros) = ('ACE_ENV_TYPE'                  => 'CORBA::Environment',
  28                'ACE_TRY_ENV'                   => '_ACE_CORBA_Environment_variable',
  29                'ACE_EXCEPTION_TYPE'            => 'CORBA::Exception',
  30                'ACE_DEFAULT_GET_ENV_METHOD'    => 'TAO_default_environment',
  31                'ACE_DECLARE_NEW_ENV'           => '',
  32                'ACE_DECLARE_NEW_CORBA_ENV'     => '',
  33                'ACE_CHECK *\(.*\)'             => '',
  34                'ACE_CHECK'                     => '',
  35                'ACE_CHECK_RETURN *\(.*\)'      => '',
  36                'ACE_THROW_INT *\((.*)\)'       => 'throw $1',
  37                'ACE_THROW *\((.*)\)'           => 'throw $1',
  38                'ACE_THROW_RETURN *\((.*),.+\)' => 'throw $1',
  39                'ACE_THROW_SPEC *\((.*)\)'      => '',
  40                'ACE_TRY'                       => 'try',
  41                'ACE_TRY_NEW_ENV'               => 'try',
  42                'ACE_TRY_EX *\([^\)]+\)'        => 'try',
  43                'ACE_TRY_CHECK'                 => '',
  44                'ACE_TRY_CHECK_EX *\([^\)]+\)'  => '',
  45                'ACE_TRY_THROW *\((.*)\)'       => 'throw $1',
  46                'ACE_TRY_THROW_EX *\((.*),.+\)' => 'throw $1',
  47                'ACE_CATCH *\((.*),(.+)\)'      => 'catch (const $1& $2)',
  48                'ACE_CATCHANY'                  => 'catch (const CORBA::Exception& ex)',
  49                'ACE_CATCHALL'                  => 'catch (...)',
  50                'ACE_RETHROW'                   => 'throw',
  51                'ACE_RE_THROW'                  => 'throw',
  52                'ACE_RE_THROW_EX *\(.+\)'       => 'throw',
  53                'ACE_ENDTRY'                    => '',
  54                'ACE_ENV_RAISE *\((.+)\)'       => '$1->_raise ()',
  55                'ACE_PRINT_TAO_EXCEPTION *\(([^,]+),(.+)\)' => '$1._tao_print_exception ($2)',
  56                'ACE_PRINT_EXCEPTION *\(([^,]+),(.+)\)'     => '$1._tao_print_exception ($2)',
  57                'TAO_INTERCEPTOR_CHECK_RETURN *\(.*\)'      => '',
  58                'TAO_INTERCEPTOR_CHECK'                     => '',
  59               );
  60 my(@keys)   = sort { length($b) <=> length($a) } keys %macros;
  61
  62 # ******************************************************************
  63 # Subroutine Section
  64 # ******************************************************************
  65
  66 sub process_file {
  67   my($file)   = shift;
  68   my($fh)     = new FileHandle();
  69   my($status) = 0;
  70
  71   if (open($fh, $file)) {
  72     my(@lines) = ();
  73     my($mod)   = undef;
  74     my($line)  = '';
  75     my($cont_until_this) = undef;
  76     while(<$fh>) {
  77       my($part) = $_;
  78       $part =~ s/\s+$//;
  79
  80       if ($cont_until_this) {
  81         if ($part =~ s/^\s+// && $line =~ /[,\)]$/) {
  82           $part = ' ' . $part;
  83         }
  84         $line .= $part;
  85         if (index($part, $cont_until_this) >= 0) {
  86           $cont_until_this = undef;
  87         }
  88         else {
  89           next;
  90         }
  91       }
  92       else {
  93         $line = $part;
  94       }
  95
  96       my($skip_blank) = undef;
  97       foreach my $key (@keys) {
  98         my($ats)    = (index($key, 'ACE_THROW_SPEC') == 0);
  99         my($search) = ($ats ? '))' : ';');
 100         my($base)   = undef;
 101         if ($key =~ /^([^\s]+\s\*\\\()/) {
 102           $base = $1;
 103         }
 104
 105         if ($line =~ /^(\s*)?($key\s*[;]?)/) {
 106           my($space)  = $1;
 107           my($rest)   = $2;
 108           my($first)  = $3 || '';
 109           my($second) = $4 || '';
 110           my($val)    = $macros{$key};
 111           while($val =~ /\$(\d+)/) {
 112             my($num) = $1;
 113             if ($num == 1) {
 114               $first =~ s/^\s+//;
 115               $first =~ s/\s+$//;
 116               $val =~ s/\$1/$first/;
 117             }
 118             elsif ($num == 2) {
 119               $second =~ s/^\s+//;
 120               $second =~ s/\s+$//;
 121               $val =~ s/\$2/$second/;
 122             }
 123             else {
 124               $val =~ s/\$\d+//;
 125             }
 126           }
 127
 128           $line =~ s/^(\s*)?($key\s*[;]?)//;
 129
 130           ## A special concession for ACE_THROW_SPEC.  In the header
 131           ## we want to ensure that the semi-colon is preserved and if
 132           ## possible placed on the previous line.  In the source file
 133           ## we want the whole thing to go away.
 134           $val .= ';' if (($ats || $val ne '') && $rest =~ /;$/);
 135           if ($ats && index($val, ';') == 0 &&
 136               !($lines[$#lines] =~ /\/\/.*$/ ||
 137                 $lines[$#lines] =~ /\/\*.*\*\/$/)) {
 138             $lines[$#lines] .= $val;
 139             $line = '';
 140           }
 141           else {
 142             $line = $space . $val . $line;
 143             $line =~ s/^\s+$//;
 144           }
 145
 146           ## Fix up problems where ACE_TRY_THROW is used
 147           ## on a line by itself with the parenthesis following
 148           ## on the second line.  The parser gets confused and
 149           ## thinks it needs to replace the ACE_TRY
 150           if ($key eq 'ACE_TRY') {
 151             $line =~ s/try_THROW/throw/g;
 152           }
 153
 154           my($len) = length($line);
 155           if ($len > 78 || $line =~ /""/) {
 156             my($level) = 0;
 157             my($indouble) = 0;
 158             my($pch) = '';
 159             my($fix_ace_text) = undef;
 160             for(my $i = 0; $i < $len; $i++) {
 161               my($ch) = substr($line, $i, 1);
 162               if ($ch eq '"' && $pch ne '\\') {
 163                 $indouble ^= 1;
 164               }
 165               if (!$indouble) {
 166                 my($nch) = substr($line, $i + 1, 1);
 167                 if ($ch eq ',' || ($ch eq '"' && $nch eq '"') || $ch eq '(') {
 168                   $level++ if ($ch eq '(');
 169                   $fix_ace_text = (substr($line, 0, $i) =~ /ACE_TEXT\s*$/);
 170                   if ($nch ne ')' && !$fix_ace_text) {
 171                     my($add) = "\n" . $space . ('  ' x $level);
 172                     my($start) = 0;
 173                     while(substr($line, $i + 1 + $start, 1) =~ /\s/) {
 174                       $start++;
 175                     }
 176                     substr($line, $i + 1, $start) = $add;
 177                     $i += length($add) - $start;
 178                     $len += length($add) - $start;
 179                   }
 180                 }
 181                 elsif ($ch eq ')') {
 182                   $level--;
 183                   if ($fix_ace_text) {
 184                     if (substr($line, $i) =~ /ACE_TEXT/) {
 185                       my($add) = "\n" . $space . ('  ' x $level);
 186                       my($start) = 0;
 187                       while(substr($line, $i + 1 + $start, 1) =~ /\s/) {
 188                         $start++;
 189                       }
 190                       substr($line, $i + 1, $start) = $add;
 191                       $i += length($add) - $start;
 192                       $len += length($add) - $start;
 193                     }
 194                     $fix_ace_text = undef;
 195                   }
 196                 }
 197               }
 198               $pch = $ch;
 199             }
 200           }
 201
 202           $mod = 1;
 203           $skip_blank = 1;
 204           last;
 205         }
 206         elsif (defined $base &&
 207                index($line, $search) == -1 && $line =~ /^(\s*)?$base/) {
 208           $cont_until_this = $search;
 209           last;
 210         }
 211       }
 212
 213       if ($line =~ s/ACE_ANY_EXCEPTION/ex/g) {
 214         $mod = 1;
 215       }
 216       if (!$cont_until_this) {
 217         if ($line =~ s/(\s*)ACE_ENV(_SINGLE)?_ARG_DECL_WITH_DEFAULTS// ||
 218             $line =~ s/(\s*)ACE_ENV(_SINGLE)?_ARG_DECL_NOT_USED// ||
 219             $line =~ s/(\s*)ACE_ENV(_SINGLE)?_ARG_DECL// ||
 220             $line =~ s/(\s*)ACE_ENV(_SINGLE)?_ARG_(PARAMETER|NOT_USED)//) {
 221           my($sp) = $1;
 222           if ($line =~ /^\)/) {
 223             if ($lines[$#lines] =~ /\/\/.*$/ ||
 224                 $lines[$#lines] =~ /\/\*.*\*\/$/) {
 225               $line = $sp . $line;
 226             }
 227             else {
 228               $lines[$#lines] .= $line;
 229               $line = '';
 230             }
 231           }
 232           $mod = 1;
 233           $skip_blank = 1;
 234         }
 235         push(@lines, $line) if ($line ne '' || !$skip_blank);
 236       }
 237     }
 238     close($fh);
 239
 240     if ($mod) {
 241       if (open($fh, ">$file")) {
 242         foreach my $line (@lines) {
 243           print $fh $line, "\n";
 244         }
 245         close($fh);
 246       }
 247       else {
 248         print "ERROR: Unable to write to $file\n";
 249         $status++;
 250       }
 251     }
 252   }
 253   else {
 254     print "ERROR: Unable to open $file\n";
 255     $status++;
 256   }
 257
 258   return $status;
 259 }
 260
 261 sub process {
 262   my($arg)    = shift;
 263   my($status) = 0;
 264
 265   if (-d $arg) {
 266     my($fh)  = new FileHandle();
 267     if (opendir($fh, $arg)) {
 268       foreach my $file (grep(!/^\.\.?$/, readdir($fh))) {
 269         if ($file ne '.svn') {
 270           $status += process($arg . '/' . $file);
 271         }
 272       }
 273       closedir($fh);
 274     }
 275   }
 276   elsif ($arg =~ /\.(h|hh|hpp|hxx|hh|cpp|cxx|cc|c|C|i|ipp|inl)$/) {
 277     $status += process_file($arg);
 278   }
 279
 280   return $status;
 281 }
 282
 283 sub usageAndExit {
 284   print "Usage: ", basename($0), " [directories or files]\n\n",
 285         "Removes all exception related ACE macros.\n";
 286   exit(0);
 287 }
 288
 289 # ******************************************************************
 290 # Main Section
 291 # ******************************************************************
 292
 293 my($status) = 0;
 294
 295 if ($#ARGV == -1) {
 296   usageAndExit();
 297 }
 298
 299 foreach my $arg (@ARGV) {
 300   if (index($arg, '-') == 0) {
 301     usageAndExit();
 302   }
 303   else {
 304     $status += process($arg);
 305   }
 306 }
 307
 308 exit($status);