Generated: Sun Aug 21 11:10:29 2011 from acscan.pl 2010/09/01 28.4 KB.
#!perl -w # 31/08/2010 - review, with better understanding of the configure.ac file) # geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # to split path into ($name, $dir) = fileparse($ff); or ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ ); use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE use Cwd; my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); #require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; #require 'fgutils.pl' or die "Unable to load fgutils.pl ...\n"; require 'fgutils02.pl' or die "Unable to load 'fgutils02.pl' ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); my $conffile = $perl_dir."\\temp.$pgmname.conf"; my $no_conf_write = 0; my $AM_CONDITIONAL_PATTERN = "AM_CONDITIONAL\\((\\w+)"; my $AM_INIT_AUTOMAKE = "AM_INIT_AUTOMAKE\\(([^,]+),[ \t]*([^)]+)"; # AC_INIT (package, version, [bug-report], [tarname]) # Set the name of the package and its version my $AC_INIT = "AC_INIT\\((.+)\\)"; my $AC_DEF = "AC_DEFINE\\((.+)"; my $AC_DEFU = "AC_DEFINE_UNQUOTED\\((.+)"; my $AC_DEFINE = "AC_DEFINE\\((.+)\\)"; my $AC_DEFINE_UNQ = "AC_DEFINE_UNQUOTED\\((.+)\\)"; my $in_file = 'C:\FG\PREOSG\SimGear\source\configure.ac'; my $load_log = 0; my $abort_on_ac_config = 0; # automake requires 'AM_CONFIG_HEADER', not 'AC_CONFIG_HEADER' my %subs_not_found = (); # shown if $dbg_ac13 my %common_subs = (); ############################################################### # debug ############################################################### my $dbg_ac01 = 0; # prt( "[01] scan_one_configure_file: Reading $filename\n" ) if $dbg_ac01; and more my $dbg_ac02 = 0; # show EACH line prt( "[02] $lnn: $cline... for each read line. my $dbg_ac03 = 0; # prt( "[03] Variable [$key] = [$nval]\n" ) my $dbg_ac04 = 0; # prt( "[04] Split to $vlen components ...\n" ) my $dbg_ac05 = 0; # prt( "[05] Substitute [$key] = [$nval]\n" ) if ((($orgkey ne $key)||($orgnval ne $nval)) my $dbg_ac06 = 0; # prt( "[06] $.: Should JOIN lines? - [$cline]\n" ) and more... my $dbg_ac07 = 0; # prt( "[07] $.: Got AC_INIT = [$1]\n" ) and AC_DEFIN... etc my $dbg_ac08 = 0; # prt( "[08] Got ac_output_line = $. [$rawline]\n" ) plus accumulation my $dbg_ac09 = 0; # prt( "[01|09] Adding $input [$ff] to mk_inp_list ...\n" ) my $dbg_ac10 = 0; # prt( "[01|10] Adding $input [$ff] to other_input_files ...\n" ) my $dbg_ac11 = 0; # prt( "[11] Storing configure_cond key $1 ... value=2\n" ) my $dbg_ac12 = 0; # prt( "[12] $.: 1=[$1] = 2=[$2] NOT USED [$cline]\n" ) my $dbg_ac13 = 0; # prt("[13] $lnn: Failed on MACRO [$blk], in file [$file]\n") my $dbg_base = 'dbg_ac'; sub get_dbg_var($) { my $val = shift; my $var = $dbg_base; my $res = -1; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } # from : http://perldoc.perl.org/functions/eval.html if (eval "defined \$$var") { $res = eval "\$$var"; } return $res; } sub get_dbg_stg() { my $s = ''; my ($i,$res,$i2); for ($i = 1; ;$i++) { $res = get_dbg_var($i); last if ($res == -1); if ($i < 10) { $i2 = "0$i"; } else { $i2 = "$i"; } if ($res) { $s .= "$i2 "; } } return $s; } sub get_dbg_range() { my ($i,$res); for ($i = 1; ;$i++) { $res = get_dbg_var($i); last if ($res == -1); } return $i - 1; } sub set_dbg_var($) { my $val = shift; my $var = $dbg_base; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } # from : http://perldoc.perl.org/functions/eval.html # NOT $$var++; # does not work! if (eval "defined \$$var") { eval "\$$var++"; } else { #print "ERROR: \$$var does NOT exist\n"; return 0; } return 1; } sub clear_dbg_var($) { my $val = shift; my $var = $dbg_base; if ($val < 10) { $var .= "0$val"; } else { $var .= "$val"; } # from : http://perldoc.perl.org/functions/eval.html # NOT $$var++; # does not work! if (eval "defined \$$var") { eval "\$$var = 0"; } else { #print "ERROR: \$$var does NOT exist\n"; return 0; } return 1; } sub set_all_dbg_on() { my ($i,$res); for ($i = 1; ;$i++) { $res = set_dbg_var($i); last if (!$res); } } sub set_all_dbg_off() { my ($i,$res); for ($i = 1; ;$i++) { $res = clear_dbg_var($i); last if (!$res); } } sub set_ac_scan_debug_on { set_all_dbg_on(); } ################################################################## ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my $conf_string = ''; sub show_missing_subs() { my @arr = keys %subs_not_found; my $cnt = scalar @arr; if ($dbg_ac13) { if ($cnt) { $cnt = scalar @arr; prt("\n[13] There are at least $cnt missing substitutions.\n"); my ($key,$fil); foreach $key (sort @arr) { $fil = $subs_not_found{$key}; prt("Missing [$key], in [$fil]\n"); } } else { prt("[13] There are NO missing substitutions.\n"); } #@arr = split $added_in_init; #$cnt = scalar @arr; #prt("But note added $cnt, [$added_in_init] in init...\n") if (length($added_in_init)); } elsif ($cnt) { prt("There are at least $cnt missing substitutions. Use '-d 13' to view.\n"); } } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } show_missing_subs(); write2file($conf_string,$conffile) if (length($conf_string) && ($val == 0) && !$no_conf_write); close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ); } } sub local_strip_both_quotes($) { my $txt = shift; if ($txt =~ /^'(.+)'$/) { return $1; } if ($txt =~ /^"(.+)"$/) { return $1; } return '' if ($txt eq '""'); return '' if ($txt eq "''"); #prt("Stripping [$txt] FAILED\n"); return $txt; } sub show_hash_of_in_file($$) { my ($fil,$hr) = @_; my ($v, $itm, $cnt, $v2, $min, $len, $form); my ($fil_name,$file_dir) = fileparse($fil); my ($ff,$ok); prt( "\nDisplay of HASH items of [$fil]...\n" ); foreach my $k (keys %{$hr}) { $v = $$hr{$k}; if ($k =~ /^A_/) { $cnt = scalar @{$v}; prt("KEY: $k ARRAY $cnt items ...\n"); $form = ' %'.length($cnt).'d'; $cnt = 0; foreach $itm (@{$v}) { $cnt++; $ff = $file_dir.$itm.'.am'; if (-f $ff) { $ok = 'ok'; $itm .= ".am"; } else { $ok = "NOT FOUND [$ff]"; } prt( sprintf($form,$cnt).": $itm $ok\n" ); } } elsif ($k =~ /^H_/) { $cnt = scalar keys( %{$v} ); prt("KEY: $k HASH $cnt items ...\n"); $min = 0; foreach $itm (keys %{$v}) { $len = length($itm); $min = $len if ($len > $min); } $form = ' %'.length($cnt).'d'; $cnt = 0; foreach $itm (keys %{$v}) { $cnt++; $v2 = $$v{$itm}; $itm .= ' ' while (length($itm) < $min); prt( sprintf($form,$cnt).": $itm = $v2\n" ); } } else { prt("KEY: $k VAL: $v\n"); } } } sub ac_trim_all2 { my ($txt) = shift; $txt = trim_all($txt); if ($txt =~ /^\[.+\]$/) { $txt = substr($txt,1,length($txt)-2); } $txt = trim_all($txt); return $txt; } ## my %conf_ac_macs = (); sub ac_do_macro_sub2 { my ($item,$rcacm) = shift; ###prt( "Checking substitution for [$item] ...\n" ) if ($dbg27); ###if (defined $conf_ac_macs{$item}) { # if it is IN the MACROS ### my $ritem = $conf_ac_macs{$item}; # extract the substitute value if (defined $$rcacm{$item}) { # if it is IN the MACROS my $ritem = $$rcacm{$item}; # extract the substitute value ###prt( "Found: returning [$ritem] ...\n" ) if ($dbg27); return $ritem; } return $item; } sub ac_do_macro_sub { my ($item, $rcacm) = @_; if ($item =~ /^\$/) { my $msub = substr($item,1); # remove leading '$' my $ritem = ac_do_macro_sub2($msub, $rcacm); if ($ritem ne $msub) { return $ritem; } } return $item; } my $test = 0; sub ac_split_macros($) { my ($val) = @_; my $len = length($val); my @arr = (); my $tag = ''; my ($i,$ch,$nxt,$nc,$k,$pc,$i2,$cn); for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $ch = substr($val,$i,1); $cn = (($i2 < $len) ? substr($val,$i2,1) : ''); if ($ch eq '$') { $nxt = $ch; $k = $i + 1; $pc = ''; if ($cn eq '{') { $pc = '}'; $nxt .= $cn; $k++; } for (; $k < $len; $k++) { $nc = substr($val,$k,1); if (!($nc =~ /\w/)) { if (($nc eq '}')&&($nc eq $pc)) { $nxt .= $nc; $k++; } last; } $nxt .= $nc; } if (length($nxt) > 2) { push(@arr,$tag) if (length($tag)); push(@arr,$nxt); $tag = ''; $i = $k - 1; next; } } $tag .= $ch; } push(@arr,$tag) if (length($tag)); # prt("Value [$val] split...\n"); # foreach $nxt (@arr) { # prt("$nxt\n"); # } # $test++; # pgm_exit(1,"TEMP EXIT") if ($test > 5); return @arr; } sub ac_add_2_ac_macros($$$) { my ($key,$val,$rcacm) = @_; $$rcacm{$key} = $val; } # $nval = ac_do_macro_sub($nval,$rmh); sub ac_do_macro_subs($$$$$) { my ($key,$val,$rmh,$lnn,$file) = @_; my $rch = \%common_subs; if ($val =~ /\$/) { my @varr = ac_split_macros($val); my ($blk,$key2,$nval,$done,$cnt); $cnt = 0; foreach $blk (@varr) { if ($blk =~ /\$/) { $done = 0; if ($blk =~ /^\$(\w+)$/) { $key2 = $1; if (defined ${$rmh}{$key2}) { $nval = ${$rmh}{$key2}; $val =~ s/\$$key2/$nval/; $done = 1; $cnt++; } elsif ($key eq $key2) { $nval = ''; ac_add_2_ac_macros($key2,$nval,$rmh); $val =~ s/\$$key2/$nval/; $done = 1; $cnt++; } elsif (defined ${$rch}{$key2}) { $nval = ${$rch}{$key2}; $val =~ s/\$$key2/$nval/; $done = 1; $cnt++; } } elsif ($blk =~ /^\$\{(\w+)\}$/) { $key2 = $1; if (defined ${$rmh}{$key2}) { $nval = ${$rmh}{$key2}; $val =~ s/\$\{$key2\}/$nval/; $done = 1; $cnt++; } elsif ($key eq $key2) { $nval = ''; ac_add_2_ac_macros($key2,$nval,$rmh); $val =~ s/\$$key2/$nval/; $done = 1; $cnt++; } elsif (defined ${$rch}{$key2}) { $nval = ${$rch}{$key2}; $val =~ s/\$$key2/$nval/; $done = 1; $cnt++; } } else { $key2 = "[$key]=[$blk]"; } if (!$done) { prt("[13] $lnn: Failed on MACRO [$blk], in file [$file]\n") if ($dbg_ac13); $subs_not_found{$key2} = "$lnn:$file"; } } } } return $val; } #ac_am_conf_line_error($filename, # $., "automake requires 'AM_CONFIG_HEADER', not 'AC_CONFIG_HEADER'") if $1 eq 'C'; sub ac_am_conf_line_error { my ($fname,$lnum,$msg) = @_; prt("ERROR: file $fname: line $lnum: $msg\n"); mydie("Aborting scan ...\n"); } sub scan_one_configure_file { my ($filename) = shift; my %hash = (); my ($sfilnm,$root_dir) = fileparse($filename); my @mk_inp_list = (); my %make_list = (); my @other_input_files = (); my $config_header_line = ''; my @config_fullnames = (); my @config_names = (); my @config_headers = (); my %cfg_defines = (); my %configure_cond = (); my ($err_msg); if (!open(CONFIGURE, $filename)) { pgm_exit(1,"ERROR: can not open [$filename]: $!\n"); } prt( "[01] scan_one_configure_file: Reading $filename\n" ) if $dbg_ac01; my %conf_ac_mac = (); my $in_ac_output = 0; my $ac_output_line = ''; my $ff = ''; my $cline = ''; my $rawline = ''; my %var_hash = (); my ($key, $nval, $orgkey, $orgnval, @varr, $vlen, $i, $ky, $nline); my $lnnum = 0; my $ac_prog = ''; my $ac_vers = ''; my $racmacs = \%conf_ac_mac; while (<CONFIGURE>) { $cline = $_; # get current line chomp $cline; $rawline = trim_all($cline); $lnnum++; # Remove comments from current line. s/\bdnl\b.*$//; s/\#.*$//; $cline =~ s/\bdnl\b.*$//; $cline =~ s/\#.*$//; next if (length($cline) == 0); prt( "[02] $lnnum: $cline\n" ) if ($dbg_ac02); if ($cline =~ /^(\w+)="(\d+)"$/) { prt( "Num Variable $1=$2\n" ); $var_hash{$1} = $2; ###} elsif ($cline =~ /^(\w+)="(.+)"$/) { ###} elsif ($cline =~ /^(\w+)=(.+)$/) { } elsif ($cline =~ /^\s*(\w+)=(.+)$/) { $key = $1; $nval = $2; $nval = substr($nval,1,length($nval)-2) if ($nval =~ /^".*"$/); $orgkey = $key; $orgnval = $nval; prt( "[03] $.: Var [$key] = [$nval], ln [$cline]\n" ) if ($dbg_ac03); $nval = ac_do_macro_subs($key,$nval,$racmacs,$lnnum,$filename); if ($dbg_ac05) { if (($orgkey ne $key)||($orgnval ne $nval)) { prt( "[05] Substitute [$key] = [$nval]\n" ); } elsif (($orgkey =~ /\$/)||($orgnval =~ /\$/)) { prt( "[05] Sub FAILED [$key] = [$nval]\n" ); } } $var_hash{$key} = $nval; ac_add_2_ac_macros($key, $nval, $racmacs); # $conf_ac_macs{$key} = $nval; } elsif ($cline =~ /^\s+(\w+)=(.+)$/) { prt( "[12] $.: 1=[$1] = 2=[$2] NOT USED [$cline]\n" ) if ($dbg_ac12); # there are lots of them ... } # Skip macro definitions. Otherwise we might be confused into # thinking that a macro that was only defined was actually # used. next if /AC_DEFUN/; if ((/$AC_DEF/) && !(/$AC_DEFINE/)) { # indicates should add next line, until complete $cline = $_; # get current line chomp $cline; prt( "[06] $.: Should JOIN lines? - [$cline]\n" ) if ($dbg_ac06); $_ = <CONFIGURE>; if ($_) { $nline = $_; # get current line $ky = $cline . ' ' . $_; $lnnum++; chomp $nline; prt( "[02] $lnnum: $nline\n" ) if ($dbg_ac02); $_ = $ky; chomp $ky; prt( "[06] $.: JOINED - [$ky]\n" ) if ($dbg_ac06); } } elsif ((/$AC_DEFU/) && !(/$AC_DEFINE_UNQ/)) { # indicates should add next line, until complete $cline = $_; # get current line chomp $cline; prt( "[06] $.: Should JOIN lines? - [$cline]\n" ) if ($dbg_ac06); $_ = <CONFIGURE>; if ($_) { $nline = $_; # get current line $ky = $cline . ' ' . $_; chomp $nline; $lnnum++; prt( "[02] $lnnum: $nline\n" ) if ($dbg_ac02); $_ = $ky; chomp $ky; prt( "[06] $.: JOINED - [$ky]\n" ) if ($dbg_ac06); } } if (/$AC_INIT/) { prt( "[07] $.: Got AC_INIT = [$1]\n" ) if ($dbg_ac07); @varr = split(',', $1); $vlen = scalar @varr; for ($i = 0; $i < $vlen; $i++) { $nval = trim_all($varr[$i]); if ($i == 0) { $nval =~ s/\s/_/g; ac_add_2_ac_macros('PACKAGE_NAME', $nval, $racmacs); $ac_prog = $nval; } elsif ($i == 1) { ac_add_2_ac_macros('PACKAGE_VERSION', $nval, $racmacs); ac_add_2_ac_macros('PACKAGE_STRING', ${$racmacs}{'PACKAGE_NAME'} .' ' .$nval, $racmacs ); $ac_vers = $nval; } elsif ($i == 2) { ac_add_2_ac_macros('PACKAGE_BUGREPORT', $nval, $racmacs); } elsif ($i == 3) { ac_add_2_ac_macros('PACKAGE_TARNAME', $nval, $racmacs); } else { $err_msg = "WARNING: $i Split of AC_INIT = $nval\n"; prtw($err_msg); } } next; } elsif (/$AC_DEFINE/) { prt( "[07] $.: Got AC_DEFINE = [$1]\n" ) if ($dbg_ac07); @varr = split(',', $1); $vlen = scalar @varr; if ($vlen >= 2) { $ky = ac_trim_all2($varr[0]); $nval = ac_trim_all2($varr[1]); ac_add_2_ac_macros( $ky, $nval, $racmacs ); } next; } elsif (/$AC_DEFINE_UNQ/) { prt( "[07] $.: Got AC_DEFINE_UNQUOTED = [$1]\n" ) if ($dbg_ac07); @varr = split(',', $1); $vlen = scalar @varr; if ($vlen >= 2) { $ky = ac_trim_all2($varr[0]); $nval = ac_trim_all2($varr[1]); ac_add_2_ac_macros( $ky, $nval, $racmacs ); } next; } # Follow includes. This is a weirdness commonly in use at # Cygnus and hopefully nowhere else. if (/sinclude\((.*)\)/ && -f ($root_dir . $1)) { $ff = $root_dir . $1; scan_one_configure_file ($ff); } if (! $in_ac_output && ( s/AC_OUTPUT\s*\(\[?// || s/AC_CONFIG_FILES\s*\(\[?// ) ) { $in_ac_output = 1; $ac_output_line = $.; # get LINE number prt( "[08] Got ac_output_line = line $ac_output_line ... [$rawline]\n" ) if ($dbg_ac08); } if ($in_ac_output) { my $closing = 0; if (s/[\]\),].*$//) { $in_ac_output = 0; $closing = 1; prt( "[08] ac_out: $rawline- CLOSING\n" ) if ($dbg_ac08); } else { prt( "[08] ac_out: $rawline\n" ) if ($dbg_ac08); } # Look at potential Makefile.am's foreach (split) { # Must skip empty string for Perl 4. next if $_ eq "\\" || $_ eq ''; my ($local,$input,@rest) = split(/:/); if (! $input) { $input = $local; } else { $input =~ s/\.in$//; } $ff = $root_dir . $input . '.am'; if (-f $ff) { prt( "[01|09] Adding $input [$ff] to mk_inp_list ...\n" ) if ($dbg_ac01 || $dbg_ac09); push(@mk_inp_list, $input); $make_list{$input} = join(':', ($local,@rest)); } else { prt( "[01|10] Adding $input [$ff] to other_input_files ...\n" ) if ($dbg_ac01 || $dbg_ac10); # We have a file that automake should cause to be # rebuilt, but shouldn't generate itself. push (@other_input_files, $_); } } } # Handle configuration headers. A config header of `[$1]' # means we are actually scanning AM_CONFIG_HEADER from # aclocal.m4. if (/A([CM])_CONFIG_HEADER\s*\((.*)\)/ && $2 ne '[$1]') { if ($abort_on_ac_config) { ac_am_conf_line_error($filename, $., "automake requires 'AM_CONFIG_HEADER', not 'AC_CONFIG_HEADER'") if $1 eq 'C'; } else { prtw("WARNING: $.: automake requires 'AM_CONFIG_HEADER', not 'AC_CONFIG_HEADER'!\n file [$filename]\n"); } $config_header_line = $.; my ($one_hdr); foreach $one_hdr (split (' ', $2)) { push (@config_fullnames, $one_hdr); if ($one_hdr =~ /^([^:]+):(.+)$/) { push (@config_names, $1); push (@config_headers, $2); } else { push (@config_names, $one_hdr); push (@config_headers, $one_hdr . '.in'); } } } if (/$AM_CONDITIONAL_PATTERN/o) { if ( defined $cfg_defines{$1} ) { # has been DEFINED in am2dsp?.cfg file prt( "[11] Storing configure_cond key $1 ... value=2\n" ) if ($dbg_ac11); $configure_cond{$1} = 2; } else { prt( "[11] Storing configure_cond key $1 ... value=1\n" ) if ($dbg_ac11); $configure_cond{$1} = 1; } } if (/$AM_INIT_AUTOMAKE/o) { $ac_prog = $1; $ac_vers = $2; $ac_prog = ac_do_macro_sub($ac_prog, $racmacs); $ac_vers = ac_do_macro_sub($ac_vers, $racmacs); if (defined $hash{'-NEW_PROJECT_NAME-'}) { if ($hash{'-NEW_PROJECT_NAME-'} ne $ac_prog) { prtw( "CHANGED DSP package from ".$hash{'-NEW_PROJECT_NAME-'}." to $ac_prog, DSP version = $ac_vers ...\n" ); } } else { prt( "Set DSP package = $ac_prog, DSP version = $ac_vers ...\n" ); } } } close(CONFIGURE); $hash{'-NEW_PROJECT_NAME-'} = $ac_prog; #$hash{'H_CONF_AC_MACS'} = { %conf_ac_macs }; $hash{'H_CONF_AC_MACS'} = $racmacs; $hash{'A_MAKE_INPUT_LIST'} = [ @mk_inp_list ]; #$hash{'A_CONFIG_NAMES'} = [ @config_names ]; #$hash{'A_CONFIG_HEADERS'} = [ @config_headers ]; #$hash{'A_CONFIG_NAMES_FULL'} = [ @config_fullnames ]; #$hash{'A_OTHER_INPUT_FILES'} = [ @other_input_files ]; #$hash{'H_VAR_HASH'} = { %var_hash }; return \%hash; } ################################################### ##### MAIN #### parse_args(@ARGV); my $rh = scan_one_configure_file($in_file); show_hash_of_in_file($in_file,$rh); pgm_exit(0,""); #################################################### ######################################## sub give_help { my ($tmp); prt("$pgmname: version 0.0.1 2010-08-31\n"); prt("Usage: $pgmname [options] in-file\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); $tmp = get_dbg_range(); prt(" --dbg <num> (-d) = Set DEBUG flag of this value. Number in range 1 to $tmp\n"); prt(" -load-log (-l) = Load log file at end. (def=".($load_log ? "On" : "Off").")\n"); prt(" --mac item val (-m) = Store a MACRO, item=value, for substitution. (use '-d 13' to list missing).\n"); prt(" -previous (-p) = Load previous commands from [$conffile]\n") if (-f $conffile); prt("Purpose:\n"); prt(" Scan the input file as a configur.ac file, and display its contents.\n"); prt("NOTES:\n"); prt(" The debug switch is strictly for that. It adds no functionality, just a noisier output,\n"); prt(" and has the text settings of 'all', 'none', or 'help', to show the list in more detail.\n"); $tmp = get_dbg_stg(); prt(" For debug, presently values [$tmp] are ON\n") if (length($tmp)); } sub show_dbg_help() { my $file = $0; my ($line,$max,$tmp,$cnt); $max = get_dbg_range(); $tmp = get_dbg_stg(); prt(" --dbg <num> (-d) = Set DEBUG flag of this value. Number in range 1 to $tmp\n"); prt(" Presently %tmp are ON.\n") if (length($tmp)); prt(" Additional text setting are 'all', 'none', and this 'help'.\n"); if (open INF, "<$file") { my @lines = <INF>; close INF; prt(" Detailed list, with some 'notes' indicating what each does.\n"); $cnt = 0; foreach $line (@lines) { $line = trim_all($line); if ($line =~ /^my\s+\$dbg_ac(\d+)\s*=\s*\d+\s*;\s*(.+)$/) { $tmp = $1; prt("$tmp: $line\n"); $cnt++; } } prt("ERROR: Found no \$dbg?? vars in file [$file], so NO DEBUG ADDITIONAL HELP!\n") if (!$cnt); } else { prt("ERROR: Unable to open file [$file], so NO DEBUG ADDITIONAL HELP!\n"); } } sub load_input_file($$) { my ($arg,$file) = @_; if (open INF, "<$file") { my @lines = <INF>; close INF; my @carr = (); my ($line,@arr,$tmp); foreach $line (@lines) { $line = trim_all($line); next if (length($line) == 0); next if ($line =~ /^#/); @arr = split(/\s/,$line); foreach $tmp (@arr) { $tmp = local_strip_both_quotes($tmp); push(@carr,$tmp); } } parse_args(@carr); } else { pgm_exit(1,"ERROR: Unable to 'open' file [$file]!\n") } } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg,$tmp); while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); $conf_string = ""; pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^d/i) { need_arg(@av); shift @av; $sarg = $av[0]; $conf_string .= "$arg $sarg\n"; $tmp = get_dbg_range(); if ( ($sarg =~ /^\d+$/) && ($sarg >= 1) && ($sarg <= $tmp) ) { $tmp = 'dbg'; if ($sarg < 10) { $tmp .= "0$sarg"; } else { $tmp .= "$sarg"; } set_dbg_var($sarg); prt("Set Debug $tmp ON!\n"); } else { if ($sarg =~ /^\d+$/) { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Out of range 1 - $tmp\n"); } else { if ($sarg =~ /^help$/i) { show_dbg_help(); $conf_string = ""; pgm_exit(0,"DEBUG Help exit(0)\n"); } elsif ($sarg =~ /^all$/i) { prt("Setting ALL debug ON!\n"); set_all_dbg_on(); } elsif ($sarg =~ /^none$/i) { prt("Setting ALL debug OFF!\n"); set_all_dbg_off(); # } elsif ($sarg =~ /^dry-run$/i) { # prt("Setting DRY RUN ONLY!\n"); # $only_dry_run = 1; # $out_dsp = 0; # $out_dsp2 = 0; } else { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Not numerical in range 1 - $tmp, nor 'all', 'none', or 'help' !\n"); } } } } elsif ($sarg =~ /^l/i) { $conf_string .= "$arg\n"; $load_log = 1; } elsif ($sarg =~ /^m/i) { # store a macro need_arg(@av); shift @av; $sarg = $av[0]; need_arg(@av); shift @av; $tmp = $av[0]; $common_subs{$sarg} = $tmp; prt("Set MACRO [$sarg] = [$tmp] in common subs...\n"); $tmp = '""' if ((length($tmp) == 0)||($tmp =~ /^\s+$/)); $conf_string .= "$arg $sarg $tmp\n"; } elsif ($sarg =~ /^p/i) { prt("Loading previous commands from [$conffile]\n"); load_input_file($arg,$conffile); $no_conf_write = 1; } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; $conf_string .= "$arg\n"; prt("Set input to [$in_file]\n"); } shift @av; } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } } # eof - acscan.pl