#!/usr/bin/perl -w # NAME: amscan.pl # AIM: Given a single Makefile.am, try to SCAN all in the set # 05/09/2010 - Some further tidying... # 31/08/2010 - Review (with new/better understanding of the Makefile.am ;=)) # 11/11/2008 - 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"; #require 'debug.pl' or die "Unable to load 'debug.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 $miss_mac_file = $perl_dir."\\temp.missed.txt"; my $in_file = ''; my $debug_on = 0; # run with DEFAULT, if no other input... my $def_file = 'C:\FG\FGCOMXML\libwww\Makefile.am'; my $def_targ = ''; ##my $def_file = 'C:\FGCVS\gettext-0.17\Makefile.am'; ##my $def_targ = "C:\\FGCVS\\gettext-0.17\\msvc\\"; ##my $def_file = 'C:\Projects\zziplib-0.13.50\Makefile.am'; ##my $def_file = 'C:\FGCVS\Jack\Makefile.am'; ##my $def_file = 'C:\FG\PREOSG\FlightGear\source\Makefile.am'; ##my $def_file = 'C:\FG\FGRUN\gettext\Makefile.am'; # features my $ignore_EXTRA_DIST = 1; # no SHOW of 'EXTRA_DIST' key my $load_log = 0; my $add_rel_sources = 1; # seems source are not stored relative already!!! ### my $add_rel_sources = 0; # seems source are stored relative already!!! my $try_harder = 1; # search HARD for program source my $try_much_harder = 1; # and do a directory scan, and find a C/C++ source of same name my $show_dup_title = 0; my $max_of_type = 30; my $show_per_file = 1; # show missing on a per file basis my $fix_relative_sources = 1; # change source to relative to target_directory, ready for DSP my $warn_on_plus = 0; # lev = 2 = Had a plus sign, is += so variable SHOULD exist # and warn if it does NOT, if $warn_on_plus my $find_bad_source = 1; my $process_subdir = 0; # CONSTANTS my $IF_PATTERN = "^if[ \t]+\([A-Za-z][A-Za-z0-9_]*\)[ \t]*\(#.*\)?\$"; my $IFD_PATTERN = "^ifdef[ \t]+\([A-Za-z][A-Za-z0-9_]*\)[ \t]*\(#.*\)?\$"; my $NIF_PATTERN = "^if[ \t]+!(.+)\$"; my $NIF_PATTERN2 = "^if!\\s+(.+)\$"; my $ELSE_PATTERN = "^else[ \t]*\(#.*\)?\$"; my $ENDIF_PATTERN = "^endif[ \t]*\(#.*\)?\$"; my $PATH_PATTERN='(\\w|/|\\.)+'; # This will pass through anything not of the prescribed form. my $INCLUDE_PATTERN = "^include[ \t]+((\\\$\\\(top_srcdir\\\)/${PATH_PATTERN})|(\\\$\\\(srcdir\\\)/${PATH_PATTERN})|([^/\\\$]${PATH_PATTERN}))[ \t]*(#.*)?\$"; my %global_hash = ( 'top_srcdir' => "", 'base_LIBS' => "", 'opengl_LIBS' => "", 'network_LIBS' => "", 'joystick_LIBS' => "", 'top_builddir' => "", 'thread_LIBS' => "", 'pkgdatadir' => "", 'openal_LIBS' => "", 'datadir' => "", 'srcdir' => "", 'docdir' => "", 'localedir' => "", 'RELOCATABLE_LDFLAGS' => "", 'LIBTOOL' => "lib", 'libdir' => "", 'SHELL' => "", 'BISON_LOCALEDIR' => "", 'AM_LIBTOOLFLAGS' => "", 'bindir' => "", 'AM_CFLAGS' => "", 'OPENMP_CFLAGS' => "", 'DESTDIR' => "", 'gl_LIBOBJS' => "glu32.lib" ); my %def_condits = ( "USE_GLUT" => "TRUE", "ENABLE_JPEG_SERVER" => "FALSE", "ENABLE_SP_FDM" => "TRUE" ); my $added_in_init = ''; my %common_subs = ( 'LIBTOOL' => 'link', 'CC' => 'cl' ); # some exception warnings suppressed my %sources_exceptions = ( 'DOXSOURCES' => 1 ); my ($root_file, $root_folder); my $target_dir = ''; # DEBUG my $dbg_s01 = 0; # show prt( "[01] $i2: $fline my $dbg_s02 = 0; # show prt( "Listing $acnt keys in hash ... my $dbg_s03 = 0; # show prt( "No LIBRARY keys ... my $dbg_s04 = 0; # show prt( "LIBRARY [$ky] has SOURCES [$val] my $dbg_s05 = 0; # show prt( "$am ". ((-f $am) ? "ok" : "no find!") my $dbg_s06 = 0; # show prt( "Opened cond_stack with [".$cond_stack[$#cond_stack]."] $fil my $dbg_s07 = 0; # add new line before 'Processing $cnt lines..., as does 08 also... my $dbg_s08 = 0; # show prt( "Processing $cnt lines from $fil ... my $dbg_s09 = 0; # show prt( "Got $cnt subdirectories [$slist] ... my $dbg_s10 = 0; # show prtw("WARNING:1: No substitution for [$ms] found in hash ... my $dbg_s11 = 0; # show target: gathering... my $dbg_s12 = 0; # show setting key=value in hash, duing am file scan my $dbg_s13 = 0; # show initial substitution, during am file scan my $dbg_s14 = 0; # similar to about, but only show NO sub FOUND my $dbg_s15 = 0; # List each source, for each project... my $dbg_s16 = 0; # Like [02] list ALL keys showing dispostion my $dbg_s17 = 0; # Out CHECK ME - SHOULD THIS ITEMS BE INCLUDED for a prog,lib,src key, now skipped! my $dbg_s18 = 0; # show change due to adding relative directory my $check_sum = 18; my @warnings = (); my @subsnotfound = (); my %g_programs = (); my %g_libraries = (); my %ams_done = (); my %subs_not_found = (); # list created if $dbg_s13 or $dbg_s14 my $total_sources = 0; my $source_missed = 0; my $found_count = 0; my $cwd = cwd(); my $os = $^O; my $exit_value = 0; # forward sub process_one_am_file($); ##################################################### ######## SUBS ONLY ########### ##################################################### # FOR DEBUG my $dbg_base = 'dbg_s'; sub set_dbg_base($) { $dbg_base = shift; } 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_debug_all() { my $cnt = get_dbg_range(); prt("Setting DEBUG 01 to $cnt ON\n"); set_all_dbg_on(); } sub set_debug_none() { my $cnt = get_dbg_range(); prt("Setting DEBUG 01 to $cnt OFF\n"); set_all_dbg_off(); } ###################################################### ### INIT ### my @common_set = qw( LIBS LDFLAGS CPPFLAGS CXXFLAGS CFLAGS X_CFLAGS ); my @common_dir_set = qw( ADDON_DIR BASE_DIR bindir BUILD_DIR DATA_DIR datadir datarootdir DESTDIR dir distdir DIRNAME docdir htmldir HTML_DIR INCLUDE_DIR infodir INSTALL_DATA includedir mkinstalldirs mandir libdir objdir sbindir 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', 'LINK' => 'link', 'LL' => 'link', 'MAKE' => 'nmake', 'manext' => 'doc', 'POSIX_SHELL' => 'sh', 'prefix' => './', 'SED' => 'sed', 'YASM' => 'yasm' ); my @others_maybe = qw( enableval ); sub get_root_dir() { return $root_folder; } sub add_key_2_added($) { my $key = shift; $added_in_init .= " " if (length($added_in_init)); $added_in_init .= $key; } sub init_commmon_subs2($$) { my ($rh,$add) = @_; # = \%common_subs my ($key,$rd,$val); $rd = get_root_dir(); # prt("Init using common directory [$rd]\n"); # like 'srcdir' foreach $key (@common_dir_set) { if (!defined ${$rh}{$key}) { ${$rh}{$key} = $rd; add_key_2_added($key) if ($add); } } foreach $key (@common_set) { if (!defined ${$rh}{$key}) { ${$rh}{$key} = ''; add_key_2_added($key) if ($add); } } # like 'CC', 'EXEEXT', ... foreach $key (keys %known_set) { if (!defined ${$rh}{$key}) { $val = $known_set{$key}; ${$rh}{$key} = $val; add_key_2_added($key) if ($add); } } } sub init_common_subs($) { my ($inf) = shift; ($root_file, $root_folder) = fileparse($inf); $root_folder = path_u2d($root_folder); if (length($target_dir) == 0) { $target_dir = $root_folder; $fix_relative_sources = 0; # no fix needed. since the SAME as 'root' } init_commmon_subs2(\%common_subs,1); } sub show_missing_subs() { if ($dbg_s13 || $dbg_s14) { my @arr = keys %subs_not_found; my ($cnt,$txt,$key,$fil,$val,%hash); $txt = ''; if (@arr) { $cnt = scalar @arr; prt("[13|14] There are at least $cnt missing substitutions.\n"); $txt = "# [13|14] There are at least $cnt missing substitutions.\n"; if ($show_per_file) { %hash = (); foreach $key (@arr) { $fil = $subs_not_found{$key}; push(@{$hash{$fil}},$key); } foreach $fil (keys %hash) { $val = $hash{$fil}; $cnt = scalar @{$val}; $txt .= "# Missing from file [$fil] $cnt\n"; prt("Missing $cnt from file [$fil] = ["); foreach $key (sort @{$val}) { $txt .= "-m $key \"\""; prt("$key "); } prt("]\n"); } } else { foreach $key (sort @arr) { $fil = $subs_not_found{$key}; prt("Missing [$key], in [$fil]\n"); $txt .= "-m $key \"\"\n"; } } } else { prt("[13|14] There are NO missing substitutions.\n"); } @arr = split(/\s/,$added_in_init); $cnt = scalar @arr; if ($cnt) { prt("But note ADDED $cnt items, during init..."); if (length($miss_mac_file) && (length($txt))) { $txt .= "# Note the following set of $cnt items were added during init...\n"; %hash = (); init_commmon_subs2(\%hash,0); $cnt = 0; foreach $key (@arr) { if (defined $hash{$key}) { $val = $hash{$key}; if ( (length($val) == 0) || ($val =~ /^\s+$/) ) { $val = '""'; } $txt .= "-m $key $val\n"; $cnt++; } } prt(" also now added to response file..."); } prt("\n"); } if (length($miss_mac_file) && (length($txt))) { write2file($txt,$miss_mac_file); prt("Written list for use as '-r $miss_mac_file' response file, after correction.\n"); } } } my %warned_done = (); my $warning_count = 0; sub prtw($) { my ($tx) = shift; $tx =~ s/\n$// if ($tx =~ /\n$/); prt("$tx\n"); if (!defined $warned_done{$tx}) { push(@warnings,$tx); $warned_done{$tx} = 1; } $warning_count++; } sub show_warnings($) { my $val = shift; if (@warnings) { my $wcnt = scalar @warnings; my $msg = ''; my $diff = $warning_count - $wcnt; $msg = "Note $diff duplicates NOT repeated." if ($diff); prt( "\nRepeat of $wcnt WARNINGS... $msg\n" ); foreach my $line (@warnings) { prt("$line\n" ); } prt("\n"); } elsif ($val) { prt("\nNo warnings issued.\n\n"); } } sub pgm_exit($$) { my ($val,$msg) = @_; show_warnings($val); show_missing_subs() if ($val == 0); if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg); } close_log($outfile,$load_log); exit($val); } sub sub_common_folder { my ($fil,$root) = @_; my $lfil = lc(path_u2d($fil)); my $lrot = lc(path_u2d($root)); my $len1 = length($lfil); my $len2 = length($lrot); my ($i); for ($i = 0; (($i < $len1)&&($i < $len2)); $i++) { if (substr($lfil,$i,1) ne substr($lrot,$i,1)) { last; } } return substr($fil,$i); } sub sub_root_folder { my ($fil) = shift; my $rd = get_root_dir(); return sub_common_folder($fil,$rd); } # given two scalar items, separated by '\s' or '\' # reutrn ZERO if ALL the second are IN the first. sub value_not_in_first($$) { my ($src,$rval) = @_; # $programs{$ky},$val my @arr1 = split(/[\s\|]/,$src); my $val2 = ${$rval}; my @arr2 = split(/[\s\|]/,$val2); my $cnt = scalar @arr2; my ($val1,$dcnt); if ($cnt == 1) { foreach $val1 (@arr1) { return 0 if ($val1 eq $val2); } } else { # put values in a hash, to allow delete my %vals = (); foreach $val1 (@arr2) { $vals{$val1} = 1; } $dcnt = 0; foreach $val1 (@arr1) { if (defined $vals{$val1}) { delete $vals{$val1}; $dcnt++; } } if ($dcnt) { @arr1 = keys(%vals); return 0 if (scalar @arr1 == 0); # but if there were 'some' items delete due to existance # then adjust the original $val... ${$rval} = join(' ',@arr1); } } return 1; } sub get_value_from_hash { my ( $rval2, $ms, $rhash ) = @_; my ($ky2, @vals, $fnd, $val, @keys, $i); my ($itm, $cond); $fnd = 0; foreach $ky2 (keys %{$rhash}) { if ($ky2 =~ /^$ms\s+/) { $val = $$rhash{$ky2}; if (!is_in_array($val, @vals)) { push(@vals,$val); push(@keys,$ky2); $fnd++; } } } if ($fnd == 1) { $$rval2 = $vals[0]; # just ONE to RETURN } elsif ($fnd > 1) { my $msg = "WARNING: For sub of [$ms], have [$fnd] to CHOOSE FROM!\n"; for ($i = 0; $i < $fnd; $i++) { $val = $vals[$i]; $ky2 = $keys[$i]; $msg .= " or \n" if ($i > 0); $msg .= "[$ky2={".$val.'}]'; if ($ky2 =~ /^$ms\s+if\s+(\w+)\@_(TRUE|FALSE)\@/) { $itm = $1; $cond = $2; $msg .= " [$itm]=[$cond]"; if (defined $def_condits{$itm}) { if ($def_condits{$itm} eq $cond) { $$rval2 = $val; # RETURN selected ### prtw("CHECK: Returning [$val] for [$ms], due [$itm]=[$cond] in def_condits!\n" ); return $fnd; } } } } $msg .= " Defaulting to FIRST! CHECK ME!!"; prtw("$msg\n"); $$rval2 = $vals[0]; # just RETURN first } return $fnd; } sub begins_with { my ($rt, $pt) = @_; my $ln = length($rt); if (length($pt) >= $ln) { for (my $i = 0; $i < $ln; $i++) { if (substr($rt,$i,1) ne substr($pt,$i,1)) { return 0; } } return 1; } return 0; } # VARIOUS FIXES FOR THE FILE NAME # 1. ensure ALL DOS format # 2. remove any simple dot relative, like '.\' from beginning # 3. if given a FULL PATH name, remove C:\FG\20\FlightGear # 4. if a relative name, remove FligthGear # 5. if any removal, ensure any beginning '\' is removed sub sub_root_dir($) { my ($ff) = shift; # = $a_dir.$src $ff = path_u2d($ff); my $rd = get_root_dir(); if (begins_with($rd, $ff)) { $ff = substr($ff, length($rd)); } return $ff; } my $done_dir_scan = 0; my @dir_scan = (); sub do_dir_scan($$); sub is_file_in_scan($$$) { my ($test,$fd,$ra) = @_; my $cnt = scalar @dir_scan; my ($i,$file,$fcnt,$ff); $fcnt = 0; for ($i = 0; $i < $cnt; $i++) { $file = $dir_scan[$i][0]; if ($test eq $file) { $ff = $dir_scan[$i][1]; # could now check if $fd at least partially matches, but for now push(@{$ra},$ff); $fcnt++; } } return $fcnt; } sub match_dir_for_c_source($$$) { my ($oky,$dir,$ra) = @_; my $cnt = scalar @dir_scan; my ($i,$file,$fcnt,$fn,$fd,$fx); $fcnt = 0; $dir = path_u2d($dir); $dir .= "\\" if (!($dir =~ /\\$/)); for ($i = 0; $i < $cnt; $i++) { $file = $dir_scan[$i][1]; ($fn,$fd,$fx) = fileparse($file,qr/\.[^.]*/); $fd = path_u2d($fd); if (($fd eq $dir) && ($fn eq $oky)) { if (is_c_source_extended($file)) { push(@{$ra},$file); return 1; } } } return 0; } sub do_dir_scan($$) { my ($dir,$lv) = @_; $dir .= "\\" if !($dir =~ /(\\|\/)$/); $dir = path_u2d($dir); my ($file,$ff,$n,$d); my @dirs = (); prt("Moment, doing full directory scan of [$dir]...\n") if ($lv == 0); if (opendir(DIR,$dir)) { my @files = readdir(DIR); closedir(DIR); foreach $file (@files) { next if (($file eq '.')||($file eq '..')); $ff = $dir.$file; if (-d $ff) { push(@dirs,$ff); next; } push(@dir_scan,[$file,$ff]); } } if (@dirs) { foreach $file (@dirs) { do_dir_scan($file,$lv+1); } } if ($lv == 0) { $file = scalar @dir_scan; prt("Done scan... got $file files...\n"); $done_dir_scan = 1; } } # extract info from one am file scan, # and try to do any substitutions, twice, but these should have been done already, # done at end of each process_AM_file, with the reference hash collected sub extract_from_hash($$$$) { my ($fil, $rhash, $rprogs, $rlibs) = @_; my ($a_nm, $a_dir) = fileparse($fil); my ($key, $val, @av); my (@skeys, @progs, @progkeys, @libs, @libkeys, @srcs, @srckeys); my ($ky, $vky, $ms, $val2, $ky2, $orgval, $fnd, $acnt); my ($src, $ff, $scnt, $i, $min, $len, $oky, $fcnt); my %extract = (); # really interested in # noinst_LIBRARIES = libAirports.a # noinst_PROGRAMS = calc_loc # bin_PROGRAMS = fgfs something # libAirports_a_SOURCES = apt_loader.cxx apt_loader.hxx ... @skeys = sort keys(%{$rhash}); $acnt = scalar @skeys; prt( "[02] extract_from_hash: Listing $acnt keys in hash passed... file [$fil]\n" ) if ($dbg_s02); # collect PROGRAM keys @progs = (); @progkeys = (); @libs = (); @libkeys = (); @srcs = (); @srckeys = (); # try to do substitutions $min = 0; foreach $key (@skeys) { $val = ${$rhash}{$key}; $orgval = $val; next if (!defined $val || (length($val) == 0)); if ($val =~ /\$\((\w+)\)/) { $ms = $1; $val2 = ''; # no sub yet $fnd = 0; # none found if (defined $global_hash{$ms}) { $val2 = $global_hash{$ms}; # found in global $fnd = 1; } elsif (defined $$rhash{$ms}) { $val2 = $$rhash{$ms}; # found in local $fnd = 2; } else { # hmmm, maybe like 'GFX_CODE if @USE_GLUT_FALSE@ = fg_os_osgviewer.cxx $(GFX_COMMON)' $fnd = get_value_from_hash(\$val2, $ms, $rhash ); } if ($fnd > 0) { $val =~ s/\$\($ms\)/$val2/g; } else { if ( ! is_in_array($ms,@subsnotfound) ) { prtw("[10] WARNING:1: No substitution for [$ms] found in hash ...\n" ) if ($dbg_s10); push(@subsnotfound,$ms); } } } if ($val ne $orgval) { $$rhash{$key} = $val; } $len = length($key); $min = $len if ($len > $min); } # try to do substitutions, twice foreach $key (@skeys) { $val = ${$rhash}{$key}; next if (!defined $val || (length($val) == 0)); $orgval = $val; if ($val =~ /\$\((\w+)\)/) { $ms = $1; $val2 = ''; $fnd = 0; if (defined $global_hash{$ms}) { $val2 = $global_hash{$ms}; $fnd = 1; } elsif (defined $$rhash{$ms}) { $val2 = $$rhash{$ms}; $fnd = 2; } else { # hmmm, maybe like 'GFX_CODE if @USE_GLUT_FALSE@ = fg_os_osgviewer.cxx $(GFX_COMMON)' foreach $ky2 (keys %{$rhash}) { if ($ky2 =~ /^$ms/) { $val2 = $$rhash{$ky2}; $fnd = 3; last; } } } if ($fnd > 0) { $val =~ s/\$\($ms\)/$val2/g; } else { if ( ! is_in_array($ms,@subsnotfound) ) { prtw("[10] WARNING:2: No substitution for [$ms] found in hash ...\n" ) if ($dbg_s10); push(@subsnotfound,$ms); } } } if ($val ne $orgval) { $$rhash{$key} = $val; } } my %htmp = (); foreach $key (@skeys) { $val = ${$rhash}{$key}; if (!defined $val) { delete ${$rhash}{$key}; next; } if ($key =~ /_PROGRAMS/) { push(@progkeys,$key); push(@progs,$val); $ms = "PROGRAMS"; } elsif (($key =~ /_LIBRARIES/)||($key =~ /_LTLIBRARIES/)) { push(@libkeys,$key); push(@libs,$val); $ms = "LIBRARIES"; } elsif (($key =~ /_SOURCES/)||($key =~ /_EXTRASOURCES/)||($key =~ /_AUXSOURCES/)) { push(@srckeys,$key); ###push(@srcs,$val); $ms = "SOURCES"; } else { $ms = "*SKIPPED*"; if (($key =~ /_/) && (($key =~ /PROGRAMS/)||($key =~ /LIBRARIES/)||($key =~ /SOURCES/))) { if (! defined $sources_exceptions{$key}) { # found bin_JAVAPROGRAMS CSHARPPROGRAMS hello_RESOURCES prtw("WARNING: *** CHECK ME *** Got [$key] val = [$val] *** CHECK ME ***\n". " SHOULD THIS ITEMS BE INCLUDED IN THE ACCUMULATION [$fil]\n"); $sources_exceptions{$key} = 1; # only output ONCE if ( !(($key =~ /JAVA/)||($key =~ /CSHARP/)||($key =~ /RESOURCES/)||($key =~ /PASCAL/)) ) { $exit_value = 1; } } } } $htmp{$ms} = [] if ( ! defined $htmp{$ms}); # list the sources, but this is JUST for DISPLAY #@av = split(/\s/,$val); # SPLIT LIST @av = split(/[\s\|]/,$val); # SPLIT LIST $val = ''; foreach $oky (@av) { $src = sub_root_dir($a_dir.$oky); $val .= ' ' if (length($val)); $val .= $src; } push(@{$htmp{$ms}}, [$key,$val]); } if ($dbg_s16) { $min = 0; foreach $ms (keys %htmp) { $ky = $htmp{$ms}; $scnt = scalar @{$ky}; prt("[16] $scnt of type $ms - file [$fil]\n"); for ($i = 0; $i < $scnt; $i++) { $src = ${$ky}[$i][0]; $len = length($src); $min = $len if ($len > $min); } $min = $max_of_type if ($min > $max_of_type); for ($i = 0; $i < $scnt; $i++) { $src = ${$ky}[$i][0]; $val = ${$ky}[$i][1]; $src .= ' ' while (length($src) < $min); prt(" $src = [$val]\n"); } } } # ======================================================================= prt("\n[02] List of items in the HASH from [$fil]...\n") if ($dbg_s02); foreach $key (@skeys) { $val = $$rhash{$key}; next if (($key eq 'EXTRA_DIST')&&($ignore_EXTRA_DIST)); $key .= ' ' while (length($key) < $min); prt(" $key = $val\n" ) if ($dbg_s02); } # ### PROCESS LIBRARY SOURCES if (@libkeys) { foreach $key (@libkeys) { $val = ${$rhash}{$key}; #@av = split(/\s/,$val); @av = split(/[\s\|]/,$val); # SPLIT LIST foreach $oky (@av) { $ky = $oky; $ky =~ s/-/_/g; $ky =~ s/\./_/g; $ky =~ s/\|//g; $ky = trim_all($ky); next if (length($ky) == 0); next if (($ky =~ /\@/)||($ky =~ /\$/)); $vky = $ky.'_SOURCES'; $fnd = 0; if (defined ${$rhash}{$vky}) { $val = ${$rhash}{$vky}; $fnd = 1; } else { foreach $val (keys %{$rhash}) { if (($val =~ /$oky/) && ($val =~ /SOURCE/i)) { $vky = $val; $val = ${$rhash}{$vky}; $fnd = 1; last; } } } if ($fnd) { #@srcs = split(/\s/, $val); @srcs = split(/[\s\|]/,$val); # SPLIT LIST $scnt = scalar @srcs; for ($i = 0; $i < $scnt; $i++) { $src = $srcs[$i]; if ($add_rel_sources) { $ff = sub_root_dir($a_dir.$src); if ($src ne $ff) { prt("[18] LIB: Changed src from [$src], to [$ff]. [$a_dir]\n") if ($dbg_s18); $srcs[$i] = $ff; } } } $val = join(' ',@srcs); if (defined ${$rlibs}{$ky}) { $ms = ${$rlibs}{$ky}; if ( value_not_in_first($ms,\$val) ) { prtw( "WARNING: libraries [$ky] has value [$ms] ADDING [$val]!\n" ); ${$rlibs}{$ky} .= ' '.$val; } } else { ${$rlibs}{$ky} = $val; } prt( "[04] LIBRARY [$ky] has SOURCES [$val]\n" ) if ($dbg_s04); } else { $ms = ''; $scnt = 0; foreach $val (keys %{$rhash}) { if ($val =~ /SOURCE/i) { $ms .= ' ' if (length($ms)); $ms .= $val; $scnt++; } } prt("But found $scnt keys [$ms] in HASH! Is it ONE of these?\n") if (length($ms)); prtw( "WARNING: No sources for LIBRARY [$ky] key [$vky] o [$oky],\n in file [$fil]\n" ); } } } } else { prt( "[03] No LIBRARY keys ...\n" ) if ($dbg_s03); } #### PROCESS PROGRAM SOURCES if (@progkeys) { foreach $key (@progkeys) { $val = $$rhash{$key}; #@av = split(/\s/,$val); @av = split(/[\s\|]/,$val); # SPLIT LIST foreach $oky (@av) { $ky = $oky; $ky =~ s/-/_/g; $ky =~ s/\./_/g; $ky = trim_all($ky); next if (length($ky) == 0); next if (($ky =~ /\@/)||($ky =~ /\$/)); $vky = $ky.'_SOURCES'; $fnd = 0; if (defined $$rhash{$vky}) { $val = $$rhash{$vky}; $fnd = 1; } else { foreach $val (keys %{$rhash}) { if (($val =~ /$oky/) && ($val =~ /SOURCE/i)) { $vky = $val; $val = $$rhash{$vky}; $fnd = 1; last; } } } if (!$fnd && $try_harder) { # search the HASH harder foreach $ky2 (keys %{$rhash}) { $val2 = $$rhash{$ky2}; @srcs = split(/[\s\|]/,$val2); # SPLIT LIST foreach $src (@srcs) { if (($src =~ /$oky\./) && is_c_source_extended($src) ) { $val = $src; $fnd = 1; last; } } } } if (!$fnd && $try_much_harder && ($oky =~ /^[-\w\.]+$/)) { do_dir_scan($root_folder,0) if (!$done_dir_scan); @srcs = (); $fcnt = match_dir_for_c_source($oky,$a_dir,\@srcs); if ($fcnt) { $val = $srcs[0]; $fnd = 1; } } if ($fnd && length($val)) { #@srcs = split(/\s/, $val); @srcs = split(/[\s\|]/,$val); # SPLIT LIST $scnt = scalar @srcs; for ($i = 0; $i < $scnt; $i++) { $src = $srcs[$i]; if ($add_rel_sources) { $ff = sub_root_dir($a_dir.$src); if ($src ne $ff) { prt("[18] PRG: Changed src from [$src], to [$ff]. [$a_dir]\n") if ($dbg_s18); $srcs[$i] = $ff; } } } $val = join(' ',@srcs); if (defined ${$rprogs}{$ky}) { $ms = ${$rprogs}{$ky}; if ( value_not_in_first($ms,\$val) ) { prtw( "WARNING: programs [$ky] has value [$ms] ADDING [$val]!\n" ); ${$rprogs}{$ky} .= ' '.$val; } } else { ${$rprogs}{$ky} = $val; } prt( "[04] PROGRAM [$ky] has SOURCES [$val]\n" ) if ($dbg_s04); } else { $ms = ''; $scnt = 0; foreach $val (keys %{$rhash}) { if ($val =~ /SOURCE/i) { $ms .= ' ' if (length($ms)); $ms .= $val; $scnt++; } } prt("But found $scnt keys [$ms] in HASH! Is it ONE of these?\n") if (length($ms)); prtw("WARNING: No sources for PROGRAM [$ky] key [$vky] org [$oky],\n in file [$fil]\n" ); } } } } else { prt( "[03] No PROGRAM keys ...\n" ) if ($dbg_s03); } $extract{'PROGRAMS'} = { %g_programs }; $extract{'LIBRARIES'} = { %g_libraries }; prt( "[02] extract_from_hash: Done $acnt from [".sub_root_folder($fil)."]...\n" ) if ($dbg_s02); return \%extract; } sub am_macro_split($) { my ($txt) = @_; 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 (length($tag)); $tag = ''; push(@arr,$mac); $ch = ''; $i = $k; } } } if (($ch eq "'") || ($ch eq '"')) { push(@arr,$tag) if (length($tag)); $tag = ''; push(@arr,$ch); } else { $tag .= $ch; } } return @arr; } sub test_for_substitution($$$$) { my ($line,$rhash,$i2,$sfil) = @_; if ($line =~ /\$/) { my $oline = $line; # keep copy of original my @arr = am_macro_split($line); my ($itm,$key,$nval,$tmp,$done,$cnt); $cnt = 0; foreach $itm (@arr) { if ($itm =~ /^\$\((\w+)\)$/) { $key = $1; $done = 0; if (defined ${$rhash}{$key}) { $nval = ${$rhash}{$key}; $line =~ s/\$\($key\)/$nval/; prt("[13] $i2:1:$key: Did sub of [$key] to [$nval]\n") if ($dbg_s13); $done = 1; $cnt++; } else { foreach $tmp (keys %{$rhash}) { if ($tmp =~ /^$key\s+.+\@_TRUE\@/) { $nval = ${$rhash}{$tmp}; $line =~ s/\$\($key\)/$nval/; prt("[13] $i2:2: Did sub to [$nval] key [$key] tmp = [$tmp]\n") if ($dbg_s13); $done = 1; $cnt++; last; } } } if (!$done) { # try in the common, which can be user expanded if (defined $common_subs{$key}) { $nval = $common_subs{$key}; $line =~ s/\$\($key\)/$nval/; prt("[13] $i2:3: Did sub to [$nval] key [$key] common subs\n") if ($dbg_s13); $done = 1; $cnt++; } } if (!$done && ($dbg_s13 || $dbg_s14)) { $subs_not_found{$key} = $sfil; prt("[13|14] $i2:2: NO sub FOUND for [$itm] key [$key] file [$sfil]\n") } } } if ($line ne $oline) { prt("[13] $i2: Line SUB [$oline] TO [$line]\n") if ($dbg_s13); } elsif ($cnt) { pgm_exit(1,"$i2:$cnt: SUBSTITUTIONS FAILED! line [$line] file [$sfil]\n"); } } return $line; } # lev = 1 = no plus sign, so should be first init of item # and warn if it is NOT # lev = 2 = Had a plus sign, is += so variable SHOULD exist # and warn if it does NOT, if $warn_on_plus sub add_key_value_2_hash($$$$$$) { my ($key,$val,$rhash,$i2,$sfil,$lev) = @_; my ($tmp,$done,$cval); if (defined ${$rhash}{$key}) { $cval = ${$rhash}{$key}; prtw( "WARNING: $i2: hash [$key] exists with [$cval]! Adding [$val]! $lev! file [$sfil]\n" ) if ($lev == 1); ${$rhash}{$key} .= '|'.$val; $tmp = 'Added to'; } else { # hmmm, maybe have a key like 'jack_freebob_la_SOURCES if HAVE_ALSA_MIDI@_TRUE@' $done = 0; if ($key =~ /\s/) { my @arr = split(/\s/,$key); my $cnt = scalar @arr; $tmp = $arr[0]; if (($cnt >= 3) && (defined ${$rhash}{$tmp})) { $cval = ${$rhash}{$key}; $key = $tmp; prtw( "WARNING: $i2: hash [$key] exists with [$cval]! Adding [$val]! $lev! file [$sfil]\n" ) if ($lev == 1); ${$rhash}{$key} .= '|'.$val; $done = 1; $tmp = 'Added (assume TRUE)'; } } if (!$done) { prtw( "WARNING: $i2: hash [$key] DOES NOT EXIST! $lev! file [$sfil]\n" ) if (($lev == 2) && $warn_on_plus); ${$rhash}{$key} = $val; $tmp = 'Setting ' } } prt("[12] $i2: $tmp key [$key], with value [$val] type $lev\n") if ($dbg_s12); } sub process_AM_file { my ($fil) = shift; my ($a_nm, $a_dir) = fileparse($fil); $a_dir = $cwd."\\" if ($a_dir =~ /^\.(\\|\/)$/); my $sfil = sub_root_folder($fil); my %my_hash = (); my $refhash = \%my_hash; my %targets = (); my ($ff); my $dooldext = 0; if (!open INF, "<$fil") { prtw( "WARNING: Unable to open $fil ... $! ...\n" ); return $refhash; } my @lns = ; close INF; my $cnt = scalar @lns; prt("\n") if ($dbg_s07 && $dbg_s08); prt( "[08] Processing $cnt lines, from [$fil] ...\n" ) if ($dbg_s08); my ($i,$line,$fline,$i2,@av,$key,$val,$j,$acnt,$ifcond); my ($ind,$len,$tmp,$scnt); my @cond_stack = (); my $in_target = 0; my $target = ''; $fline = ''; for ($i = 0; $i < $cnt; $i++) { $line = $lns[$i]; $i2 = $i + 1; chomp $line; $line = trim_all($line); prt("[01] $i2: [$line]\n") if ($dbg_s01); next if ($line =~ /^#/); $fline .= $line; #$len = length($fline); #if ($len == 0) { # $in_target = 0; # next; #} # join continuation lines into one if ($fline =~ /\\$/) { $fline =~ s/\\$/ /; next; } # deal with the FULL line $fline = trim_all($fline); $len = length($fline); if ($len == 0) { $in_target = 0; next; } $fline = test_for_substitution($fline,$refhash,$i2,$sfil); if (($fline =~ /$IF_PATTERN/o)||($fline =~ /$IFD_PATTERN/o)) { # open an IF $ifcond = $1; push(@cond_stack, $ifcond . "\@_TRUE\@"); $scnt = scalar @cond_stack; prt( "[06] IF:$scnt: Opened cond_stack with [".$cond_stack[$#cond_stack]."] [$sfil]\n" ) if ($dbg_s06); #$in_target = 0; } elsif (($fline =~ /$NIF_PATTERN/o)||($fline =~ /$NIF_PATTERN2/o)) { # open an IF !(SOMETHING) $ifcond = $1; push(@cond_stack, $ifcond . "\@_FALSE\@"); prt( "[06] NIF:$scnt: Opened cond_stack with [".$cond_stack[$#cond_stack]."] [$sfil]\n" ) if ($dbg_s06); #$in_target = 0; } elsif ($fline =~ /$ELSE_PATTERN/o) { # switch to else $scnt = scalar @cond_stack; if ($scnt) { if ($cond_stack[$#cond_stack] =~ /\@_TRUE\@$/) { $cond_stack[$#cond_stack] =~ s/\@_TRUE\@$/\@_FALSE\@/; } else { $cond_stack[$#cond_stack] =~ s/\@_FALSE\@$/\@_TRUE\@/; } prt( "[06] Else:$scnt: Switched cond_stack to [".$cond_stack[$#cond_stack]."] $sfil\n" ) if ($dbg_s06); } else { prtw( "POTENTIAL ERROR: else without if or nif! [$fil:$i2]\n" ); $exit_value = 1; } #$in_target = 0; } elsif ($fline =~ /$ENDIF_PATTERN/o) { # reached endif if (! @cond_stack) { prtw( "ERROR: endif without if! ($sfil:$i2)\n" ); } else { $ifcond = pop (@cond_stack); prt( "[06] Closed cond_stack with [$ifcond] $sfil\n" ) if ($dbg_s06); } #$in_target = 0; } elsif ($fline =~ /$INCLUDE_PATTERN/o) { $key = $1; $ff = $a_dir.$key; $ff = fix_rel_path3($ff,'process_AM_file'); my ($irh,$k,$v,$sff); $sff = sub_root_folder($ff); if (-f $ff) { prt( "[08] Processing INCLUDE file [$ff], from [$fil] ...\n" ) if ($dbg_s08); $irh = process_AM_file($ff); $v = scalar keys(%{$irh}); prt( "\n[08] ADVICE: Merging include of $v items from [$sff]...\n") if ($dbg_s08); foreach $k (keys %{$irh}) { $v = ${$irh}{$k}; if (defined ${$refhash}{$k}) { ${$refhash}{$k} .= ' '.$v; } else { ${$refhash}{$k} = $v; } } } else { prtw( "ERROR: Unhandled INCLUDE [$key], ($sfil:$i2) [$sff] NOT FOUND\n" ); } } elsif ($fline =~ /^(\w+)\s*=\s*(.*)$/) { #$key = $1; @av = split('=',$fline); $key = trim_all($av[0]); $acnt = scalar @av; $val = ''; # start with NO VALUE # if can be just 'JPEG_SERVER =' for ($j = 1; $j < $acnt; $j++) { if ($j == 1) { $val = trim_all($av[$j]); } else { $val .= '='.trim_all($av[$j]); } } #show_line_split($fline,$key,$val,\@av,$i2); if (@cond_stack) { $ifcond = $cond_stack[$#cond_stack]; $key .= ' if '.$ifcond; } if (length($key) == 0) { pgm_exit(1,"ERROR: Split of line [$fline] DID NOT YIELD key! Losing value [$val]\n"); } else { add_key_value_2_hash($key,$val,$refhash,$i2,$sfil,1); # should NOT exist } } elsif ($fline =~ /^(\w+)\s*\+=\s*(.+)$/) { $key = $1; $val = $2; if (@cond_stack) { $ifcond = $cond_stack[$#cond_stack]; $key .= ' if '.$ifcond; } add_key_value_2_hash($key,$val,$refhash,$i2,$sfil,2); # plus, so key SHOULD exist } elsif ($fline =~ /^([\.\w-]+)\s*:/) { $target = $1; $in_target = 1; $val = ''; $ind = index($fline,':'); if (($ind > 0) && (($ind+1) < $len)) { $val = trim_all(substr($fline,($ind+1))); } if (@cond_stack) { $ifcond = $cond_stack[$#cond_stack]; $target .= ' if '.$ifcond; } if (defined $targets{$target}) { ##prtw( "WARNING: targets[$target] exists with [".$targets{$target}."]! Adding [$val]!! file=$sfil\n" ); $targets{$target} .= ' '.$val; $tmp = 'Added to'; } else { $targets{$target} = $val; ##prtw( "WARNING: targets[$target] DOES NOT exist! Adding [$val]!! file=$sfil\n" ); $tmp = 'Started'; } prt("[11] $i2: $tmp target [$target], with value [$val]\n") if ($dbg_s11); } else { if ($in_target && length($target)) { if (defined $targets{$target}) { $targets{$target} .= "\n".$fline; } else { $targets{$target} = $fline; ##prtw( "WARNING: targets[$target] DOES NOT exist! Adding [$val]!! file=$sfil\n" ); } prt("[11] $i2: Added to targets [$target] value [$fline]\n") if ($dbg_s11); } else { prt("[01] $i2: [$fline] SKIPPED file=[$fil]\n" ) if ($dbg_s01); } } $fline = ''; # kill this processed line $key = ''; $val = ''; } # done all the LINES, now play with the HASH collected $acnt = scalar keys(%{$refhash}); if ($acnt) { my $rextr = extract_from_hash( $fil, $refhash, \%g_programs, \%g_libraries ); } else { prt( "NOTE: NO KEYS IN HASH! for [$fil] $cnt lines...\n" ); } # WARN if conditional stack NOT closed if (@cond_stack) { $val = join("\n",@cond_stack); prtw( "WARNING: Items still in cond_stack! [$val]\n file [$fil]\n" ); } return $refhash; } sub process_one_am_file($) { my ($fil) = shift; $fil = fix_rel_path3($fil,'process_one_am_file'); my $sfil = sub_root_folder($fil); return if (defined $ams_done{$fil}); $ams_done{$fil} = 1; my $ramh = process_AM_file($fil); my ($p_tit,$p_dir,$p_ext) = fileparse( $fil, qr/\.[^.]*/ ); if ($process_subdir && (defined ${$ramh}{'SUBDIRS'})) { my $slist = ${$ramh}{'SUBDIRS'}; my @ar = split(/\s/,$slist); my $cnt = scalar @ar; prt( "[09] Got $cnt subdirectories [$slist] ...from [$sfil]\n" ) if ($dbg_s09); foreach my $dir (@ar) { my $am = $p_dir.$dir.'\Makefile.am'; $am = path_u2d($am); $am =~ s/\\\\/\\/g while ($am =~ /\\\\/); my $sam = sub_root_folder($am); if (-f $am) { prt( "[05] Processing AM file [$am], from [$fil] ...\n" ) if ($dbg_s05); process_one_am_file($am); } else { prtw( "[05] WARNING: AM [$am] NOT FOUND! in [$dir], from [$fil]!\n" ) if ($dbg_s05); } } } return $ramh; } # SUMMARY OUTPUT # ============== sub list_to_arrays($$$) { my ($in_fil,$rprogs,$rlibs) = @_; my ($in_tit,$in_dir) = fileparse($in_fil); my %my_src_hash = (); my $rsh = \%my_src_hash; my @msvc_c_files = (); my @msvc_h_files = (); my $am_cnt = scalar keys(%ams_done); my $prog_cnt = scalar keys(%{$rprogs}); my $libs_cnt = scalar keys(%{$rlibs}); if (($prog_cnt == 0) && ($libs_cnt == 0)) { if ($am_cnt == 1) { prt("Processed $am_cnt AM file, but NO programs nor libraries found. [$in_file]\n"); } else { prt("\nAM files processed yielded NO programs nor libraries! ($am_cnt am files)\n"); } return $rsh; } my $prog_cnt2 = 0; my $lib_cnt2 = 0; # ==================================================================================== # This is also the SUMMARY, and check if source found, or NOT # set my $total_sources = 0; and my $source_missed = 0; prt( "\nAM files yielded programs $prog_cnt... (from $am_cnt file)\n" ) if ($prog_cnt); my ($key, $val, @av, $fil); my ($src, $tit, $dir, $ext, $cnt, $ok, $ff, $rfil); my ($ff2,$ok2,@arr); my @done = (); my $sgrp = get_def_src_grp(); # "Source Files"; my $sflt = get_def_src_filt(); my $hgrp = get_def_hdr_grp(); # "Header Files"; my $hflt = get_def_hdr_filt(); my $rel_path = ''; if ($fix_relative_sources) { $rel_path = get_rel_dos_path($in_dir,$target_dir); prt("Got relative [$rel_path], from in [$in_dir], and targ [$target_dir]\n"); } foreach $key (sort keys %{$rprogs}) { next if ((length($key) == 0)||($key =~ /^\s+$/)); # ignore BLANKS $prog_cnt2++; $val = ${$rprogs}{$key}; @av = split(/\s/,$val); $cnt = scalar @av; prt( "PROGRAM [$key] $cnt SOURCES\n" ); @done = (); # clear DONE foreach $fil (@av) { next if ((length($fil) == 0)||($fil =~ /^\s+$/)); # ignore BLANKS $ff = $in_dir.$fil; $ff = fix_rel_path3($ff,"list_to_arrays"); next if (-d $ff); # ignore DIRECTORIES $total_sources++; if (-f $ff) { $ok = "ok"; } else { if (is_c_source_extended($fil)) { $ok = "*** PROG SOURCE NOT FOUND [$ff]"; } else { $ok = "not found [$ff]"; } if ($find_bad_source) { do_dir_scan($root_folder,0) if (!$done_dir_scan); @arr = (); ($tit,$dir) = fileparse($fil); $cnt = is_file_in_scan($tit,$dir,\@arr); if ($cnt) { $ff = $arr[0]; # for now take just the FIRST, but... $ok = "ok - found $cnt"; if (!$fix_relative_sources) { # but have the FULL PATH ($tit,$dir) = fileparse($ff); $rel_path = get_rel_dos_path($dir,$root_folder); $fil = $rel_path.$tit; $fil =~ s/^\.\\//; } $found_count++; } } if (!($ok =~ /^ok/)) { $source_missed++; } } ($tit,$dir) = fileparse($ff); if ($fix_relative_sources) { $rel_path = get_rel_dos_path($dir,$target_dir); $rfil = $rel_path.$tit; $ff2 = $target_dir.$rfil; if (-f $ff2) { $ok2 = "ok2"; } else { if ($ok eq 'ok') { $ok2 = "RELATIVE PROBLEM [$ff2]"; } else { $ok2 = ''; } } prt( " [15] rel [$rfil] [$fil] $ok $ok2\n") if ($dbg_s15); $fil = $rfil; } else { prt( " [15] [$fil] $ok\n") if ($dbg_s15); } if ( is_c_source_extended($fil) ) { if ( is_in_array($tit,@done) ) { prtw("Duplicate of prog FILE TITLE [$tit] file [$fil]!\n" ) if ($show_dup_title); } else { push(@done,$tit); } #push(@msvc_c_files, $src); push(@msvc_c_files, [$fil, $sgrp, $sflt]); } else { #push(@msvc_h_files, $src); push(@msvc_h_files, [$fil, $hgrp, $hflt]); } } } prt("\nAM files yielded the following library SOURCES... (from $am_cnt files)\n") if ($libs_cnt); foreach $key (sort keys %{$rlibs}) { next if ((length($key) == 0)||($key =~ /^\s+$/)); # ignore BLANKS $lib_cnt2++; $val = ${$rlibs}{$key}; @av = split(/\s/,$val); $cnt = scalar @av; prt( "LIBRARY [$key] $cnt SOURCES\n" ); @done = (); # clear DONE foreach $fil (@av) { next if ((length($fil) == 0)||($fil =~ /^\s+$/)); # ignore BLANKS $ff = $in_dir.$fil; $ff = fix_rel_path3($ff,"list_to_arrays"); next if (-d $ff); # ignore DIRECTORIES $total_sources++; if (-f $ff) { $ok = "ok"; } else { if (is_c_source_extended($fil)) { $ok = "*** LIB SOURCE NOT FOUND [$ff]"; } else { $ok = "not found [$ff]"; } if ($find_bad_source) { do_dir_scan($root_folder,0) if (!$done_dir_scan); @arr = (); ($tit,$dir) = fileparse($fil); $cnt = is_file_in_scan($tit,$dir,\@arr); if ($cnt) { $ff = $arr[0]; # for now take just the FIRST, but... $ok = "ok - found $cnt"; $found_count++; } } if (!($ok =~ /^ok/)) { $source_missed++; } } ($tit,$dir) = fileparse($ff); if ($fix_relative_sources) { $rel_path = get_rel_dos_path($dir,$target_dir); $rfil = $rel_path.$tit; $ff2 = $target_dir.$rfil; if (-f $ff2) { $ok2 = "ok2"; } else { if ($ok eq 'ok') { $ok2 = "RELATIVE PROBLEM [$ff2]"; } else { $ok2 = ''; } } prt( " [15] rel [$rfil] [$fil] $ok $ok2\n" ) if ($dbg_s15); $fil = $rfil; } else { prt( " [15] [$fil] $ok\n" ) if ($dbg_s15); } if (is_c_source($fil)) { if (is_in_array($tit,@done)) { prtw("Duplicate of libs src FILE TITLE [$tit] file [$fil]!\n" ) if ($show_dup_title); } else { push(@done,$tit); } ###push(@msvc_c_files, $src); push(@msvc_c_files, [$fil, $sgrp, $sflt]); } else { ###push(@msvc_h_files, $src); push(@msvc_h_files, [$fil, $hgrp, $hflt]); } } } $key = scalar @msvc_c_files; $val = scalar @msvc_h_files; if ($key || $val || $prog_cnt2 || $lib_cnt2) { $ok = "Done AM file [$in_file], "; $ok .= "and ".($am_cnt - 1)." more, " if ($am_cnt > 1); $ok .= "and found -"; prt("$ok\n"); prt("Set of $key C SOURCE files, and $val headers (and others)...for progs=$prog_cnt2, libs=$lib_cnt2\n" ); } # hmmm, since this is the LAST output, perhaps not a warning prt("NOTE: $source_missed of total $total_sources sources were NOT FOUND! [$in_file]\n") if ($source_missed); prt("NOTE: $found_count files were found by a full directory scan of [$in_dir].\n") if ($found_count); ${$rsh}{'C_SOURCES'} = [ @msvc_c_files ]; ${$rsh}{'H_SOURCES'} = [ @msvc_h_files ]; return $rsh; } sub process_primary($) { my ($fil) = shift; my ($key); my $rh = process_one_am_file($fil); # iteratively process the Makefile.am files list_to_arrays($fil,\%g_programs,\%g_libraries); ##write_temp_dsp($dsp_outfile); } ############################################################# ##### MAIN ##### set_dbg_base("dbg_s"); #set_debug_none(); #set_debug_all(); pgm_exit(1,"ERROR: Debugging is FAILING! check-sum=$check_sum, dbg = ".get_dbg_range()."!\n") if (get_dbg_range() != $check_sum); parse_args(@ARGV); init_common_subs( $in_file ); process_primary( $in_file ); pgm_exit($exit_value,""); ############################################################## sub give_help { my ($tmp); prt("$pgmname: version 0.2.1 2010-09-05 - see amscan02.pl for later implementation.\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 (-d) = Set DEBUG flag of this value. Number in range 1 to $tmp\n"); prt(" --load-log (-l) = Load LOG file at end.\n"); prt(" --mac item val (-m) = Store a MACRO, item=value, for substitution. (use '-d 14' to list missing).\n"); prt(" --quick (-q) = Be quick. This turn OFF any directory scanning for sources.\n"); prt(" --subdir (-s) = Process SUBDIR entries, and ALL Makefile.am files found.\n"); prt(" --resp (-r) = Commands from a reponse/input file.\n"); prt(" --targ (-t) = Establish a target directory for the DSW/DSP files.\n"); prt("Purpose:\n"); prt("Read the file given as a GNU Makefile.am autotools project description file, and\n"); prt("show its contents. If the --subdir (-s) command is given, and it contains any SUBDIRS = macro,\n"); prt("then it check each sub-directory for a Makefile.am file, and if found, process it also.\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"); prt(" While this script does NOT output DSW/DSP files, if given a target directory, the source file\n"); prt(" lists for each project source listed will be adjusted as if the DSP file was in this target\n"); prt(" directory. The default will be the same directory as the primary Makefile.am file.\n"); prt(" This script does NOT function with a Makefile.in, which is more like a 'standard' makefile that\n"); prt(" would be used by the 'make', or 'nmake' tools in windows.\n"); $tmp = get_dbg_stg(); prt(" For debug, presently values [$tmp] are ON\n") if (length($tmp)); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub show_dbg_help() { my $file = $0; my ($line,$max,$tmp,$cnt); $max = get_dbg_range(); $tmp = get_dbg_stg(); prt(" --dbg (-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 = ; 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_s(\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 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; } my $in_input_file = 0; sub load_input_file($$) { my ($arg,$file) = @_; if (open INF, "<$file") { my @lines = ; close INF; my @carr = (); my ($line,@arr); foreach $line (@lines) { $line = trim_all($line); next if (length($line) == 0); next if ($line =~ /^#/); @arr = split(/\s/,$line); push(@carr,@arr); } $in_input_file++; parse_args(@carr); $in_input_file--; } else { pgm_exit(1,"ERROR: Unable to 'open' file [$file]!\n") } } sub wait_key() { prt("Any key to continue...\n"); my $char = <>; } sub parse_args { my (@av) = @_; my ($arg,$sarg,$tmp,$rng); 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(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^l/i) { $load_log = 1; prt("Set to load log at end.\n"); } elsif ($sarg =~ /^d/i) { need_arg(@av); shift @av; $sarg = $av[0]; $rng = get_dbg_range(); if (($sarg =~ /^\d+$/)&&($sarg >= 1)&&($sarg <= $rng)) { $tmp = 'dbg'; if ($sarg < 10) { $tmp .= "0$sarg"; } else { $tmp .= "$sarg"; } set_dbg_var($sarg); prt("Set Debug $tmp ON! (of $rng)\n"); } else { if ($sarg =~ /^\d+$/) { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Out of range 1 - $rng\n"); } else { if ($sarg =~ /^help$/i) { show_dbg_help(); pgm_exit(0,"DEBUG Help exit(0)\n"); } elsif ($sarg =~ /^all$/i) { set_all_dbg_on(); $tmp = get_dbg_stg(); prt("Set ALL debug ON! 1 to $rng [$tmp]\n"); } elsif ($sarg =~ /^none$/i) { set_all_dbg_off(); $tmp = get_dbg_stg(); prt("Setting ALL debug OFF! 1 to $rng [$tmp]\n"); } else { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Not numerical in range 1 - $tmp, nor 'all', 'none', or 'help' !\n"); } } } } 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} = local_strip_both_quotes($tmp); prt("Set MACRO $sarg = [$tmp] in common subs...\n"); } elsif ($sarg =~ /^q/i) { # quick = no directory scan $try_harder = 0; $try_much_harder = 0; prt("Turned OFF the try harder directory scans, if needed.\n"); } elsif ($sarg =~ /^r/i) { # response file need_arg(@av); shift @av; $sarg = $av[0]; load_input_file($arg,$sarg); } elsif ($sarg =~ /^s/i) { # process SUBDIR entries $process_subdir = 1; prt("Set to process SUBDIR entries, if found.\n"); } elsif ($sarg =~ /^t/i) { # target directory for DSP file(s) need_arg(@av); shift @av; $sarg = $av[0]; $target_dir = File::Spec->rel2abs($sarg); $fix_relative_sources = 1; prt("Set to TARGET folder to [$target_dir].\n"); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = File::Spec->rel2abs($arg); prt("Set input to [$in_file]\n"); } shift @av; } if (!$in_input_file) { if ((length($in_file) == 0) && $debug_on) { $in_file = $def_file; $target_dir = $def_targ if (length($target_dir) == 0); #$load_log = 1; $rng = get_dbg_range(); set_all_dbg_on(); $tmp = get_dbg_stg(); prt("[debug_on] Set ALL debug ON! 1 to $rng [$tmp]\n"); } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } $in_file = path_u2d($in_file); if (! -f $in_file) { pgm_exit(1,"ERROR: Input file [$in_file] NOT FOUND!\n"); } } #wait_key(); } # eof - amscan.pl