Generated: Sun Aug 21 11:10:30 2011 from acscan02.pl 2010/09/04 38.8 KB.
#!/usr/bin/perl -w # NAME: acscan02.pl # AIM: Scan a single configure.ac file # 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:\Projects\boost\tools\jam\src\boehm_gc\configure.ac'; #my $in_file = 'C:\FG\PREOSG\SimGear\source\configure.ac'; my $load_log = 1; my $abort_on_ac_config = 0; # automake requires 'AM_CONFIG_HEADER', not 'AC_CONFIG_HEADER' my $add_all_tags = 0; # only add those that conform to a MACRO 1:$AB\W 2:${AB} or 3:$(AB) my %subs_not_found = (); # shown if $dbg_ac13 my %common_subs = (); my @common_set = qw( LIBS LDFLAGS CPPFLAGS CXXFLAGS CFLAGS X_CFLAGS ); my @common_dir_set = qw( top_srcdir BASE_DIR BUILD_DIR DATA_DIR datadir dir DIRNAME docdir INCLUDE_DIR mandir objdir srcdir tardir top_builddir top_srcdir X_EXTRA_LIBS x_includes x_libraries X_LIBS X_PRE_LIBS X11_LIB ); my %known_set = ( 'CC' => 'cl', 'CXX' => 'cl', 'EXEEXT' => 'exe', 'OBJEXT' => 'obj', 'ac_default_prefix' => './', 'exec_prefix' => './', 'host' => 'WIN32', 'host_cpu' => 'X86', 'host_os' => 'Windows', 'host_vendor' => 'MS', 'POSIX_SHELL' => 'sh', 'prefix' => './', 'SED' => 'sed', 'YASM' => 'yasm' ); my @others_maybe = qw( enableval ); ############################################################### # 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_ac14 = 0; # show each MACRO split in FULL my $dbg_ac15 = 0; # Show each AC MACRO accumulation... my $dbg_ac16 = 0; # Show back slash accumulation... my $dbg_ac17 = 0; # show all substitutions 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 = ''; # some common things - used often, so set to a blank # set some to current in_file directory, # and some to known values... sub init_common_subs($) { my ($fil) = shift; my ($fn,$fd) = fileparse($fil); $fd = $cwd."\\" if ((length($fd)==0)||($fd =~ /^\.(\\|\/)$/)); my ($key,$rcs); $rcs = \%common_subs; foreach $key (@common_set) { if (!defined ${$rcs}{$key}) { ${$rcs}{$key} = ''; } } foreach $key (@common_dir_set) { if (!defined ${$rcs}{$key}) { ${$rcs}{$key} = $fd; #if ($key eq 'top_builddir') { # prt("Set [$key] = [$fd], in \%common_subs...\n"); #} } } foreach $key (keys %known_set) { if (!defined ${$rcs}{$key}) { ${$rcs}{$key} = $known_set{$key}; } } } 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; } sub ac_split_macros($) { my ($val) = @_; my $len = length($val); my @arr = (); my $tag = ''; my ($i,$ch,$nxt,$nc,$k,$pc,$i2,$cn,$min); for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $ch = substr($val,$i,1); if ($ch eq '$') { # got the beginning '$' char, so get NEXT $cn = (($i2 < $len) ? substr($val,$i2,1) : ''); $nxt = $ch; $k = $i + 1; $pc = ''; $min = 3; # has to be '$12' - a length greater than this if ($cn eq '{') { $pc = '}'; $nxt .= $cn; $k++; $min = 5; } elsif ($cn eq '(') { $pc = ')'; $nxt .= $cn; $k++; $min = 5; } for (; $k < $len; $k++) { $nc = substr($val,$k,1); if ($nc =~ /\W/) { # NOT an alpha-numeric + '_', then # hmmm, what to do about things like ${DEFAULT_BLOCKING-20} if ($nc eq $pc) { $nxt .= $nc; $k++; } elsif (length($pc)) { $nxt = ''; # NOT HANDLED like ${DEFAULT_BLOCKING-20} } last; } $nxt .= $nc; } if (length($nxt) > $min) { push(@arr,$tag) if (length($tag) && $add_all_tags); push(@arr,$nxt); $tag = ''; $i = $k - 1; next; } } $tag .= $ch; } push(@arr,$tag) if (length($tag) && $add_all_tags); if ($dbg_ac14) { $len = scalar @arr; prt("[14] Value [$val] split into $len pieces...\n"); $len = 0; foreach $nxt (@arr) { $len++; prt(" $len: [$nxt]\n"); } } return @arr; } sub ac_add_2_ac_macros($$$) { my ($key,$val,$rcacm) = @_; $$rcacm{$key} = $val; } # $nval = ac_do_macro_sub($nval,$rmh); # MAYBE the defined here should be 'exists'!?!? sub ac_do_macro_subs($$$$$) { my ($key,$val,$rmh,$lnn,$file,$bval,$typ) = @_; my $rch = \%common_subs; if ($val =~ /\$/) { my @varr = ac_split_macros($val); my ($blk,$key2,$nval,$done,$cnt,$oline); $cnt = 0; $oline = $val; foreach $blk (@varr) { if ($blk =~ /\$/) { $done = 0; $key2 = '<none>'; $typ = 0; # 1: if a bare '$ABC' if ($blk =~ /^\$(\w+)$/) { $key2 = $1; $typ = 1; if (defined ${$rmh}{$key2}) { $nval = ${$rmh}{$key2}; prt("[17] do_macro_subs:$typ:1: \$[$key2] for [$nval]\n") if ($dbg_ac17); $val =~ s/\$$key2/$nval/; $done = 1; $cnt++; } elsif (defined ${$rch}{$key2}) { $nval = ${$rch}{$key2}; prt("[17] do_macro_subs:$typ:2: \$[$key2] for [$nval]\n") if ($dbg_ac17); $val =~ s/\$$key2/$nval/; $done = 1; $cnt++; } elsif ($key eq $key2) { $nval = ''; ac_add_2_ac_macros($key2,$nval,$rmh); prt("[17] do_macro_subs:$typ:3: \$[$key2] for [$nval]\n") if ($dbg_ac17); $val =~ s/\$$key2/$nval/; $done = 1; $cnt++; } # 2: if a curly '${ABC}' } elsif ($blk =~ /^\$\{(\w+)\}$/) { $key2 = $1; $typ = 2; if (defined ${$rmh}{$key2}) { $nval = ${$rmh}{$key2}; prt("[17] do_macro_subs:$typ:1: \$[$key2] for [$nval]\n") if ($dbg_ac17); $val =~ s/\$\{$key2\}/$nval/; $done = 1; $cnt++; } elsif (defined ${$rch}{$key2}) { $nval = ${$rch}{$key2}; prt("[17] do_macro_subs:$typ:2: \$[$key2] for [$nval]\n") if ($dbg_ac17); $val =~ s/\$\{$key2\}/$nval/; $done = 1; $cnt++; } elsif ($key eq $key2) { $nval = ''; ac_add_2_ac_macros($key2,$nval,$rmh); prt("[17] do_macro_subs:$typ:3: \$[$key2] for [$nval]\n") if ($dbg_ac17); $val =~ s/\$\{$key2\}/$nval/; $done = 1; $cnt++; } # 3: if a bracket '$(ABC)' } elsif ($blk =~ /^\$\((\w+)\)$/) { $key2 = $1; $typ = 3; if (defined ${$rmh}{$key2}) { $nval = ${$rmh}{$key2}; prt("[17] do_macro_subs:$typ:1: \$[$key2] for [$nval]\n") if ($dbg_ac17); $val =~ s/\$\($key2\)/$nval/; $done = 1; $cnt++; } elsif (defined ${$rch}{$key2}) { $nval = ${$rch}{$key2}; prt("[17] do_macro_subs:$typ:2: \$[$key2] for [$nval]\n") if ($dbg_ac17); $val =~ s/\$\($key2\)/$nval/; $done = 1; $cnt++; } elsif ($key eq $key2) { $nval = ''; ac_add_2_ac_macros($key2,$nval,$rmh); prt("[17] do_macro_subs:$typ:3: \$[$key2] for [$nval]\n") if ($dbg_ac17); $val =~ s/\$\($key2\)/$nval/; $done = 1; $cnt++; } } # ========================================================================================== if (!$done) { prt("[13] $lnn: Failed on MACRO [$key] = [$blk], [$typ] [$key2], in file [$file]\n") if ($dbg_ac13); $key2 = $blk if (!$typ); $subs_not_found{$key2} = "$lnn:$file"; } # ========================================================================================== } } } return $val; } # ======================================================================= # based on ALL AC_MACROS are of the form # AC_MACRO([...],....,....), could also check [ ], but that's for later.. # ======================================================================= sub accumulate_ac_macro($$) { my ($iline,$fh) = @_; my $len = length($iline); my ($i,$ch,$brcnt,$k,$k2,$lcnt,$acmac,$oline,$sqcnt); # prt("Accumulate AC MACRO until end...\n"); #$k = ${$ri}; $k = 0; $oline = $iline; # eat any initial space only for ($i = 0; $i < $len; $i++) { $ch = substr($iline,$i,1); last if ($ch =~ /\S/); # stop on first non-white space } $acmac = ''; # accumulate the name of the MACRO for (; $i < $len; $i++) { $ch = substr($iline,$i,1); last if ($ch =~ /\W/); # stop on non-alpha-numeric - should be '(' $acmac .= $ch; } # could allow 'space' BEFORE '(' # ONE DAY pgm_exit(1,"ERROR: mac=[$acmac] Fix eat_ac_macro to accept [$ch] following 'name'!\n") if ($ch ne '('); # essentially get to END of MACRO - may be mutiple lines $i++; # note, BUMP past FIRST '(', and set $brcnt == 0 $brcnt = 0; $sqcnt = 0; $lcnt = 1; for (; $i < $len; $i++) { $ch = substr($iline,$i,1); if ($ch eq '(') { if (!$sqcnt) { $brcnt++; } } elsif ($ch eq '[') { $sqcnt++; } elsif ($ch eq ']') { $sqcnt-- if ($sqcnt); } elsif ($ch eq ')') { if ($sqcnt) { $ch = ''; } else { if ($brcnt) { $brcnt--; $ch = ''; } else { last; } } } } if ($ch ne ')') { # oops, need more lines $k++; $k2 = $k + 1; my $nline = ''; while (<$fh>) { #prt( "$k2:$.: need more lines...br=$brcnt, sq=$sqcnt...\n" ); # if ($dbg01); $nline = trim_all($_); $lcnt++; $len = length($nline); #prt( "[dbg01] $k2: [$line] AC_MACRO cont...($brcnt) line $lcnt, len $len\n" ) if ($dbg01); for ($i = 0; $i < $len; $i++) { $ch = substr($nline,$i,1); if ($ch eq '(') { if ($sqcnt) { $ch = ''; } else { $brcnt++; #prt("Bumped brcnt [$brcnt]\n"); } } elsif ($ch eq '[') { $sqcnt++; #prt("Bumped sqcnt [$sqcnt]\n"); } elsif ($ch eq ']') { #prt("Will decrement sqcnt [$sqcnt]\n"); $sqcnt-- if ($sqcnt); } elsif ($ch eq ')') { if ($sqcnt) { $ch = ''; } else { if ($brcnt) { $brcnt--; $ch = ''; # CLEAR this char - is NOT the end #prt("Decrement brcnt [$brcnt]\n"); } else { #prt( "[dbg01] $k2: Multipline macro EXIT1...($brcnt) lines $lcnt\n" ) if ($dbg01); last; } } } } if ($ch eq ')') { #prt( "[dbg01] $k2: Multipline [$acmac] macro EXIT2... lines $lcnt\n\n" ) if ($dbg01); if (length($nline)) { #$iline .= ' ' if ( !( ($iline =~ /\s$/) || ($nline =~ /^\s/) ) ); $iline .= " "; # "\n"; $iline .= $nline; $nline = ''; } last; } $k++; # need MORE $k2 = $k + 1; if (length($nline)) { #$iline .= ' ' if ( !( ($iline =~ /\s$/) || ($nline =~ /^\s/) ) ); $iline .= " "; #"\n"; $iline .= $nline; $nline = ''; } } #pgm_exit(1,"ERROR: Ran out of line in an ac macro!\n") if ($k >= $max); #${$ri} = $k; # pass back line number } if ($dbg_ac15 && ($oline ne $iline)) { prt("Accumulated from\n[$oline] to \n[$iline]\n"); } return $iline; } sub accumulate_with_back($$) { my ($iline,$fh) = @_; my ($nline,$oline); $oline = $iline; $oline =~ s/\\$//; $oline = substr($oline,0,length($oline) - 1) while ($oline =~ /\s$/); # remove all TRAILING space while ($iline =~ /\\$/) { $iline =~ s/\\$//; $iline = substr($iline,0,length($iline) - 1) while ($iline =~ /\s$/); # remove all TRAILING space $nline = <$fh>; if ($nline) { $nline = trim_all($nline); $iline .= " "; $iline .= $nline; } else { last; } } if ($dbg_ac16 && ($oline ne $iline)) { prt("Accumulated back from\n[$oline] to \n[$iline]\n"); } return $iline; } #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 trim_ac_define($) { my ($txt) = shift; my $len = length($txt); my $ntxt = ''; my ($i,$ch,$brcnt,$sqcnt); $brcnt = 0; $sqcnt = 0; for ($i = 0; $i < $len; $i++) { $ch = substr($txt,$i,1); $ntxt .= $ch; if ($ch eq '[') { $sqcnt++; } elsif ($ch eq ']') { $sqcnt-- if ($sqcnt); } elsif ($ch eq '(') { if (!$sqcnt) { $brcnt++; } } elsif ($ch eq ')') { if (!$sqcnt) { if ($brcnt) { $brcnt--; } else { last; } } } } return $ntxt; } 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; my $joined = 0; while (<CONFIGURE>) { chomp; $cline = $_; # get current line $rawline = trim_all($cline); $lnnum++; $joined = 0; # Remove comments from current line. s/\bdnl\b.*$//; s/\#.*$//; $cline =~ s/\bdnl\b.*$//; $cline =~ s/\#.*$//; next if (length($cline) == 0); if (/\\$/) { $_ = accumulate_with_back($_,\*CONFIGURE); $cline = $_; } if (/^\s*\w+\(.*$/) { $_ = accumulate_ac_macro($_,\*CONFIGURE); $cline = $_; $joined = 1; } prt( "[02] $lnnum: $_\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_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/) { $nval = trim_ac_define($1); prt( "[07] $.: Got AC_DEFINE = [$nval]\n" ) if ($dbg_ac07); @varr = split(',', $nval); $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/) { $nval = trim_ac_define($1); prt( "[07] $.: Got AC_DEFINE_UNQUOTED = [$nval]\n" ) if ($dbg_ac07); @varr = split(',', $nval); $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\((.*)\)/ ) { $ff = $root_dir.$1; if ( -f $ff ) { my $hr = scan_one_configure_file ($ff); foreach $ky (keys %{$hr}) { $nval = ${$hr}{$ky}; ac_add_2_ac_macros( $ky, $nval, $racmacs ); } } else { prtw("WARNING:$.: Unable to find INCLUDE [$ff], line [$_], in [$filename]\n"); } } 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); init_common_subs($in_file); 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 - acscan02.pl