rename.pl 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122
  1. #!/usr/bin/perl
  2. #
  3. # This file is part of mbed TLS (https://tls.mbed.org)
  4. #
  5. # Copyright (c) 2015-2016, ARM Limited, All Rights Reserved
  6. #
  7. # Purpose
  8. #
  9. # This script migrates application source code from the mbed TLS 1.3 API to the
  10. # mbed TLS 2.0 API.
  11. #
  12. # The script processes the given source code and renames identifiers - functions
  13. # types, enums etc, as
  14. #
  15. # Usage: rename.pl [-f datafile] [-s] [--] [filenames...]
  16. #
  17. use warnings;
  18. use strict;
  19. use utf8;
  20. use Path::Class;
  21. use open qw(:std utf8);
  22. my $usage = "Usage: $0 [-f datafile] [-s] [--] [filenames...]\n";
  23. (my $datafile = $0) =~ s/rename.pl$/data_files\/rename-1.3-2.0.txt/;
  24. my $do_strings = 0;
  25. while( @ARGV && $ARGV[0] =~ /^-/ ) {
  26. my $opt = shift;
  27. if( $opt eq '--' ) {
  28. last;
  29. } elsif( $opt eq '-f' ) {
  30. $datafile = shift;
  31. } elsif( $opt eq '-s' ) {
  32. $do_strings = 1; shift;
  33. } else {
  34. die $usage;
  35. }
  36. }
  37. my %subst;
  38. open my $nfh, '<', $datafile or die "Could not read $datafile\n";
  39. my $ident = qr/[_A-Za-z][_A-Za-z0-9]*/;
  40. while( my $line = <$nfh> ) {
  41. chomp $line;
  42. my ( $old, $new ) = ( $line =~ /^($ident)\s+($ident)$/ );
  43. if( ! $old || ! $new ) {
  44. die "$0: $datafile:$.: bad input '$line'\n";
  45. }
  46. $subst{$old} = $new;
  47. }
  48. close $nfh or die;
  49. my $string = qr/"(?:\\.|[^\\"])*"/;
  50. my $space = qr/\s+/;
  51. my $idnum = qr/[a-zA-Z0-9_]+/;
  52. my $symbols = qr/[-!#\$%&'()*+,.\/:;<=>?@[\\\]^_`{|}~]+|"/;
  53. my $lib_include_dir = dir($0)->parent->parent->subdir('include', 'mbedtls');
  54. my $lib_source_dir = dir($0)->parent->parent->subdir('library');
  55. # if we replace inside strings, we don't consider them a token
  56. my $token = $do_strings ? qr/$space|$idnum|$symbols/
  57. : qr/$string|$space|$idnum|$symbols/;
  58. my %warnings;
  59. # If no files were passed, exit...
  60. if ( not defined($ARGV[0]) ){ die $usage; }
  61. while( my $filename = shift )
  62. {
  63. print STDERR "$filename... ";
  64. if( dir($filename)->parent eq $lib_include_dir ||
  65. dir($filename)->parent eq $lib_source_dir )
  66. {
  67. die "Script cannot be executed on the mbed TLS library itself.";
  68. }
  69. if( -d $filename ) { print STDERR "skip (directory)\n"; next }
  70. open my $rfh, '<', $filename or die;
  71. my @lines = <$rfh>;
  72. close $rfh or die;
  73. my @out;
  74. for my $line (@lines) {
  75. if( $line =~ /#include/ ) {
  76. $line =~ s/polarssl/mbedtls/;
  77. $line =~ s/POLARSSL/MBEDTLS/;
  78. push( @out, $line );
  79. next;
  80. }
  81. my @words = ($line =~ /$token/g);
  82. my $checkline = join '', @words;
  83. if( $checkline eq $line ) {
  84. my @new = map { exists $subst{$_} ? $subst{$_} : $_ } @words;
  85. push( @out, join '', @new );
  86. } else {
  87. $warnings{$filename} = [] unless $warnings{$filename};
  88. push @{ $warnings{$filename} }, $line;
  89. push( @out, $line );
  90. }
  91. }
  92. open my $wfh, '>', $filename or die;
  93. print $wfh $_ for @out;
  94. close $wfh or die;
  95. print STDERR "done\n";
  96. }
  97. if( %warnings ) {
  98. print "\nWarning: lines skipped due to unexpected characters:\n";
  99. for my $filename (sort keys %warnings) {
  100. print "in $filename:\n";
  101. print for @{ $warnings{$filename} };
  102. }
  103. }