#!/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




