makesrcs02.pl to HTML.

index -|- end

Generated: Mon Aug 29 19:34:48 2016 from makesrcs02.pl 2014/03/24 59.8 KB. text copy

#!/perl -w
# NAME: makesrcs02.pl
# AIM: Read a makefile, and (hopefully) list the SOURCES
# 24/03/2014 - More... but decided too complicated... ;=(( 
# 28/08/2010 - Add more features, when using with say libxml2 makefile.msvc
# 23/08/2010 - Turn OFF debug for release, and add a littel HELP
# 09/08/2010 - Another try to improve the makefile scan...
# 06/07/2010 - Revisit, and hopefully IMPROVE
# 26/12/2007 - geoff mclane - http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE
use Cwd;
my $perl_base = 'C:\GTools\perl'; # perl directory
unshift(@INC, $perl_base);
#require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
require 'fgutils02.pl' or die "Unable to load fgutils02.pl ...\n";
require 'fgdsphdrs03.pl' or die "Unable to load fgdsphdrs03.pl ...\n";
require 'scanvc.pl' or die "Unable to load scanvc.pl ...\n";
require 'chkmain.pl' or die "Unable to load chkmain.pl...\n";

# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$pgmname);
   $pgmname = $tmpsp[-1];
}
my $outfile = $perl_base."\\temp.$pgmname.txt";
open_log($outfile);

my $cwd = getcwd();
# prt( "$0 ... Hello, World ... CWD: $cwd\n" );

# features
my $load_log = 0;
my $temp_dsp = $perl_base.'\temp2010.dsp';
my $temp_dsw = $perl_base.'\temp2010.dsw';
my $check4main = 1; # using chkmain.pl library
my $max_line = 80;
my $show_not_defined = 0;   # show ifdef, ifndef encountered

my $root_dir = '';
my $in_file  = '';
my $targ_dir = '';
my $proj_name = '';
my $proj_type = "CA";   # default to console application

my %makemacs = (
    'LDFLAGS' => ''
);
my %obj_hash = ();
my %hdr_hash = ();
my %file_hash = ();
my %targets = ();
my %defines = (
    'MSVC' => 1
    );

my %defines_seen = ();
my $act_define = '';
my @def_stack = ();
my @if_stack = ();
my @warnings = ();
my $verbosity = 0;
my ($fil_name, $fil_dir);

# forward
sub get_sources($);

# debug
my $debug_on = 0;
my $def_in_file  = 'Z:\ImageMagick-6.8.8\cairo\src\Makefile.in';
##my $def_in_file  = 'C:\Projects\libxml2\Win32\makefile.msvc';
#my $def_in_file  = 'C:\Projects\shapelib-1.2.10\makefile';
my $dbg01 = 0; # show during makefile decode...
my $dbg02 = 0; # show the macros collected...
my $dbg03 = 0; # show details of conversion to TARGET directory (relative)
my $dbg04 = 0; # show uncased lines
my $dbg05 = 0; # also show uncased lines before expansion
my $dbg06 = 0; # trace IF stack
my $dbg07 = 0; # trace end ifeq and ifnequ
my $dbg08 = 0; # trace targets
my $dbg09 = 0; # output EACH line from makefile
my $dbg10 = 0; # show each SUBJECT returned
my $dbg11 = 0; # show line at end, before next acquired...
my $dbg12 = 0; # output MISSING expansion items
my $dbg13 = 0; # show each substitution made
my $dbg14 = 0; # show accumulation when back slash seen

sub VERB1() { return $verbosity >= 1; }
sub VERB2() { return $verbosity >= 2; }
sub VERB5() { return $verbosity >= 5; }
sub VERB9() { return $verbosity >= 9; }

sub set_debug_val($) {
    my ($v) = shift;
    $dbg01 = $v; $dbg02 = $v; $dbg03 = $v; $dbg04 = $v; $dbg05 = $v;
    $dbg06 = $v; $dbg07 = $v; $dbg08 = $v; $dbg09 = $v; $dbg10 = $v;
}

# debug
sub get_dbg_var($) {
    my $val = shift;
    my $var = 'dbg';
    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';
    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';
    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_on() { set_all_dbg_on(); }
sub set_debug_off() { set_all_dbg_off(); }

# general


#####################################################################
####### subs #######
sub prtw($) {
    my ($tx) = shift;
    $tx =~ s/\n$// if ($tx =~ /\n$/);
    prt("$tx\n");
    push(@warnings,$tx);
}

sub show_warnings($) {
    my ($dbg) = shift;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS ...\n" );
        foreach my $line (@warnings) {
            prt("$line\n" );
        }
        prt("\n");
    } elsif ($dbg) {
        prt("\nNo warnings issued.\n\n");
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    show_warnings( 0 );
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt("$msg\n");
    }
    close_log($outfile,$load_log);
    # unlink($outfile);
    exit($val);
}

sub unix_2_dos($) {
   my ($f) = shift;
   $f =~ s/\//\\/g;
   return $f;
}

# fix relative path
sub fix_rel($) { # fixed 26/12/2007 to remove '\\' entries
   my ($path) = shift;
   $path = unix_2_dos($path);   # ensure DOS separator
   my @a = split(/\\/, $path);   # split on DOS separator
   my $npath = '';
   my $wmsg = '';
   my $max = scalar @a;
   my @na = ();
   for (my $i = 0; $i < $max; $i++) {
      my $p = $a[$i];
      if ($p eq '.') {
         # ignore this
      } elsif ($p eq '..') {
         if (@na) {
            pop @na;   # discard previous
         } else {
            $wmsg = "WARNING: Got relative .. without previous!!! [$path]";
            prtw( "$wmsg\n" );
            push(@warnings,$wmsg);
         }
      } elsif (length($p)) {   # added 26/12/2007
         push(@na,$p);
      }
   }
   foreach my $pt (@na) {
      $npath .= "\\" if length($npath);
      $npath .= $pt;
   }
   return $npath;
}

sub expand_it($) {
   my ($txt) = shift;
   my $len = length($txt);
   my ($j, $ch, $pch, $k, $nch, $tag);
   $pch = '';
   my $ntxt = '';
   for ($j = 0; $j < $len; $j++) {
      $ch = substr($txt,$j,1);
      $tag = '';
      if ($ch eq '$') {   # start of MACRO
         $k = $j + 1;
         if ($k < $len) {
            $nch = substr($txt,$k,1);
            if ($nch eq '(') {   # start $( - find )
               $k++;
               for (; $k < $len; $k++) {
                  $pch = substr($txt,$k,1);
                  if ($pch eq ')') {   # found CLOSE
                     last;
                  } elsif ($pch eq ':') {
                     last;
                  }
                  $tag .= $pch;
               }
            }
         }
      } elsif ($ch eq '@') {
            # start of an @ macro like @PACKAGE@
         $k = $j + 1;
            $tag = '';
         for (; $k < $len; $k++) {
            $nch = substr($txt,$k,1);
                if ($nch eq '@') {
                    last;
                } elsif ($nch =~ /\s/) {
                    $tag = '';
                    last;
                }
                $tag .= $nch;
            }
        }
      if (length($tag)) {
         if (defined $makemacs{$tag}) {
            $ntxt .= $makemacs{$tag};
            $j = $k;
         } else {
            $ntxt .= $ch;
         }
      } else {
         $ntxt .= $ch;
      }
   }
   return $ntxt;
}

# try to deal with ALL $(ABC) items
sub expand_it_better($$) {
   my ($lnn,$txt) = @_;
   my $len = length($txt);
    prt("[dbg13] $lnn: Expanding line [$txt]($len)\n") if ($dbg13);
   my ($j, $ch, $pch, $k, $nch, $tag, $tmp);
   $pch = '';
   my $ntxt = '';
   for ($j = 0; $j < $len; $j++) {
      $ch = substr($txt,$j,1);
      $tag = '';
      if ($ch eq '$') {   # start of MACRO
         $k = $j + 1;    # bump to NEXT char
         if ($k < $len) {    # if there is more
            $nch = substr($txt,$k,1);   # get next
            if ($nch eq '(') {   # start $( - find )
               $k++;   # bump again
               for (; $k < $len; $k++) {
                  $pch = substr($txt,$k,1);
                  if ($pch eq ')') {   # found CLOSE
                     last;
                  #} elsif ($pch eq ':') {
                  } elsif ( !($pch =~ /(\w|-)/) ) {
                            $tag = '';
                     last;
                  }
                  $tag .= $pch;   # build up a tag
               }
            }
         }
      }
      if (length($tag)) {
         if (defined $makemacs{$tag}) {
                $tmp = $makemacs{$tag};
                prt("[dbg13] Substitution: [$tag], with [$tmp]\n") if ($dbg13);
            $ntxt .= $tmp;   # extract
            $j = $k;    # bump to here
         } else {
                prt("[dbg12] Note [$tag] not in MACS at present!\n") if ($dbg12);
            $ntxt .= $ch;
         }
      } else {
         $ntxt .= $ch;
      }
   }
    if ($txt eq $ntxt) {
        prt("[dbg13] $lnn: Done expansion - NO CHANGE\n") if ($dbg13);
    } else {
        prt("[dbg13] $lnn: Done expansion - [$ntxt]\n") if ($dbg13);
    }
   return $ntxt;
}

# care only accept ^\s*(\w+)\s*:
sub get_target_subject($) {
    my ($line) = shift;
    my $subj = '';
    if ($line =~ /^\s*([\w-]+)\s*:/) {
        $subj = $1;
    }
    prt("[dbg10] Returning subject [$subj]\n") if ($dbg10);
    return $subj;
}

sub get_target_subject_OLD($) {
    my ($line) = shift;
    my $len = length($line);
    my $subj = '';
    my ($i,$ch);
    for ($i = 0; $i < $len; $i++) {
        $ch = substr($line,$i,1);
        last if ($ch =~ /\S/);
    }
    # get subject, until ':'
    for (; $i < $len; $i++) {
        $ch = substr($line,$i,1);
        next if ($ch =~ /\s/);
        last if ($ch eq ':');
        $subj .= $ch;
    }
    prt("[dbg10] Returning subject [$subj]\n") if ($dbg10);
    return $subj;
}

sub is_target_line($$) {
    my ($line,$rsub) = @_;
    my ($tmp);
    if ( ($line =~ /:/) && !($line =~ /:=/) ) {
        $tmp = get_target_subject($line);
        if (length($tmp)) {
            ${$rsub} = $tmp;
            return 1;
        }
    }
    return 0;
}

sub is_iffy_line($$) {
    my ($line,$lnn) = @_;
    my $ret = 0;
    if ($line =~ /^ifdef\s+/) {
        push(@if_stack,$lnn);
        $ret = 1;
    } elsif ($line =~ /^ifndef\s+/) {
        push(@if_stack,$lnn);
        $ret = 2;
    } elsif ($line =~ /^\@if\s+/) {
        push(@if_stack,$lnn);
        $ret = 2;
    } elsif ($line =~ /^else/) {
        $ret = 3;
    } elsif ($line =~ /^endif/) {
        if (@if_stack) {
            pop @if_stack;
            $ret = 4;
        } else {
            $ret = 5;   # appears an ENDIF, NOT STACKED
            # maybe belongs to ifequ or ifnequ
        }
    }
    return $ret;
}

sub prtdw($) {
    my ($txt) = shift;
    if ($show_not_defined) {
        prt($txt);
    }
}

sub deal_with_iffy($$$) {
    my ($line,$lnn,$typ) = @_;
    my ($def,$cnt,$val);
    my $msg = '';
    my $min = 80;
    $cnt = scalar @def_stack;
    if ($line =~ /^ifdef\s+(\w+)(.*)$/) {
        $def = $1;
        push(@def_stack,[$def,'YES']);
        $cnt = scalar @def_stack;
        $msg = "[dbg06] ifdef:$lnn:$typ: Added [$def] to def_stack";
        if (defined $defines{$def}) {
            $act_define = 'YES_'.$def;
        } elsif (defined $makemacs{$def}) {
            $act_define = 'YES_'.$def;
        } else {
            if (defined $defines_seen{$def}) {
                # do NOT repeat a message
            } else {
                prtdw("WARNING:$lnn: ifdef [$def] NOT in defines. Assume NOT defined!\n");
                $defines_seen{$def} = 1;
            }
            $act_define = 'NOO_'.$def;
            $def_stack[-1][1] = "NO";
        }
    } elsif ($line =~ /^\@if\s+(\w+)(.*)$/) {
        $def = $1;
        push(@def_stack,[$def,'YES']);
        $cnt = scalar @def_stack;
        $msg = "[dbg06] ifdef:$lnn:$typ: Added [$def] to def_stack";
        if (defined $defines{$def}) {
            $act_define = 'YES_'.$def;
        } elsif (defined $makemacs{$def}) {
            $act_define = 'YES_'.$def;
        } else {
            if (defined $defines_seen{$def}) {
                # do NOT repeat a message
            } else {
                prtdw("WARNING:$lnn: ifdef [$def] NOT in defines. Assume NOT defined!\n");
                $defines_seen{$def} = 1;
            }
            $act_define = 'NOO_'.$def;
            $def_stack[-1][1] = "NO";
        }
    } elsif ($line =~ /^ifndef\s(\w+)(.*)$/) {
        $def = $1;
        push(@def_stack,[$def,'NO']);
        $cnt = scalar @def_stack;
        $msg = "[dbg06] ifndef:$lnn:$typ: Added [$def] to def_stack";
        if (defined $defines{$def}) {
            $act_define = 'NO__'.$def;
        } elsif (defined $makemacs{$def}) {
            $act_define = 'NO__'.$def;
        } else {
            if (defined $defines_seen{$def}) {
                # do NOT repeat a message
            } else {
                prtdw("WARNING:$lnn: ifndef [$def] NOT in defines. Assumed not defined!\n");
                $defines_seen{$def} = 1;
            }
            $act_define = 'NOT_'.$def;
            $def_stack[-1][1] = "YES";
        }

    } elsif ($line =~ /^else\s*(.*)$/) {
        # switch last to opposite
        $cnt = scalar @def_stack;
        $def = "*NO STACK*";
        $val = "*NO SWITCH*";
        if (@def_stack) {
            $def = $def_stack[-1][0];
            $val = $def_stack[-1][1];
            if ($val eq 'YES') {
                $def_stack[-1][1] = "NO";
            } else {
                $def_stack[-1][1] = "YES";
            }
        } else {
            prtw("WARNING:$lnn: No stacked defines on 'else'\n");
        }
        $msg = "[dbg06] else:$lnn:$typ: [$def] switched [$val]";
    } elsif ($line =~ /^endif\s*(.*)$/) {
        # out of IF
        $cnt = scalar @def_stack;
        $def = "*NO STACK*";
        $val = "*NO END*";
        if ($typ != 5) {
            $act_define = '';
            if (@def_stack) {
                $def = $def_stack[-1][0];
                $val = $def_stack[-1][1];
                pop @def_stack;
                $cnt = scalar @def_stack;
            } else {
                prtw("WARNING:$lnn: No stacked defines on 'endif'\n");
            }
        }
        $msg = "[dbg06] endif:$lnn:$typ: [$def] closed [$val]";
    } elsif ($line =~ /\@*if\s+\%/) {
        # just ignore this, like
        # [@if %ERRORLEVEL% NEQ 0 @( \]
    } else {
        prtw("WARNING:$lnn: Unhandled IFFY line [$line]\n");
        $msg = "[dbg06] WARNING: Unhandled IFFY line";
    }
    if ($dbg06) {
        $msg .= ' ' while (length($msg) < $min);
        prt("$msg $cnt\n");
        prt("\n") if ($cnt == 0);
    }
}


sub get_sources($) {
   my ($inf) = shift;
   if (!open INF, "<$inf") {
        prtw( "WARNING: Unable to open [$inf]...\n" );
        return;
    }

    my @lines = <INF>;
    close INF;
    my ($inf_nam,$inf_dir) = fileparse($inf);
    my ($lc, $line, $i, $nxln, $ifeq, $equ, $ecnt, $con, $j, $iftyp);
    my ($lnnum, $bgnln, $endln, $inc);
    my ($pt1, $pt2, $disc, $pt2exp);
    my ($def,$msg,$msg2,$subj,$isif,$ff);
    $lc = scalar @lines;
    prt( "Get $lc lines, from [$inf]...\n" );
    my @cond = ();
    my @ifequ = ();
    for ($i = 0; $i < $lc; $i++) {
        $lnnum = $i + 1;
        $bgnln = $lnnum;    # begin, and
        $endln = $lnnum;    # end
        $line = trim_all($lines[$i]);
        next if (length($line) == 0);
        next if ($line =~ /^#/);
        if ( $line =~ /\\$/ ) {
            prt("[dbg14] $bgnln: GOT continuation character - an ending '\'...\n") if ($dbg14);
            # join this line with the next, until NO continuation
            $i++;
            $lnnum = $i + 1;
            $line =~ s/\\$/ /;  # convert continuation to SPACE
            for ( ; $i < $lc; $i++) {   # and process next line
                $lnnum = $i + 1;
                $nxln = trim_all($lines[$i]);
                next if ($nxln =~ /^#/);    # skip comment lines
                if (length($nxln)) {
                    if ($nxln =~ /\\$/) {
                        $nxln =~ s/\\$/ /;
                        $line .= $nxln;
                    } else {
                        $line .= $nxln;
                        last;
                    }
                } else {
                    last;   # empty line breaks pattern
                }
            }
            $endln = $lnnum;
            prt("[dbg14] $bgnln:$endln: END continuation character...\n") if ($dbg14);
        }

        # process the acquired FULL line
        prt("[dbg09] $bgnln:$endln: line [$line]\n") if ($dbg09);
        $pt2exp = expand_it_better($bgnln,$line);
        if ($line ne $pt2exp) {
            prt("[dbg09] $bgnln:$endln: expanded [$pt2exp]\n") if ($dbg09);
            $line = $pt2exp;
        }

        if (is_target_line($line,\$subj)) {
            prt("[v9] $bgnln: Is target [$subj], eat ALL lines until either blank, or another target line...\n") if (VERB9());
            # should also include/exclude per 'ifdef/ifndef...else...endif
            $i++;
            $lnnum = $i + 1;
            $line .= "{ "# open braces
            for ( ; $i < $lc; $i++) {   # and process next line
                $lnnum = $i + 1;
                $nxln = trim_all($lines[$i]);
                next if ($nxln =~ /^#/);    # skip comment lines
                if (length($nxln)) {
                    $isif = is_iffy_line($nxln,$lnnum);
                    if ($isif) {
                        deal_with_iffy($nxln,$lnnum,$isif);
                        next;
                    }
                    if (is_target_line($nxln,\$msg)) {
                        $i--;   # backup to catch this line
                        $line .= " } ";
                        last;
                    }
                    $line .= ' ' if ( !($line =~ /\s$/) );
                    $line .= $nxln;
                } else {
                    $line .= " } ";
                    last;   # empty line break pattern
                }
            }
            if (defined $targets{$subj}) {
                prtw("$bgnln:$endln: WARNING: Subject [$subj] REPEATED!\n");
            }
            $targets{$subj} = $line;
            $endln = $lnnum;
            prt("[v9] $bgnln:$endln: End target lines for subject [$subj]\n") if (VERB9());
            prt("[dbg09] $bgnln:$endln: SUBJECT : [$line]\n") if ($dbg09);
            next;
        }

        if (( $line =~ /^ifeq\s+(.+)$/ )||
            ( $line =~ /^ifneq\s+(.+)$/ )) {
            $ifeq = $1;
            # eat all the LINES inside this ifeq or ifneq
            $iftyp = substr($line,0,3);
            if ($ifeq =~ /,/) {
                @ifequ = split(',',$ifeq);
                $ecnt = scalar @ifequ;
                for ($j = 0; $j < $ecnt; $j++) {
                    $equ = trim_all($ifequ[$j]);
                    if ($equ =~ /^\(\$\((\w+)\)$/) {
                        $con = $1;
                        if (defined $makemacs{$con}) {
                            prt( "[dbg01] $con = $makemacs{$con}\n" ) if ($dbg01);
                        } else {
                            prt( "NO MATCH FOR $con\n" );
                        }
                    }
                }
            }

            push(@cond,$ifeq);  # stack a condition
            $bgnln = $lnnum;
            $i++;
            $lnnum = $i + 1;
            for ( ; $i < $lc; $i++) {
                # YUK, can have ifdef, ifndef, else, endif INSIDE this
                # ----------------------------------------------------
                $lnnum = $i + 1;
                $nxln = $lines[$i];
                chomp $nxln;
                if (length($nxln)) {
                    $nxln = trim_all($nxln);
                    next if ($nxln =~ /^#/);
                    if (( $nxln =~ /ifeq\s+(.+)$/ )||
                        ( $nxln =~ /ifneq\s+(.+)$/ )) {
                        $ifeq = $1;
                        push(@cond, $ifeq);
                    }
                    $line .= ' ' . $nxln;
                    $isif = is_iffy_line($nxln,$lnnum);
                    if ($isif && @def_stack) {
                        deal_with_iffy($nxln,$lnnum,$isif);
                    }
                    #if ($nxln =~ /endif/) {
                    if ($isif == 5) {
                        if (@cond) {
                           pop @cond;
                        }
                        if (! @cond) {
                            last;
                        }
                    }
                }
            }
            $endln = $lnnum;
            $msg2 = (length($line) > $max_line) ? substr($line,0,$max_line).'...' : $line;
            prt( "[dbg01|07] $bgnln:$endln: IF [$ifeq] {$msg2}\n" ) if ($dbg01 || $dbg07);
            next;
        }

        # handle ifdef, ifndef, else, endif
        $isif = is_iffy_line($line,$lnnum);
        if ($isif) {
            deal_with_iffy($line,$lnnum,$isif);
            next;
        }

        # handle 'define'
        if ($line =~ /^define\s+(.+)$/) {
            $def = $1;
            $i++;
            $lnnum = $i + 1;
            $line = "{"# open braces
            for ( ; $i < $lc; $i++) {   # and process next line
                $lnnum = $i + 1;
                $nxln = trim_all($lines[$i]);
                next if ($nxln =~ /^#/);    # skip comment lines
                if (length($nxln)) {
                    last if ($nxln =~ /^endif\s*/);
                    $line .= ' ';
                    $line .= $nxln;
                }
            }
            $line .= "}";
            $makemacs{$def} = $line;
            next;
        }

        # handle 'export' something
        if ($line =~ /^export\s+(.*)$/) {
            next;
        } elsif ($line =~ /^unexport\s+(.*)$/) {
            next;
        }


        #if ($line =~ /=/) {
        #if ($line =~ /^[\w-]+\s*\+*=/) {
        if ($line =~ /^[\w-]+\s*(\+|:|\?)*=/) {
            my @parts = split('=',$line);
            my $pc = scalar @parts;
            if ($pc < 2) {
                # prt("WARNING: Only got $pc part for line [$line]!\n");
                $pt1 = trim_all($parts[0]);
                if (defined $makemacs{$pt1}) {
                    prt("[dbg01] $bgnln:$lnnum: [$pt1]=[<blank>] already exists in makemacs\n") if ($dbg01);
                } else {
                    prt("[dbg01] $bgnln:$lnnum: [$pt1]=[<blank>] to makemacs\n") if ($dbg01);
                    $makemacs{$pt1} = "";
                }
                next;
            }
            if ($pc > 2) {
                for (my $j = 2; $j < $pc; $j++) {
                    $parts[1] .= '='.$parts[$j];
                }
            }
            $pt1 = trim_all($parts[0]);
            if ($pt1 =~ /\+$/) {
                $pt1 =~ s/\+$//;
                $pt1 = trim_all($pt1);
            }
            $pt2 = trim_all($parts[1]);
            $disc = '';
            if ($pt1 =~ /^(\w+)\s*:/) {
                $disc = substr($pt1,length($1));
                $pt1 = $1;
            }
            $pt2exp = expand_it($pt2);
            if ($pt2 ne $pt2exp) {
                prt("[dbg01] un-expanded: [$pt1]=[$pt2]\n") if ($dbg01);
            }
            #if (defined $makemacs{$pt1}) {
            #    prt("[dbg01] $bgnln:$lnnum: [$pt1]=[$pt2exp] added makemacs ($disc)\n") if ($dbg01);
            #    $makemacs{$pt1} .= " && " . $pt2exp;
            #} else {
            prt("[dbg01] $bgnln:$lnnum: [$pt1]=[$pt2exp] to makemacs ($disc)\n") if ($dbg01);
            $makemacs{$pt1} = $pt2exp;
            #}
        } elsif ($line =~ /^-*include\s+(.*)/) {
            $inc = trim_all($1);
            $pt2exp = expand_it($inc);
            if ($inc ne $pt2exp) {
                prt("[dbg01] un-expanded: [$inc]\n") if ($dbg01);
            }
            prt( "[dbg01] $bgnln:$lnnum: include {$pt2exp}\n" ) if ($dbg01);
        } else {
            $pt2exp = expand_it($line);
            $msg = (length($pt2exp) > $max_line) ? substr($pt2exp,0,$max_line).'...' : $pt2exp;
            if ($line ne $pt2exp) {
                $msg2 = (length($line) > $max_line) ? substr($line,0,$max_line).'...' : $line;
                prt("[dbg01|05] un-expanded: [$msg2]\n") if ($dbg01 || $dbg05);
                $line = $pt2exp;
            }
            prt( "[dbg01|04] $bgnln:$lnnum: [$msg]\n" ) if ($dbg01 || $dbg04);
        }

        if ($line =~ /^\!include\s+(.+)$/) {
            $inc = $1;
            $ff = $inf_dir.$inc;
            get_sources($ff);
        }

        prt( "[dbg11] $bgnln:$lnnum: Done [$line]\n" ) if ($dbg11);
    }
}

sub get_sources_PREVIOUS($) {
   my ($inf) = shift;
   if (!open INF, "<$inf") {
        prtw( "WARNING: Unable to open [$inf]...\n" );
        return;
    }

    my @lines = <INF>;
    close INF;
    my ($inf_nam,$inf_dir) = fileparse($inf);
    my ($lc, $line, $i, $nxln, $ifeq, $equ, $ecnt, $con, $j, $iftyp);
    my ($lnnum, $bgnln, $endln, $inc);
    my ($pt1, $pt2, $disc, $pt2exp);
    my ($def,$msg,$msg2,$subj,$isif,$ff);
    $lc = scalar @lines;
    prt( "Get $lc lines, from [$inf]...\n" );
    my @cond = ();
    my @ifequ = ();
    for ($i = 0; $i < $lc; $i++) {
        $lnnum = $i + 1;
        $bgnln = $lnnum;
        $endln = $lnnum;
        $line = trim_all($lines[$i]);
        next if (length($line) == 0);
        next if ($line =~ /^#/);
        if ( $line =~ /\\$/ ) {
            # GOT continuation character - an ending '\'
            # join this line with the next, until NO continuation
            $i++;
            $lnnum = $i + 1;
            $line =~ s/\\$/ /;  # convert continuation to SPACE
            for ( ; $i < $lc; $i++) {   # and process next line
                $lnnum = $i + 1;
                $nxln = trim_all($lines[$i]);
                next if ($nxln =~ /^#/);    # skip comment lines
                if (length($nxln)) {
                    if ($nxln =~ /\\$/) {
                        $nxln =~ s/\\$/ /;
                        $line .= $nxln;
                    } else {
                        $line .= $nxln;
                        last;
                    }
                } else {
                    last;   # empty line breaks pattern
                }
            }
            $endln = $lnnum;
        }

        # process the acquired FULL line
        prt("[dbg09] $bgnln:$endln: line [$line]\n") if ($dbg09);
        $pt2exp = expand_it_better($bgnln,$line);
        if ($line ne $pt2exp) {
            prt("[dbg09] $bgnln:$endln: expanded [$pt2exp]\n") if ($dbg09);
            $line = $pt2exp;
        }

        if (is_target_line($line,\$subj)) {
            # eat ALL lines until either blank, or another target line
            # should also include/exclude per 'ifdef/ifndef...else...endif
            $i++;
            $lnnum = $i + 1;
            $line .= "{ "# open braces
            for ( ; $i < $lc; $i++) {   # and process next line
                $lnnum = $i + 1;
                $nxln = trim_all($lines[$i]);
                next if ($nxln =~ /^#/);    # skip comment lines
                if (length($nxln)) {
                    $isif = is_iffy_line($nxln,$lnnum);
                    if ($isif) {
                        deal_with_iffy($nxln,$lnnum,$isif);
                        next;
                    }
                    if (is_target_line($nxln,\$msg)) {
                        $i--;   # backup to catch this line
                        $line .= " } ";
                        last;
                    }
                    $line .= ' ' if ( !($line =~ /\s$/) );
                    $line .= $nxln;
                } else {
                    $line .= " } ";
                    last;   # empty line break pattern
                }
            }
            if (defined $targets{$subj}) {
                prtw("$bgnln:$endln: WARNING: Subject [$subj] REPEATED!\n");
            }
            $targets{$subj} = $line;
            $endln = $lnnum;
            prt("[dbg09] $bgnln:$endln: SUBJECT : [$line]\n") if ($dbg09);
            next;
        }

        if (( $line =~ /^ifeq\s+(.+)$/ )||
            ( $line =~ /^ifneq\s+(.+)$/ )) {
            $ifeq = $1;
            # eat all the LINES inside this ifeq or ifneq
            $iftyp = substr($line,0,3);
            if ($ifeq =~ /,/) {
                @ifequ = split(',',$ifeq);
                $ecnt = scalar @ifequ;
                for ($j = 0; $j < $ecnt; $j++) {
                    $equ = trim_all($ifequ[$j]);
                    if ($equ =~ /^\(\$\((\w+)\)$/) {
                        $con = $1;
                        if (defined $makemacs{$con}) {
                            prt( "[dbg01] $con = $makemacs{$con}\n" ) if ($dbg01);
                        } else {
                            prt( "NO MATCH FOR $con\n" );
                        }
                    }
                }
            }

            push(@cond,$ifeq);  # stack a condition
            $bgnln = $lnnum;
            $i++;
            $lnnum = $i + 1;
            for ( ; $i < $lc; $i++) {
                # YUK, can have ifdef, ifndef, else, endif INSIDE this
                # ----------------------------------------------------
                $lnnum = $i + 1;
                $nxln = $lines[$i];
                chomp $nxln;
                if (length($nxln)) {
                    $nxln = trim_all($nxln);
                    next if ($nxln =~ /^#/);
                    if (( $nxln =~ /ifeq\s+(.+)$/ )||
                        ( $nxln =~ /ifneq\s+(.+)$/ )) {
                        $ifeq = $1;
                        push(@cond, $ifeq);
                    }
                    $line .= ' ' . $nxln;
                    $isif = is_iffy_line($nxln,$lnnum);
                    if ($isif && @def_stack) {
                        deal_with_iffy($nxln,$lnnum,$isif);
                    }
                    #if ($nxln =~ /endif/) {
                    if ($isif == 5) {
                        if (@cond) {
                           pop @cond;
                        }
                        if (! @cond) {
                            last;
                        }
                    }
                }
            }
            $endln = $lnnum;
            $msg2 = (length($line) > $max_line) ? substr($line,0,$max_line).'...' : $line;
            prt( "[dbg01|07] $bgnln:$endln: IF [$ifeq] {$msg2}\n" ) if ($dbg01 || $dbg07);
            next;
        }

        # handle ifdef, ifndef, else, endif
        $isif = is_iffy_line($line,$lnnum);
        if ($isif) {
            deal_with_iffy($line,$lnnum,$isif);
            next;
        }

        # handle 'define'
        if ($line =~ /^define\s+(.+)$/) {
            $def = $1;
            $i++;
            $lnnum = $i + 1;
            $line = "{"# open braces
            for ( ; $i < $lc; $i++) {   # and process next line
                $lnnum = $i + 1;
                $nxln = trim_all($lines[$i]);
                next if ($nxln =~ /^#/);    # skip comment lines
                if (length($nxln)) {
                    last if ($nxln =~ /^endif\s*/);
                    $line .= ' ';
                    $line .= $nxln;
                }
            }
            $line .= "}";
            $makemacs{$def} = $line;
            next;
        }

        # handle 'export' something
        if ($line =~ /^export\s+(.*)$/) {
            next;
        } elsif ($line =~ /^unexport\s+(.*)$/) {
            next;
        }


        #if ($line =~ /=/) {
        #if ($line =~ /^[\w-]+\s*\+*=/) {
        if ($line =~ /^[\w-]+\s*(\+|:|\?)*=/) {
            my @parts = split('=',$line);
            my $pc = scalar @parts;
            if ($pc < 2) {
                # prt("WARNING: Only got $pc part for line [$line]!\n");
                $pt1 = trim_all($parts[0]);
                if (defined $makemacs{$pt1}) {
                    prt("[dbg01] $bgnln:$lnnum: [$pt1]=[<blank>] already exists in makemacs\n") if ($dbg01);
                } else {
                    prt("[dbg01] $bgnln:$lnnum: [$pt1]=[<blank>] to makemacs\n") if ($dbg01);
                    $makemacs{$pt1} = "";
                }
                next;
            }
            if ($pc > 2) {
                for (my $j = 2; $j < $pc; $j++) {
                    $parts[1] .= '='.$parts[$j];
                }
            }
            $pt1 = trim_all($parts[0]);
            if ($pt1 =~ /\+$/) {
                $pt1 =~ s/\+$//;
                $pt1 = trim_all($pt1);
            }
            $pt2 = trim_all($parts[1]);
            $disc = '';
            if ($pt1 =~ /^(\w+)\s*:/) {
                $disc = substr($pt1,length($1));
                $pt1 = $1;
            }
            $pt2exp = expand_it($pt2);
            if ($pt2 ne $pt2exp) {
                prt("[dbg01] un-expanded: [$pt1]=[$pt2]\n") if ($dbg01);
            }
            if (defined $makemacs{$pt1}) {
                prt("[dbg01] $bgnln:$lnnum: [$pt1]=[$pt2exp] added makemacs ($disc)\n") if ($dbg01);
                $makemacs{$pt1} .= " && " . $pt2exp;
            } else {
                prt("[dbg01] $bgnln:$lnnum: [$pt1]=[$pt2exp] to makemacs ($disc)\n") if ($dbg01);
                $makemacs{$pt1} = $pt2exp;
            }
        } elsif ($line =~ /^-*include\s+(.*)/) {
            $inc = trim_all($1);
            $pt2exp = expand_it($inc);
            if ($inc ne $pt2exp) {
                prt("[dbg01] un-expanded: [$inc]\n") if ($dbg01);
            }
            prt( "[dbg01] $bgnln:$lnnum: include {$pt2exp}\n" ) if ($dbg01);
        } else {
            $pt2exp = expand_it($line);
            $msg = (length($pt2exp) > $max_line) ? substr($pt2exp,0,$max_line).'...' : $pt2exp;
            if ($line ne $pt2exp) {
                $msg2 = (length($line) > $max_line) ? substr($line,0,$max_line).'...' : $line;
                prt("[dbg01|05] un-expanded: [$msg2]\n") if ($dbg01 || $dbg05);
                $line = $pt2exp;
            }
            prt( "[dbg01|04] $bgnln:$lnnum: [$msg]\n" ) if ($dbg01 || $dbg04);
        }

        if ($line =~ /^\!include\s+(.+)$/) {
            $inc = $1;
            $ff = $inf_dir.$inc;
            get_sources($ff);
        }

        prt( "[dbg11] $bgnln:$lnnum: Done [$line]\n" ) if ($dbg11);
    }
}

sub add_obj_item($) {
    my ($itm) = @_;
    $itm = unix_2_dos($itm);
    if (defined $obj_hash{$itm}) {
        $obj_hash{$itm}++;
    } else {
        $obj_hash{$itm} = 1;
    }
}
sub add_hdr_item($) {
    my ($itm) = @_;
    if (defined $hdr_hash{$itm}) {
        $hdr_hash{$itm}++;
    } else {
        $hdr_hash{$itm} = 1;
    }
}

sub has_hdr_ext($) {
    my ($hdr) = @_;
    return 1 if ($hdr =~ /\.h$/i);
    return 1 if ($hdr =~ /\.hxx$/i);
    return 1 if ($hdr =~ /\.hpp$/i);
    return 0;
}

sub split_into_objs($) {
    my ($val) = @_;
    my @arr = split(/\s/,$val);
    my $cnt = scalar @arr;
    my ($itm,$itm2,@a2);
    foreach $itm (@arr) {
        if ($itm =~ /\.o$/) {
            if ($itm =~ /,/) {
                @a2 = split(",",$itm);
                foreach $itm2 (@a2) {
                    if ($itm2 =~ /\.o$/) {
                        add_obj_item($itm2);
                    }
                }
            } else {
                add_obj_item($itm);
            }
        } elsif (has_hdr_ext($itm)) {
            if ($itm =~ /,/) {
                @a2 = split(",",$itm);
                foreach $itm2 (@a2) {
                    if ($itm2 =~ /\.o$/) {
                        add_hdr_item($itm2);
                    }
                }
            } else {
                add_hdr_item($itm);
            }
        }
    }
}

sub show_macros($) {
    my ($inf) = @_;
    my ($item,$val,$min,$len,$itexp,$msg,$max);
    $min = 0;
    $max = 80;
    foreach $item (keys %makemacs) {
        $val = $makemacs{$item};
        $itexp = expand_it($item);
        $len = length($itexp);
        $min = $len if ($len > $min);
        last if ($min > 40);
    }
    $min = 40 if ($min > 40);
    foreach $item (keys %makemacs) {
        $val = $makemacs{$item};
        $itexp = expand_it($item);
        $msg = '';
        if ($item ne $itexp) {
            $msg = " Expanded [$item]";
        }
        $itexp .= ' ' while (length($itexp) < $min);
        my @arr = split_into_objs($val);
        if (length($val) > $max) {
            $val = substr($val,0,$max)."...";
        }
        prt("[$itexp] = [$val] $msg\n") if ($dbg02);
    }
}

sub list_ref_hash($$$) {
    my ($inf,$rh,$typ) = @_;
    my @objs = sort keys(%{$rh});
    my $cnt = scalar @objs;
    prt("\nList of $cnt $typ...\n");
    my ($msg,$obj,@arr,$path,$pc,$cp,$np,$i,$not);
    $msg = '';
    $path = '';
    $not = 0;
    foreach $obj (@objs) {
        if ($obj =~ /(\\|\/)/) {
            @arr = split(/(\\|\/)/,$obj);
            $pc = scalar @arr;
            $pc-- if ($pc);
            $cp = '';
            for ($i = 0; $i < $pc; $i++) {
                $np = $arr[$i];
                $cp .= '/' if (length($cp));
                $cp .= $np;
            }
            if ($cp ne $path) {
                prt("$msg\n") if (length($msg));
                $msg = $obj;
                $path = $cp;
            } else {
                $msg .= ' ' if (length($msg));
                $msg .= $obj;
                if (length($msg) > 80) {
                    prt("$msg\n");
                    $msg = '';
                }
            }
        } else {
            $not++;
        }
    }
    prt("$msg\n") if (length($msg));

    prt("\nList of $not root $typ...\n") if ($not);
    $msg = '';
    foreach $obj (@objs) {
        if (!($obj =~ /(\\|\/)/)) {
            $msg .= ' ' if (length($msg));
            $msg .= $obj;
            if (length($msg) > 80) {
                prt("$msg\n");
                $msg = '';
            }
        }
    }
    prt("$msg\n") if (length($msg));
}

sub convert_obj_to_files($) {
    my ($inf) = shift;
    my ($file,$tf,$nf,$subs,$fnd);
    my %hash = ();
    $subs = 0;
    foreach $file (keys %obj_hash) {
        $tf = $file;
        $file =~ s/o$//;
        $nf = $file.'c';
        $fnd = 0;
        if (defined $file_hash{$nf}) {
            $hash{$nf} = 1;
            $subs++;
            $fnd = 1;
        } else {
            $nf = $file.'cxx';
            if (defined $file_hash{$nf}) {
                $hash{$nf} = 1;
                $subs++;
                $fnd = 1;
            } else {
                $nf = $file.'cpp';
                if (defined $file_hash{$nf}) {
                    $hash{$nf} = 1;
                    $subs++;
                    $fnd = 1;
                } else {
                    $hash{$tf} = 1;
                }
            }
        }
        if ($fnd) {
            my $ff = $fil_dir;
            $ff .= "\\" if ( !($ff =~ /(\\|\/)$/) );
            $ff .= $nf;
            if (-f $ff) {
                # maybe search for 'main', if desired...
                # hasmain.pl => require 'chkmain.pl' or die "Unable to load chkmain.pl ...\n";
                # vc6srcs01.pl => require 'chkmain.pl' or die "Unable to load chkmain.pl ...\n";
                if ($check4main) {
                    if (chkmain2(0,$ff)) {
                        prtw("WARNING: File [$nf] contains a 'main'...\n");
                    }
                }
            } else {
                prtw("WARNING: Unable to locate [$ff]!\n");
            }
        } else {
            prtw("WARNING: No file matching [$tf] FOUND!\n");
        }
    }

    if ($subs && length($targ_dir)) {
        # have been given a target MSVC directory
        # convert files to that target
        my $dir = $fil_dir; # root directory of INPUT file
        $dir .= "\\" if (!($dir =~ /(\\|\/)$/));
        prt("With ROOT [$dir], convert to TARGET [$targ_dir]\n");
        my %h = ();
        foreach $file (keys %hash) {
            # the file is relative to the ROOT $dir
            $tf = $dir.$file;   # get full qualified path
            my ($sn,$sd) = fileparse($tf);
            $nf = get_rel_dos_path($sd,$targ_dir);
            my $nrf = $nf.$sn;
            prt("From [$tf] to [$targ_dir], got [$nf], or [$nrf]?\n") if ($dbg03);
            $h{$nrf} = 1;
        }
        %hash = %h;
    } elsif ($subs) {
        prtw("WARNING: No target directory, so left relative to [$fil_dir]...\n");
    } else {
        prtw("WARNING: Got NO substituions for the REAL file!\n");
    }
    %obj_hash = %hash if ($subs);
}


sub list_objects($) {
    my ($inf) = @_;
    list_ref_hash($inf,\%obj_hash,"objects");
}

sub list_headers($) {
    my ($inf) = @_;
    list_ref_hash($inf,\%hdr_hash,"headers");
}

sub os_is_win() { return (($^O eq 'MSWin32') ? 1 : 0); }

#sub sub_root_dir($$) {
# exclude the ROOT FOLDER,
# if there is a $root_dir,
# and this file BEGINS with that root!
sub sub_root_dir($$) {
   my ($root,$fil) = @_;
   my $lr = length($root);
   my $lf = length($fil);
   if ($lr && ($lr < $lf)) {
      my $off = 0;
      my $dfil = unix_2_dos($fil);
      my $droot = unix_2_dos($root);
      while ( substr($dfil,$off,1) eq substr($droot,$off,1) ) {
         $off++;
      }
      $fil = substr($fil,$off);
   }
   return $fil;
}

sub get_dir_list($$);

# $missed{$src1} = get_file_type($src1);
sub get_file_type($) {
    my ($src) = @_;
    return 4 if (is_text_ext_file($src));
    return 8 if (is_resource_file($src));
    return 2 if (is_h_source_extended($src));
    return 1 if (is_c_source_extended($src));
    return 0;
}

sub get_dir_list($$) {
    my ($root,$dir) = @_;
    my @dirs = ();
    my ($ff,$file,@files,$rf);
    if (opendir(DIR,$dir)) {
        @files = readdir(DIR);
        closedir(DIR);
        $dir .= "\\" if (!($dir =~ /(\\|\/)$/));
        foreach $file (@files) {
            next if (($file eq '.')||($file eq '..'));
            $ff = $dir.$file;
            if (-d $ff) {
                push(@dirs,$ff);
            } elsif (-f $ff) {
                $rf = sub_root_dir($root,$ff);
                $file_hash{$rf} = get_file_type($rf);
            } else {
                prtw("WARNING: What is THIS [$ff]?\n");
            }
        }
    }
    foreach $file (@dirs) {
        get_dir_list($root,$file);
    }
}

sub get_root_dir_list($) {
    my ($dir) = shift;
    my @dirs = ();
    my ($ff,$file,@files);
    if (opendir(DIR,$dir)) {
        @files = readdir(DIR);
        closedir(DIR);
        $dir .= "\\" if (!($dir =~ /(\\|\/)$/));
        foreach $file (@files) {
            next if (($file eq '.')||($file eq '..'));
            $ff = $dir.$file;
            if (-d $ff) {
                push(@dirs,$ff);
            } elsif (-f $ff) {
                $file_hash{$file} = get_file_type($file);
            } else {
                prtw("WARNING: What is THIS [$ff]?\n");
            }
        }
    }
    foreach $file (@dirs) {
        get_dir_list($dir,$file);
    }
}

sub show_dir_list_debug() {
    my ($key,$val);
    my $cnt0 = 0;
    my $cnt1 = 0;
    my $cnt2 = 0;
    my $cnt4 = 0;
    my $cnt8 = 0;
    my $cntOther = 0;
    my %hash = ();
    foreach $key (keys %file_hash) {
        $val = $file_hash{$key};
        if ($val == 8) {
            $cnt8++;
        } elsif ($val == 4) {
            $cnt4++;
        } elsif ($val == 2) {
            $cnt2++;
        } elsif ($val == 1) {
            $cnt1++;
        } elsif ($val == 0) {
            $cnt0++;
        } else {
            $cntOther++;
        }
    }
    prt("\n") if ($cnt1);
    %hash = ();
    foreach $key (keys %file_hash) {
        $val = $file_hash{$key};
        if ($val == 1) {
            $hash{$key} = $val;
            #prt("$key\n");
        }
    }
    list_ref_hash("",\%hash,"C/C++") if ($cnt1);

    prt("\n") if ($cnt2);
    %hash = ();
    foreach $key (keys %file_hash) {
        $val = $file_hash{$key};
        if ($val == 2) {
            $hash{$key} = $val;
            #prt("$key\n");
        }
    }
    list_ref_hash("",\%hash,"Headers") if ($cnt2);

    prt("\n") if ($cnt4);
    %hash = ();
    foreach $key (keys %file_hash) {
        $val = $file_hash{$key};
        if ($val == 4) {
            $hash{$key} = $val;
            #prt("$key\n");
        }
    }
    list_ref_hash("",\%hash,"Text") if ($cnt2);

    prt("\n") if ($cnt8);
    %hash = ();
    foreach $key (keys %file_hash) {
        $val = $file_hash{$key};
        if ($val == 8) {
            $hash{$key} = $val;
            #prt("$key\n");
        }
    }
    list_ref_hash("",\%hash,"resource") if ($cnt8);

    prt("\n") if ($cnt0);
    %hash = ();
    foreach $key (keys %file_hash) {
        $val = $file_hash{$key};
        if ($val == 0) {
            $hash{$key} = $val;
            #prt("$key\n");
        }
    }
    list_ref_hash("",\%hash,"other") if ($cnt0);

    prt("\nListing $cntOther other files...\n") if ($cntOther);
    %hash = ();
    foreach $key (keys %file_hash) {
        $val = $file_hash{$key};
        if (!(($val == 0)||($val == 1)||($val == 2)||($val == 4)||($val == 8))) {
            $hash{$key} = $val;
            #prt("$key\n");
        }
    }
    list_ref_hash("",\%hash,"OTHERS?") if ($cntOther);

    prt("\n");
}

sub get_file_list($) {
    my ($inf) = shift;
    my ($nam,$dir) = fileparse($in_file);
    $dir = $cwd if ($dir =~ /^.(\\|\/)$/);
    $dir =~ s/(\\|\/)$//;
    local $| = 1;
    prt("Moment, get file list for [$dir]...");
    get_root_dir_list($dir);
    my $cnt = scalar keys(%file_hash);
    prt( " done. Got $cnt file items...\n");
    #show_dir_list_debug();
}

# =======================================================
# writting DSP stuff
sub get_def_dsp_hash_ref($) {
    my ($fil) = @_;
    my $rh = get_default_ref_hash($fil);
    #${$rh}{'PROJECT_VERS'} = 1; # version of the HASH
    #${$rh}{'PROJECT_FILE'} = $fil;
    #${$rh}{'PROJECT_FLAG'} = 0;
    #${$rh}{'PROJECT_APTP'} = '';
    ${$rh}{'PROJECT_NAME'} = '';
    #${$rh}{'PROJECT_CCNT'} = 0; # count of configurations
    #${$rh}{'PROJECT_CFGS'} = [ ];
    #${$rh}{'PROJECT_SRCS'} = [ ];
    #${$rh}{'CURR_FLAG'}    = 0;
    #${$rh}{'CURR_LOFF'}    = 0; # last/current source OFFSET
    #${$rh}{'CURR_LINE'}    = '<not started>';
    return $rh;
}

# [dbg_v40] STORE:1: In rcfgs (ra)[Release], [-NEW_OUTD-], [Release|Win32], & $dsp_sub_sub ] )
# [dbg_v40] STORE:2: In rcfgs (ra)[Debug], [-NEW_OUTD-], [Debug|Win32], & $dsp_sub_sub ] )
sub set_default_configs_2($) {
    my ($rh) = @_;
    my $var1 = "-NEW_OUTD-";
    my $rcfgs = get_project_configs($rh);   # 'PROJECT_CFGS'
    my ($dsp_sub_sub,$confname,$conf);
    $dsp_sub_sub = get_default_sub3(0);
    $confname = 'Release';
    $conf = 'Release|WIN32';
    push(@{$rcfgs}, [ $confname, $var1, $conf, $dsp_sub_sub ]); # ONLY STORE OF 'PROJECT_CFGS'
    ${$rh}{'PROJECT_CCNT'}++;   # count of stored 'PROJECT_CFGS
    $dsp_sub_sub = get_default_sub3(1);
    $confname = 'Debug';
    $conf = 'Debug|WIN32';
    push(@{$rcfgs}, [ $confname, $var1, $conf, $dsp_sub_sub ]); # ONLY STORE OF 'PROJECT_CFGS'
    ${$rh}{'PROJECT_CCNT'}++;   # count of stored 'PROJECT_CFGS
}

sub write_temp_dsp($$) {
    my ($inf,$dsp) = @_;
    my $dsp_ref_hash = get_def_dsp_hash_ref($dsp);

    # =============================================================
    # 1: set PROJECT NAME
    ${$dsp_ref_hash}{'PROJECT_NAME'} = $proj_name;
    # =============================================================

    # ==============================================================
    # 2: Set 'PROJECT_APTP' = Application TYPE string (from short forms)
    my $type = '';
    if ( !get_app_type_4_short($proj_type,\$type) ) {
        prt("-type can ONLY be one of 'CA'=console (default), 'WA'=windows, 'DLL'=dynalib, or 'SL'=statlib!\n");
        pgm_exit(1,"ERROR: Unable to get desired application type string from [$proj_type]!\n" );
    }
    ${$dsp_ref_hash}{'PROJECT_APTP'} = $type;
    # ==============================================================

    # ==============================================================
    # 3: set C/C++ source files
    my ($src);
    my @sources = ();
    my $group = get_def_src_grp();
    my $flist = get_def_src_filt();
    #                     0     1       2       3  4
    # push(@{$src_ref}, [ $src, $group, $flist, 0, '' ]); # and PUSH onto SOURCE stack
    #     push(@sources,[ $var, $group, $flist, 0, '' ]);
    foreach $src (keys %obj_hash) {
        push(@sources, [ $src, $group, $flist, 0, '' ]);
    }
    # could also set HEADER files
    $group = get_def_hdr_grp();
    $flist = get_def_hdr_filt();
    # ***TBD***
    # store results
    ${$dsp_ref_hash}{'PROJECT_SRCS'} = [ @sources ];
    # ===============================================================

    # ===============================================================
    # set CONFIGURATIONS
    #push(@{$rcfgs}, [ $confname, $var1, $conf, $dsp_sub_sub ]); # ONLY STORE OF 'PROJECT_CFGS'
    #${$rh}{'PROJECT_CCNT'}++;   # count of stored 'PROJECT_CFGS
    # [dbg_v40] STORE:1: In rcfgs (ra)[Release], [-NEW_OUTD-], [Release|Win32], & $dsp_sub_sub ] )
    # [dbg_v40] STORE:2: In rcfgs (ra)[Debug], [-NEW_OUTD-], [Debug|Win32], & $dsp_sub_sub ] )
    set_default_configs_2($dsp_ref_hash);
    # ================================================================

    if ( write_hash_to_DSP3( $dsp, $dsp_ref_hash, 0 ) ) {
        prt( "OK, written $dsp\n" );
        my $dsw = get_simple_DSW_txt($proj_name,$proj_name.".dsp");
        write2file($dsw,$temp_dsw);
        prt( "and written $temp_dsw\n" );
    } else {
        prt( "FAILED on write $dsp!\n" );
    }

    return $dsp_ref_hash;
}

sub is_src_type($) {
    my ($fil) = shift;
    return 1 if (is_c_source_extended($fil));
    return 2 if (is_h_source_extended($fil));
    return 0;
}

sub list_targets($) {
    my ($inf) = @_;
    my ($nam,$dir) = fileparse($inf);
    my @arr = keys %targets;
    my $tcnt = scalar @arr;
    prt("\nGot $tcnt TARGET keys...\n");
    my ($key,$line,@srcs,$item,%dupes,$ff,$has_main,$max,$i);
    foreach $key (%targets) {
        $line = $targets{$key};
        prt("$key: [$line]\n") if ($dbg08);
        if (defined $line and length($line)) {
            @arr = split(/\s/,$line);
            @srcs = ();
            %dupes = ();
            foreach $item (@arr) {
                if (is_src_type($item)) {
                    if (!defined $dupes{$item}) {
                        $ff = $dir.$item;
                        $has_main = 3;
                        if (-f $ff) {
                            $has_main = 2;
                            if ($check4main) {
                                $has_main = 0;
                                if (chkmain2(0,$ff)) {
                                    $has_main = 1;
                                }
                            }
                        }
                        push(@srcs,[$item,$has_main]);
                        $dupes{$item} = 1;
                    }
                }
            }
            $max = scalar @srcs;
            if ($max) {
                prt("Target [$key] has $max sources\n");
                if (VERB9()) {
                    prt("[");
                    for ($i = 0; $i < $max; $i++) {
                        $item = $srcs[$i][0];
                        $has_main = $srcs[$i][1];
                        prt("$item($has_main) ");
                    }
                    prt("]\n");
                }
            }
        }
    }
}

#####################################################################
### main ###

parse_args(@ARGV);

($fil_name, $fil_dir) = fileparse($in_file);
$fil_dir = $cwd."\\" if ($fil_dir =~ /^.(\\|\/)$/);
$makemacs{'BLDDIR'} = $fil_dir;
$makemacs{'SRCDIR'} = $fil_dir;

prt( "Split in_file to [$fil_dir] [$fil_name]\n");

get_file_list( $in_file );

get_sources( $in_file );

list_targets( $in_file );

show_macros( $in_file );

convert_obj_to_files( $in_file );

list_headers( $in_file );

list_objects( $in_file );

write_temp_dsp( $in_file, $temp_dsp );

pgm_exit(0,"");

#####################################################################
sub give_help {
    my ($tmp);
    prt("$pgmname: version 0.0.2 2010-08-23\n");
    prt("Usage: $pgmname [options] makefile\n");
    prt("Options:\n");
    prt(" --help ( -h -?)     = This help, and exit 0\n");
    $tmp = get_dbg_range();
    prt(" --dbg <num>   (-d)  = Set DEBUG flag of this value. Number in range 1 to $tmp\n");
    prt(" --in <file>   (-i)  = Commands from an input file.\n");
    prt(" --load-log    (-l)  = Load log at end.\n");
    prt(" --mac itm val (-m)  = Store a MACRO, item=value.\n");
    prt(" --targ <dir>  (-t)  = Target directory for DSP file. If none given then that of the input file.\n");
    prt("Purpose:\n");
    prt(" Attempts to read the 'makefile' input file, and output\n");
    prt(" a DSP file to [$temp_dsp]\n");
    prt("Notes:\n");
    prt(" The input file is a set of line delimited commands. Lines beginning with '#' are skipped.\n");
    prt(" The debug switch is strictly for that. It add no functionality, just a noisier output,\n");
    prt("  and has the text setting of 'all', 'none', or 'help', to show the list in more detail.\n");
    $tmp = get_dbg_stg();
    prt(" For debug, presently values [$tmp] are ON\n") if (length($tmp));
    prt(" Warning: Paths, or more importantly, File name with spaces may NOT be handled correctly.\n");
    prt(" Remember the command 'dir /X *' will display the 8.3 DOS format names to use instead.\n");
}

sub show_dbg_help() {
    my $file = $0;
    my ($line,$max,$tmp);
    $max = get_dbg_range();
    $tmp = get_dbg_stg();
    prt(" --dbg <num>  (-d)  = Set DEBUG flag of this value. Number in range 1 to $tmp\n");
    prt(" Presently %tmp are ON.\n") if (length($tmp));
    prt(" Additional text setting are 'all', 'none', and this 'help'.\n");
    if (open INF, "<$file") {
        my @lines = <INF>;
        close INF;
        prt(" Detailed list, with some 'notes' indicating what eash does.\n");
        foreach $line (@lines) {
            $line = trim_all($line);
            if ($line =~ /^my\s+\$dbg(\d+)\s*=\s*\d+\s*;\s*(.+)$/) {
                $tmp = $1;
                prt("$tmp: $line\n");
            }
        }
    } else {
        prt("ERROR: Unable to open file [$file], so NO DEBUG ADDITIONAL HELP!\n");
    }
}

sub load_input_file($$) {
    my ($arg,$file) = @_;
    if (open INF, "<$file") {
        my @lines = <INF>;
        close INF;
        my @carr = ();
        my ($line,@arr);
        foreach $line (@lines) {
            $line = trim_all($line);
            next if (length($line) == 0);
            next if ($line =~ /^#/);
            @arr = split(/\s/,$line);
            push(@carr,@arr);
        }
        parse_args(@carr);
    } else {
        pgm_exit(1,"ERROR: Unable to 'open' file [$file]!\n")
    }
}

sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have follwoing argument!\n")
        if (!@av);
}
sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg,$tmp);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^d/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $tmp = get_dbg_range();
                if (($sarg =~ /^\d+$/)&&($sarg >= 1)&&($sarg <= $tmp)) {
                    $tmp = 'dbg';
                    if ($sarg < 10) {
                        $tmp .= "0$sarg";
                    } else {
                        $tmp .= "$sarg";
                    }
                    set_dbg_var($sarg);
                    prt("Set Debug $tmp ON!\n");
                } else {
                    if ($sarg =~ /^\d+$/) {
                        pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Out of range 1 - $tmp\n");
                    } else {
                        if ($sarg =~ /^help$/i) {
                            show_dbg_help();
                            pgm_exit(0,"DEBUG Help exit(0)\n");
                        } elsif ($sarg =~ /^all$/i) {
                            prt("Setting ALL debug ON!\n");
                            set_all_dbg_on();
                        } elsif ($sarg =~ /^none$/i) {
                            prt("Setting ALL debug OFF!\n");
                            set_all_dbg_off();
                        } else {
                            pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Not numerical in range 1 - $tmp, or 'all' or 'none'!\n");
                        }
                    }
                }
            } elsif ($sarg =~ /^i/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                load_input_file($arg,$sarg);
            } elsif ($sarg =~ /^l/i) {
                $load_log = 1;
                prt("Set to load log at end.\n");
            } elsif ($sarg =~ /^m/i) {
                # store a macro
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                need_arg(@av);
                shift @av;
                $tmp = $av[0];
                $makemacs{$sarg} = $tmp;
                prt("Set MACRO $sarg=$tmp\n");
            } elsif ($sarg =~ /^t/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $targ_dir = File::Spec->rel2abs($sarg);
                prt("Set target directory to [$targ_dir]\n");
                pgm_exit(1,"ERROR: Target DIRECTORY does NOT EXIST!\n") if (! -d $targ_dir);
            } 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 ((length($in_file) == 0)&& $debug_on) {
        $in_file = File::Spec->rel2abs($def_in_file);
        prt("[debug_on] Set input to DEFAULT [$in_file]\n");
        #set_debug_on();
        $load_log = 1;
    }
    if ($debug_on) {
        $sarg = 'XML_SRCDIR';
        $tmp = "C:\\Projects\\libxm2";
        $makemacs{$sarg} = $tmp;
        prt("Set DEBUG MACRO $sarg=$tmp\n");
    }
    if (length($in_file) == 0) {
        pgm_exit(1,"ERROR: No input file found on command line!\n");
    } elsif (! -f $in_file) {
        pgm_exit(1,"ERROR: Input file [$in_file] NOT FOUND!\n");
    }

    if (length($root_dir) == 0) {
        ($arg,$root_dir) = fileparse($in_file);
        if ($root_dir =~ /^\.(\\|\/)$/) {
            $root_dir = $cwd;
        }
        prt("Set root directory to [$root_dir]\n");
    }
    if (length($targ_dir) == 0) {
        $targ_dir = $root_dir;
        #$targ_dir .= "\\" if ( !($targ_dir =~ /(\\|\/)$/) );
        #$targ_dir .= 'msvc';
        prt("Set target directory to [$targ_dir]\n");
    }
}

# eof - makesrcs02.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional