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 FT_REL_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_REL_OID
 183            FT_EUI64
 184       )],
 185    {# valid encoding args
 186     "a"=>"ENC_NA",
 187     "b"=>"ENC_LITTLE_ENDIAN",
 188     "c"=>"ENC_BIG_ENDIAN",
 189
 190     "d"=>"ENC_ASCII|ENC_NA",
 191     "e"=>"ENC_ASCII|ENC_LITTLE_ENDIAN",
 192     "f"=>"ENC_ASCII|ENC_BIG_ENDIAN",
 193
 194     "g"=>"ENC_UTF_8|ENC_NA",
 195     "h"=>"ENC_UTF_8|ENC_LITTLE_ENDIAN",
 196     "i"=>"ENC_UTF_8|ENC_BIG_ENDIAN",
 197
 198     "j"=>"ENC_EBCDIC|ENC_NA",
 199     "k"=>"ENC_EBCDIC|ENC_LITTLE_ENDIAN",
 200     "l"=>"ENC_EBCDIC|ENC_BIG_ENDIAN",
 201    }
 202   );
 203
 204 # ---------------------------------------------------------------------
 205
 206 my @findAllFunctionList =
 207 ##         proto_tree_add_bitmask_text  !! ToDo: encoding arg not last arg
 208 ##         ptvcursor_add_with_subtree   !! ToDo: encoding Arg not last arg
 209   qw (
 210          proto_tree_add_item
 211          proto_tree_add_bits_item
 212          proto_tree_add_bits_ret_val
 213          proto_tree_add_bitmask
 214          tvb_get_bits
 215          tvb_get_bits16
 216          tvb_get_bits24
 217          tvb_get_bits32
 218          tvb_get_bits64
 219          ptvcursor_add
 220          ptvcursor_add_no_advance
 221     );
 222
 223 # ---------------------------------------------------------------------
 224 #
 225 # MAIN
 226 #
 227 my $writeFlag = '';
 228 my $helpFlag  = '';
 229 my $action    = 'fix-all';
 230
 231 my $result = GetOptions(
 232                         'action=s' => \$action,
 233                         'write'    => \$writeFlag,
 234                         'help|?'   => \$helpFlag
 235                        );
 236
 237 if (!$result || $helpFlag || !$ARGV[0]) {
 238     usage();
 239 }
 240
 241 if (($action ne 'fix-all') && ($action ne 'find-all')) {
 242     usage();
 243 }
 244
 245 sub usage {
 246         print "\nUsage: $0 [--action=fix-all|find-all] [--write] FILENAME [...]\n\n";
 247         print "  --action = fix-all (default)\n";
 248         print "    Fix <certain-fcn-names>() encoding arg when possible in FILENAME(s)\n";
 249         print "    Fixes (if any) are listed on stdout)\n\n";
 250         print "  --write     create FILENAME.encoding-arg-fixes (original file with fixes)\n";
 251         print "              (effective only for fix-all)\n";
 252         print "\n";
 253         print "  --action = find-all\n";
 254         print "    Find all occurrences of <certain-fcn-names>() statements)\n";
 255         print "     highlighting the 'encoding' arg\n";
 256         exit(1);
 257 }
 258
 259 # Read through the files; fix up encoding parameter of proto_tree_add_item() calls
 260 # Essentially:
 261 #  For each file {
 262 #  .  Create a hash of the hf_index_names & associated field types from the entries in hf[]
 263 #  .  For each requested "conversion request" {
 264 #  .  .  For each hf[] entry hf_index_name with a field type in a set of specified field types {
 265 #  .  .  .  For each proto_tree_add_item() statement
 266 #  .  .  .  .  - replace encoding arg in proto_tree_add_item(..., hf_index_name, ..., 'encoding-arg')
 267 #                  specific values ith new values
 268 #  .  .  .  .  - print the statement showing the change
 269 #  .  .  .  }
 270 #  .  .  }
 271 #  .  }
 272 #  .  If requested and if replacements done: write new file "orig-filename.encoding-arg-fixes"
 273 #  }
 274 #
 275 # Note: The proto_tree_add_item() encoding arg will be converted only if
 276 #        the hf_index_name referenced is in one of the entries in hf[] in the same file
 277
 278 my $found_total = 0;
 279
 280 while (my $fileName = $ARGV[0]) {
 281     shift;
 282     my $fileContents = '';
 283
 284     die "No such file: \"$fileName\"\n" if (! -e $fileName);
 285
 286     # delete leading './'
 287     $fileName =~ s{ ^ \. / } {}xo;
 288
 289     # Read in the file (ouch, but it's easier that way)
 290     open(FCI, "<", $fileName) || die("Couldn't open $fileName");
 291     while (<FCI>) {
 292         $fileContents .= $_;
 293     }
 294     close(FCI);
 295
 296     # Create a hash of the hf[] entries (name_index_name=>field_type)
 297     my $hfArrayEntryFieldTypeHRef = find_hf_array_entries(\$fileContents, $fileName);
 298
 299     if ($action eq "fix-all") {
 300
 301         # Find and replace: <fcn_name_pattern>() encoding arg in $fileContents for:
 302         #     - hf[] entries with specified field types;
 303         #     - 'proto' as returned from proto_register_protocol()
 304         my $fcn_name = "(?:proto_tree_add_item|ptvcursor_add(?:_no_advance)?)";
 305         my $found = 0;
 306         $found += fix_encoding_args_by_hf_type(1, \@types_NA,          $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 307         $found += fix_encoding_args_by_hf_type(1, \@types_INT,         $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 308         $found += fix_encoding_args_by_hf_type(1, \@types_MISC,        $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 309         $found += fix_encoding_args_by_hf_type(1, \@types_STRING,      $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 310         $found += fix_encoding_args_by_hf_type(1, \@types_UINT_STRING, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 311         $found += fix_encoding_args_by_hf_type(1, \@types_REG_PROTO,   $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 312
 313         # Find and replace: alters <fcn_name>() encoding arg in $fileContents
 314         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bits_(?:item|ret_val)",      \$fileContents, $fileName);
 315         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "proto_tree_add_bitmask",                    \$fileContents, $fileName);
 316         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "tvb_get_bits(?:16|24|32|64)?",              \$fileContents, $fileName);
 317         $found += fix_encoding_args(1, $searchReplaceFalseTrueHRef, "tvb_get_(?:ephemeral_)?unicode_string[z]?", \$fileContents, $fileName);
 318
 319         # If desired and if any changes, write out the changed version to a file
 320         if (($writeFlag) && ($found > 0)) {
 321             open(FCO, ">", $fileName . ".encoding-arg-fixes");
 322 #        open(FCO, ">", $fileName );
 323             print FCO "$fileContents";
 324             close(FCO);
 325         }
 326         $found_total += $found;
 327     }
 328
 329     if ($action eq "find-all") {
 330         # Find all proto_tree_add_item() statements
 331         #  and output same highlighting the encoding arg
 332         $found_total += find_all(\@findAllFunctionList, \$fileContents, $fileName);
 333     }
 334
 335 # Optional searches: (kind of obsolete ?)
 336 # search for (and output) proto_tree_add_item() statements with invalid encoding arg for specified field types
 337 #    $fcn_name = "proto_tree_add_item";
 338 #    fix_encoding_args(2, \@types_NA,          $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 339 #    fix_encoding_args(2, \@types_INT,         $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 340 #    fix_encoding_args(2, \@types_MISC,        $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 341 #    fix_encoding_args(2, \@types_STRING,      $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 342 #    fix_encoding_args(2, \@types_UINT_STRING, $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 343 #    fix_encoding_args(2, \@types_ALL,         $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 344 # search for (and output) proto_tree_add_item()$fcn_name,  statements with any encoding arg for specified field types
 345 #    fix_encoding_args(3, \@types_TIME,        $fcn_name, \$fileContents, $hfArrayEntryFieldTypeHRef, $fileName);
 346 #
 347
 348 } # while
 349
 350 exit $found_total;
 351
 352 # ---------------------------------------------------------------------
 353 # Create a hash containing an entry (hf_index_name => field_type) for each hf[]entry.
 354 # also: create an entry in the hash for the 'protocol name' variable (proto... => FT_PROTOCOL)
 355 # returns: ref to the hash
 356
 357 sub find_hf_array_entries {
 358     my ($fileContentsRef, $fileName) = @_;
 359
 360     # The below Regexp is based on one from:
 361     # http://aspn.activestate.com/ASPN/Cookbook/Rx/Recipe/59811
 362     # It is in the public domain.
 363     # A complicated regex which matches C-style comments.
 364     my $CCommentRegEx = qr{ / [*] [^*]* [*]+ (?: [^/*] [^*]* [*]+ )* / }xo;
 365
 366     # hf[] entry regex (to extract an hf_index_name and associated field type)
 367     my $hfArrayFieldTypeRegEx = qr {
 368                                        \{
 369                                        \s*
 370                                        &\s*([A-Z0-9_\[\]-]+)                # &hf
 371                                        \s*,\s*
 372                                        \{\s*
 373                                        .+?                                  # (a bit dangerous)
 374                                        \s*,\s*
 375                                        (FT_[A-Z0-9_]+)                      # field type
 376                                        \s*,\s*
 377                                        .+?
 378                                        \s*,\s*
 379                                        HFILL                                # HFILL
 380                                }xios;
 381
 382     # create a copy of $fileContents with comments removed
 383     my $fileContentsWithoutComments = $$fileContentsRef;
 384     $fileContentsWithoutComments =~ s {$CCommentRegEx} []xg;
 385
 386     # find all the hf[] entries (searching $fileContentsWithoutComments).
 387     # Create a hash keyed by the hf_index_name with the associated value being the field_type
 388     my %hfArrayEntryFieldType;
 389     while ($fileContentsWithoutComments =~ m{ $hfArrayFieldTypeRegEx }xgis) {
 390 #        print "$1 $2\n";
 391         if (exists $hfArrayEntryFieldType{$1}) {
 392             printf "%-35.35s: ? duplicate hf[] entry: no fixes done for: $1; manual action may be req'd\n", $fileName;
 393             $hfArrayEntryFieldType{$1} = "???"; # prevent any substitutions for this hf_index_name
 394         } else {
 395             $hfArrayEntryFieldType{$1} = $2;
 396         }
 397     }
 398
 399     # RegEx to get "proto" variable name
 400     my $protoRegEx = qr /
 401                             ^ \s*                     # note m modifier below
 402                             (
 403                                 [a-zA-Z0-9_]+
 404                             )
 405                             \s*
 406                             =
 407                             \s*
 408                             proto_register_protocol
 409                             \s*
 410                             \(
 411                         /xoms;
 412
 413     # Find all registered protocols
 414     while ($fileContentsWithoutComments =~ m { $protoRegEx }xgioms ) {
 415         ##print "$1\n";
 416         if (exists $hfArrayEntryFieldType{$1}) {
 417             printf "%-35.35s: ? duplicate 'proto': no fixes done for: $1; manual action may be req'd\n", $fileName;
 418             $hfArrayEntryFieldType{$1} = "???"; # prevent any substitutions for this protocol
 419         } else {
 420             $hfArrayEntryFieldType{$1} = "REG_PROTO";
 421         }
 422     }
 423
 424     return \%hfArrayEntryFieldType;
 425 }
 426
 427 # ---------------------------------------------------------------------
 428 # fix_encoding_args
 429 # Substitute new values for the specified <fcn_name>() encoding arg values
 430 #    when the encoding arg is the *last* arg of the call to fcn_name
 431 # args:
 432 #   substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
 433 #   ref to hash containing search (keys) and replacement (values) for encoding arg
 434 #   fcn_name string
 435 #   ref to string containing file contents
 436 #   filename string
 437 #
 438 { # block begin
 439
 440     # shared variables
 441     my $fileName;
 442     my $searchReplaceHRef;
 443     my $found;
 444
 445     sub fix_encoding_args {
 446         (my $subFlag, $searchReplaceHRef, my $fcn_name, my $fileContentsRef, $fileName) = @_;
 447
 448         my $encArgPat;
 449
 450         if ($subFlag == 1) {
 451             # just match for <fcn_name>() statements which have an encoding arg matching one of the
 452             #   keys in the searchReplace hash.
 453             # Escape any "|" characters in the keys
 454             #  and then create "alternatives" string containing all the values (A|B|C\|D|...)
 455             $encArgPat = join "|",  map { s{ ( \| ) }{\\$1}gx; $_ } keys %$searchReplaceHRef;
 456         } elsif ($subFlag == 3) {
 457             # match for <fcn_name>() statements for any value of the encoding parameter
 458             # IOW: find all the <fcn_name> statements
 459             $encArgPat = qr / [^,)]+? /x;
 460         }
 461
 462         # build the complete pattern
 463         my $patRegEx = qr /
 464                               ( # part 1: $1
 465                                   (?:^|=)            # don't try to handle fcn_name call when arg of another fcn call
 466                                   \s*
 467                                   $fcn_name \s* \(
 468                                   [^;]+?             # a bit dangerous
 469                                   ,\s*
 470                               )
 471                               ( # part 2: $2
 472                                   $encArgPat
 473                               )
 474                               ( # part 3: $3
 475                                   \s* \)
 476                                   \s* ;
 477                               )
 478                           /xms;  # m for ^ above
 479
 480         ##print "$patRegEx\n";
 481
 482         ## Match and substitute as specified
 483         $found = 0;
 484
 485         $$fileContentsRef =~ s/ $patRegEx /patsubx($1,$2,$3)/xges;
 486
 487         return $found;
 488     }
 489
 490     # Called from fix_encoding_args to determine replacement string when a regex match is encountered
 491     #  $_[0]: part 1
 492     #  $_[1]: part 2: encoding arg
 493     #  $_[2]: part 3
 494     #  lookup the desired replacement value for the encoding arg
 495     #  print match string showing and highlighting the encoding arg replacement
 496     #  return "replacement" string
 497     sub patsubx {
 498         $found += 1;
 499         my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
 500         my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr,  $_[2]);
 501         $str =~ tr/\t\n\r/ /d;
 502         printf "%s: $str\n", $fileName;
 503         return $_[0] . $substr . $_[2];
 504     }
 505 } # block end
 506
 507 # ---------------------------------------------------------------------
 508 # fix_encoding_args_by_hf_type
 509 #
 510 # Substitute new values for certain proto_tree_add_item() encoding arg
 511 #     values (for specified hf field types)
 512 #  Variants: search for and display for "exceptions" to allowed encoding arg values;
 513 #            search for and display all encoding arg values
 514 # args:
 515 #   substitute_flag: 1: replace specified encoding arg values by a new value (keys/values in search hash);
 516 #                    2: search for "exceptions" to allowed encoding arg values (values in search hash);
 517 #                    3: search for all encoding arg values
 518 #   ref to array containing two elements:
 519 #      - ref to array containing hf[] types to be processed (FT_STRING, etc)
 520 #      - ref to hash containing search (keys) and replacement (values) for encoding arg
 521 #   fcn_name string
 522 #   ref to hfArrayEntries hash (key: hf name; value: field type)
 523 #   ref to string containing file contents
 524 #   filename string
 525
 526 {  # block begin
 527
 528 # shared variables
 529     my $fileName;
 530     my $searchReplaceHRef;
 531     my $found;
 532     my $hf_field_type;
 533
 534     sub fix_encoding_args_by_hf_type {
 535
 536         (my $subFlag, my $mapArg, my $fcn_name, my $fileContentsRef, my $hfArrayEntryFieldTypeHRef, $fileName) = @_;
 537
 538         my $hf_index_name;
 539         my $hfTypesARef;
 540         my $encArgPat;
 541
 542         $hfTypesARef       = $$mapArg[0];
 543         $searchReplaceHRef = $$mapArg[1];
 544
 545         my %hfTypes;
 546         @hfTypes{@$hfTypesARef}=();
 547
 548         # set up the encoding arg match pattern
 549         if ($subFlag == 1) {
 550             # just match for <fcn_name>() statements which have an encoding arg matching one of the
 551             #   keys in the searchReplace hash.
 552             # Escape any "|" characters in the keys
 553             #  and then create "alternatives" string containing all the values (A|B|C\|D|...)
 554             $encArgPat = join "|",  map { s{ ( \| ) }{\\$1}gx; $_ } keys %$searchReplaceHRef;
 555         } elsif ($subFlag == 2) {
 556             # Find all the <fcn_name>() statements wherein the encoding arg is a value other than
 557             #      one of the "replace" values.
 558             #  Uses zero-length negative-lookahead to find <fcn_name>() statements for which the encoding
 559             #    arg is something other than one of the the provided replace values.
 560             # Escape any "|" characters in the values to be matched
 561             #  and then create "alternatives" string containing all the values (A|B|C\|D|...)
 562             my $match_str = join "|",  map { s{ ( \| ) }{\\$1}gx; $_ } values %$searchReplaceHRef;
 563             $encArgPat = qr /
 564                                 (?!                  # negative zero-length look-ahead
 565                                     \s*
 566                                     (?: $match_str ) # alternatives we don't want to match
 567                                     \s*
 568                                 )
 569                                 [^,)]+?              # OK: enoding arg is other than one of the alternatives:
 570                                                      #   match to end of the arg
 571                             /x;
 572         } elsif ($subFlag == 3) {
 573             # match for <fcn_name>() statements for any value of the encoding parameter
 574             # IOW: find all the proto_tree_add_item statements with an hf entry of the desired types
 575             $encArgPat = qr / [^,)]+? /x;
 576         }
 577
 578         # For each hf[] entry which matches a type in %hfTypes do replacements
 579         $found = 0;
 580         foreach my $key (keys %$hfArrayEntryFieldTypeHRef) {
 581             $hf_index_name = $key;
 582             $hf_index_name =~ s{ ( \[ | \] ) }{\\$1}xg;     # escape any "[" or "]" characters
 583             $hf_field_type = $$hfArrayEntryFieldTypeHRef{$key};
 584             ##printf "--> %-35.35s: %s\n", $hf_index_name,  $hf_field_type;
 585
 586             next unless exists $hfTypes{$hf_field_type};    # Do we want to process for this hf[] entry type ?
 587
 588             # build the complete pattern
 589             my $patRegEx = qr /
 590                                   ( # part 1: $1
 591                                       $fcn_name \s* \(
 592                                       [^;]+?
 593                                       ,\s*
 594                                       $hf_index_name
 595                                       \s*,
 596                                       [^;]+
 597                                       ,\s*
 598                                   )
 599                                   ( # part 2: $2
 600                                       $encArgPat
 601                                   )
 602                                   ( # part 3: $3
 603                                       \s* \)
 604                                       \s* ;
 605                                   )
 606                               /xs;
 607
 608             ##print "\n$hf_index_name $hf_field_type\n";
 609
 610             ## Match and substitute as specified
 611             $$fileContentsRef =~ s/ $patRegEx /patsub($1,$2,$3)/xges;
 612
 613         }
 614
 615         return $found;
 616     }
 617
 618     # Called from fix_encoding_args to determine replacement string when a regex match is encountered
 619     #  $_[0]: part 1
 620     #  $_[1]: part 2: encoding arg
 621     #  $_[2]: part 3
 622     #  lookup the desired replacement value for the encoding arg
 623     #  print match string showing and highlighting the encoding arg replacement
 624     #  return "replacement" string
 625     sub patsub {
 626         $found += 1;
 627         my $substr = exists $$searchReplaceHRef{$_[1]} ? $$searchReplaceHRef{$_[1]} : "???";
 628         my $str = sprintf("%s[[%s]-->[%s]]%s", $_[0], $_[1], $substr,  $_[2]);
 629         $str =~ tr/\t\n\r/ /d;
 630         printf "%s:  %-17.17s $str\n", $fileName, $hf_field_type . ":";
 631         return $_[0] . $substr . $_[2];
 632     }
 633 }  # block end
 634
 635 # ---------------------------------------------------------------------
 636 # Find all <fcnList> statements
 637 #  and output same highlighting the encoding arg
 638 #  Currently: encoding arg is matched as the *last* arg of the function call
 639
 640 sub find_all {
 641     my( $fcnListARef, $fileContentsRef, $fileName) = @_;
 642
 643     my $found = 0;
 644     my $fcnListPat = join "|", @$fcnListARef;
 645     my $pat = qr /
 646                      (
 647                          (?:$fcnListPat) \s* \(
 648                          [^;]+
 649                          , \s*
 650                      )
 651                      (
 652                          [^ \t,)]+?
 653                      )
 654                      (
 655                          \s* \)
 656                          \s* ;
 657                      )
 658                  /xs;
 659
 660     while ($$fileContentsRef =~ / $pat /xgso) {
 661         my $str = "${1}[[${2}]]${3}\n";
 662         $str =~ tr/\t\n\r/ /d;
 663         $str =~ s/ \s+ / /xg;
 664         print "$fileName: $str\n";
 665         $found += 1;
 666     }
 667     return $found;
 668 }
 669