tools/fix-encoding-args.pl

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright 2011, William Meier <wmeier[AT]newsguy.com>
   4 #
   5 # A program to fix encoding args for certain Wireshark API function calls
   6 #   from TRUE/FALSE to ENC_?? as appropriate (and possible)
   7 #   - proto_tree_add_item
   8 #   - proto_tree_add_bits_item
   9 #   - proto_tree_add_bits_ret_val
  10 #   - proto_tree_add_bitmask
  11 #   - proto_tree_add_bitmask_text  !! ToDo: encoding arg not last arg
  12 #   - tvb_get_bits
  13 #   - tvb_get_bits16
  14 #   - tvb_get_bits24
  15 #   - tvb_get_bits32
  16 #   - tvb_get_bits64
  17 #   - ptvcursor_add
  18 #   - ptvcursor_add_no_advance
  19 #   - ptvcursor_add_with_subtree   !! ToDo: encoding arg not last arg
  20 #
  21 #
  22 # $Id$
  23 #
  24 # Wireshark - Network traffic analyzer
  25 # By Gerald Combs <gerald@wireshark.org>
  26 # Copyright 1998 Gerald Combs
  27 #
  28 # This program is free software; you can redistribute it and/or
  29 # modify it under the terms of the GNU General Public License
  30 # as published by the Free Software Foundation; either version 2
  31 # of the License, or (at your option) any later version.
  32 #
  33 # This program is distributed in the hope that it will be useful,
  34 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  35 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  36 # GNU General Public License for more details.
  37 #
  38 # You should have received a copy of the GNU General Public License
  39 # along with this program; if not, write to the Free Software
  40 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  41 #
  42
  43 use strict;
  44 use warnings;
  45
  46 use Getopt::Long;
  47
  48 # Conversion "Requests"
  49
  50 # Standard conversions
  51 my $searchReplaceFalseTrueHRef =
  52   {
  53    "FALSE"              => "ENC_BIG_ENDIAN",
  54    "0"                  => "ENC_BIG_ENDIAN",
  55    "TRUE"               => "ENC_LITTLE_ENDIAN",
  56    "1"                  => "ENC_LITTLE_ENDIAN"
  57   };
  58
  59 my $searchReplaceEncNAHRef =
  60    {
  61     "FALSE"             => "ENC_NA",
  62     "0"                 => "ENC_NA",
  63     "TRUE"              => "ENC_NA",
  64     "1"                 => "ENC_NA",
  65     "ENC_LITTLE_ENDIAN" => "ENC_NA",
  66     "ENC_BIG_ENDIAN"    => "ENC_NA"
  67    };
  68
  69
  70 # ---------------------------------------------------------------------
  71 # Conversion "request" structure
  72 # (
  73 #   [ <list of field types for which this conversion request applies> ],
  74 #   { <hash of desired encoding arg conversions> }
  75 # }
  76
  77 my @types_NA  =
  78   (
  79    [ qw (FT_NONE FT_BYTES FT_ETHER FT_IPv6 FT_IPXNET FT_OID)],
  80    $searchReplaceEncNAHRef
  81   );
  82
  83 my @types_INT =
  84   (
  85    [ qw (FT_UINT8 FT_UINT16 FT_UINT24 FT_UINT32 FT_UINT64 FT_INT8
  86          FT_INT16 FT_INT24 FT_INT32 FT_INT64 FT_FLOAT FT_DOUBLE)],
  87    $searchReplaceFalseTrueHRef
  88   );
  89
  90 my @types_MISC =
  91   (
  92    [ qw (FT_BOOLEAN FT_IPv4 FT_GUID FT_EUI64)],
  93    $searchReplaceFalseTrueHRef
  94   );
  95
  96 my @types_STRING =
  97   (
  98    [qw (FT_STRING FT_STRINGZ)],
  99    {
 100     "FALSE"                        => "ENC_ASCII|ENC_NA",
 101     "0"                            => "ENC_ASCII|ENC_NA",
 102     "TRUE"                         => "ENC_ASCII|ENC_NA",
 103     "1"                            => "ENC_ASCII|ENC_NA",
 104     "ENC_LITTLE_ENDIAN"            => "ENC_ASCII|ENC_NA",
 105     "ENC_BIG_ENDIAN"               => "ENC_ASCII|ENC_NA",
 106     "ENC_NA"                       => "ENC_ASCII|ENC_NA",
 107
 108     "ENC_ASCII"                    => "ENC_ASCII|ENC_NA",
 109     "ENC_ASCII|ENC_LITTLE_ENDIAN"  => "ENC_ASCII|ENC_NA",
 110     "ENC_ASCII|ENC_BIG_ENDIAN"     => "ENC_ASCII|ENC_NA",
 111
 112     "ENC_UTF_8"                    => "ENC_UTF_8|ENC_NA",
 113     "ENC_UTF_8|ENC_LITTLE_ENDIAN"  => "ENC_UTF_8|ENC_NA",
 114     "ENC_UTF_8|ENC_BIG_ENDIAN"     => "ENC_UTF_8|ENC_NA",
 115
 116     "ENC_EBCDIC"                   => "ENC_EBCDIC|ENC_NA",
 117     "ENC_EBCDIC|ENC_LITTLE_ENDIAN" => "ENC_EBCDIC|ENC_NA",
 118     "ENC_EBCDIC|ENC_BIG_ENDIAN"    => "ENC_EBCDIC|ENC_NA",
 119    }
 120   );
 121
 122 my @types_UINT_STRING =
 123   (
 124    [qw (FT_UINT_STRING)],
 125    {
 126     "FALSE"                   => "ENC_ASCII|ENC_BIG_ENDIAN",
 127     "0"                       => "ENC_ASCII|ENC_BIG_ENDIAN",
 128     "TRUE"                    => "ENC_ASCII|ENC_LITTLE_ENDIAN",
 129     "1"                       => "ENC_ASCII|ENC_LITTLE_ENDIAN",
 130     "ENC_BIG_ENDIAN"          => "ENC_ASCII|ENC_BIG_ENDIAN",
 131     "ENC_LITTLE_ENDIAN"       => "ENC_ASCII|ENC_LITTLE_ENDIAN",
 132    }
 133   );
 134
 135 my @types_REG_PROTO  =
 136   (
 137    [ qw (REG_PROTO)],
 138    $searchReplaceEncNAHRef
 139   );
 140
 141 # ---------------------------------------------------------------------
 142 # For searching (and doing no substitutions) (obsolete ?)
 143
 144 my @types_TIME =  (
 145                     [qw (FT_ABSOLUTE_TIME FT_RELATIVE_TIME)],
 146                     {}
 147                    );
 148
 149 my @types_ALL =
 150   (
 151    [qw (
 152            FT_NONE
 153            FT_PROTOCOL
 154            FT_BOOLEAN
 155            FT_UINT8
 156            FT_UINT16
 157            FT_UINT24
 158            FT_UINT32
 159            FT_UINT64
 160            FT_INT8
 161            FT_INT16
 162            FT_INT24
 163            FT_INT32
 164            FT_INT64
 165            FT_FLOAT
 166            FT_DOUBLE
 167            FT_ABSOLUTE_TIME
 168            FT_RELATIVE_TIME
 169            FT_STRING
 170            FT_STRINGZ
 171            FT_UINT_STRING
 172            FT_ETHER
 173            FT_BYTES
 174            FT_UINT_BYTES
 175            FT_IPv4
 176            FT_IPv6
 177            FT_IPXNET
 178            FT_FRAMENUM
 179            FT_PCRE
 180            FT_GUID
 181            FT_OID
 182            FT_EUI64
 183       )],
 184    {# valid encoding args
 185     "a"=>"ENC_NA",
 186     "b"=>"ENC_LITTLE_ENDIAN",
 187     "c"=>"ENC_BIG_ENDIAN",
 188
 189     "d"=>"ENC_ASCII|ENC_NA",
 190     "e"=>"ENC_ASCII|ENC_LITTLE_ENDIAN",
 191     "f"=>"ENC_ASCII|ENC_BIG_ENDIAN",
 192
 193     "g"=>"ENC_UTF_8|ENC_NA",
 194     "h"=>"ENC_UTF_8|ENC_LITTLE_ENDIAN",
 195     "i"=>"ENC_UTF_8|ENC_BIG_ENDIAN",
 196
 197     "j"=>"ENC_EBCDIC|ENC_NA",
 198     "k"=>"ENC_EBCDIC|ENC_LITTLE_ENDIAN",
 199     "l"=>"ENC_EBCDIC|ENC_BIG_ENDIAN",
 200    }
 201   );
 202
 203 # ---------------------------------------------------------------------
 204
 205 my @findAllFunctionList =
 206 ##         proto_tree_add_bitmask_text  !! ToDo: encoding arg not last arg
 207 ##         ptvcursor_add_with_subtree   !! ToDo: encoding Arg not last arg
 208   qw (
 209          proto_tree_add_item
 210          proto_tree_add_bits_item
 211          proto_tree_add_bits_ret_val
 212          proto_tree_add_bitmask
 213          tvb_get_bits
 214          tvb_get_bits16
 215          tvb_get_bits24
 216          tvb_get_bits32
 217          tvb_get_bits64
 218          ptvcursor_add
 219          ptvcursor_add_no_advance
 220     );
 221
 222 # ---------------------------------------------------------------------
 223 #
 224 # MAIN
 225 #
 226 my $writeFlag = '';
 227 my $helpFlag  = '';
 228 my $action    = 'fix-all';
 229
 230 my $result = GetOptions(
 231                         'action=s' => \$action,
 232                         'write'    => \$writeFlag,
 233                         'help|?'   => \$helpFlag
 234                        );
 235
 236 if (!$result || $helpFlag || !$ARGV[0]) {
 237     usage();
 238 }
 239
 240 if (($action ne 'fix-all') && ($action ne 'find-all')) {
 241     usage();
 242 }
 243
 244 sub usage {
 245         print "\nUsage: $0 [--action=fix-all|find-all] [--write] FILENAME [...]\n\n";
 246         print "  --action = fix-all (default)\n";
 247         print "    Fix <certain-fcn-names>() encoding arg when possible in FILENAME(s)\n";
 248         print "    Fixes (if any) are listed on stdout)\n\n";
 249         print "  --write     create FILENAME.encoding-arg-fixes (original file with fixes)\n";
 250         print "              (effective only for fix-all)\n";
 251         print "\n";
 252         print "  --action = find-all\n";
 253         print "    Find all occurrences of <certain-fcn-names>() statements)\n";
 254         print "     highlighting the 'encoding' arg\n";
 255         exit(1);
 256 }
 257
 258 # Read through the files; fix up encoding parameter of proto_tree_add_item() calls
 259 # Essentially:
 260 #  For each file {
 261 #  .  Create a hash of the hf_index_names & associated field types from the entries in hf[]
 262 #  .  For each requested "conversion request" {
 263 #  .  .  For each hf[] entry hf_index_name with a field type in a set of specified field types {
 264 #  .  .  .  For each proto_tree_add_item() statement
 265 #  .  .  .  .  - replace encoding arg in proto_tree_add_item(..., hf_index_name, ..., 'encoding-arg')
 266 #                  specific values ith new values
 267 #  .  .  .  .  - print the statement showing the change
 268 #  .  .  .  }
 269 #  .  .  }
 270 #  .  }
 271 #  .  If requested and if replacements done: write new file "orig-filename.encoding-arg-fixes"
 272 #  }
 273 #
 274 # Note: The proto_tree_add_item() encoding arg will be converted only if
 275 #        the hf_index_name referenced is in one of the entries in hf[] in the same file
 276
 277 my $found_total = 0;
 278
 279 while (my $fileName = $ARGV[0]) {
 280     shift;
 281     my $fileContents = '';
 282
 283     die "No such file: \"$fileName\"\n" if (! -e $fileName);
 284
 285     # delete leading './'
 286     $fileName =~ s{ ^ \. / } {}xo;
 287
 288     # Read in the file (ouch, but it's easier that way)
 289     open(FCI, "<", $fileName) || die("Couldn't open $fileName");
 290     while (<FCI>) {
 291         $fileContents .= $_;
 292     }
 293     close(FCI);
 294
 295     # Create a hash of the hf[] entries (name_index_name=>field_type)
 296     my $hfArrayEntryFieldTypeHRef = find_hf_array_entries(\$fileContents, $fileName);
 297
 298     if ($action eq "fix-all") {
 299
 300         # Find and replace: <fcn_name_pattern>() encoding arg in $fileContents for:
 301         #     - hf[] entries with specified field types;
 302         #     - 'proto' as returned from proto_register_protocol()
 303         my $fcn_name = "(?:proto_tree_add_item|ptvcursor_add(?:_no_advance)?)";
 304         my $found = 0;
 305         $found += fix_encoding_args_by_hf_type(1, \@types_NA,          $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 306         $found += fix_encoding_args_by_hf_type(1, \@types_INT,         $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 307         $found += fix_encoding_args_by_hf_type(1, \@types_MISC,        $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 308         $found += fix_encoding_args_by_hf_type(1, \@types_STRING,      $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 309         $found += fix_encoding_args_by_hf_type(1, \@types_UINT_STRING, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 310         $found += fix_encoding_args_by_hf_type(1, \@types_REG_PROTO,   $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 311
 312         # Find and replace: alters <fcn_name>() encoding arg in $fileContents
 313         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bits_(?:item|ret_val)",      \$fileContents, $fileName);
 314         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bitmask",                    \$fileContents, $fileName);
 315         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "tvb_get_bits(?:16|24|32|64)?",              \$fileContents, $fileName);
 316         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "tvb_get_(?:ephemeral_)?unicode_string[z]?", \$fileContents, $fileName);
 317
 318         # If desired and if any changes, write out the changed version to a file
 319         if (($writeFlag) && ($found > 0)) {
 320             open(FCO, ">", $fileName . ".encoding-arg-fixes");
 321 #        open(FCO, ">", $fileName );
 322             print FCO "$fileContents";
 323             close(FCO);
 324         }
 325         $found_total += $found;
 326     }
 327
 328     if ($action eq "find-all") {
 329         # Find all proto_tree_add_item() statements
 330         #  and output same highlighting the encoding arg
 331         $found_total += find_all(\@findAllFunctionList, \$fileContents, $fileName);
 332     }
 333
 334 # Optional searches: (kind of obsolete ?)
 335 # search for (and output) proto_tree_add_item() statements with invalid encoding arg for specified field types
 336 #    $fcn_name = "proto_tree_add_item";
 337 #    fix_encoding_args(2, \@types_NA,          $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 338 #    fix_encoding_args(2, \@types_INT,         $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 339 #    fix_encoding_args(2, \@types_MISC,        $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 340 #    fix_encoding_args(2, \@types_STRING,      $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 341 #    fix_encoding_args(2, \@types_UINT_STRING, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 342 #    fix_encoding_args(2, \@types_ALL,         $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 343 # search for (and output) proto_tree_add_item()$fcn_name,  statements with any encoding arg for specified field types
 344 #    fix_encoding_args(3, \@types_TIME,        $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 345 #
 346
 347 } # while
 348
 349 exit $found_total;
 350
 351 # ---------------------------------------------------------------------
 352 # Create a hash containing an entry (hf_index_name => field_type) for each hf[]entry.
 353 # also: create an entry in the hash for the 'protocol name' variable (proto... => FT_PROTOCOL)
 354 # returns: ref to the hash
 355
 356 sub find_hf_array_entries {
 357     my ($fileContentsRef, $fileName) = @_;
 358
 359     # The below Regexp is based on one from:
 360     # http://aspn.activestate.com/ASPN/Cookbook/Rx/Recipe/59811
 361     # It is in the public domain.
 362     # A complicated regex which matches C-style comments.
 363     my $CCommentRegEx = qr{ / [*] [^*]* [*]+ (?: [^/*] [^*]* [*]+ )* / }xo;
 364
 365     # hf[] entry regex (to extract an hf_index_name and associated field type)
 366     my $hfArrayFieldTypeRegEx = qr {
 367                                        \{
 368                                        \s*
 369                                        &\s*([A-Z0-9_\[\]-]+)                # &hf
 370                                        \s*,\s*
 371                                        \{\s*
 372                                        .+?                                  # (a bit dangerous)
 373                                        \s*,\s*
 374                                        (FT_[A-Z0-9_]+)                      # field type
 375                                        \s*,\s*
 376                                        .+?
 377                                        \s*,\s*
 378                                        HFILL                                # HFILL
 379                                }xios;
 380
 381     # create a copy of $fileContents with comments removed
 382     my $fileContentsWithoutComments = $$fileContentsRef;
 383     $fileContentsWithoutComments =~ s {$CCommentRegEx} []xg;
 384
 385     # find all the hf[] entries (searching $fileContentsWithoutComments).
 386     # Create a hash keyed by the hf_index_name with the associated value being the field_type
 387     my %hfArrayEntryFieldType;
 388     while ($fileContentsWithoutComments =~ m{ $hfArrayFieldTypeRegEx }xgis) {
 389 #        print "$1 $2\n";
 390         if (exists $hfArrayEntryFieldType{$1}) {
 391             printf "%-35.35s: ? duplicate hf[] entry: no fixes done for: $1; manual action may be req'd\n", $fileName;
 392             $hfArrayEntryFieldType{$1} = "???"; # prevent any substitutions for this hf_index_name
 393         } else {
 394             $hfArrayEntryFieldType{$1} = $2;
 395         }
 396     }
 397
 398     # RegEx to get "proto" variable name
 399     my $protoRegEx = qr /
 400                             ^ \s*                     # note m modifier below
 401                             (
 402                                 [a-zA-Z0-9_]+
 403                             )
 404                             \s*
 405                             =
 406                             \s*
 407                             proto_register_protocol
 408                             \s*
 409                             \(
 410                         /xoms;
 411
 412     # Find all registered protocols
 413     while ($fileContentsWithoutComments =~ m { $protoRegEx }xgioms ) {
 414         ##print "$1\n";
 415         if (exists $hfArrayEntryFieldType{$1}) {
 416             printf "%-35.35s: ? duplicate 'proto': no fixes done for: $1; manual action may be req'd\n", $fileName;
 417             $hfArrayEntryFieldType{$1} = "???"; # prevent any substitutions for this protocol
 418         } else {
 419             $hfArrayEntryFieldType{$1} = "REG_PROTO";
 420         }
 421     }
 422
 423     return \%hfArrayEntryFieldType;
 424 }
 425
 426 # ---------------------------------------------------------------------
 427 # fix_encoding_args
 428 # Substitute new values for the specified <fcn_name>() encoding arg values
 429 #    when the encoding arg is the *last* arg of the call to fcn_name
 430 # args:
 431 #   substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
 432 #   ref to hash containing search (keys) and replacement (values) for encoding arg
 433 #   fcn_name string
 434 #   ref to string containing file contents
 435 #   filename string
 436 #
 437 { # block begin
 438
 439     # shared variables
 440     my $fileName;
 441     my $searchReplaceHRef;
 442     my $found;
 443
 444     sub fix_encoding_args {
 445         (my $subFlag, $searchReplaceHRef, my $fcn_name, my $fileContentsRef, $fileName) = @_;
 446
 447         my $encArgPat;
 448
 449         if ($subFlag == 1) {
 450             # just match for <fcn_name>() statements which have an encoding arg matching one of the
 451             #   keys in the searchReplace hash.
 452             # Escape any "|" characters in the keys
 453             #  and then create "alternatives" string containing all the values (A|B|C\|D|...)
 454             $encArgPat = join "|",  map { s{ ( \| ) }{\\$1}gx; $_ } keys %$searchReplaceHRef;
 455         } elsif ($subFlag == 3) {
 456             # match for <fcn_name>() statements for any value of the encoding parameter
 457             # IOW: find all the <fcn_name> statements
 458             $encArgPat = qr / [^,)]+? /x;
 459         }
 460
 461         # build the complete pattern
 462         my $patRegEx = qr /
 463                               ( # part 1: $1
 464                                   (?:^|=)            # don't try to handle fcn_name call when arg of another fcn call
 465                                   \s*
 466                                   $fcn_name \s* \(
 467                                   [^;]+?             # a bit dangerous
 468                                   ,\s*
 469                               )
 470                               ( # part 2: $2
 471                                   $encArgPat
 472                               )
 473                               ( # part 3: $3
 474                                   \s* \)
 475                                   \s* ;
 476                               )
 477                           /xms;  # m for ^ above
 478
 479         ##print "$patRegEx\n";
 480
 481         ## Match and substitute as specified
 482         $found = 0;
 483
 484         $$fileContentsRef =~ s/ $patRegEx /patsubx($1,$2,$3)/xges;
 485
 486         return $found;
 487     }
 488
 489     # Called from fix_encoding_args to determine replacement string when a regex match is encountered
 490     #  $_[0]: part 1
 491     #  $_[1]: part 2: encoding arg
 492     #  $_[2]: part 3
 493     #  lookup the desired replacement value for the encoding arg
 494     #  print match string showing and highlighting the encoding arg replacement
 495     #  return "replacement" string
 496     sub patsubx {
 497         $found += 1;
 498         my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
 499         my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr,  $_[2]);
 500         $str =~ tr/\t\n\r/ /d;
 501         printf "%s: $str\n", $fileName;
 502         return $_[0] . $substr . $_[2];
 503     }
 504 } # block end
 505
 506 # ---------------------------------------------------------------------
 507 # fix_encoding_args_by_hf_type
 508 #
 509 # Substitute new values for certain proto_tree_add_item() encoding arg
 510 #     values (for specified hf field types)
 511 #  Variants: search for and display for "exceptions" to allowed encoding arg values;
 512 #            search for and display all encoding arg values
 513 # args:
 514 #   substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
 515 #                    2: search for "exceptions" to allowed encoding arg values (values in search hash);
 516 #                    3: search for all encoding arg values
 517 #   ref to array containing two elements:
 518 #      - ref to array containing hf[] types to be processed (FT_STRING, etc)
 519 #      - ref to hash containing search (keys) and replacement (values) for encoding arg
 520 #   fcn_name string
 521 #   ref to hfArrayEntries hash (key: hf name; value: field type)
 522 #   ref to string containing file contents
 523 #   filename string
 524
 525 {  # block begin
 526
 527 # shared variables
 528     my $fileName;
 529     my $searchReplaceHRef;
 530     my $found;
 531     my $hf_field_type;
 532
 533     sub fix_encoding_args_by_hf_type {
 534
 535         (my $subFlag, my $mapArg, my $fcn_name, my $fileContentsRef, my $hfArrayEntryFieldTypeHRef, $fileName) = @_;
 536
 537         my $hf_index_name;
 538         my $hfTypesARef;
 539         my $encArgPat;
 540
 541         $hfTypesARef       = $$mapArg[0];
 542         $searchReplaceHRef = $$mapArg[1];
 543
 544         my %hfTypes;
 545         @hfTypes{@$hfTypesARef}=();
 546
 547         # set up the encoding arg match pattern
 548         if ($subFlag == 1) {
 549             # just match for <fcn_name>() statements which have an encoding arg matching one of the
 550             #   keys in the searchReplace hash.
 551             # Escape any "|" characters in the keys
 552             #  and then create "alternatives" string containing all the values (A|B|C\|D|...)
 553             $encArgPat = join "|",  map { s{ ( \| ) }{\\$1}gx; $_ } keys %$searchReplaceHRef;
 554         } elsif ($subFlag == 2) {
 555             # Find all the <fcn_name>() statements wherein the encoding arg is a value other than
 556             #      one of the "replace" values.
 557             #  Uses zero-length negative-lookahead to find <fcn_name>() statements for which the encoding
 558             #    arg is something other than one of the the provided replace values.
 559             # Escape any "|" characters in the values to be matched
 560             #  and then create "alternatives" string containing all the values (A|B|C\|D|...)
 561             my $match_str = join "|",  map { s{ ( \| ) }{\\$1}gx; $_ } values %$searchReplaceHRef;
 562             $encArgPat = qr /
 563                                 (?!                  # negative zero-length look-ahead
 564                                     \s*
 565                                     (?: $match_str ) # alternatives we don't want to match
 566                                     \s*
 567                                 )
 568                                 [^,)]+?              # OK: enoding arg is other than one of the alternatives:
 569                                                      #   match to end of the arg
 570                             /x;
 571         } elsif ($subFlag == 3) {
 572             # match for <fcn_name>() statements for any value of the encoding parameter
 573             # IOW: find all the proto_tree_add_item statements with an hf entry of the desired types
 574             $encArgPat = qr / [^,)]+? /x;
 575         }
 576
 577         # For each hf[] entry which matches a type in %hfTypes do replacements
 578         $found = 0;
 579         foreach my $key (keys %$hfArrayEntryFieldTypeHRef) {
 580             $hf_index_name = $key;
 581             $hf_index_name =~ s{ ( \[ | \] ) }{\\$1}xg;     # escape any "[" or "]" characters
 582             $hf_field_type = $$hfArrayEntryFieldTypeHRef{$key};
 583             ##printf "--> %-35.35s: %s\n", $hf_index_name,  $hf_field_type;
 584
 585             next unless exists $hfTypes{$hf_field_type};    # Do we want to process for this hf[] entry type ?
 586
 587             # build the complete pattern
 588             my $patRegEx = qr /
 589                                   ( # part 1: $1
 590                                       $fcn_name \s* \(
 591                                       [^;]+?
 592                                       ,\s*
 593                                       $hf_index_name
 594                                       \s*,
 595                                       [^;]+
 596                                       ,\s*
 597                                   )
 598                                   ( # part 2: $2
 599                                       $encArgPat
 600                                   )
 601                                   ( # part 3: $3
 602                                       \s* \)
 603                                       \s* ;
 604                                   )
 605                               /xs;
 606
 607             ##print "\n$hf_index_name $hf_field_type\n";
 608
 609             ## Match and substitute as specified
 610             $$fileContentsRef =~ s/ $patRegEx /patsub($1,$2,$3)/xges;
 611
 612         }
 613
 614         return $found;
 615     }
 616
 617     # Called from fix_encoding_args to determine replacement string when a regex match is encountered
 618     #  $_[0]: part 1
 619     #  $_[1]: part 2: encoding arg
 620     #  $_[2]: part 3
 621     #  lookup the desired replacement value for the encoding arg
 622     #  print match string showing and highlighting the encoding arg replacement
 623     #  return "replacement" string
 624     sub patsub {
 625         $found += 1;
 626         my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
 627         my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr,  $_[2]);
 628         $str =~ tr/\t\n\r/ /d;
 629         printf "%s:  %-17.17s $str\n", $fileName, $hf_field_type . ":";
 630         return $_[0] . $substr . $_[2];
 631     }
 632 }  # block end
 633
 634 # ---------------------------------------------------------------------
 635 # Find all <fcnList> statements
 636 #  and output same highlighting the encoding arg
 637 #  Currently: encoding arg is matched as the *last* arg of the function call
 638
 639 sub find_all {
 640     my( $fcnListARef, $fileContentsRef, $fileName) = @_;
 641
 642     my $found = 0;
 643     my $fcnListPat = join "|", @$fcnListARef;
 644     my $pat = qr /
 645                      (
 646                          (?:$fcnListPat) \s* \(
 647                          [^;]+
 648                          , \s*
 649                      )
 650                      (
 651                          [^ \t,)]+?
 652                      )
 653                      (
 654                          \s* \)
 655                          \s* ;
 656                      )
 657                  /xs;
 658
 659     while ($$fileContentsRef =~ / $pat /xgso) {
 660         my $str = "${1}[[${2}]]${3}\n";
 661         $str =~ tr/\t\n\r/ /d;
 662         $str =~ s/ \s+ / /xg;
 663         print "$fileName: $str\n";
 664         $found += 1;
 665     }
 666     return $found;
 667 }
 668