| 1 | #!/usr/bin/perl
|
|---|
| 2 |
|
|---|
| 3 | # rename identifiers (functions, types, enum constant, etc)
|
|---|
| 4 | # on upgrades of major version according to a list
|
|---|
| 5 |
|
|---|
| 6 | use warnings;
|
|---|
| 7 | use strict;
|
|---|
| 8 |
|
|---|
| 9 | use utf8;
|
|---|
| 10 | use open qw(:std utf8);
|
|---|
| 11 |
|
|---|
| 12 | my $usage = "Usage: $0 [-f datafile] [-s] [--] [filenames...]\n";
|
|---|
| 13 |
|
|---|
| 14 | (my $datafile = $0) =~ s/rename.pl$/data_files\/rename-1.3-2.0.txt/;
|
|---|
| 15 | my $do_strings = 0;
|
|---|
| 16 |
|
|---|
| 17 | while( @ARGV && $ARGV[0] =~ /^-/ ) {
|
|---|
| 18 | my $opt = shift;
|
|---|
| 19 | if( $opt eq '--' ) {
|
|---|
| 20 | last;
|
|---|
| 21 | } elsif( $opt eq '-f' ) {
|
|---|
| 22 | $datafile = shift;
|
|---|
| 23 | } elsif( $opt eq '-s' ) {
|
|---|
| 24 | $do_strings = 1; shift;
|
|---|
| 25 | } else {
|
|---|
| 26 | die $usage;
|
|---|
| 27 | }
|
|---|
| 28 | }
|
|---|
| 29 |
|
|---|
| 30 | my %subst;
|
|---|
| 31 | open my $nfh, '<', $datafile or die "Could not read $datafile\n";
|
|---|
| 32 | my $ident = qr/[_A-Za-z][_A-Za-z0-9]*/;
|
|---|
| 33 | while( my $line = <$nfh> ) {
|
|---|
| 34 | chomp $line;
|
|---|
| 35 | my ( $old, $new ) = ( $line =~ /^($ident)\s+($ident)$/ );
|
|---|
| 36 | if( ! $old || ! $new ) {
|
|---|
| 37 | die "$0: $datafile:$.: bad input '$line'\n";
|
|---|
| 38 | }
|
|---|
| 39 | $subst{$old} = $new;
|
|---|
| 40 | }
|
|---|
| 41 | close $nfh or die;
|
|---|
| 42 |
|
|---|
| 43 | my $string = qr/"(?:\\.|[^\\"])*"/;
|
|---|
| 44 | my $space = qr/\s+/;
|
|---|
| 45 | my $idnum = qr/[a-zA-Z0-9_]+/;
|
|---|
| 46 | my $symbols = qr/[-!#\$%&'()*+,.\/:;<=>?@[\\\]^_`{|}~]+|"/;
|
|---|
| 47 |
|
|---|
| 48 | # if we replace inside strings, we don't consider them a token
|
|---|
| 49 | my $token = $do_strings ? qr/$space|$idnum|$symbols/
|
|---|
| 50 | : qr/$string|$space|$idnum|$symbols/;
|
|---|
| 51 |
|
|---|
| 52 | my %warnings;
|
|---|
| 53 |
|
|---|
| 54 | while( my $filename = shift )
|
|---|
| 55 | {
|
|---|
| 56 | print STDERR "$filename... ";
|
|---|
| 57 | if( -d $filename ) { print STDERR "skip (directory)\n"; next }
|
|---|
| 58 |
|
|---|
| 59 | open my $rfh, '<', $filename or die;
|
|---|
| 60 | my @lines = <$rfh>;
|
|---|
| 61 | close $rfh or die;
|
|---|
| 62 |
|
|---|
| 63 | my @out;
|
|---|
| 64 | for my $line (@lines) {
|
|---|
| 65 | if( $line =~ /#include/ ) {
|
|---|
| 66 | $line =~ s/polarssl/mbedtls/;
|
|---|
| 67 | $line =~ s/POLARSSL/MBEDTLS/;
|
|---|
| 68 | push( @out, $line );
|
|---|
| 69 | next;
|
|---|
| 70 | }
|
|---|
| 71 |
|
|---|
| 72 | my @words = ($line =~ /$token/g);
|
|---|
| 73 | my $checkline = join '', @words;
|
|---|
| 74 | if( $checkline eq $line ) {
|
|---|
| 75 | my @new = map { exists $subst{$_} ? $subst{$_} : $_ } @words;
|
|---|
| 76 | push( @out, join '', @new );
|
|---|
| 77 | } else {
|
|---|
| 78 | $warnings{$filename} = [] unless $warnings{$filename};
|
|---|
| 79 | push @{ $warnings{$filename} }, $line;
|
|---|
| 80 | push( @out, $line );
|
|---|
| 81 | }
|
|---|
| 82 | }
|
|---|
| 83 |
|
|---|
| 84 | open my $wfh, '>', $filename or die;
|
|---|
| 85 | print $wfh $_ for @out;
|
|---|
| 86 | close $wfh or die;
|
|---|
| 87 | print STDERR "done\n";
|
|---|
| 88 | }
|
|---|
| 89 |
|
|---|
| 90 | if( %warnings ) {
|
|---|
| 91 | print "\nWarning: lines skipped due to unexpected characters:\n";
|
|---|
| 92 | for my $filename (sort keys %warnings) {
|
|---|
| 93 | print "in $filename:\n";
|
|---|
| 94 | print for @{ $warnings{$filename} };
|
|---|
| 95 | }
|
|---|
| 96 | }
|
|---|