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