1#!/usr/bin/env perl 2# 3# Copyright 2013, William Meier (See AUTHORS file) 4# 5# Validate hf_... and ei_... usage for a dissector file; 6# 7# Usage: checkhf.pl [--debug=?] <file or files> 8# 9# Wireshark - Network traffic analyzer 10# By Gerald Combs <gerald@wireshark.org> 11# Copyright 1998 Gerald Combs 12# 13# SPDX-License-Identifier: GPL-2.0-or-later 14# 15 16## Note: This program is a re-implementation of the 17## original checkhf.pl written and (C) by Joerg Mayer. 18## The overall objective of the new implementation was to reduce 19## the number of false positives which occurred with the 20## original checkhf.pl 21## 22## This program can be used to scan original .c source files or source 23## files which have been passed through a C pre-processor. 24## Operating on pre-processed source files is optimal; There should be 25## minimal false positives. 26## If the .c input is an original source file there may very well be 27## false positives/negatives due to the fact that the hf_... variables & etc 28## may be created via macros. 29## 30## ----- (The following is extracted from the original checkhf.pl with thanks to Joerg) ------- 31## Example: 32## ~/work/wireshark/trunk/epan/dissectors> ../../tools/checkhf.pl packet-afs.c 33## Unused entry: packet-afs.c, hf_afs_ubik_voteend 34## Unused entry: packet-afs.c, hf_afs_ubik_errcode 35## Unused entry: packet-afs.c, hf_afs_ubik_votetype 36## ERROR: NO ARRAY: packet-afs.c, hf_afs_fs_ipaddr 37## 38## or checkhf.pl packet-*.c, which will check all the dissector files. 39## 40## NOTE: This tool currently generates false positives! 41## 42## The "NO ARRAY" messages - if accurate - points to an error that will 43## cause (t|wire)shark to report a DISSECTOR_BUG when a packet containing 44## this particular element is being dissected. 45## 46## The "Unused entry" message indicates the opposite: We define an entry but 47## never use it (e.g., in a proto_...add... function). 48## ------------------------------------------------------------------------------------ 49 50# ------------------------------------------------------------------------------------ 51# Main 52# 53# Logic: 54# 1. Clean the input: remove blank lines, comments, quoted strings and code under '#if 0'. 55# 2. hf_defs: 56# Find (and remove from input) list of hf_... variable 57# definitions ('static? g?int hf_... ;') 58# 2. hf_array_entries: 59# Find (and remove from input) list of hf_... variables 60# referenced in the hf[] entries; 61# 3. hf_usage: 62# From the remaining input, extract list of all strings of form hf_... 63# (which may include strings which are not actually valid 64# hf_... variable references). 65# 4. Checks: 66# If entries in hf_defs not in hf_usage then "unused" (for static hf_defs only) 67# If entries in hf_defs not in hf_array_entries then "ERROR: NO ARRAY"; 68 69use strict; 70use warnings; 71 72use Getopt::Long; 73 74my $help_flag = ''; 75my $debug = 0; # default: off; 1=cmt; 2=#if0; 3=hf_defs; 4=hf_array_entries; 5=hfusage (See code) 76 77my $sts = GetOptions( 78 'debug=i' => \$debug, 79 'help|?' => \$help_flag 80 ); 81if (!$sts || $help_flag || !$ARGV[0]) { 82 usage(); 83} 84 85my $error = 0; 86 87while (my $filename = $ARGV[0]) { 88 shift; 89 90 my ($file_contents); 91 my (%hf_defs, %hf_static_defs, %hf_array_entries, %hf_usage); 92 my ($unused_href, $no_array_href); 93 my (%ei_defs, %ei_static_defs, %ei_array_entries, %ei_usage); 94 my ($unused_ei, $no_array_ei); 95 96 read_file(\$filename, \$file_contents); 97 98 remove_comments (\$file_contents, $filename); 99 remove_blank_lines (\$file_contents, $filename); 100 $file_contents =~ s/^\s+//m; # Remove leading spaces 101 remove_quoted_strings(\$file_contents, $filename); 102 remove_if0_code (\$file_contents, $filename); 103 104 find_remove_hf_defs (\$file_contents, $filename, \%hf_defs); 105 find_remove_hf_array_entries (\$file_contents, $filename, \%hf_array_entries); 106 find_remove_proto_get_id_hf_assignments(\$file_contents, $filename, \%hf_array_entries); 107 find_hf_usage (\$file_contents, $filename, \%hf_usage); 108 109 find_remove_ei_defs (\$file_contents, $filename, \%ei_defs); 110 find_remove_ei_array_entries (\$file_contents, $filename, \%ei_array_entries); 111 find_ei_usage (\$file_contents, $filename, \%ei_usage); 112 113# Tests (See above) 114# 1. Are all the static hf_defs and ei_defs entries in hf_usage and ei_usage? 115# if not: "Unused entry:" 116# 117 118 # create a hash containing entries just for the static definitions 119 @hf_static_defs{grep {$hf_defs{$_} == 0} keys %hf_defs} = (); # All values in the new hash will be undef 120 @ei_static_defs{grep {$ei_defs{$_} == 0} keys %ei_defs} = (); # All values in the new hash will be undef 121 122 $unused_href = diff_hash(\%hf_static_defs, \%hf_usage); 123 remove_hf_pid_from_unused_if_add_oui_call(\$file_contents, $filename, $unused_href); 124 125 $unused_ei = diff_hash(\%ei_static_defs, \%ei_usage); 126 127 print_list("Unused href entry: $filename: ", $unused_href); 128 print_list("Unused ei entry: $filename: ", $unused_ei); 129 130# 2. Are all the hf_defs and ei_ entries (static and global) in [hf|ei]_array_entries ? 131# (Note: if a static hf_def or ei is "unused", don't check for same in [hf|ei]_array_entries) 132# if not: "ERROR: NO ARRAY" 133 134## Checking for missing global defs currently gives false positives 135## So: only check static defs for now. 136## $no_array_href = diff_hash(\%hf_defs, \%hf_array_entries); 137 $no_array_href = diff_hash(\%hf_static_defs, \%hf_array_entries); 138 $no_array_href = diff_hash($no_array_href, $unused_href); # Remove "unused" hf_... from no_array list 139 $no_array_ei = diff_hash(\%ei_static_defs, \%ei_array_entries); 140 $no_array_ei = diff_hash($no_array_ei, $unused_ei); # Remove "unused" ei_... from no_array list 141 142 print_list("ERROR: NO ARRAY: $filename: ", $no_array_href); 143 print_list("ERROR: NO ARRAY: $filename: ", $no_array_ei); 144 145 if ((keys %{$no_array_href}) != 0) { 146 $error += 1; 147 } 148 if ((keys %{$no_array_ei}) != 0) { 149 $error += 1; 150 } 151} 152 153exit (($error == 0) ? 0 : 1); # exit 1 if ERROR 154 155 156# --------------------------------------------------------------------- 157# 158sub usage { 159 print "Usage: $0 [--debug=n] Filename [...]\n"; 160 exit(1); 161} 162 163# --------------------------------------------------------------------- 164# action: read contents of a file to specified string 165# arg: filename_ref, file_contents_ref 166 167sub read_file { 168 my ($filename_ref, $file_contents_ref) = @_; 169 170 die "No such file: \"${$filename_ref}\"\n" if (! -e ${$filename_ref}); 171 172 # delete leading './' 173 ${$filename_ref} =~ s{ ^ [.] / } {}xmso; 174 175 # Read in the file (ouch, but it's easier that way) 176 open(my $fci, "<:crlf", ${$filename_ref}) || die("Couldn't open ${$filename_ref}"); 177 178 ${$file_contents_ref} = do { local( $/ ) ; <$fci> } ; 179 180 close($fci); 181 182 return; 183} 184 185# --------------------------------------------------------------------- 186# action: Create a hash containing entries in 'a' that are not in 'b' 187# arg: a_href, b_href 188# returns: pointer to hash 189 190sub diff_hash { 191 my ($a_href, $b_href) = @_; 192 193 my %diffs; 194 195 @diffs{grep {! exists $b_href->{$_}} keys %{$a_href}} = (); # All values in the new hash will be undef 196 197 return \%diffs; 198} 199 200# --------------------------------------------------------------------- 201# action: print a list 202# arg: hdr, list_href 203 204sub print_list { 205 my ($hdr, $list_href) = @_; 206 207 print 208 map {"$hdr$_\n"} 209 sort 210 keys %{$list_href}; 211 212 return; 213} 214 215# ------------ 216# action: remove blank lines from input string 217# arg: code_ref, filename 218 219sub remove_blank_lines { 220 my ($code_ref, $filename) = @_; 221 222 ${$code_ref} =~ s{ ^ \s* \n ? } {}xmsog; 223 224 return; 225} 226 227sub get_quoted_str_regex { 228 # A regex which matches double-quoted strings. 229 # 's' modifier added so that strings containing a 'line continuation' 230 # ( \ followed by a new-line) will match. 231 my $double_quoted_str = qr{ (?: ["] (?: \\. | [^\"\\\n])* ["]) }xmso; 232 233 # A regex which matches single-quoted strings. 234 my $single_quoted_str = qr{ (?: ['] (?: \\. | [^\'\\\n])* [']) }xmso; 235 236 return qr{ $double_quoted_str | $single_quoted_str }xmso; 237} 238 239# ------------ 240# action: remove comments from input string 241# arg: code_ref, filename 242 243sub remove_comments { 244 my ($code_ref, $filename) = @_; 245 246 # The below Regexp is based on one from: 247 # https://web.archive.org/web/20080614012925/http://aspn.activestate.com/ASPN/Cookbook/Rx/Recipe/59811 248 # It is in the public domain. 249 # A complicated regex which matches C-style comments. 250 my $c_comment_regex = qr{ / [*] [^*]* [*]+ (?: [^/*] [^*]* [*]+ )* / }xmso; 251 252 ${$code_ref} =~ s{ $c_comment_regex } {}xmsog; 253 254 # Remove single-line C++-style comments. Be careful not to break up strings 255 # like "coap://", so match double quoted strings, single quoted characters, 256 # division operator and other characters before the actual "//" comment. 257 my $quoted_str = get_quoted_str_regex(); 258 my $cpp_comment_regex = qr{ ^((?: $quoted_str | /(?!/) | [^'"/\n] )*) // .*$ }xm; 259 ${$code_ref} =~ s{ $cpp_comment_regex } { $1 }xmg; 260 261 ($debug == 1) && print "==> After Remove Comments: code: [$filename]\n${$code_ref}\n===<\n"; 262 263 return; 264} 265 266# ------------ 267# action: remove quoted strings from input string 268# arg: code_ref, filename 269 270sub remove_quoted_strings { 271 my ($code_ref, $filename) = @_; 272 273 my $quoted_str = get_quoted_str_regex(); 274 ${$code_ref} =~ s{ $quoted_str } {}xmsog; 275 276 ($debug == 1) && print "==> After Remove quoted strings: code: [$filename]\n${$code_ref}\n===<\n"; 277 278 return; 279} 280 281# ------------- 282# action: remove '#if 0'd code from the input string 283# args codeRef, fileName 284# returns: codeRef 285# 286# Essentially: split the input into blocks of code or lines of #if/#if 0/etc. 287# Remove blocks that follow '#if 0' until '#else/#endif' is found. 288 289{ # block begin 290 291 sub remove_if0_code { 292 my ($codeRef, $fileName) = @_; 293 294 # Preprocess outputput (ensure trailing LF and no leading WS before '#') 295 $$codeRef =~ s/^\s*#/#/m; 296 if ($$codeRef !~ /\n$/) { $$codeRef .= "\n"; } 297 298 # Split into blocks of normal code or lines with conditionals. 299 my $ifRegExp = qr/if 0|if|else|endif/; 300 my @blocks = split(/^(#\s*(?:$ifRegExp).*\n)/m, $$codeRef); 301 302 my ($if_lvl, $if0_lvl, $if0) = (0,0,0); 303 my $lines = ''; 304 for my $block (@blocks) { 305 my $if; 306 if ($block =~ /^#\s*($ifRegExp)/) { 307 # #if/#if 0/#else/#endif processing 308 $if = $1; 309 if ($debug == 99) { 310 print(STDERR "if0=$if0 if0_lvl=$if0_lvl lvl=$if_lvl [$if] - $block"); 311 } 312 if ($if eq 'if') { 313 $if_lvl += 1; 314 } elsif ($if eq 'if 0') { 315 $if_lvl += 1; 316 if ($if0_lvl == 0) { 317 $if0_lvl = $if_lvl; 318 $if0 = 1; # inside #if 0 319 } 320 } elsif ($if eq 'else') { 321 if ($if0_lvl == $if_lvl) { 322 $if0 = 0; 323 } 324 } elsif ($if eq 'endif') { 325 if ($if0_lvl == $if_lvl) { 326 $if0 = 0; 327 $if0_lvl = 0; 328 } 329 $if_lvl -= 1; 330 if ($if_lvl < 0) { 331 die "patsub: #if/#endif mismatch in $fileName" 332 } 333 } 334 } 335 336 if ($debug == 99) { 337 print(STDERR "if0=$if0 if0_lvl=$if0_lvl lvl=$if_lvl\n"); 338 } 339 # Keep preprocessor lines and blocks that are not enclosed in #if 0 340 if ($if or $if0 != 1) { 341 $lines .= $block; 342 } 343 } 344 $$codeRef = $lines; 345 346 ($debug == 2) && print "==> After Remove if0: code: [$fileName]\n$$codeRef\n===<\n"; 347 return $codeRef; 348 } 349} # block end 350 351# --------------------------------------------------------------------- 352# action: Add to hash an entry for each 353# 'static? g?int hf_...' definition (including array names) 354# in the input string. 355# The entry value will be 0 for 'static' definitions and 1 for 'global' definitions; 356# Remove each definition found from the input string. 357# args: code_ref, filename, hf_defs_href 358# returns: ref to the hash 359 360sub find_remove_hf_defs { 361 my ($code_ref, $filename, $hf_defs_href) = @_; 362 363 # Build pattern to match any of the following 364 # static? g?int hf_foo = -1; 365 # static? g?int hf_foo[xxx]; 366 # static? g?int hf_foo[xxx] = { 367 368 # p1: 'static? g?int hf_foo' 369 my $p1_regex = qr{ 370 ^ 371 \s* 372 (static \s+)? 373 g?int 374 \s+ 375 (hf_[a-zA-Z0-9_]+) # hf_.. 376 }xmso; 377 378 # p2a: ' = -1;' 379 my $p2a_regex = qr{ 380 \s* = \s* 381 (?: 382 - \s* 1 383 ) 384 \s* ; 385 }xmso; 386 387 # p2b: '[xxx];' or '[xxx] = {' 388 my $p2b_regex = qr/ 389 \s* \[ [^\]]+ \] \s* 390 (?: 391 = \s* [{] | ; 392 ) 393 /xmso; 394 395 my $hf_def_regex = qr{ $p1_regex (?: $p2a_regex | $p2b_regex ) }xmso; 396 397 while (${$code_ref} =~ m{ $hf_def_regex }xmsog) { 398 #print ">%s< >$2<\n", (defined $1) ? $1 ; ""; 399 $hf_defs_href->{$2} = (defined $1) ? 0 : 1; # 'static' if $1 is defined. 400 } 401 ($debug == 3) && debug_print_hash("VD: $filename", $hf_defs_href); # VariableDefinition 402 403 # remove all 404 ${$code_ref} =~ s{ $hf_def_regex } {}xmsog; 405 ($debug == 3) && print "==> After remove hf_defs: code: [$filename]\n${$code_ref}\n===<\n"; 406 407 return; 408} 409 410# --------------------------------------------------------------------- 411# action: Add to hash an entry (hf_...) for each hf[] entry. 412# Remove each hf[] entries found from the input string. 413# args: code_ref, filename, hf_array_entries_href 414 415sub find_remove_hf_array_entries { 416 my ($code_ref, $filename, $hf_array_entries_href) = @_; 417 418# hf[] entry regex (to extract an hf_index_name and associated field type) 419 my $hf_array_entry_regex = qr / 420 [{] 421 \s* 422 & \s* ( [a-zA-Z0-9_]+ ) # &hf 423 (?: 424 \s* [[] [^]]+ []] # optional array ref 425 ) ? 426 \s* , \s* 427 [{] 428 [^}]+ 429 , \s* 430 (FT_[a-zA-Z0-9_]+) # field type 431 \s* , 432 [^}]+ 433 , \s* 434 (?: 435 HFILL | HF_REF_TYPE_NONE 436 ) 437 [^}]* 438 } 439 [\s,]* 440 [}] 441 /xmso; 442 443 # find all the hf[] entries (searching ${$code_ref}). 444 while (${$code_ref} =~ m{ $hf_array_entry_regex }xmsog) { 445 ($debug == 98) && print "+++ $1 $2\n"; 446 $hf_array_entries_href->{$1} = undef; 447 } 448 449 ($debug == 4) && debug_print_hash("AE: $filename", $hf_array_entries_href); # ArrayEntry 450 451 # now remove all 452 ${$code_ref} =~ s{ $hf_array_entry_regex } {}xmsog; 453 ($debug == 4) && print "==> After remove hf_array_entries: code: [$filename]\n${$code_ref}\n===<\n"; 454 455 return; 456} 457 458# --------------------------------------------------------------------- 459# action: Add to hash an entry (hf_...) for each hf_... var 460# found in statements of the form: 461# 'hf_... = proto_registrar_get_id_byname ...' 462# 'hf_... = proto_get_id_by_filtername ...' 463# Remove each such statement found from the input string. 464# args: code_ref, filename, hf_array_entries_href 465 466sub find_remove_proto_get_id_hf_assignments { 467 my ($code_ref, $filename, $hf_array_entries_href) = @_; 468 469 my $_regex = qr{ ( hf_ [a-zA-Z0-9_]+ ) 470 \s* = \s* 471 (?: proto_registrar_get_id_byname | proto_get_id_by_filter_name ) 472 }xmso; 473 474 my @hfvars = ${$code_ref} =~ m{ $_regex }xmsog; 475 476 if (@hfvars == 0) { 477 return; 478 } 479 480 # found: 481 # Sanity check: hf_vars shouldn't already be in hf_array_entries 482 if (defined @$hf_array_entries_href{@hfvars}) { 483 printf "? one or more of [@hfvars] initialized via proto_registrar_get_by_name() also in hf[] ??\n"; 484 } 485 486 # Now: add to hf_array_entries 487 @$hf_array_entries_href{@hfvars} = (); 488 489 ($debug == 4) && debug_print_hash("PR: $filename", $hf_array_entries_href); 490 491 # remove from input (so not considered as 'usage') 492 ${$code_ref} =~ s{ $_regex } {}xmsog; 493 494 ($debug == 4) && print "==> After remove proto_registrar_by_name: code: [$filename]\n${$code_ref}\n===<\n"; 495 496 return; 497} 498 499# --------------------------------------------------------------------- 500# action: Add to hash all hf_... strings remaining in input string. 501# arga: code_ref, filename, hf_usage_href 502# return: ref to hf_usage hash 503# 504# The hash will include *all* strings of form hf_... 505# which are in the input string (even strings which 506# aren't actually vars). 507# We don't care since we'll be checking only 508# known valid vars against these strings. 509 510sub find_hf_usage { 511 my ($code_ref, $filename, $hf_usage_href) = @_; 512 513 my $hf_usage_regex = qr{ 514 \b ( hf_[a-zA-Z0-9_]+ ) # hf_... 515 }xmso; 516 517 while (${$code_ref} =~ m{ $hf_usage_regex }xmsog) { 518 #print "$1\n"; 519 $hf_usage_href->{$1} += 1; 520 } 521 522 ($debug == 5) && debug_print_hash("VU: $filename", $hf_usage_href); # VariableUsage 523 524 return; 525} 526 527# --------------------------------------------------------------------- 528# action: Remove from 'unused' hash an instance of a variable named hf_..._pid 529# if the source has a call to llc_add_oui() or ieee802a_add_oui(). 530# (This is rather a bit of a hack). 531# arga: code_ref, filename, unused_href 532 533sub remove_hf_pid_from_unused_if_add_oui_call { 534 my ($code_ref, $filename, $unused_href) = @_; 535 536 if ((keys %{$unused_href}) == 0) { 537 return; 538 } 539 540 my @hfvars = grep { m/ ^ hf_ [a-zA-Z0-9_]+ _pid $ /xmso} keys %{$unused_href}; 541 542 if ((@hfvars == 0) || (@hfvars > 1)) { 543 return; # if multiple unused hf_..._pid 544 } 545 546 if (${$code_ref} !~ m{ llc_add_oui | ieee802a_add_oui }xmso) { 547 return; 548 } 549 550 # hf_...pid unused var && a call to ..._add_oui(); delete entry from unused 551 # XXX: maybe hf_..._pid should really be added to hfUsed ? 552 delete @$unused_href{@hfvars}; 553 554 return; 555} 556 557# --------------------------------------------------------------------- 558# action: Add to hash an entry for each 559# 'static? expert_field ei_...' definition (including array names) 560# in the input string. 561# The entry value will be 0 for 'static' definitions and 1 for 'global' definitions; 562# Remove each definition found from the input string. 563# args: code_ref, filename, hf_defs_href 564# returns: ref to the hash 565 566sub find_remove_ei_defs { 567 my ($code_ref, $filename, $ei_defs_eiref) = @_; 568 569 # Build pattern to match any of the following 570 # static? expert_field ei_foo = -1; 571 # static? expert_field ei_foo[xxx]; 572 # static? expert_field ei_foo[xxx] = { 573 574 # p1: 'static? expert_field ei_foo' 575 my $p1_regex = qr{ 576 ^ 577 (static \s+)? 578 expert_field 579 \s+ 580 (ei_[a-zA-Z0-9_]+) # ei_.. 581 }xmso; 582 583 # p2a: ' = EI_INIT;' 584 my $p2a_regex = qr{ 585 \s* = \s* 586 (?: 587 EI_INIT 588 ) 589 \s* ; 590 }xmso; 591 592 # p2b: '[xxx];' or '[xxx] = {' 593 my $p2b_regex = qr/ 594 \s* \[ [^\]]+ \] \s* 595 (?: 596 = \s* [{] | ; 597 ) 598 /xmso; 599 600 my $ei_def_regex = qr{ $p1_regex (?: $p2a_regex | $p2b_regex ) }xmso; 601 602 while (${$code_ref} =~ m{ $ei_def_regex }xmsog) { 603 #print ">%s< >$2<\n", (defined $1) ? $1 ; ""; 604 $ei_defs_eiref->{$2} = (defined $1) ? 0 : 1; # 'static' if $1 is defined. 605 } 606 ($debug == 3) && debug_print_hash("VD: $filename", $ei_defs_eiref); # VariableDefinition 607 608 # remove all 609 ${$code_ref} =~ s{ $ei_def_regex } {}xmsog; 610 ($debug == 3) && print "==> After remove ei_defs: code: [$filename]\n${$code_ref}\n===<\n"; 611 612 return; 613} 614 615# --------------------------------------------------------------------- 616# action: Add to hash an entry (ei_...) for each ei[] entry. 617# Remove each ei[] entries found from the input string. 618# args: code_ref, filename, ei_array_entries_href 619 620sub find_remove_ei_array_entries { 621 my ($code_ref, $filename, $ei_array_entries_eiref) = @_; 622 623# ei[] entry regex (to extract an ei_index_name and associated field type) 624 my $ei_array_entry_regex = qr / 625 { 626 \s* 627 & \s* ( [a-zA-Z0-9_]+ ) # &ei 628 (?: 629 \s* [ [^]]+ ] # optional array ref 630 ) ? 631 \s* , \s* 632 { 633 # \s* "[^"]+" # (filter string has been removed already) 634 \s* , \s* 635 PI_[A-Z0-9_]+ # event group 636 \s* , \s* 637 PI_[A-Z0-9_]+ # event severity 638 \s* , 639 [^,]* # description string (already removed) or NULL 640 , \s* 641 EXPFILL 642 \s* 643 } 644 \s* 645 } 646 /xs; 647 648 # find all the ei[] entries (searching ${$code_ref}). 649 while (${$code_ref} =~ m{ $ei_array_entry_regex }xsg) { 650 ($debug == 98) && print "+++ $1\n"; 651 $ei_array_entries_eiref->{$1} = undef; 652 } 653 654 ($debug == 4) && debug_print_hash("AE: $filename", $ei_array_entries_eiref); # ArrayEntry 655 656 # now remove all 657 ${$code_ref} =~ s{ $ei_array_entry_regex } {}xmsog; 658 ($debug == 4) && print "==> After remove ei_array_entries: code: [$filename]\n${$code_ref}\n===<\n"; 659 660 return; 661} 662 663# --------------------------------------------------------------------- 664# action: Add to hash all ei_... strings remaining in input string. 665# arga: code_ref, filename, ei_usage_eiref 666# return: ref to ei_usage hash 667# 668# The hash will include *all* strings of form ei_... 669# which are in the input string (even strings which 670# aren't actually vars). 671# We don't care since we'll be checking only 672# known valid vars against these strings. 673 674sub find_ei_usage { 675 my ($code_ref, $filename, $ei_usage_eiref) = @_; 676 677 my $ei_usage_regex = qr{ 678 \b ( ei_[a-zA-Z0-9_]+ ) # ei_... 679 }xmso; 680 681 while (${$code_ref} =~ m{ $ei_usage_regex }xmsog) { 682 #print "$1\n"; 683 $ei_usage_eiref->{$1} += 1; 684 } 685 686 ($debug == 5) && debug_print_hash("VU: $filename", $ei_usage_eiref); # VariableUsage 687 688 return; 689} 690 691# --------------------------------------------------------------------- 692sub debug_print_hash { 693 my ($title, $href) = @_; 694 695 ##print "==> $title\n"; 696 for my $k (sort keys %{$href}) { 697 my $h = defined($href->{$k}) ? $href->{$k} : "undef"; 698 printf "%-40.40s %5.5s %s\n", $title, $h, $k; 699 } 700} 701