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