tools/checkhf.pl

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