Generated: Sun Aug 21 11:11:11 2011 from lib_confscan.pl 2010/09/10 16.8 KB.
#!/usr/bin/perl # module : lib_confscan.pl # purpose : to rougholy scan a 'configure' file, and obtain any macros found. # 10/09/2010 geoff mclane http://geoffair.net/mperl use strict; use warnings; our ($dbg_cs01, $dbg_cs02, $dbg_cs03, $dbg_cs04, $dbg_cs05, $dbg_cs06, $dbg_cs07, $dbg_cs08, $dbg_cs09, $dbg_cs10 ); # SPLIT text into # 1: $(\w+) # 2: ${\w+} # 3: $\w+ # 4: @\w+@ # With $add, include ALL in the returned array sub conf_macro_split($$) { my ($txt,$add) = @_; my @arr = (); my $len = length($txt); my ($i,$tag,$ch,,$nc,$mac,$k); $tag = ''; for ($i = 0; $i < $len; $i++) { $ch = substr($txt,$i,1); if ($ch eq '$') { $k = $i + 1; if ((($k+3) < $len)&&(substr($txt,$k,1) eq '(')) { $k++; $mac = '$('; for (; $k < $len; $k++) { $nc = substr($txt,$k,1); $mac .= $nc; last if ($nc eq ')'); last if !($nc =~ /\w/); } if ($nc eq ')') { push(@arr,$tag) if ($add && length($tag)); $tag = ''; push(@arr,$mac); $ch = ''; $i = $k; } } elsif ((($k+3) < $len)&&(substr($txt,$k,1) eq '{')) { $k++; $mac = '${'; for (; $k < $len; $k++) { $nc = substr($txt,$k,1); $mac .= $nc; last if ($nc eq '}'); last if !($nc =~ /\w/); } if ($nc eq '}') { push(@arr,$tag) if ($add && length($tag)); $tag = ''; push(@arr,$mac); $ch = ''; $i = $k; } } elsif ((($k+1) < $len)&&(substr($txt,$k,1) =~ /\w/)) { $mac = '$'; for (; $k < $len; $k++) { $nc = substr($txt,$k,1); last if ($nc =~ /\W/); $mac .= $nc; } push(@arr,$tag) if ($add & length($tag)); $tag = ''; push(@arr,$mac); $ch = ''; $i = $k - 1; # leave last ot be picked up again } } elsif ($ch eq '@') { $k = $i + 1; if ((($k+1) < $len) && (substr($txt,$k) =~ /^(\w+)\@/)) { $mac = '@'; for (; $k < $len; $k++) { $nc = substr($txt,$k,1); $mac .= $nc; last if ($nc eq '@'); last if ($nc =~ /\W/); } if ($nc eq '@') { push(@arr,$tag) if ($add && length($tag)); $tag = ''; push(@arr,$mac); $ch = ''; $i = $k; } } } if ( $add && (($ch eq "'") || ($ch eq '"')) ) { push(@arr,$tag) if (length($tag)); $tag = ''; push(@arr,$ch); } else { $tag .= $ch; } } return @arr; } sub macro_replacement($$) { my ($txt,$rparams) = @_; my $otxt = $txt; my @arr = conf_macro_split($txt,0); if (@arr) { my ($itm,$mac,$val,$done,$typ); my $rm = ${$rparams}{'REF_MACS_FOUND'}; if ($dbg_cs07) { prt("[07] Got macro split "); foreach $itm (@arr) { prt("[$itm] "); } prt("\n"); } my $inf = ${$rparams}{'CURR_IN_FILE'}; my $rsnf = ${$rparams}{'CURR_SUBS_NOT_FOUND'}; my $lnn = ${$rparams}{'CURR_LINE'}; foreach $itm (@arr) { $done = 0; $typ = 0; if ($itm =~ /^\$\((\w+)\)$/) { $mac = $1; $typ = 1; if (defined ${$rm}{$mac}) { $val = ${$rm}{$mac}; $txt =~ s/\$\($mac\)/$val/; $done = 1; } } elsif ($itm =~ /^\$\{(\w+)\}$/) { $mac = $1; $typ = 2; if (defined ${$rm}{$mac}) { $val = ${$rm}{$mac}; $txt =~ s/\$\{$mac\}/$val/; $done = 2; } } elsif ($itm =~ /^\$\@(\w+)\@$/) { $mac = $1; $typ = 3; if (defined ${$rm}{$mac}) { $val = ${$rm}{$mac}; $txt =~ s/\$\@$mac\@/$val/; $done = 3; } } elsif ($itm =~ /^\$(\w+)$/) { $mac = $1; $typ = 4; if (defined ${$rm}{$mac}) { $val = ${$rm}{$mac}; $txt =~ s/\$$mac/$val/; $done = 4; } } else { pgm_exit(1,"ERROR: macro split of [$itm], from [$otxt] NOT HANDLED [$txt]\n"); } if (!$done) { prt("[09] NOTE: Failed to find replacement for [$mac] [$itm] type [$typ]\n") if ($dbg_cs09); $mac = $itm if ($typ == 0); if (!defined ${$rsnf}{$mac}) { # keep the first instance found ${$rsnf}{$mac} = "$lnn:$inf"; } } } } return $txt; } sub show_if_stack($$) { my ($rea,$rxa) = @_; # = \@ifenter,\@ifexit my ($i,$line,$num,$done); my $ecnt = scalar @{$rea}; my $pos = -1; $done = 0; for ($i = 0; $i < $ecnt; $i++) { $line = ${$rea}[$pos][0]; $num = ${$rea}[$pos][1]; prt( " $line\n"); $pos--; last if ($done > 1); $done++ if ($num == 1); } my $xcnt = scalar @{$rxa}; my $xpos = -1; $done = 0; for ($i = 0; $i < $xcnt; $i++) { $line = ${$rxa}[$xpos][0]; $num = ${$rxa}[$xpos][1]; prt( " $line\n"); $xpos--; last if ($done > 1); $done++ if ($num == 0); } } sub show_if_stack3($$$) { my ($rea,$rxa,$ris) = @_; # = \@ifenter,\@ifexit,\@ifstack my ($i,$line,$num,$done); my $cnt = scalar @{$ris}; my $pos = -1; $done = 0; for ($i = 0; $i < $cnt; $i++) { $line = ${$ris}[$pos][0]; $num = ${$ris}[$pos][1]; prt( " $line\n"); $done++; #last if ($done > 6); last if (($done > 6) && ($line =~ /\s+Enter\s+/) && ($num == 1)); $pos--; } } sub show_if_stack4($$$$) { my ($rea,$rxa,$ris,$rsi) = @_; # = \@ifenter,\@ifexit,\@ifstack my ($i,$line,$num,$done); my $cnt = scalar @{$ris}; my $pos = -1; my $msg = ''; $done = 0; if (@{$rsi}) { prt(" IF stacked ".join(", ",@{$rsi})."\n"); } for ($i = 0; $i < $cnt; $i++) { $line = ${$ris}[$pos][0]; $num = ${$ris}[$pos][1]; $line =~ s/\n$//; $msg .= " $line\n"; $done++; #last if ($done > 6); #last if (($done > 6) && ($line =~ /^\s+\d+:\s+Enter\s+/) && ($num == 1)); last if ( ($line =~ /^\s*\d+:\s+Enter\s+/) && ($num == 1) ); $pos--; } return $msg; } sub closed_with_fi($) { my $line = shift; $line = trim_all($line); return 1 if ($line =~ /[;\s]+fi$/); return 0; } sub process_in_file($) { my ($rparams) = @_; my $inf = ${$rparams}{'CURR_IN_FILE'}; my $rsnf = ${$rparams}{'CURR_SUBS_NOT_FOUND'}; my %macros = (); my $rm = \%macros; ${$rparams}{'REF_MACS_FOUND'} = $rm; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to OPEN file [$inf]!\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inif,$lnn,$tline,$incase,$mac,$equ,$nline,$i,$org,$ifclosed,$ifentered,$cline); my ($tmp,$msg); $inif = 0; $lnn = 0; $incase = 0; $ifclosed = ''; $ifentered = ''; my @ifenter = (); my @ifexit = (); my @ifstack = (); my @stackedif = (); for ($i = 0; $i < $lncnt; $i++) { $line = $lines[$i]; chomp $line; $tline = trim_all($line); $lnn = $i + 1; prt("[03] $lnn: [$tline] if=$inif case=$incase\n") if ($dbg_cs03); next if ($line =~ /^\s*#/); if ($tline eq 'if') { $i++; # bump line if ($i < $lncnt) { $tline = trim_all($lines[$i]); # get next $line .= ' '.$tline; $lnn = $i + 1; prt("[03] $lnn: [$tline]\n") if ($dbg_cs03); } } # accumulate the back, until none while (($line =~ /\\$/) && ($i < $lncnt)) { $line =~ s/\\$//; # remove back slash $i++; # bump line if ($i < $lncnt) { $tline = trim_all($lines[$i]); # get next $line .= ' '.$tline; $lnn = $i + 1; prt("[03] $lnn: [$tline]\n") if ($dbg_cs03); } } $tline = trim_all($line); $lnn = $i + 1; #prt("$lnn: [$line]\n"); if ($incase) { if ($line =~ /\s*esac\b/) { prt("[04] $lnn: Exit 'case' ($incase) line [$tline] if=$inif\n") if ($dbg_cs04); $incase--; if ($incase == 0) { if ( closed_with_fi($line) ) { if (@stackedif) { $tmp = pop @stackedif; } else { prt("$lnn: NO STACKED IF TO POP!\n"); $tmp = "NO STACKED IF TO POP!"; } $msg = "$lnn: Exit 'if' closed_with_fi ($inif) line [$tline] $tmp ".(($inif == 1) ? "CLOSED\n" : ""); prt("[01] $msg\n") if ($dbg_cs01); $ifclosed = $msg; $inif-- if ($inif); push(@ifexit,[$ifclosed,$inif]); push(@ifstack,[$ifclosed,$inif,$lnn]); } } } elsif ($line =~ /^\s*case\b/) { $incase++; prt("[04] $lnn: Enter 'case' ($incase) line [$tline] if=$inif\n") if ($dbg_cs04); } next; # stick with the CASE } elsif ($inif) { if ($line =~ /^\s*case\b/) { $incase++; prt("[04] $lnn: Enter 'case' ($incase) line [$tline] if=$inif\n") if ($dbg_cs04); next; } $cline = $line; #if ($line =~ /^\s*fi\b/) if ($line =~ /^\s*fi\s*/) { # potential 'fi' $cline =~ s/\#.*$//; # clean '#....' if ($cline =~ /[;\}]/) { $cline = "NOT an 'ef'"; prt("[01] $lnn: AVOIDED 'fi' endif ($inif) line [$tline]\n") if ($dbg_cs01); } } if ($cline =~ /^\s*fi\s*/) { if (@stackedif) { $tmp = pop @stackedif; } else { prt("$lnn: NO STACKED IF TO POP!\n"); $tmp = "NO STACKED IF TO POP!"; } $msg = "$lnn: Exit 'if' endif ($inif) line [$tline] $tmp ".(($inif == 1) ? "CLOSED\n" : ""); prt("[01] $msg\n") if ($dbg_cs01); $ifclosed = $msg; $inif--; push(@ifexit,[$ifclosed,$inif]); push(@ifstack,[$ifclosed,$inif,$lnn]); } elsif ($line =~ /^else\b/) { if (@stackedif) { $tmp = $stackedif[-1]; } else { $tmp = "NO STACKED IF TO POP!"; } prt("[02] $lnn: Else 'if' ($inif) line [$tline] $tmp\n") if ($dbg_cs02); } elsif ($line =~ /^elif\b/) { prt("[02] $lnn: Elif 'if' ($inif) line [$tline]\n") if ($dbg_cs02); } elsif ($line =~ /^\s*if\s+(.+)$/) { if ( closed_with_fi($line) ) { prt("[01] $lnn: Enter and Exit 'if' ($inif) line [$tline]\n") if ($dbg_cs01); } else { $inif++; prt("[01] $lnn: Enter 'if' ($inif) line [$tline]\n") if ($dbg_cs01); $ifentered = "$lnn: Enter 'if' line [$tline] ($inif)"; push(@ifenter,[$ifentered,$inif]); push(@ifstack,[$ifentered,$inif,$lnn]); push(@stackedif,$ifentered); } } next; # stick with the IF } elsif ($line =~ /^\s*if\s+(.+)$/) { $inif++; prt("[01] $lnn: Enter 'if' ($inif) line [$tline] OPENNED\n") if ($dbg_cs01); $ifentered = "$lnn: Enter 'if' line [$tline] ($inif)"; push(@ifenter,[$ifentered,$inif]); push(@ifstack,[$ifentered,$inif,$lnn]); push(@stackedif,$ifentered); } elsif ($line =~ /^\s*fi\b/) { $tmp = show_if_stack4(\@ifenter,\@ifexit,\@ifstack,\@stackedif); prtw("WARNING: $lnn: Seen 'fi' OUTSIDE 'if' ($inif) line [$tline]\n$tmp") if ($dbg_cs10); } elsif ($line =~ /^\s*else\b/) { $tmp = show_if_stack4(\@ifenter,\@ifexit,\@ifstack,\@stackedif); prtw("WARNING: $lnn: Seen 'else' OUTSIDE 'if' ($inif) line [$tline]\n$tmp") if ($dbg_cs10); } elsif ($line =~ /^\s*elif\b/) { $tmp = show_if_stack4(\@ifenter,\@ifexit,\@ifstack,\@stackedif); prtw("WARNING: $lnn: Seen 'elif' OUTSIDE 'if' ($inif) line [$tline]\n$tmp") if ($dbg_cs10); } elsif ($line =~ /^\s*case\b/) { $incase++; prt("[04] $lnn: Enter 'case' ($incase) line [$tline] if=$inif\n") if ($dbg_cs04); } elsif (length($tline)) { if ($line =~ /^(\w+)\s*=\s*(.*)$/) { $mac = $1; $equ = trim_all($2); #prt("$lnn: [$mac] = [$equ]\n"); if ($equ =~ /^'/) { if ((length($equ) > 1) && ($equ =~ /'$/)) { # got END } else { $i++; while ($i < $lncnt) { $nline = trim_all($lines[$i]); #prt("$lnn: [$nline]\n"); $equ .= ' '; $equ .= $nline; if ($nline =~ /'$/) { #prt("$lnn: END\n"); last; } $i++; } } $equ =~ s/^'(.*)'$/$1/; } prt("[05] $lnn: MACRO [$mac] = [$equ]\n") if ($dbg_cs05); $org = $equ; ${$rparams}{'CURR_LINE'} = $lnn; $equ = macro_replacement($equ,$rparams) if ($equ =~ /[\$\@]/); prt("[06] $lnn: CHANGED [$mac] to [$equ] from [$org]\n") if ($dbg_cs06 && ($org ne $equ)); ${$rm}{$mac} = $equ; } else { prt("[08] $lnn: [$line] NOT USED\n") if ($dbg_cs08); } } } return $rm; } sub show_macs($) { my ($rparams) = @_; my ($cnt,$key,$val,$min,$len,$max); $max = 40; my $rsnf = ${$rparams}{'CURR_SUBS_NOT_FOUND'}; my $rm = ${$rparams}{'REF_MACS_FOUND'}; $cnt = scalar keys(%{$rsnf}); prt("\nNo sub found for potentially $cnt keys...\n"); $min = 0; foreach $key (keys %{$rsnf}) { $len = length($key); $min = $len if ($len > $min); last if ($min > $max); } $min = $max if ($min > $max); $cnt = 0; foreach $key (sort keys %{$rsnf}) { if (! defined ${$rm}{$key} ) { $val = ${$rsnf}{$key}; $cnt++; $key .= ' ' while (length($key) < $min); prt("$cnt: $key = [$val]\n"); } } prt("Done $cnt subs not found...\n"); $cnt = scalar keys(%{$rm}); prt("\nMac has $cnt keys...\n"); $min = 0; foreach $key (keys %{$rm}) { $len = length($key); $min = $len if ($len > $min); last if ($min > $max); } $min = $max if ($min > $max); $cnt = 0; foreach $key (sort keys %{$rm}) { $val = ${$rm}{$key}; $cnt++; $key .= ' ' while (length($key) < $min); prt("$cnt: $key = [$val]\n"); } prt("Done $cnt Mac keys...\n"); } 1; # eof - lib_confscan.pl