showsrcs3.pl to HTML.

index -|- end

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, &quote_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 . ' ' . &quote_cond_val ($val))."\n" ) if $verb2;
                  $conditional{$last_var_name} .= ($cond_string . ' ' . &quote_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

index -|- top

checked by tidy  Valid HTML 4.01 Transitional