Generated: Tue Feb 2 17:54:55 2010 from showsrcs3.pl 2005/12/09 30.9 KB.
#!/Perl # ######################################################################## # AIM: Find and display SOURCES from the Makefile.am in a FOLDER ... # and COMPARE that source list with the VCPROJ file # Show what should be DELETED, and what should be ADDED to the VCPROJ file # Geoff R. McLane - mailto: geoffair _at_ hotmail _dot_ com - 8 December, 2005 # ######################################################################## # just to show how long the program ran ... use Time::HiRes qw( usleep ualarm gettimeofday tv_interval nanosleep ); my ($t0, $t1, $elapsed); my $OF; # create an OUTPUT file, for review ... open $OF, ">tempout.txt" || die "ERROR: Unable to create output file ...\n"; $t0 = [gettimeofday]; # start the TIMER my $verb2 = 0; # add MORE output prt( "Hello, World... running $0 ...\n" ); my $dir = shift || die "ERROR: Must give an input direcory, folder ...\n"; my $IF_PATTERN = "^if[ \t]+\([A-Za-z][A-Za-z0-9_]*\)[ \t]*\(#.*\)?\$"; my $ELSE_PATTERN = "^else[ \t]*\(#.*\)?\$"; my $ENDIF_PATTERN = "^endif[ \t]*\(#.*\)?\$"; my $WHITE_PATTERN = "^[ \t]*\$"; my $RULE_PATTERN = "^([\$a-zA-Z_.][-.a-zA-Z0-9_(){}/\$]*) *:([^=].*|)\$"; my $SUFFIX_RULE_PATTERN = "^\\.([a-zA-Z]+)\\.([a-zA-Z]+)\$"; my $MACRO_PATTERN = "^([A-Za-z][A-Za-z0-9_]*)[ \t]*([:+]?)=[ \t]*(.*)\$"; my $BOGUS_MACRO_PATTERN = "^([^ \t]*)[ \t]*([:+]?)=[ \t]*(.*)\$"; my @conditional_stack = (); my %contents = (); my %conditional = (); my @var_list = (); my %am_vars = (); my %def_type = (); # This holds the line numbers at which various elements of # %contents are defined. my %content_lines = (); prt( "Checking folder: $dir ...\n"); my ($ch, $i, $len, $is, $part); my @dirs = (); my $line; split_in_dir(); my $dircnt = scalar @dirs; my $file = $dir . '/Makefile.am'; my $root = $dir; if (! -f $file) { prt( "WARNING: No find of 'Makefile.am' in $dir ...\n"); exit(1); } prt ("Found $file ... \n"); my @lines = (); my @srcs = (); my $insrc = 0; my @arr; my $insub = 0; my @subs = (); my $pos = 0; my @scrsc = (); my $subcnt = 0; ### configure.ac variables ########################## my $AM_CONDITIONAL_PATTERN = "AM_CONDITIONAL\\((\\w+)"; my $AM_INIT_AUTOMAKE = "AM_INIT_AUTOMAKE\\(([^,]+),[ \t]*([^)]+)"; my $AC_SUBST = "^AC_SUBST\\((\\w+)"; # Hash table of AM_CONDITIONAL variables seen in configure. my %configure_cond = (); my @make_input_list = (); my @other_input_files = (); my @input_files = (); my %output_files = (); my %make_list = (); # Names used in AC_CONFIG_HEADER call. @config_fullnames holds the # name which appears in AC_CONFIG_HEADER, colon and all. # @config_names holds the file names. @config_headers holds the '.in' # files. Ordinarily these are similar, but they can be different if # the weird "NAME:FILE" syntax is used. my @config_fullnames = (); my @config_names = (); my @config_headers = (); # Line number at which AC_CONFIG_HEADER appears in configure.ac. my $config_header_line = 0; # Extracted from AM_INIT_AUTOMAKE(package,version) my $dsp_package = 'FGFS'; my $dsp_version = '0.2'; scan_configure($dir); ########################## read_am_file( $file ); $subcnt = scalar @subs; prt( "Got " . scalar @srcs . " source files ...and subs=$subcnt ...\n"); while ($subcnt) { # process lower 'Makefile.am' below this start folder my @subs2 = @subs; @subs = (); prt( "Processing subs ". join(' ',@subs2) . "\n" ) if $verb2; foreach my $sub (@subs2) { ###if( ($sub eq 'tests') || ($sub eq 'man') || ($sub eq 'scripts') || ($sub eq 'utils') ) { ### next; ###} $file = $dir . '/' . $sub . '/Makefile.am'; if ( -f $file) { read_am_file( $file ); ###my $sc = scalar @subs; ###print "Got " . scalar @srcs . " source files ...and subs=$sc ...\n"; } else { prt( "WARNING: $file not found!\n"); } } $subcnt = scalar @subs; } # process the SOURCES gathered in the above Makefile.am scan # only retain *.c, *.cxx, and *.cpp - output a CHECK if not *.h, *.hxx, *.hpp foreach $line (@srcs) { chomp $line; if (($line =~ /\.cxx$/i) || ($line =~ /\.c$/i) || ($line =~ /\.cpp$/i)) { ### print "add $line to scrsc ...\n"; push(@scrsc,$line); } else { if ( !(($line =~ /\.hxx$/i) || ($line =~ /\.h$/i) || ($line =~ /\.hpp$/i)) ) { prt( "CHECK Discarded source $line\n"); } } } my $srccnt = scalar @scrsc; prt( "Got $srccnt c/cxx/cpp source files ...\n"); if (! $srccnt) { prt( "Warning: Got NO source files ...\n" ); exit(2); } ###open FH, ">tempout.txt"; ###foreach $line (@scrsc) { ### print FH "$line\n"; ###} ###close FH; ###exit(4); # have the SET of source files from the Makefile.am # find the *.vcproj file ... maybe back up the path given #my $dircnt = scalar @dirs; my ($cd, $nf); while ($dircnt) { $cd = get_nxt_dir( $dircnt ); ###print "$cd\n"; $nf = find_vcproj( $cd ); if (length($nf)) { last; } $dircnt--; } $file = $cd . '/' . $nf; if (! -f $file) { prt( "ERROR: Failed to find VCPROJ file ...\n" ); exit(4); } my $rdir = get_rel_dir($dircnt); my $lrdir = length($rdir); prt( "Processing $file ...\$dircnt=$dircnt ... rel.dir=$rdir\n" ) if $verb2; my @xmllines = (); my @srclns = (); load_vcproj( $file ); my $xlncnt = scalar @xmllines; my $scnt = scalar @srclns; prt( "Got $xlncnt XML lines ... $scnt file source lines ...\n" ); ###open FH, ">tempout.txt"; ###foreach $line (@xmllines) { $file =~ s/\.vcproj$/\.dsp/i; my $dspfile = $file; my @dsplines = (); my @dspsrcs = (); load_dsp( $dspfile ); # do the COMPARISONS my $gotln = 0; prt( "\nCOMPARE 1: " . scalar @srclns . " VCPROJ lines with " . scalar @scrsc . " Makefile.am lines ...\n" ); my $ln; my $uline; my $delcnt = 0; foreach $line (@srclns) { $gotln = 0; $uline = uc($line); foreach $ln (@scrsc) { if ($uline eq uc($ln)) { $gotln = 1; last; } } if ($gotln) { ###print FH "Found $line\n"; } else { # check MORE @parts = split( '/', $line ); my $fn = uc($parts[$#parts]); foreach $ln (@scrsc) { my @parts2 = split('/',$ln); my $fn2 = $parts2[$#parts2]; if ($fn eq uc($fn2)) { $gotln = 1; last; } } if ($gotln) { # ok found the file name - paths are different?? prt( "Found2 $line=$ln!\n" ); } else { prt( "DELETE $line ... $fn\n" ); $delcnt++; } } } if ($delcnt) { prt( "Appears $delcnt NEED to be removed from the VCPROJ file!\n" ); } else { prt( "Appears no entries NEED to be removed from the VCPROJ file!\n" ); } prt( "\nCOMPARE 2: sources from the AM file lines ... with VCPROJ sources\n" ); $gotln = 0; my $addcnt = 0; foreach $line (@scrsc) { $gotln = 0; $uline = uc($line); foreach $ln (@srclns) { if (uc($ln) eq $uline) { $gotln = 1; last; } } if ($gotln) { ###print FH "Found $line\n"; } else { # try HARDER @parts = split( '/', $line ); my $fn = uc($parts[$#parts]); foreach my $ln (@srclns) { my @parts2 = split('/',$ln); my $fn2 = $parts2[$#parts2]; if ($fn eq uc($fn2)) { $gotln = 1; last; } } if ($gotln) { # ok found the file name - paths are different?? prt( "Found2 $line=$ln!\n" ); } else { prt( "ADD $line\n" ); $addcnt++; } } } if ($addcnt) { prt( "Appears $addcnt NEED to be added from makefile.am, to VCPROJ file ...\n" ); } else { prt( "Appears NONE need be added from makefile.am, to VCPROJ file ...\n" ); } prt( "\nCOMPARE 3: " . scalar @dspsrcs . " DSP lines with " . scalar @scrsc . " Makefile.am lines ...\n" ); $delcnt = 0; foreach $line (@dspsrcs) { $gotln = 0; $uline = uc($line); foreach $ln (@scrsc) { if ($uline eq uc($ln)) { $gotln = 1; last; } } if ($gotln) { ###print FH "Found $line\n"; } else { # check MORE @parts = split( '/', $line ); my $fn = uc($parts[$#parts]); foreach $ln (@scrsc) { my @parts2 = split('/',$ln); my $fn2 = $parts2[$#parts2]; if ($fn eq uc($fn2)) { $gotln = 1; last; } } if ($gotln) { # ok found the file name - paths are different?? prt( "Found2 $line=$ln!\n" ); } else { prt( "DELETE $line ... $fn\n" ); $delcnt++; } } } if ($delcnt) { prt( "Appears $delcnt NEED to be removed from the DSP file!\n" ); } else { prt( "Appears no entries NEED to be removed from the DSP file!\n" ); } prt( "\nCOMPARE 4: sources from the AM file lines ... with VCPROJ sources\n" ); $gotln = 0; $addcnt = 0; foreach $line (@scrsc) { $gotln = 0; $uline = uc($line); foreach $ln (@dspsrcs) { if (uc($ln) eq $uline) { $gotln = 1; last; } } if ($gotln) { ###print FH "Found $line\n"; } else { # try HARDER @parts = split( '/', $line ); my $fn = uc($parts[$#parts]); foreach my $ln (@dspsrcs) { my @parts2 = split('/',$ln); my $fn2 = $parts2[$#parts2]; if ($fn eq uc($fn2)) { $gotln = 1; last; } } if ($gotln) { # ok found the file name - paths are different?? prt( "Found2 $line=$ln!\n" ); } else { prt( "ADD $line\n" ); $addcnt++; } } } if ($addcnt) { prt( "Appears $addcnt NEED to be added from makefile.am, to DSP file ...\n" ); } else { prt( "Appears NONE need be added from makefile.am, to DSP file ...\n" ); } $t1 = [gettimeofday]; $elapsed = tv_interval( $t0, $t1 ); prt( "\nEnd of program - $0 ran for $elapsed seconds ...\n" ); close $OF; ###system 'tempout.txt'; exit( ($delcnt + $addcnt) ); ### end of program ### sub find_vcproj { my ($d) = @_; ###print "Finding in $d ...\n"; opendir DIR, $d; my @fils = readdir(DIR); closedir DIR; ###print "Found " . scalar @fils . " files and directories ...\n"; foreach my $fil (@fils) { if ($fil =~ /(.*)\.vcproj$/i) { ###print "Found $fil ...\n"; return $fil; } } return ''; } sub get_nxt_dir { my ($p) = @_; my $nd = ''; my $cnt = 0; foreach $line (@dirs) { ###print "$line "; if ($cnt) { $nd .= '/'; } $nd .= $line; $cnt++; if ($cnt == $p) { last; } } return $nd; } sub get_rel_dir { my ($p) = @_; my $nd = ''; my $cnt = 0; foreach $line (@dirs) { $cnt++; if ($cnt > $p) { ###print "$line "; if (length($nd)) { $nd .= '/'; } $nd .= $line; } } return $nd; } sub dos_to_unix { my ($d) = @_; $d =~ s/\\/\//g; return $d; } sub rel_dir { my ($f) = @_; my $rd = dos_to_unix($f); # ensure unix form $r = dos_to_unix($root); my $pat = '^'; $pat .= quotemeta($r); ###$pat .= '\/'; $rd =~ s/$pat//i; $rd =~ s/\/Makefile.am//i; if (substr($rd,0,1) eq '/') { $rd = substr($rd,1); } return $rd; } sub read_am_file { my ($fil) = @_; open FH, $fil; @lines = <FH>; close FH; my $rd = rel_dir( $fil ); prt ("$fil has " . scalar @lines . " lines ... \$rd=$rd ...\n") if $verb2; my $ln; my $inif = 0; my $inelse = 0; my $saw_bk = 0; my $is_rule = 0; my $spacing = ''; my $comment = ''; my $last_var_name = ''; my $blank = 0; my $fl = ''; my $lineno = 0; my %mactents = (); # put macro stuff into here foreach $line (@lines) { $lineno++; chomp $line; if( $line =~ /$WHITE_PATTERN/ ) { # = "^[ \t]*\$"; $blank = 1; # signal had a BLANK line if ($is_rule) { prt( "RULE closed by BLANK\n" ) if $verb2; } $is_rule = 0; # also end of a RULE: if ($saw_bk) { prt( "MACRO closed by BLANK!\n" ) if $verb2; } $saw_bk = 0; # and no continuation next; # go for next line } ###if (($is_rule)&&($line =~ /$MACRO_PATTERN/o)) { ### prt( "RULE closed by MACRO!\n" ); ### $is_rule = 0; ###} while (( substr($line,0,1) eq ' ' )||( substr($line,0,1) eq "\t")) { $line = substr($line,1); } if ($is_rule) { prt( "RULE line=[$line]" ) if $verb2; $saw_bk = ($line =~ /\\$/); prt( $saw_bk ? " cont." : " end" ) if $verb2; prteol() if $verb2; } elsif ($saw_bk) { prt( "MACRO line=[$line]" ) if $verb2; $saw_bk = ($line =~ /\\$/); prt( $saw_bk ? " cont." : " end" ) if $verb2; prteol() if $verb2; if ($saw_bk) { $line = substr($line,0, length($line) - 1); } $mactents{$last_var_name} .= " $line"; } elsif ($inif) { # processing an 'if', on @conditional_stack if ($line =~ /$ELSE_PATTERN/o) { $inelse = 1; if (! @conditional_stack) { die "$lineno: else without if!\n"; } elsif ($conditional_stack[$#conditional_stack] =~ /_FALSE\@$/) { print "$lineno: else after else!\n"; } else { # switch TRUE to FALSE $conditional_stack[$#conditional_stack] =~ s/_TRUE\@$/_FALSE\@/; } } elsif ($line =~ /$ENDIF_PATTERN/o) { if (! @conditional_stack) { die "$lineno: endif without if!\n"; } else { pop @conditional_stack; } $inif = 0; $inelse = 0; } elsif ($line =~ /$MACRO_PATTERN/o) { $last_var_name = $1; if (defined $contents{$1} && (@conditional_stack ? ! defined $conditional{$1} : defined $conditional{$1})) { die "$1, : conditionally and unconditionally!\n"; } my $value; if ($3 ne '' && substr ($3, -1) eq "\\") { $value = substr ($3, 0, length ($3) - 1); } else { $value = $3; } my $type = $2; prt ("Got MACRO PATTERN - $last_var_name = $value (type=$type)\n") if $verb2; if ($type eq '+') { if (! defined $contents{$last_var_name} && defined $configure_vars{$last_var_name}) { $contents{$last_var_name} = '@' . $last_var_name . '@'; } $contents{$last_var_name} .= ' ' . $value; } else { if (defined $contents{$last_var_name} ) { my $val2 = $contents{$last_var_name}; if ($val2 eq 'SP') { prt( "SPECIAL NOTE: Replacing [$val2] with [$value] EXCEPTED!\n" ); $value = $val2; # EXCEPTION: do NOT kill this MACRO } else { prt( "NOTE: Replacing [$val2] with [$value] - CHECK!\n" ) if $verb2; } } $contents{$last_var_name} = $value; # The first assignment to a macro sets the line # number. Ideally I suppose we would associate line # numbers with random bits of text. $content_lines{$last_var_name} = $lineno; } my $cond_string = join ('', @conditional_stack); if (@conditional_stack) { my $found = 0; my $val; if ($conditional{$last_var_name}) { if ($type eq '+') { # If we're adding to the conditional, and it # exists, then we might want to simply replace # the old value with the new one. my (@new_vals, @cond_vals); @cond_vals = split (' ', $conditional{$last_var_name}); while (@cond_vals) { $vcond = shift (@cond_vals); push (@new_vals, $vcond); ###if (&conditional_same ($vcond, $cond_string)) { if (&conditional_true_when ($vcond, $cond_string)) { $found = 1; $val = (&unquote_cond_val (shift (@cond_vals)) . ' ' . $value); push (@new_vals, "e_cond_val ($val)); } else { push (@new_vals, shift (@cond_vals)); } } if ($found) { $conditional{$last_var_name} = join (' ', @new_vals); } } if (! $found) { &check_ambiguous_conditional ($last_var_name, $cond_string); $conditional{$last_var_name} .= ' '; $val = $value; } } else { $conditional{$last_var_name} = ''; $val = $contents{$last_var_name}; } if (! $found) { prt( "Not found: Extend ".$conditional{$last_var_name}." by ". ($cond_string . ' ' . "e_cond_val ($val))."\n" ) if $verb2; $conditional{$last_var_name} .= ($cond_string . ' ' . "e_cond_val ($val)); } } # FIXME: this doesn't always work correctly; it will group # all comments for a given variable, no matter where # defined. $am_vars{$last_var_name} = $comment . $spacing; $def_type{$last_var_name} = ($type eq ':') ? ':' : ''; push (@var_list, $last_var_name); $comment = $spacing = ''; ######$saw_bk = /\\$/; } } elsif ($insrc) { if ($line =~ /\\$/) { $line = substr($line, 0, length($line) - 1); $insrc = 1; } else { $insrc = 0; } @arr = split ' ', $line; foreach $ln (@arr) { if ($ln =~ /^\$\(([^\)]*)\)$/) { prt( "Found a variable $1 ... " ) if $verb2; my $varname = $1; if (defined $contents{$varname}) { foreach (split(' ', $contents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@srcs,$fl); } } elsif (defined $mactents{$varname}) { foreach (split(' ', $mactents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@srcs,$fl); } } else { prt( "Line $lineno: in $fil ...\n" ); prt( "MAC WARNING: [$varname] NO SUCH MACRO AVAILABLE!\n" ); } prt("\n") if $verb2; } else { if (length($rd)) { push(@srcs, "$rd/$ln"); } else { push(@srcs, $ln); } } } ###} elsif ($line =~ /(.*)_SOURCES/) { } elsif ($line =~ /^lib(.*)_a_SOURCES/) { my $group = 'Lib_' . $1; $pos = index ($line, '='); # get position of equal sign if ($pos > 0) { $line = substr($line, ($pos+1)); # get balance of line, after '=' if ($line =~ /\\$/) { $line = substr($line, 0, length($line) - 1); $insrc = 1; } @arr = split ' ', $line; foreach $ln (@arr) { if ($ln =~ /^\$\(([^\)]*)\)$/) { prt( "Found a variable $1 ... " ) if $verb2; my $varname = $1; if (defined $contents{$varname}) { foreach (split(' ', $contents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@srcs,$fl); } } elsif (defined $mactents{$varname}) { foreach (split(' ', $mactents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@srcs,$fl); } } else { prt( "Line $lineno: in $fil ...\n" ); prt( "MAC WARNING: [$varname] NO SUCH MACRO AVAILABLE!\n" ); } prt("\n") if $verb2; } else { if (length($rd)) { push(@srcs, "$rd/$ln"); } else { push(@srcs, $ln); } } } } } elsif ($line =~ /^fgfs_SOURCES/) { my $group = 'Main'; $pos = index ($line, '='); # get position of equal sign if ($pos > 0) { $line = substr($line, ($pos+1)); # get balance of line, after '=' if ($line =~ /\\$/) { $line = substr($line, 0, length($line) - 1); $insrc = 1; } @arr = split ' ', $line; foreach $ln (@arr) { if ($ln =~ /^\$\(([^\)]*)\)$/) { prt( "Found a variable $1 ... " ) if $verb2; my $varname = $1; if (defined $contents{$varname}) { foreach (split(' ', $contents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@srcs,$fl); } } elsif (defined $mactents{$varname}) { foreach (split(' ', $mactents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@srcs,$fl); } } else { prt( "Line $lineno: in $fil ...\n" ); prt( "MAC WARNING: [$varname] NO SUCH MACRO AVAILABLE!\n" ); } prt("\n") if $verb2; } else { if (length($rd)) { push(@srcs, "$rd/$ln"); } else { push(@srcs, $ln); } } } } } elsif ($line =~ /^SUBDIRS/) { $pos = index ($line, '='); # get position of equal sign if ($pos > 0) { $line = substr($line, ($pos+1)); # get balance of line, after '=' if ($line =~ /\\$/) { $line = substr($line, 0, length($line) - 1); $insub = 1; } @arr = split ' ', $line; foreach $ln (@arr) { if ($ln =~ /^\$\(([^\)]*)\)$/) { prt( "Found a variable $1 ... " ) if $verb2; my $varname = $1; if (defined $contents{$varname}) { foreach (split(' ', $contents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@subs,$fl); } } elsif (defined $mactents{$varname}) { foreach (split(' ', $mactents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@subs,$fl); } } else { prt( "Line $lineno: in $fil ...\n" ); prt( "MAC WARNING: [$varname] NO SUCH MACRO AVAILABLE!\n" ); } prt("\n") if $verb2; } else { if (length($rd)) { push(@subs, "$rd/$ln"); } else { push(@subs, $ln); } } } } } elsif ($insub) { if ($line =~ /\\$/) { $line = substr($line, 0, length($line) - 1); $insub = 1; } else { $insub = 0; } @arr = split ' ', $line; foreach $ln (@arr) { if ($ln =~ /^\$\(([^\)]*)\)$/) { prt( "Found a variable $1 ... " ) if $verb2; my $varname = $1; if (defined $contents{$varname}) { foreach (split(' ', $contents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@subs,$fl); } } elsif (defined $mactents{$varname}) { foreach (split(' ', $mactents{$varname})) { $fl = ''; if (length($rd)) {$fl = $rd . '/';} $fl .= $_; prt( "$fl " ) if $verb2; push(@subs,$fl); } } else { prt( "Line $lineno: in $fil ...\n" ); prt( "MAC WARNING: [$varname] NO SUCH MACRO AVAILABLE!\n" ); } prt("\n") if $verb2; } else { if (length($rd)) { push(@subs, "$rd/$ln"); } else { push(@subs, $ln); } } } } elsif ($line =~ /$IF_PATTERN/o) { $inif = 1; # openned an IF - stay until closed die "Line $lineno: $1 does not appear in AM_CONDITIONAL" if (! $configure_cond{$1}); prt( "IF - Added reference to $1 to the conditional_stack ...\n" ) if $verb2; push (@conditional_stack, "\@" . $1 . "_TRUE\@"); } elsif ($line =~ /$RULE_PATTERN/o) { prt( "FOUND PATTERN RULE = 1[$1] line=[$line]\n" ) if $verb2; $is_rule = 1; } elsif ($line =~ /$MACRO_PATTERN/o) { $is_rule = 0; $last_var_name = $1; my $mvalue; if ($3 ne '' && substr ($3, -1) eq "\\") { $mvalue = substr ($3, 0, length ($3) - 1); } else { $mvalue = $3; } prt( "FOUND PATTERN MACRO = 1[$1] line=[$line]" ) if $verb2; $saw_bk = ($line =~ /\\$/); prt( $saw_bk ? " cont." : " end" ) if $verb2; prteol() if $verb2; if (defined $mactents{$last_var_name} ) { prt( "MACRO WARNING: Killing ".$mactents{$last_var_name}." macro contents with $mvalue!\n" ); } $mactents{$last_var_name} = $mvalue; } $blank = 0; } # for each line die "unterminated conditionals: " . join (' ', @conditional_stack) if (@conditional_stack); } sub split_in_dir { $len = length($dir); $is = 0; for ($i = 0; $i < $len ; $i++) { $ch = substr($dir,$i,1); if (($ch eq '/') || ($ch eq '\\')) { # got a folder $part = substr($dir, $is, $i - $is); if (substr($part,0,1) eq $ch) { $part = substr($part,1); } push(@dirs, $part); $is = $i; } } if ($i > $is) { $part = substr($dir, $is, $i - $is); $ch = substr($part,0,1); if (($ch eq '/')||($ch eq '\\')) { $part = substr($part,1); } push(@dirs, $part); } } # Quote a value in order to put it in $conditional. We need to quote # spaces, and we need to handle null strings, so that we can later # retrieve values by splitting on space. sub quote_cond_val { my ($val) = @_; $val =~ s/ /\001/g; $val =~ s/\t/\003/g; $val = "\002" if $val eq ''; return $val; } sub unquote_cond_val { my ($val) = @_; $val =~ s/\001/ /g; $val =~ s/\003/\t/g; $val =~ s/\002//g; return $val; } # See if a conditional is true. Both arguments are conditional # strings. This returns true if the first conditional is true when # the second conditional is true. sub conditional_true_when { my ($cond, $when) = @_; # Check the easy case first. if ($cond eq $when) { prt( "conditional_true_when easy = 1\n" ) if $verb2; return 1; } # Check each component of $cond, which looks @COND1@@COND2@. foreach my $comp (split ('@', $cond)) { # The way we split will give null strings between each # condition. next if ! $comp; if (index ($when, '@' . $comp . '@') == -1) { return 0; } } return 1; } # Check for an ambiguous conditional. This is called when a variable # or target is being defined conditionally. If we already know about # a definition that is true under the same conditions, then we have an # ambiguity. sub check_ambiguous_conditional { my ($var_name, $cond) = @_; prt( "Checking $var_name for $cond ...\n" ) if $verb2; my (@cond_vals) = split (' ', $conditional{$var_name}); while (@cond_vals) { my ($vcond) = shift (@cond_vals); shift (@cond_vals); prt( "Check $vcond ...\n" ) if $verb2; if (&conditional_true_when ($vcond, $cond) || &conditional_true_when ($cond, $vcond)) { prt ("WARNING: $var_name multiple defined in condition\n"); } } } sub prt { my ($msg) = @_; print $msg; print $OF $msg; } sub prteol { prt( "\n" ); } sub scan_configure { my ($d) = @_; my ($cac,$acl); $cac = $d . '/configure.ac'; $acl = $d . '/aclocal.m4'; scan_one_configure_file($cac); scan_one_configure_file($acl) if -f $acl; if (! @input_files) { @input_files = @make_input_list; %output_files = %make_list; } } sub scan_one_configure_file { my $filename = shift; open(CONFIGURE, $filename) || die "$0: can't open \`$filename': $!\n"; prt ("$0: reading $filename ...\n"); my $in_ac_output = 0; my $ac_output_line = ''; while (<CONFIGURE>) { # Remove comments from current line. s/\bdnl\b.*$//; s/\#.*$//; # Skip macro definitions. Otherwise we might be confused into # thinking that a macro that was only defined was actually # used. next if /AC_DEFUN/; # Follow includes. This is a weirdness commonly in use at # Cygnus and hopefully nowhere else. if (/sinclude\((.*)\)/ && -f $1) { &scan_one_configure_file ($1); } if (! $in_ac_output && ( s/AC_OUTPUT\s*\(\[?// || s/AC_CONFIG_FILES\s*\(\[?// ) ) { $in_ac_output = 1; $ac_output_line = $.; } if ($in_ac_output) { my $closing = 0; if (s/[\]\),].*$//) { $in_ac_output = 0; $closing = 1; } # 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$//; } if (-f $input . '.am') { push(@make_input_list, $input); $make_list{$input} = join(':', ($local,@rest)); } else { # 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]') { die "$filename: line $.: automake requires 'AM_CONFIG_HEADER', not 'AC_CONFIG_HEADER'" if $1 eq 'C'; $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) { prt ("Setting configure_cond $1 ...\n") if $verb2; $configure_cond{$1} = 1; } ###if (/$AC_SUBST/o) { ### for compatibility_DIR ###} if (/$AM_INIT_AUTOMAKE/o) { $dsp_package = $1; $dsp_version = $2; } } close(CONFIGURE); } sub load_vcproj { my ($f) = @_; open FH, $f || die "ERROR: Unable to open file $f! ...\n"; @lines = <FH>; close FH; my $lncnt = scalar @lines; prt( "File $f contain $lncnt lines ...\n" ); my $aline = ''; foreach $line (@lines) { chomp $line; while (( substr($line,0,1) eq ' ' )||( substr($line,0,1) eq "\t")) { $line = substr($line,1); } if (length($aline)) { $aline .= ' '; } $aline .= $line; if ($aline =~ />$/) { push(@xmllines, $aline); if ($aline =~ /^<File /i) { $aline =~ s/^<File //; $aline =~ s/\">$//; $aline =~ s/^RelativePath=\"//i; $aline = dos_to_unix($aline); $aline =~ s/^\.\///; # strip leading './' from path if (length($aline) > $lrdir) { my $sub1 = uc(substr($aline,0,$lrdir)); my $sub2 = uc($rdir); ###print "Comparing $sub1 with $sub2 ...\n"; if ( $sub1 eq $sub2 ) { my $pat = '^'; $pat .= quotemeta($rdir); $aline =~ s/$pat//i; if (substr($aline,0,1) eq '/') { $aline = substr($aline,1); } if (($aline =~ /\.cxx$/i) || ($aline =~ /\.c$/i) || ($aline =~ /\.cpp$/i)) { push(@srclns, $aline); } else { if ( !(($aline =~ /\.hxx$/i) || ($aline =~ /\.h$/i) || ($aline =~ /\.hpp$/i)) ) { prt( "CHECK Discarded source $aline\n" ); } } } } } $aline = ''; } } } sub load_dsp { my ($f) = @_; open FH, $f || die "ERROR: Unable to open file $f! ...\n"; @dsplines = <FH>; close FH; my $lncnt = scalar @dsplines; prt( "File $f contains $lncnt lines ...\n" ); foreach $line (@dsplines) { chomp $line; if( $line =~ /^SOURCE=/ ) { $line =~ s/^SOURCE=//o; while ($line =~ /\W$/) { # ending in NON-alphanumic ####prt( "Discarding [".substr($line,-1,1)."]!\n" ); $line = substr($line,0,length($line)-1); } ##while (( substr($line,-1,1) eq ' ' )||( substr($line,-1,1) eq "\t")|| ## ( substr($line,-1,1) eq "\r")||( substr($line,-1,1) eq "\n")) { ## $line = substr($line,0,length($line)-1); ##} $line =~ s/^\"//; # remove leading inverted commas $line =~ s/\"$//; # remove trailing inverted commas $line = dos_to_unix($line); $line =~ s/^\.\///; if (($line =~ /\.cxx$/i) || ($line =~ /\.c$/i) || ($line =~ /\.cpp$/i)) { push(@dspsrcs, $line); } else { if ( !(($line =~ /\.hxx$/i) || ($line =~ /\.h$/i) || ($line =~ /\.hpp$/i)) ) { prt( "CHECK Discarded $line\n" ); } } } } $lncnt = scalar @dspsrcs; prt( "File $f contains $lncnt SOURCES ...\n" ); } # eof - showsrcs2.pl