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