Porting/fixCORE

   1 #!/usr/local/bin/perl -w
   2 use Data::Dumper;
   3
   4 my $targ = shift;
   5 my $inc  = join(' ',map("-I$_",@INC));
   6
   7 my $work = 1;
   8 while ($work)
   9  {
  10   open(PIPE,"$^X -w $inc -M$targ -e '' 2>&1 |") || die "Cannot open pipe to child:$!";
  11   my %fix;
  12   while (<PIPE>)
  13    {
  14     if (/^Ambiguous call resolved as CORE::(\w+)\(\), qualify as such or use \& at (\S+) line (\d+)/
  15          && -f $2 )
  16      {
  17       my ($var,$file,$line) = ($1,$2,$3);
  18       $fix{$file} = [] unless exists $fix{$file};
  19       push(@{$fix{$file}},[$line => $var]) unless ($var =~ /^PL_/ || $file =~ /\.h$/);
  20      }
  21     print;
  22    }
  23   close(PIPE);
  24 # warn "Make retured $?\n";
  25 # last unless $?;
  26   my $changed = 0;
  27   foreach my $file (keys %fix)
  28    {
  29     my @ar = sort( { $a->[0] <=> $b->[0] } @{delete $fix{$file}});
  30     my @miss;
  31     my $fixed = 0;
  32     @ARGV = ($file);
  33     $. = 0;
  34     local $^I = '.sav';
  35     while (<>)
  36      {
  37       while (@ar && $. == $ar[0][0])
  38        {
  39         my ($line,$var) = @{shift(@ar)};
  40         if (s/(?<!CORE::)\b$var\b(?=\s*\()/CORE::$var/)
  41          {
  42           warn "$file:$line: FIX $var\n";
  43           $fixed++;
  44           $changed++;
  45          }
  46         else
  47          {
  48           push(@miss,[$line,$var,$_]);
  49          }
  50        }
  51       print;
  52      }
  53     unless ($fixed)
  54      {
  55       rename("$file$^I",$file);
  56       if (@miss)
  57        {
  58         while (@miss)
  59          {
  60           my ($line,$var,$txt) = @{shift(@miss)};
  61           warn "$file:$line:$var | $txt";
  62          }
  63        }
  64      }
  65    }
  66   last unless $changed;
  67  }
  68