guessdsp.pl to HTML.

index -|- end

Generated: Sun Apr 15 11:46:21 2012 from guessdsp.pl 2011/10/15 39.7 KB.

#!/usr/bin/perl -w
# NAME: guessdsp.pl
# AIM: Scan the directory and build a GUESSED DSP file
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_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n";
require 'lib_dsphdrs.pl' or die "Unable to load 'lib_dsphdrs.pl'! Check location and \@INC content.\n";
require 'lib_vcscan.pl' or die "Unable to load 'lib_vcscan.pl'! Check location and \@INC content.\n";
require 'lib_params.pl' or die "Unable to load 'lib_params.pl'! Check location and \@INC content.\n";

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

# user variables
my $VERS = "0.0.1 2011-10-14";
my $load_log = 0;
my $in_dir = '';
my $verbosity = 0;
my $add_auto_flag = 0; # this needs LOTS more works to complete

my $def_name = 'tempguess';
########################################
### SHARED RESOURCES, VALUES
### ========================
our $fix_relative_sources = 1;
our %g_user_subs = ();    # supplied by USER INPUT
our %g_user_condits = (); # conditionals supplied by the user

my %excluded_projects = ();
# my %joined_projects = ();

my @input_sources = (); # user LIST of source files [full,relative] array
my $use_user_src = 0;
my $separate_text = 1;
my $create_dsw = 1; # if on. also create a DSW file

my $project_name = '';
my $proj_type = ''; # 'CA' => $app_console_stg, 'WA' => $app_windows_stg, 'DLL' => $app_dynalib_stg, 'SL' => $app_statlib_stg
my $dsp_out = $perl_dir."\\tempcdsp.dsp";
my $proj_targ = ''; # target directory for DSP file
my $copy_bat = $perl_dir."\\tempcb.bat";
if (-d 'C:\MDOS') {
    $copy_bat = 'C:\MDOS\tempcb.bat';
}
my $conf_string = '';

my %by_proj_includes = ();
my $proj_incs = '/I "."';

my $proj_rt = 'D';


my %by_proj_types = ();
my %by_proj_typused = ();

my $proj_defs = '/D "_CRT_SECURE_NO_WARNINGS"';
my %by_proj_defines = ();
my %by_proj_defused = ();

# NOTE: For user includes, usually also NEED 'libpath'
# like $proj_libD .= " /libpath:\"Debug\" foo.lib";
# like $proj_libR .= " /libpath:\"Release\" foo.lib";
# OR
# like $proj_lib .= " /libpath:\"lib\";
# like $proj_libD .= " fooD.lib";
# like $proj_libR .= " foo.lib";
# sub in line ADD LINK32 kernel32.lib ... -NEW_LIBS- /nologo ...
my $proj_libs = 'Winmm.lib ws2_32.lib';
my $proj_libD = '';
my $proj_libR = '';

# NOTE: This is for BOTH '/out:"bin\foo.exe"' AND '/libpath:"lib"' COMBINED
my $proj_outR = '';
my $proj_outD = '';

# object output, and the default for other things if NOT specifically stated
my $proj_interR = '"Release"';
my $proj_interD = '"Debug"';

# Auto output does the following -
# For libaries
# Debug:  '/out:"lib\barD.lib"'
# Release:'/out:"lib\barD.lib"'
# for programs
# Debug:  '/out:"bin\fooD.exe"'
# Release:'/out:"bin\foo.exe"'
# This also 'adds' missing 'include' files
#Bit:   1: Use 'Debug\$proj_name', and 'Release\$proj_name' for intermediate and out directories
#Bit:   2: Set output to lib, or bin, and names to fooD.lib/foo.lib or barD.exe/bar.exe
#Bit:   4: Set program dependence per library output directories
#Bit:   8: Add 'msvc' to input file directory, if no target directory given
#Bit:  16: Add program library dependencies, if any, to DSW file output.
#Bit:  32: Add all headers to the DSP file. That is scan sources for #include "foo.h", etc.
#Bit:  64: Write a blank header group even there are no header files for that component.
#Bit: 128: Add defined item of HAVE_CONFIG_H to all DSP files.
#Bit: 256: Exclude projects in SUBDIRS protected by a DEFINITION macro, else include ALL.
#Bit: 512: Unconditionally add ANY libraries build, and NOT excluded to the last application
#Bit:1024: If NO users conditional, do sustitution, if at all possible, regardless of TRUE or FALSE
#Bit:2048: Add User -L dependent libraries to each application
#Bit: These can be given as an integer, or the form 2+8, etc. Note using -1 sets ALL bits on.
#Bit: Bit 32 slows down the DSP creation, since it involves scanning every line of the sources.
my $auto_max_bit = 512;
our $auto_on_flag = -1; #Bit: ALL ON by default = ${$rparams}{'CURR_AUTO_ON_FLAG'}

### DEBUG
my $debug_on = 0;
my $def_dir = 'C:\FG\fgrun\fgrun2008\gettext\gettext-runtime\intl';
my $dbg_out = 0;
my $dbg_write = 0;  # 8; # for substitutions

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my $in_input_file = 0;

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

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        ### prt( "\nNo warnings issued.\n\n" );
    }
}

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


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

sub get_user_rt($$) {
    my ($flag,$line) = @_;
    my $urt = '';
    if ($proj_rt eq 'D') {
        if ($flag == 1) {
            $urt = '/MD';
        } else {
            $urt = '/MDd';
        }
    } else {
        if ($flag == 1) {
            $urt = '/MT';
        } else {
            $urt = '/MTd';
        }
    }
    return $urt;
}

sub get_user_libs($$) {
    my ($flag,$line) = @_;
    my $var1 = $proj_libs;
    if ($flag == 1) {
        if (length($proj_libR)) {
            $var1 .= " " if (length($var1));
            $var1 .= $proj_libR;
        }
    } else {
        if (length($proj_libD)) {
            $var1 .= " " if (length($var1));
            $var1 .= $proj_libD;
        }
    }
    return $var1;
}

sub get_user_incs($$) {
    my ($flag,$line) = @_;
    return $proj_incs;
}

sub get_user_defs($$) {
    my ($flag,$line) = @_;
    return $proj_defs;
}

sub get_user_out($$) {
    my ($flag,$line) = @_;
    if ( ($flag == 1) && ( length($proj_outR) ) ) {
        return $proj_outR;
    }
    if (($flag == 2)&&(length($proj_outD))) {
        return $proj_outD;
    }
    return $line;
}

sub get_user_inter($$) {
    my ($flag,$line) = @_;
    if ( ($flag == 1) && ( length($proj_interR) ) ) {
        return $proj_interR;
    }
    if (($flag == 2)&&(length($proj_interD))) {
        return $proj_interD;
    }
    return $line;
}

# NOTE: This is for say '/out:"bin\foo.exe"' or '/out:"lib\bar.lib"'
# my $proj_outR = '';
# my $proj_outD = '';
# object output, and the default for other things if NOT specifically stated
# my $proj_interR = '"Release"';
# my $proj_interD = '"Debug"';
sub local_set_new_user_outs($$) {
    my ($pn,$pt) = @_;
    my ($dnm,$rnm,$od,$dstg,$rstg);
    if (length($pn) == 0) {
        pgm_exit(1,"ERROR: INTERNAL: function 'set_new_user_outs' called with INVALID project name [$pn]!\n");
    }
    if (($pt eq 'CA')||($pt eq 'WA')) {
        # these are EXE outputs to 'bin'
        $dnm = $pn."D.exe";
        $rnm = $pn.".exe";
        $od = 'bin';
        $rstg = "/out:\"".$od."\\".$rnm."\"";
        $dstg = "/out:\"".$od."\\".$dnm."\"";
    } elsif ($pt eq 'SL') {
        # these are LIB outputs to 'lib'
        $dnm = $pn."D.lib";
        $rnm = $pn.".lib";
        $od = 'lib';
        $rstg = "/out:\"".$od."\\".$rnm."\"";
        $dstg = "/out:\"".$od."\\".$dnm."\"";
    } elsif ($pt eq 'DLL') {
        # these are DLL outputs to 'bin'
        $dnm = $pn."D.dll";
        $rnm = $pn.".dll";
        $od = 'bin';
        $rstg = "/out:\"".$od."\\".$rnm."\"";
        $dstg = "/out:\"".$od."\\".$dnm."\"";

        # AND LIB outputs to 'lib'
        $dnm = $pn."D.lib";
        $rnm = $pn.".lib";
        $od = 'lib';
        $rstg .= " /implib:\"".$od."\\".$rnm;
        $dstg .= " /implib:\"".$od."\\".$dnm;
    } else {
        pgm_exit(1,"ERROR: INTERNAL: function 'set_new_user_outs' called with INVALID type [$pt]!\n");
    }

    #$proj_outputR = $rstg;
    #$proj_outputD = $dstg;
    $proj_outR = $rstg;
    $proj_outD = $dstg;

    if ($proj_interR eq '"Release"') {
        $proj_interR = "Release\\$pn";
        $proj_interR = '"'.$proj_interR.'"';
    }
    if ($proj_interD eq '"Debug"') {
        $proj_interD = "Debug\\$pn";
        $proj_interD = '"'.$proj_interD.'"';
    }
}

sub is_project_src_excluded($$) {
    my ($proj,$rslist) = @_;
    if (defined $excluded_projects{$proj}) {
        ${$rslist} = $excluded_projects{$proj}; # for all = '<all>'
        return 1;
    }
    return 0;
}

sub is_project_all_excluded($) {
    my ($proj) = @_;
    my $list = '';
    if ( is_project_src_excluded($proj,\$list) && ($list eq '<all>')) {
        return 1;
    }
    return 0;
}


# [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 file_in_array($$) {
    my ($file,$rxarr) = @_;
    my ($itm);
    my ($fil,$dir) = fileparse($file);
    foreach $itm (@{$rxarr}) {
        return 1 if ($itm eq $fil);
    }
    return 0;
}

sub create_proj_dsp($$) {
    my ($fil,$odir) = @_;

    my ($nm,$dr,$ex) = fileparse($fil, qr/\.[^.]*/ );

    my $hr = get_default_ref_hash($fil);    # this it the VERSION 1

    my $xsrcs = '';
    my $isinx = is_project_src_excluded($project_name,\$xsrcs);
    $xsrcs = '' if ($xsrcs eq '<all>');
    my ($xit);
    my @xarr = split(/;/,$xsrcs);

    my ($line,$key,$group,$filter,$ok,$rdir,$cfil,$cdir,$sfil,$tdsp,$msg);
    my ($name,$type,$i,$conf,$rh2,$flag,$cnt,$i2);
    my ($confname,$var1,$rcfgs);
    my ($tempdsw,$realdsw,$realdsp,$fulldsw);

    $name = $project_name;


    $tdsp = $odir;
    $tdsp .= "\\" if (!($tdsp =~ /(\\|\/)$/));
    $tdsp .= $name.".dsp";

    # FIX20110804 - set REAL and TEMPORARY DSW file names
    $realdsw = $name.".dsw";
    $realdsp = $name.".dsp";
    $fulldsw = $odir;
    $fulldsw .= "\\" if (!($fulldsw =~ /(\\|\/)$/));
    $fulldsw .= $realdsw;
    $tempdsw = $dr; # same directory as the TEMPORARY dsp file
    $tempdsw .= $realdsw;

    $key = 'PROJECT_NAME';
    ${$hr}{$key} = $name;
    #$key = 'PROJECT_TYPE';
    $key = 'PROJECT_APTP';
    if ( get_app_type_4_short($proj_type, \$type) ) {
        ${$hr}{$key} = $type;
        prt("Set project type to [$type], from [$proj_type]\n") if (VERB2());
    } else {
        pgm_exit(1,"ERROR: Unable to get project type from [$proj_type]! Only 'CA', 'SL', 'DLL', 'WA'!\n");
    }

    local_set_new_user_outs($project_name,$proj_type); # adjust output name, directory

    my @sources = ();
    my ($ii,$scnt);
    $scnt = scalar @input_sources;
    prt("DSP output directory is [$odir].\n") if (VERB9());
    prt("Got $scnt sources to add to the DSP file.\n") if (VERB9());
    for ($ii = 0; $ii < $scnt; $ii++) {
        $line = $input_sources[$ii][0]; # get the FULL PATH TO SOURCE
        $ok = 0;
        ($cfil,$cdir) = fileparse($line); # get its directory (of the FULL)
        # $rdir = get_relative_path($cdir,$odir);
        $rdir = get_rel_dos_path($cdir,$odir);
        # prt("Got relative directory: [$rdir]!\n") if (VERB9());
        if ($use_user_src) {
            $sfil = $input_sources[$ii][1]; # user supplied, relative, source
        } else {
            $sfil = $rdir.$cfil;
        }
        #prt("From [$line], to [$proj_targ], got rel [$sfil]\n");
        prt("for [$line],\n to [$proj_targ], got\n") if (VERB5());
        if (VERB2()) {
            if ($use_user_src) {
                prt("Rel [$sfil], per input.\n");
            } else {
                prt("Rel [$sfil] [$rdir]\n");
            }
        }
        if ($separate_text && is_text_ext_file($line)) {
            $filter = "";
            $group = "";
            $ok = 1;
        } elsif (is_c_source_extended($line)) {
            # if (($line =~ /\.cxx$/i) || ($line =~ /\.c$/i) || ($line =~ /\.cpp$/i) || ($line =~ /\.cc$/i))
            $filter = get_def_src_filt();
            $group = get_def_src_grp();
            $ok = 1;
        } elsif (is_h_source_extended($line)) {
            # elsif ( ($line =~ /\.hxx$/i) || ($line =~ /\.h$/i) || ($line =~ /\.hpp$/i) )
            $filter = get_def_hdr_filt();
            $group = get_def_hdr_grp();
            $ok = 1;
        } elsif (is_resource_file($line)) {
            $filter = get_def_rcs_filt();
            $group = get_def_rcs_grp();
            $ok = 1;
        }

        if ($ok) {
            #push(@sources, [ $line, $group, $filter, 0, '' ]);
            $xit = 0;
            # failed with ($xsrcs =~ /\b$sfil\b/)
            if ($isinx && length($xsrcs) && file_in_array($sfil,\@xarr)) { 
                $xit = 1;
                prt("[v2] Excluding from build source [$sfil]\n") if (VERB5());
            }
            push(@sources, [ $sfil, $group, $filter, $xit, '' ]);
        } else {
            prtw("WARNING: CHECK Discarded [$line]\n");
      }
   }
    # ==============================
    # add the sources to the project
    # ==============================
    if (@sources) {
        $key = 'PROJECT_SRCS';
        ${$hr}{$key} = [@sources];
    } else {
        # no way to continue - NO SOURCES
        pgm_exit(1,"ERROR: No sources!!!\n");
    }

    set_default_configs_2($hr);     # set Release and Debug

    $key = 'PROJECT_CFGS';
    if (defined ${$hr}{$key}) {
        $rcfgs = ${$hr}{$key};
        $cnt = scalar @{$rcfgs};
        prt( "Got $cnt CONFIGS...\n" ) if (VERB5());
        for ($i = 0; $i < $cnt; $i++) {
            $i2 = $i + 1;
            #                   0          1          2           3
            #                   Debug      -NEW_OUTD- Debug|WIN32
            # push(@{$rcfgs}, [ $confname, $var1,     $conf,      $dsp_sub_sub ]);
            $confname = ${$rcfgs}[$i][0];
            #$var1     = ${$rcfgs}[$i][1]; # has no meaning!!!
            $conf     = ${$rcfgs}[$i][2];
            $rh2      = ${$rcfgs}[$i][3];
            if (($conf =~ /Release/i)||($confname =~ /Release/i)) {
                $flag = 1;
            } elsif (($conf =~ /Debug/i)||($confname =~ /Debug/i)) {
                $flag = 2;
            } else {
                pgm_exit(1,"ERROR: Can NOT set config type as 'Release' or 'Debug'! Got [$conf] [$confname]\n");
            }

            prt("$i2: [$conf] [$confname] ($flag)\n") if (VERB5());
            foreach $key (keys %{$rh2}) {
                $line = ${$rh2}{$key};
                $var1 = $line# start the SAME
                $msg = '';
                if ($key eq '-NEW_OUTD-') {
                    $var1 = get_user_inter($flag,$line); # -NEW_OUTD- = ["Release"]
                } elsif ($key eq '-NEW_POST-') {
                    # -NEW_POST- = []
                } elsif ($key eq '-NEW_INTER-') {
                    $var1 = get_user_inter($flag,$line); # -NEW_INTER- = ["Release"]
                } elsif ($key eq '-NEW_INCS-') {
                    $var1 = get_user_incs($flag,$line); # -NEW_INCS- = []
                } elsif ($key eq '-NEW_LIBS-') {
                    $var1 = get_user_libs($flag,$line); # -NEW_LIBS- = [Winmm.lib ws2_32.lib]
                } elsif ($key eq '-NEW_OUT-') {
                    $var1 = get_user_out($flag,$line); # -NEW_OUT- = []
                } elsif ($key eq '-NEW_DEFS-') {
                    $var1 = get_user_defs($flag,$line); # -NEW_DEFS- = [/D "_CRT_SECURE_NO_WARNINGS"]
                } elsif ($key eq '-NEW_RT-') {
                    $var1 = get_user_rt($flag,$line); # -NEW_RT- = [/MT]
                } else {
                    prtw("WARNING: Key [$key] NOT in if table!?!?\n");
                }
                if ($line ne $var1) {
                    $msg = "changed to [$var1]";
                    ${$rh2}{$key} = $var1;
                }
                prt("$key = [$line] $msg\n") if (VERB9());
            }
        }
    } else {
        pgm_exit(1,"INTERNAL ERROR: Hash does NOT have key [$key]!\n");
    }
    # if ( !get_project_name($rh, \$name) || (length(trim_all($name)) == 0))
    # if ( !get_project_type($rh, \$type) ) {
    #my $isdllapp = (is_dll_project($hr) | is_app_project($hr));
    #my $conf1 = '';
    #my $rconfarr = get_configs_array3($hr, \$conf1, $name);
    # my $func = \&get_configs_array3; # ($$$);
    # my $rconfarr = $func->($hr, \$conf1, $name);
    #$cnt = scalar @{$rconfarr};
    #prt( "Got $cnt CONFIGS...Default = [$conf1]\n" );
    #for ($i = 0; $i < $cnt; $i++) {
    #    $conf = ${$rconfarr}[$i][0];    # This is the FULL string 'name - Win32 Debug'
    #    $rh2 = ${$rconfarr}[$i][2];
    #    if ($conf =~ /Release/i) {
    #        $flag = 1;
    #    } elsif ($conf =~ /Debug/i) {
    #        $flag = 2;
    #    } elsif ($conf =~ /DLL/) {
    #        $flag = 1; # 2010/05/05 - assume RELEASE when a DLL type
    #    } else {
    #        pgm_exit(1,"ERROR: Can NOT place config [$conf] into a category!\n");
    #    }
    #    foreach $key (keys %{$rh2}) {
    #        $line = ${$rh2}{$key};
    #        prt("$key = [$line]\n");
    #    }
    #}
    #pgm_exit(1,"TEMP");

    if (write_hash_to_DSP3( $fil, $hr, $dbg_write )) {
        # successful creation of the 'temporary' DSP file
        prt("Written DSP to [$fil]\n");
        if ($create_dsw) {
            # write a DSW, of the name "$name.dsw", to load this "$name.dsp" file
            $msg = get_dsw_head();
            $msg .= get_proj_begin($name, $realdsp);
            # $msg .= get_proj_depends3( $prj, $ref_deps );
          $msg .= get_proj_end();
           $msg .= get_dsw_tail();
            write2file($msg,$tempdsw); # write to TEMPORARY DSW
            prt("Written DSW to [$tempdsw]\n");
       }

        # create a batch file to COPY this DSP to the destination
        $msg  = "\@echo Copy [$fil],\n";
        $msg .= "\@echo to   [$tdsp]?\n";
        $msg .= "\@if NOT EXIST $tdsp goto CHK2\n";
        $msg .= "\@if \"%1x\" == \"NOPAUSEx\" goto CHK2\n";
        $msg .= "\@echo NOTE: THIS WILL OVERWRITE THE EXISTING FILE!!!\n";
        $msg .= ":CHK1\n";
        $msg .= "\@echo *** CONTINUE? *** Ctrl+C to abort.\n";
        $msg .= "\@pause\n";
        $msg .= "\@if NOT EXIST $tdsp goto CHK2\n";
        $msg .= "\@echo Exisitng file will be OVERWRITTEN! Are you SURE?\n";
        $msg .= "\@pause\n";
        $msg .= ":CHK2\n";
        $msg .= "copy $fil $tdsp\n";
        if ($create_dsw) {
            # ==================================
            $msg .= "\@echo Copy [$tempdsw],\n";
            $msg .= "\@echo to   [$fulldsw]?\n";
            $msg .= "\@if NOT EXIST $fulldsw goto CHK3\n";
            $msg .= "\@if \"%1x\" == \"NOPAUSEx\" goto CHK3\n";
            $msg .= "\@echo NOTE: THIS WILL OVERWRITE THE EXISTING FILE!!!\n";
            $msg .= "\@echo *** CONTINUE? *** ONLY Ctrl+C to abort.\n";
            $msg .= "\@pause\n";
            $msg .= ":CHK3\n";
            $msg .= "copy $tempdsw $fulldsw\n";
        }
        $msg .= "\@echo Done...\n";
        write2file($msg,$copy_bat);
        prt("Update can be via the [$copy_bat] file.\n");
    } else {
        prt("WARNING: FAILED TO WRITE DSP FILE!\n");
    }
}


sub process_in_dir($) {
    my ($dir) = @_;
    if (! opendir(DIR,"$dir") ) {
        pgm_exit(1,"ERROR: Unable to open file [$dir]\n"); 
    }
    my @files = readdir(DIR);
    closedir(DIR);
    my $cnt = scalar @files;
    prt("Got $cnt items, from [$dir]\n");
    my ($i,$fil,$ff,$keep);
    my @csources = ();
    my @hsources = ();
    my @others = ();
    my $ccnt = 0;
    my $hcnt = 0;
    my $ocnt = 0;
    my $tcnt = 0;
    my $rcnt = 0;
    $dir .= "\\" if ( !($dir =~ /(\\|\/)$/) );
    for ($i = 0; $i < $cnt; $i++) {
        $fil = $files[$i];
        next if (($fil eq '.')||($fil eq '..'));
        $ff = $dir.$fil;
        $keep = 0;
        if (is_c_source_extended($fil)) {
            $ccnt++;
            push(@csources,$fil);
            $keep = 1;
        } elsif (is_h_source_extended($fil)) {
            $hcnt++;
            push(@hsources,$fil);
            $keep = 2;
        } else {
            push(@others,$fil);
            if ($separate_text && is_text_ext_file($fil)) {
                $keep = 3;
                $tcnt++;
            } elsif ( is_resource_file($fil) ) {
                $keep = 4;
                $rcnt++;
            } else {
                $ocnt++;
            }
        }
        if ($keep) {
            push(@input_sources, [$ff,$fil,$keep]); # user LIST of source files [full,relative] array
        }
    }
    prt("Found files C=$ccnt, H=$hcnt, Txt=$tcnt, RC=$rcnt, Others=$ocnt\n");
    return $ccnt;
}

sub process_in_file($) {
    my ($inf) = @_;
    if (! open INF, "<$inf") {
        pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); 
    }
    my @lines = <INF>;
    close INF;
    my $lncnt = scalar @lines;
    prt("Processing $lncnt lines, from [$inf]...\n");
    my ($line,$inc,$lnn);
    $lnn = 0;
    foreach $line (@lines) {
        chomp $line;
        $lnn++;
        if ($line =~ /\s*#\s*include\s+(.+)$/) {
            $inc = $1;
            prt("$lnn: $inc\n");
        }
    }
}

#########################################
### MAIN ###
parse_args(@ARGV);
#### prt( "$pgmname: in [$cwd]: Hello, World...\n" );
if (process_in_dir($in_dir)) {
    # only pass a TEMPORARY output directory
    create_proj_dsp("$perl_dir\\$project_name.dsp",$proj_targ);
} else {
    pgm_exit(1,"ERROR: NO source files found in [$in_dir]\n");
}
pgm_exit(0,"");
########################################



sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help    (-h or -?) = This help, and exit 0.\n");
    if ($add_auto_flag) {
        prt(" --auto on|off|v (-a) = Automate certain preferred outputs. '-a help' for MORE. (def=$auto_on_flag)\n");
    }
    prt(" --verb[n]       (-v) = Bump [or set] verbosity. def=$verbosity\n");
    prt(" --DEF mac[:nam] (-D) = Add a global defined macro, OR to a specific ':project', if given.\n");
    prt(" --INC <path>    (-I) = Add an include macro, like '/I \"path\"', to the DSP compile.\n");
    prt("                        Add :project to add an include on a per project basis.\n");
    prt(" --name <name>   (-n) = Name of the project. Def=$def_name\n");
    prt(" --RT  [D|T]     (-R) = Set global RUNTIME. D=/MD|/MDd T=/MT|/MTd (def=$proj_rt).\n");
    prt(" --resp <file>   (-r) = Commands from a reponse/input file.\n");
    prt(" --TYPE nm:type  (-T) = Set other than default types for project name : types CA|WA|SL|DLL, and\n");
    prt("                        the type can be followed with additional 'sources'. name:type:src1;src2;...\n");
    prt(" --targ <dir>    (-t) = Establish a target directory for the DSW/DSP files.\n");
    prt(" --xclude <set>  (-x) = Exclude a 'project', or sources, from a project. A 'set' consists of\n");
    prt("                        a project names, optionally followed, after a colon,\n");
    prt("                        by a semi-colon separated list of sources. eg proj:src1;src2'...\n");
}
sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av);
}

# SET -T project:type[:source_list]
sub set_project_type($$) {
    my ($arg,$sarg) = @_;
    my @arr = split(/:/,$sarg);
    my $cnt = scalar @arr;
    my $bad = 0;
    my $msg = '';
    my ($proj,$type,$srcs,@ts);
    if (($cnt >= 2)&&($cnt <= 3)) {
        $proj = $arr[0];
        $type = $arr[1];
        $srcs = ($cnt == 3) ? $arr[2] : '';
        if ( get_app_type_4_short($type, \$msg) ) {
            $by_proj_types{$proj} = $type;
            $proj_type = $type;
            if (length($srcs)) {
                $by_proj_types{$proj} .= ':'.$srcs;
                $msg .= " + srcs [$srcs]";
            }
        } else {
            $msg = "FAILED conversion on type [$type] to string! Only 'CA', 'WA', 'SL', 'DLL' allowed!";
            $bad = 1;
        }
    } else {
        # assume NO project name
        $type = $arr[0];
        if ( get_app_type_4_short($type, \$msg) ) {
            $proj_type = $type;
            $proj = $project_name;
        } else {
            $bad = 1;
            $msg = "Did not split to 2 (or 3) on ':', and NOT valid 'type' $type!";
        }
    }
    if ($bad) {
        pgm_exit(2,"ERROR: Command [$arg $sarg] FAILED! $msg\n");
    } else {
        prt("Set project [$proj], to type [$type] $msg\n");
    }
}

sub got_colon_split($) {
    my ($txt) = @_;
    my $len = length($txt);
    my ($i,$ch,$pc,$i2,$nc);
    $ch = '';
    for ($i = 0; $i < $len; $i++) {
        $pc = $ch;
        $ch = substr($txt,$i,1);
        if ($ch eq ':') {
            # skip over LETTER : SLASH
            $i2 = $i + 1;
            $nc = ($i2 < $len) ? substr($txt,$i2,1) : "";
            if (($nc =~ /(\\|\/)/) && ($pc =~ /\w+/)) {
                # next is slash - previous was letter - no split here
            } else {
                return 1;
            }
        }
    }
    return 0;
}

# take care with things like lib:C:\projs\lib - skip 'DRIVE_LETTER:\'
sub colon_split($) {
    my ($txt) = @_;
    my $len = length($txt);
    my @arr = ();
    my ($i,$ch,$tag,$pc,$i2,$nc);
    $ch = '';
    $tag = '';
    for ($i = 0; $i < $len; $i++) {
        $pc = $ch;
        $ch = substr($txt,$i,1);
        $i2 = $i + 1;
        $nc = ($i2 < $len) ? substr($txt,$i2,1) : "";
        if ($ch eq ':') {
            # skip over LETTER : SLASH
            if (($nc =~ /(\\|\/)/) && ($pc =~ /\w+/)) {
                # next is slash - previous was letter - no split here
            } else {
                #push(@arr,$tag) if (length($tag));
                push(@arr,$tag); # even BLANK tags get pushed
                $tag = ''; # kill current tag
                next;   # and go for NEXT
            }
        }
        $tag .= $ch;
    }
    push(@arr,$tag) if (length($tag));
    return @arr;
}


# setting defines
# FIX20110323 - All a global define like '-D PATH=C:\some\path
sub add_defined_item($) {
    my $txt = shift;
    my $msg = '';
    # if ($txt =~ /:/) {
    if (got_colon_split($txt)) {
        my (@a,$cnt,$pj);
        #@a = split(/:/,$txt);
        @a = colon_split($txt);
        $cnt = scalar @a;
        pgm_exit(1,"ERROR: Define [$txt] did NOT split in 2! Must be say -D TESTNUM=1:signal1...\n")
            if ($cnt != 2);
        $txt = '/D "'.$a[0].'"';
        $pj = $a[1];
        if (defined $by_proj_defines{$pj}) {
            $txt = " $txt";
            $by_proj_defines{$pj} .= $txt;
        } else {
            $by_proj_defines{$pj} .= $txt;
        }
        $msg = "only for project [$pj].";
    } else {
        $msg = "globally.";
        $txt = '/D "'.$txt.'"';
        $proj_defs .= ' ' if (length($proj_defs));
        $proj_defs .= $txt;
        $proj_defs = eliminate_dupes($proj_defs);
    }
    prt("Added [$txt] to compiler defines $msg.\n");
}

# SET a /I "include\path"
# FIX20110323 - allow on by project basis '-I SOME_VALUE:project_only'
# FIX20110803 - allow simple -I path1;path2;path3
sub add_include_item($) {
    my $cmd = shift;
    my $txt = $cmd;
    my (@a,$cnt,$pj);
    if (got_colon_split($txt)) {
        @a = colon_split($txt);
        $cnt = scalar @a;
        pgm_exit(1,"ERROR: Define [$txt] did NOT split in 2! Must be say -I C:\\some\\path:project\n")
            if ($cnt != 2);
        $txt = '/I "'.$a[0].'"';
        $pj = $a[1];
        if (defined $by_proj_includes{$pj}) {
            $txt = " $txt";
            $by_proj_includes{$pj} .= $txt;
        } else {
            $by_proj_includes{$pj} = $txt;
        }
        prt("Added [$txt] to compiler includes for project [$pj].\n");
    } else {
        @a = split(/;+/,$txt);
        $txt = '';
        foreach $pj (@a) {
            if (length($pj)) {
                $txt .= " " if (length($txt));
                $txt .= '/I "'.$pj.'"';
            }
        }
        if (length($txt)) {
            $proj_incs .= ' ' if (length($proj_incs));
            $proj_incs .= $txt;
            $proj_incs = eliminate_dupes($proj_incs);
            prt("Added [$txt] to global compiler includes.\n");
        } else {
            pgm_exit(1,"ERROR: -I options FAILED to yield any /I paths! cmd = [$cmd]\n")
        }
    }
}

sub show_auto_help() {
    my $file = $0;
    my ($line,$max,$tmp,$cnt,$tmp2);
    my $auto_on = $auto_on_flag;
    if (open INF, "<$file") {
        my @lines = <INF>;
        close INF;
        prt("Bit list, with some 'notes', indicating what each BIT does.\n");
        $cnt = 0;
        foreach $line (@lines) {
            chomp $line;
            if ($line =~ /\#Bit:/) {
                prt("$line\n");
                $cnt++;
            }
        }
        prt("ERROR: Not able to find auto on flag lines!\n") if ($cnt == 0);
    } else {
        prt("Unable to open file [$file], no auto help NOT available!\n");
    }
    $tmp = 1;
    $tmp2 = '';
    while ($tmp) {
        if ($auto_on & $tmp) {
            $tmp2 .= ' ' if (length($tmp2));
            $tmp2 .= "$tmp";
        }
        $tmp = $tmp << 1;
        last if ($tmp > $auto_max_bit);
    }

    prt("Current auto on = $auto_on. Bits: [$tmp2]\n");
    prt("The flag can be SET by '-a on' to enable all, and '-a off' to disable all.\n");
    prt("Or set to a specific value, '-a 64', '-a 255', or groups, '-a 2+4+8+64'.\n");
    prt("\n");
    prt("ALSO bits can be MODIFIED using the command...\n");
    prt(" --auto-mod [-]v (-am)= Add bit if positive, remove bit if negative.\n");
    prt("For example '-am -512' would remove this bit from the value.\n");
    prt("\n");
    pgm_exit(0,"End AUTO help ($cnt)\n");
}

sub set_auto_flag($$) {
    my ($arg,$sarg) = @_;
    my $ok = -1;
    my $num = 0;
    my $sa = substr($arg,1) if ($arg =~ /^-/);
    $sa = substr($sa,1) while ($sa =~ /^-/);
    my $caf = $auto_on_flag;
    if ($sarg =~ /^\d+\+\d+/) {
        my @arr = split(/\+/,$sarg);
        $num = 0;
        foreach (@arr) {
            $num += $_;
        }
        $sarg = $num;
    }

    if ($sarg =~ /^-(\d+)$/) {
        $num = $1;
        $num *= -1;
        $ok = 2;
    } elsif ($sarg =~ /^(\d+)$/) {
        $num = $1;
        if ($num > 0) {
            $ok = 1;
        } else {
            $ok = 0;
        }
    } else {
        if (($sa eq 'am')||($sa eq 'auto-mod')) {
            pgm_exit(1,"ERROR: Unknown command '$arg $sarg'! Can NOT be '-am' or '--auto-mod' with text 'on', 'off', or integer. (or -1 for all)\n");
        } else {
            if ($sarg =~ /^on$/i) {
                $ok = 1;
                $num = -1;
            } elsif ($sarg =~ /^off$/i) {
                $ok = 0;
                $num = 0;
            } elsif ($sarg =~ /^help$/i) {
                show_auto_help();
            } else {
                pgm_exit(1,"ERROR: Unknown command '$arg $sarg'! Can only be 'on', 'off', or integer. (or -1 for all)\n");
            }
        }
    }
    if (($sa eq 'am')||($sa eq 'auto-mod')) {
        # ONLY MODIFY THE CURRENT FLAG
        if ($ok == 2) {
            $auto_on_flag &= ~(-$num);
        } else {
            $auto_on_flag |= $num;
        }
        $ok = 'MOD';
    } else {
        if ($ok) {
            $ok = 'ON';
            $auto_on_flag = $num;
        } else {
            $auto_on_flag = $num;
            $ok = 'OFF';
        }
    }
    prt("Set auto on flag [$sa] $ok - From [$caf] to [$auto_on_flag] ");
    $ok = 1;
    my $msg = '';
    $num = 0;
    while($ok) {
        if ($auto_on_flag & $ok) {
            $msg .= "+" if (length($msg));
            $msg .= "$ok";
            $num += $ok;
        }
        $ok = $ok << 1;
        last if ($ok > $auto_max_bit);
    }
    prt("Value [$msg] ($num)\n");
}

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


# my %excluded_projects = ();
# my %joined_projects = ();

sub set_exclude_project($$$) {
    my ($arg,$sarg,$verb) = @_;
    my @arr = split(/:/,$sarg);
    my $cnt = scalar @arr;
    my ($prj,$srcs);
    if ($cnt == 1) {
        $prj = $arr[0];
        $srcs = '<all>';
        $excluded_projects{$prj} = $srcs;
        prt("Set to eXclude ALL of project [$prj]\n") if ($verb);
    } elsif ($cnt == 2) {
        $prj = $arr[0];
        $srcs = $arr[1];
        @arr = split(/;/,$srcs);
        $cnt = scalar @arr;
        $excluded_projects{$prj} = $srcs;
        prt("Set to eXclude $cnt sources of project [$prj] [".join(";",@arr)."]\n") if ($verb);
    } else {
        if ($verb) {
            pgm_exit(2,"ERROR: Command [$arg $sarg] FAILED! Not of form prj[:srcs]...\n");
        } else {
            prtw("WARNING: INTERNAL: Command [$arg $sarg] FAILED! Not of form prj[:srcs]...\n");
        }
    }
}


sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    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 ($add_auto_flag && ($sarg =~ /^a/)) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                set_auto_flag($arg,$sarg);
                $conf_string .= "$arg $sarg\n";
            } elsif ($sarg =~ /^D/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                add_defined_item($sarg);
                $conf_string .= "$arg $sarg\n";
            } elsif ($sarg =~ /^n/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $project_name = $sarg;
                prt("Set default over-all project name to [$project_name]\n");
                $conf_string .= "$arg $sarg\n";
            } elsif ($sarg =~ /^I/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                add_include_item($sarg);
                $conf_string .= "$arg $sarg\n";
            } elsif ($sarg =~ /^R/) {
                # FIX20110306 - Set project RUNTIME - either 'T'=static, or 'D'=DLL (default)
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                if (($sarg eq 'T')||($sarg eq 'D')) {
                    $proj_rt = $sarg;
                    prt("Set RUNTIME to [$sarg]... ");
                    if ($proj_rt eq 'D') {
                        prt("i.e. /MD release, /MDd debug DLL libs\n");
                    } else {
                        prt("i.e. /MT release, /MTd debug static libs\n");
                    }
                } else {
                    pgm_exit(1,"ERROR: Runtime can ONLY be 'T', for static, or 'D' for DLL! Not [$sarg]!\n");
                }
            } elsif ($sarg =~ /^r/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                prt("Loading from response file [$sarg]...\n");
                load_input_file($arg,$sarg);
            } elsif ($sarg =~ /^t/) {  # target directory for DSP file(s)
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $proj_targ = File::Spec->rel2abs($sarg);
                $fix_relative_sources = 1;
                prt("Set to TARGET folder to [$proj_targ].\n");
                $conf_string .= "$arg $sarg\n";
            } elsif ($sarg =~ /^T/) {  # set TYPE SL->DLL, or CA->WA for a project
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                set_project_type($arg,$sarg);
                $conf_string .= "$arg $sarg\n";
            } elsif ($sarg =~ /v/) {
                if ($sarg =~ /v.*(\d+)$/) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /v/) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Verbosity = $verbosity\n") if (VERB1());
            } elsif ($sarg =~ /^x/i) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                set_exclude_project($arg,$sarg,1);
                $conf_string .= "$arg $sarg\n";
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_dir = File::Spec->rel2abs($arg);
            prt("Set input to [$in_dir]\n");
        }
        shift @av;
    }

    if ($in_input_file == 0) {
        if ((length($in_dir) ==  0) && $debug_on) {
            $in_dir = $def_dir;
        }
        if (length($in_dir) ==  0) {
            pgm_exit(1,"ERROR: No input DIRECTORY found in command!\n");
        }
        if (! -d $in_dir) {
            pgm_exit(1,"ERROR: Unable to find in directory [$in_dir]! Check name, location...\n");
        }
        if (length($project_name) == 0) {
            $project_name = $def_name; # 'tempguess'
            prtw("WARNING: NO project name given! Using '$project_name'\n");
        }
        if (length($proj_type) == 0) {
            $proj_type = 'CA';
            prtw("WARNING: NO project type given! Using '$proj_type' = Console application\n");
        }
        if (length($proj_targ) == 0) {
            $proj_targ = '.';
            prtw("WARNING: NO project target given given! Using current '$proj_targ'\n");
        }
    }
}

# eof - guessdsp.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional