Generated: Sun Apr 15 11:45:56 2012 from chkrt.pl 2011/09/11 97.2 KB.
#!/perl -w # NAME: chkrt.pl # AIM: Check the RUNTIME of - # DSW set of files MSVC6 # DSP single file MSVC6 # SLN set of files MSVC7 or 8 # vcproj single file MSVC7 or 8 # 11/09/2011 - When changing the RUNTIME, write a batch file to do the COPY of the NEW... # and add the ability to CHANGE the 'CharacterSet' ="1" for UNICODE, ="2" for Multibyte, ="0" for Not set # 19/08/2011 - Add --depends (-d) switch, to show dependents # 17/08/2011 - Add file name to 'RuntimeLibrary NOT FOUND!' warning, and EXCLUDE some OSG cmake vcproj files # 22/04/2011 - Added 0 => 'MAKEFILE', # 20110422 - added this type # 03/04/2011 - Add ConfigurationType output, shown if -v1, plus other displays if v2,5,9 (for vcproj) # 10/03/2011 - Add wild card input, like *.sln, or *.dsp # 11/08/2010 - Added File::Spec->rel2abs to convert any relative input to absolute # 03/07/2010 - For vcproj at least, show OutputFile= # 08/06/2010 - Just a little tidying, and UI enhancements... # 14/11/2008 - Add show of sources, and add and use prtw(); # 24/09/2007 - Also SHOW output 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_root = "C:\\GTools\\perl"; unshift(@INC, $perl_root); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl'! Check location and \@INC content.\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_root."\\temp.$pgmname.txt"; open_log($outfile); #my $in_file = ''; my @inp_files = (); # user file set, or from expand of wild - full qualified path my $dbg_inp = 0; # on to run WITHOUT command line .. my $def_file = 'C:\FGCVS\gdal\gdal-1.8\makegdal80.sln'; my $out_dsp_dir = $perl_root; my $do_set = 0; # set to do SET my @sln_set = (); my $max_line_wid = 75; # features my $load_log = 0; # load log into Wordpad my $show_srcs = 0; # check and display the SOURCE files my $excl_excluded = 1; # check for PROP # PROP Exclude_From_Build 1 my $showfiles = 0; # also OUTPUT the file list my $showfilter = 0; # also OUTPUT the filter list my $showenter = 0; # show enter and exit - more for debug my $curr_app_type = ''; my $write_dsp = 1; my $fix_rel_paths = 0; # if given an output dsp directory, fix the releative source paths my $dbg4write = 0; my $comp_2_dsps = 0; my $verbosity = 0; my $show_deps = 0; my $characterset = ''; # "0" Not set (the default), "1" Unicode, "2" Mutibyte my $new_runtime = ''; # 'T' = /MT/MTd, 'D' = /MD/MDd my %dups_vcprojs = (); my %vcproj_defs = (); my %vcproj_incs = (); my %vcproj_libs = (); my %vcproj_linc = (); sub VERB1() { return ($verbosity >= 1); } sub VERB2() { return ($verbosity >= 2); } sub VERB5() { return ($verbosity >= 5); } sub VERB9() { return ($verbosity >= 9); } my @g_change_list = (); my ($fil_nm,$fil_dir,$fil_ext); #my @lines = (); #my $line = ''; my @warnings = (); # push of ALL WARNINGS ... my $wrnmsg = ''; my $show_out_file = 1; # show the OUTPUT file also my $vcprojcnt = 0; my $projcount = 0; my $tot_dsp_count = 0; my $tot_vcproj_count = 0; ######################################################### my %dswprojs = (); ######################################### ### DSP handling sub clear_per_dsp { my %macros = (); # clear DSP macro set my %dspmacros = (); my $customdbg = ''; my $custonrel = ''; my @discardedsrcs = (); my $update_bat = ''; my %lcdupes = (); # constants my $COMMENT_PATTERN = "^#"; my $MACRO_PATTERN2 = "^([A-Za-z][A-Za-z0-9_]+)[ \t]*=[ \t]*(.*)\$"; my %runtimes = (); # store of RUNTIMES found my %rtlines = (); my %rtfiles = (); my %rthash = (); my $mtrts = 0; my $dllrts = 0; my $otherrts = 0; my @src_list = (); my @dsp_file_list = (); my @project_list = (); #-- get current directory my $pwd = cwd(); my @osg_excluded = qw( ALL_BUILD.vcproj INSTALL.vcproj ZERO_CHECK.vcproj uninstall.vcproj ); ######################################################### # debug # DSP debug items my $dbg_out = 0; # write the RE-LINED XML to a file my $dbg5 = 0; # show "Got Project: $pn, $ff ... my $dbg6 = 0; # show "Split is [$if0] == [$if1] my $dbg8 = 0; # show "Entered IF [$1] $inanif my $dbg9 = 0; # show "SET: MACRO $1, to $2 ... my $dbg10 = 0; # show "Begin Group: $1 my $dbg11 = 0; # show "File $f contains $lncnt lines ... my $dbg30 = 0; # show "Discarding [$ls] due to Exclude_From_Build ... if $excl_excluded ON my $dbg31 = 0; # show "WARNING: CHECK Discarded [$fline]" my $dgb32 = 0; # show "Use_Debug_Libraries $1 my $dgb33 = 0; # show "RUNTIME: $form $rt my $dbg34 = 0; # show "WARNING: Duplicated MACRO $1, now $2, was $macros{$1} ... my $dbg35 = 0; # show "$vcprojcnt:$cfgcnt: End Configuration ... my $dbg40 = 0; # show "Processing $lc lines ... my $dbg41 = 0; # show "Done $lc lines ... $cnt projects ... my $dbg42 = 0; # show "\n$vcprojcnt: Processing VCPROJ file [$fil] ... my $dbg43 = 0; # show "$vcprojcnt: Processing $cnt lines ... my $dbg44 = 0; # show "$vcprojcnt: Done $cnt lines ... got $ncnt new lines ... my $dbg45 = 0; # show "$vcprojcnt: Project Name = $actname ($actvers)... my $dbg46 = 0; # show "$vcprojcnt:$cfgcnt: Config Name = $actcfg ... my $dbg47 = 0; # show "$vcprojcnt:$cfgcnt: Preprocessor = $actpp my $dbg48 = 0; # show "$cnt: Project [".$arr[0]."] File [".$arr[1]."] ... my $dbg49 = 0; # show "$vcprojcnt:$cfgcnt: Runtime = $rt ($rts) ... for $actcfg ($rng) my $dbg50 = 0; # show "$vcprojcnt:$cfgcnt: Output = $1 my $dbg51 = 0; # show "Processing CONCLUDED without WARNINGS! my $dbg52 = 0; # show "$vcprojcnt:$cfgcnt: AdditionalDependencies = ... my $dbg53 = 1; # prt( "[dbg53] $pgmname: Scanning [$in]...\n" ) if ($dbg53); my $dbg54 = 0; my $dbg55 = 0; my $dbg56 = 0; # show active config #################### ### WARNING LIST ### 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($val); if (length($msg)) { $msg .= "\n" if ( !($msg =~ /\n$/) ); prt($msg); } close_log($outfile,$load_log); exit($val); } # this could be split(/\s/,$line), but there is a # problem with name="with space", that this overcomes. # Slower. but sure the split is as desired. sub space_split_local($) { my ($lin) = shift; my $ll = length($lin); my $tag = ''; my @rarr = (); my $inquots = 0; for (my $p = 0; $p < $ll; $p++) { my $ch = substr($lin,$p,1); if ($inquots) { $tag .= $ch; if ($ch eq '"') { $inquots = 0; } } else { if ($ch =~ /\s/) { push(@rarr, $tag) if (length($tag)); $tag = ''; } else { $tag .= $ch; if ($ch eq '"') { $inquots = 1; } } } } push(@rarr, $tag) if (length($tag)); return @rarr; } sub is_osg_excluded($) { my ($file) = shift; foreach my $f (@osg_excluded) { return 1 if ($f eq $file); } return 0; } sub show_sources { my $scnt = scalar @src_list; prt( "Show of $scnt SOURCE files ...\n" ); my ($file, $msg, $i, $cnt, $rfil, $proj, $len, $minp, $mins, $sf, $j); my ($rsrcs); $minp = 0; $mins = 0; # 0 1 2 3 #push(@src_list, [ $actname, [@vcsrcs], $fil, [@srcs] ]); # run to get LENGTHS for ($i = 0; $i < $scnt; $i++) { $proj = $src_list[$i][0]; $rfil = $src_list[$i][1]; $len = length($proj); $minp = $len if ($len > $minp); foreach $file (@{$rfil}) { $len = length($file); $mins = $len if ($len > $mins); } } # run for DISPLAY for ($i = 0; $i < $scnt; $i++) { $proj = $src_list[$i][0]; $rfil = $src_list[$i][1]; $sf = $src_list[$i][2]; $rsrcs= $src_list[$i][3]; $cnt = scalar @{$rfil}; $proj .= ' ' while (length($proj) < $minp); prt("Project $proj: $cnt sources, from $sf\n"); $j = 0; foreach $file (@{$rfil}) { $msg = ((-f $file) ? "ok" : "MISSING"); $file .= ' ' while (length($file) < $mins); prt( " [$file] $msg (${$rsrcs}[$j])\n" ); $j++; } } } ## if (lc($fil_ext) eq 'dsw') { sub process_dsw { my ($fil) = shift; my ($msg, $lc, $lin, $pcnt, $ln, $bal, $pn, $pf, $ff); prt( "Processing DSW file [$fil] ...\n" ); if ( !open INF, "<$fil" ) { $msg = "WARNING: Unable to open [$fil] ..."; prtw( "$msg\n" ); return 0; } my @lines = <INF>; close INF; $lc = scalar @lines; prt( "Processing $lc lines ...\n" ); my ($nm, $dir, $ext) = fileparse( $fil, qr/\.[^.]*/ ); $pcnt = 0; $ln = 0; foreach $lin (@lines) { # seeking Project: "gennmtab"=".\gennmtab.dsp" - Package Owner=<4> chomp $lin; $ln++; ##prt( "$ln [$lin]\n" ); if ($lin =~ /^Project:\s+(.*)/) { $bal = $1; ###prt( "Got Project: [$bal]...\n" ); if ($bal =~ /\"(\w+)\"=\"*([\w\.\\\/]+)\"*/) { $pn = $1; $pf = $2; $ff = fix_rel($dir . $pf); ###prt( "Name = [$pn], file = [$pf][$ff] " ); prt( "Got Project: $pn, $ff ...\n" ) if ($dbg5); if (defined $dswprojs{$pn} ) { $msg = "WARNING: Duplicate PROJECT [%pn] ... $pf versus ".$dswprojs{$pn}; prtw( "$msg\n" ); } else { $dswprojs{$pn} = $ff; # keep project DSP file $pcnt++; if ( !(-f $ff) ) { $msg = "WARNING: [$ff] CAN NOT BE FOUND ..."; prtw( "$msg\n" ); } } } } } prt( "Done $lc lines ... got $pcnt projects \n" ); return $lc; } ## } elsif (lc($fil_ext) eq 'dsp') { sub process_dsp { my ($fil) = shift; return if (defined $dups_vcprojs{$fil}); $dups_vcprojs{$fil} = 1; # set file as DONE prt( "\nProcessing DSP file [$fil] ...\n" ) if (VERB9()); load_dsp($fil); } ## } elsif (lc($fil_ext) eq 'sln') { sub process_sln { my ($fil) = shift; my ($lc, $wmsg, @lines, $line); prt( "\nProcessing SLN file [$fil] ...\n" ); if ( !open INF, "<$fil" ) { $wmsg = "WARNING: Unable to open [$fil] ..."; prtw( "$wmsg\n" ); return 0; } @lines = <INF>; close INF; $lc = scalar @lines; prt( "Processing $lc lines ...\n" ) if ($dbg40); my $cnt = 0; my @projs = (); foreach $line (@lines) { $line = trim_all($line); if ($line =~ /Project\(.*=(.*)/) { $cnt++; ##prt( "$1\n" ); my @arr = split(/,/, $1); if (scalar @arr >= 2) { $arr[0] = trim_all($arr[0]); $arr[1] = trim_all($arr[1]); $arr[0] = substr($arr[0],1,length($arr[0])-2); $arr[1] = substr($arr[1],1,length($arr[1])-2); prt( "$cnt: Project [".$arr[0]."] File [".$arr[1]."] ...\n" ) if ($dbg48); push(@projs, [ $arr[0], $arr[1] ]); } else { $wmsg = "WARNING:$cnt:[$fil]: Scalar count of split only ".scalar @arr."???"; prtw( "$wmsg\n" ); } } } $cnt = scalar @projs; prt( "Done $lc lines ... $cnt projects ...\n" ) if ($dbg41); for (my $i = 0; $i < $cnt; $i++) { my $relfil = fix_rel($fil_dir.$projs[$i][1]); my ($fnm,$fdir,$fext) = fileparse( $relfil, qr/\.[^.]*/ ); if (lc($fext) eq '.vcproj') { process_vcproj( $relfil ); } elsif (lc($fext) eq '.csproj') { $wrnmsg = "WARNING: Input file [$relfil] is C#, NOT handled ..."; prtw( "$wrnmsg\n" ); } else { $wrnmsg = "WARNING: Project file [$relfil] NOT of known extension ..."; prtw( "$wrnmsg\n" ); } } return $lc; } # ensure -NEW_LIBS- hash ref does NOT contain LIBS already in default sub fix_lib_list($) { my ($rh) = @_; my $key = 'PROJECT_CFGS'; my $chgd = 0; my $def = get_def_lib_list(); my @a2 = split(/\s/,$def); if (defined ${$rh}{$key}) { my $val = ${$rh}{$key}; my $k2 = '-NEW_LIBS-'; my $acnt = scalar @{$val}; for (my $i = 0; $i < $acnt; $i++) { my $rsb = ${$val}[$i][3]; # get -NEW_LIBS- hash ref if (defined ${$rsb}{$k2}) { my $v2 = ${$rsb}{$k2}; prt("[dbg_sl_13] [$v2],\nwith default [$def]\n") if ($dbg54); my @a1 = split(/\s/,$v2); my $chg = 0; my @arr = (); my ($lib, $lib2,$fnd,$lclib); foreach $lib (@a1) { $lclib = lc($lib); if ($lib =~ /^\/libpath:/i) { # no change in these push(@arr,$lib); } else { $fnd = 0; # else check if already in DEFAULTS foreach $lib2 (@a2) { if ($lclib eq lc($lib2)) { $fnd = 1; last; } } if ($fnd) { $chg++; # dump this DUPLICATE } else { push(@arr,$lib); # else keep this } } } if ($chg) { $lib = join(" ",@arr); ${$rsb}{$k2} = $lib; prt(" Set NEW [$lib]\n") if ($dbg54); $chgd++; } } } # for each configuration if ($chgd) { # pgm_exit(1,"TEMP EXIT"); } } } # dbg_show_entering_files(); # dbg_show_source_files(); # dbg_show_output_files(); # { $dbg_v21 = 1; $dbg_v24 = 1; } # 2009/10/29 - make it work for TWO different forms of VC HASH sub process_vcproj_file_NOT_USED($$) { my ($in, $outd) = @_; my ($key,$tmp,$out,$cnt,$dsp); my ($prjf,$nm,$dir,$ext,$dspf); my ($msg); my ($rdspf,$fprjf,$fdspf,$dprjf); prt( "[dbg_sl_05] $pgmname: Scanning [$in]...\n" ) if ($dbg53); my ($vc_name,$vc_dir) = fileparse($in); $vc_dir = $pwd."\\" if ($vc_dir =~ /^\.(\\|\/)$/); my $rh = process_VCPROJ3($in); # check for application type over-ride... if (length($curr_app_type)) { $key = 'APP_TYPE'; $key = 'PROJECT_APTP' if (!defined ${$rh}{$key}); if (defined ${$rh}{$key}) { $tmp = ${$rh}{$key}; ${$rh}{$key} = $curr_app_type; if ($tmp ne $curr_app_type) { prt("Overrode $key with [$curr_app_type], from [$tmp]\n"); } } } # 2010-01-15 - get appropriate DSP file name (real = to replace existing, if any) $key = 'PROJECT_FILE'; $fprjf = ''; $rdspf = ''; $fdspf = ''; if (defined ${$rh}{$key}) { $fprjf = ${$rh}{$key}; ($nm,$dprjf,$ext) = fileparse($fprjf, qr/\.[^.]*/); $fdspf = $dprjf.$nm.".dsp"; # this may/should be ABSOLUTE } else { pgm_exit(1,"ERROR: key [$key] NOT IN hash! AND IT MUST BE!! Aborting!!!\n"); } # show_hash_results3($rh) if ($dbg_sl_04); # this would be BEFORE any changes made in chk_relative_paths... $key = '-NEW_PROJECT_NAME-'; $key = 'PROJECT_NAME' if (!defined ${$rh}{$key}); if ( $write_dsp && (defined ${$rh}{$key}) ) { $tmp = ${$rh}{$key}; # get the PROJECT NAME $dsp = $tmp.".dsp"; # make a DSP file name ${$rh}{'PROJECT_DSPF'} = $dsp; $outd .= "\\" if ( !($outd =~ /[\\\/]$/) ); # ensure out directory ends '\' $out = $outd; # using OUT directory $out .= "temp.".$dsp; # form a TEMPORARY DSP file name fix_lib_list($rh); # crude game to ensure TEMP DSP name for this project is UNIQUE $cnt = 0; while ( is_in_array($out, @dsp_file_list) ) { $cnt++; # already have a DSP of that name, so $out = $outd; # get OUT directory again, and $out .= "temp.".$tmp.$cnt.".dsp"; # add a COUNT to name } if ($fix_rel_paths) { # ok, need to change sources from perhaps '.\src.cxx' to '..\..\lib\src.cxx' - a big job chk_relative_paths($rh,$outd,$vc_dir); # was $perl_base; # this can be changed by -dsp=<new_dir> } else { prt("No relative path change: vcd=[$vc_dir] out=[$outd]\n"); } show_hash_results3($rh) if ($dbg53); # *** WRITE DSP FILE - FIRST TO A 'TEMP' FILE, to do a compare, if needed *** # =========================================================================== if ( write_hash_to_DSP3( $out, $rh, $dbg4write ) ) { push(@dsp_file_list,$out); # store name # project_list 0 1 2 #push(@project_list, [ $tmp, $dsp, $out ]); push(@project_list, [ $tmp, $fdspf, $out ]); $key = 'PROJECT_FILE'; if (defined ${$rh}{$key}) { $prjf = ${$rh}{$key}; prt( "For '$prjf'\n written '$out'\n" ); # Uses cmp2dsps[?].pl, external to here... if ($comp_2_dsps) { ($nm,$dir,$ext) = fileparse($prjf, qr/\.[^.]*/); $dspf = $dir.$nm.".dsp"; if (( -f $dspf)&&( -f $out)) { $msg = "cmp2dsps $dspf $out"; $msg .= " -l" if ($load_log); prt("Doing $msg...\n"); system("$msg"); } else { $msg = "No compare done! "; if ( !(-f $dspf) ) { $msg .= "Missing [$dspf]?"; } if ( !(-f $out) ) { $msg .= "Missing [$out]??"; } prtw("WARNING: $msg\n"); } } # ======================================= } } else { prtw("WARNING: No DSP written for [$tmp] project.\n" ); } } else { show_hash_results3($rh) if ($dbg53); prtw("WARNING: NO PROJECT NAME! = NO DSP WRITTEN!\n"); } return $rh; } sub modify_vcproj_runtime($) { my ($rh) = @_; my ($nfil,$txt); my ($i,$line,$rnt,$rts,$i2,$lnn,$nrt,$off,$cc,$nline); my ($fil,$rlns,$cnt,$fn,$dir,%map,$changes); if ((length($new_runtime)||(length($characterset))) && (defined ${$rh}{'CURR_FILE_NAME'})&&(defined ${$rh}{'CURR_FILE_LINES'})) { $fil = ${$rh}{'CURR_FILE_NAME'}; $rlns = ${$rh}{'CURR_FILE_LINES'}; $cnt = scalar @{$rlns}; ($fn,$dir) = fileparse($fil); %map = (); $changes = 0; if ($new_runtime eq 'T') { $map{2} = 0; $map{3} = 1; } else { $map{0} = 2; $map{1} = 3; } prt("Modify runtime of [$fn]... scanning $cnt lines...\n") if (VERB5()); for ($i = 0; $i < $cnt; $i++) { $i2 = $i + 1; $line = ${$rlns}[$i]; if (length($new_runtime)) { if ($line =~ /RuntimeLibrary=\"(\d+)\"/) { # RuntimeLibrary="2" $rnt = $1; $rts = rt_2_switch($rnt); $off = index($line,'RuntimeLibrary="'); $cc = '?'; if ($off >= 0) { $off += 16; $cc = substr($line,$off,1); } $lnn = sprintf("%4d",$i2); if (defined $map{$rnt}) { $nrt = $map{$rnt}; prt("$lnn: runtime [$rnt]($cc), [$rts] to [$nrt]\n") if (VERB1()); if ($rnt == $cc) { $nline = substr($line,0,$off).$nrt.substr($line,$off+1); prt($nline) if (VERB2()); ${$rlns}[$i] = $nline; $changes++; } } else { prt("$lnn: runtime [$rnt], [$rts] UNCHANGED\n") if (VERB9()); } } } if (length($characterset)) { if ($line =~ /CharacterSet=\"(\d+)\"/) { # CharacterSet="2" or "1" or "0" $rnt = $1; $off = index($line,'CharacterSet="'); $cc = '?'; $nrt = $characterset; if ($off >= 0) { $off += 14; $cc = substr($line,$off,1); $lnn = sprintf("%4d",$i2); if (($cc eq $rnt)&&($cc ne $nrt)) { $nline = substr($line,0,$off).$nrt.substr($line,$off+1); prt($nline) if (VERB2()); ${$rlns}[$i] = $nline; $changes++; } else { prt("$lnn: CharacterSet [$rnt], UNCHANGED\n") if (VERB9()); } } else { prt("WARNING: $lnn: CharacterSet [$rnt], INDEX FAILED [$fil]\n") if (VERB9()); } } } } if ($changes) { $nfil = $perl_root."\\temp$vcprojcnt.$fn"; $txt = join("",@{$rlns})."\n"; write2file($txt,$nfil); prt("Written mod to [$nfil]\n"); push(@g_change_list, [$fil,$nfil]); } } else { prtw("WARNING: ref. hash OR rt parameters NOT valid\n"); } } # // ConfigurationType Application, Utility StaticLibrary DynamicLibrary # However VC10 - CMake module shows # std::string configType = "<ConfigurationType>"; # switch(this->Target->GetType()) { # case cmTarget::SHARED_LIBRARY: # case cmTarget::MODULE_LIBRARY: # configType += "DynamicLibrary"; break; # case cmTarget::STATIC_LIBRARY: # configType += "StaticLibrary"; break; # case cmTarget::EXECUTABLE: # configType += "Application"; break; # case cmTarget::UTILITY: # configType += "Utility"; break; } # configType += "</ConfigurationType>\n"; # enum BuildType {STATIC_LIBRARY, DLL, EXECUTABLE, WIN32_EXECUTABLE, UTILITY}; # /*** Specify the type of the build: static, dll, or executable. */ my %configtype_hash = ( 0 => 'MAKEFILE', # 20110422 - added this type 1 => 'Application', 4 => 'Static Library', 3 => '3 - to be resolved', 2 => 'Dynamic Link Library', 5 => '5 - to be resolved' ); my %config_indicator = ( '_LIB' => 2, # <Tool name="VCCLCompilerTool" PreporcessorDefintions="WIN32;_DEBUG;_WINDOWS;_LIB;... '_USRDLL' => 4 # <Tool name="VCCLCompilerTool" PreporcessorDefintions="WIN32;_DEBUG;_WINDOWS;_USRDLL;... ); sub get_configurationtype($) { my $tmp = shift; if (defined $configtype_hash{$tmp}) { return $configtype_hash{$tmp}; } return "config type [$tmp] NOT LISTED"; } ###################################### ## process a VCPROJ file # FIX20110402 - Keep ConfigurationType="4" # <Configurations> # <Configuration Name="Release|Win32" # OutputDirectory=".\..\..\..\objs\release" # IntermediateDirectory=".\..\..\..\objs\release" # ConfigurationType="4" ... CharacterSet="2"> ###################################### sub process_vcproj { my ($fil) = shift; # process_vcproj_file($fil, $out_dsp_dir); return if (defined $dups_vcprojs{$fil}); $dups_vcprojs{$fil} = 1; # set file as DONE my ($cnt, $ac, $i, $ln, $actcfg, $j, $bgn, $end, $rnt, $rts, $cfgcnt, $incfg, $wmsg); my ($fnm,$fdir,$fext) = fileparse( $fil, qr/\.[^.]*/ ); my ($filnam,$fildir) = fileparse($fil); my (@nlines, $ncnt, @arr, $actname, $actvers, $actpp, $incfgs, $infiles); my ($grpname, $grpfilter, $grpfile, $ingrp, $key, $rng, $rtrng); my ($ind, @arr2, $tmp1, $tmp2, @adld, $ch); my ($ff, $msg, $lnnum, $xln,@lines,$line); my ($tmp,$find,$rh); my (@tarr,$ConfigurationName,$Name); my $is_osg_ex = is_osg_excluded($filnam); #my ($ratthash); my @vcsrcs = (); my @srcs = (); my %lnmap = (); my %hash = (); my $cmptoolcnt = 0; $vcprojcnt++; prt( "\n$vcprojcnt: Processing VCPROJ file [$fil] ...\n" ) if ($dbg42); if ( !open INF, "<$fil" ) { $wmsg = "WARNING: Unable to open [$fil] ..."; prtw( "$wmsg\n" ); return 0; } @lines = <INF>; close INF; $cnt = scalar @lines; $hash{'CURR_FILE_NAME'} = $fil; $hash{'CURR_FILE_LINES'} = \@lines; prt( "[v9] $vcprojcnt: Processing $cnt lines... from [$fil]\n" ) if ($dbg43 || VERB9()); $tot_vcproj_count++; ### push(@nlines, [$nline, $bgn, $end]); ### @nlines = reline_xml(@lines); @nlines = xml_to_lines($fil,\%lnmap, @lines); $ncnt = scalar @nlines; prt( "$vcprojcnt: Done $cnt lines ... got $ncnt new lines ...\n" ) if ($dbg44); if ($dbg_out) { my $tmp = "C:\\GTools\\perl\\temp.$fnm.$vcprojcnt.txt"; my $tln = ''; $lnnum = 0; for ($j = 0; $j < $ncnt; $j++) { ##$line = $nlines[$j][0]; ##$tln .= "\n" if (length($tln)); $lnnum++; $line = $nlines[$j]; $xln = $lnmap{$lnnum}; $tln .= "$xln: [$line]\n"; } write2file( $tln, $tmp ); prt( "XML written to $tmp ...\n" ); } $actcfg = ''; $cfgcnt = 0; $incfg = 0; $actname = ''; # name of the PROJECT $actpp = ''; $incfgs = 0; $infiles = 0; $grpname = ''; $grpfilter = ''; $ingrp = 0; $lnnum = 0; $rnt = -1; # means NO runtime found in vcproj file $rtrng = '<NR>'; $ConfigurationName = ''; $Name = ''; my %atthash = (); my %cfgtypes = (); for ($j = 0; $j < $ncnt; $j++) { #$line = $nlines[$j][0]; # XML line #$bgn = $nlines[$j][1]; # begin line number #$end = $nlines[$j][2]; # end line number $lnnum++; $line = $nlines[$j]; $xln = $lnmap{$lnnum}; @arr = split('-',$xln); $bgn = $arr[0]; $end = $arr[1]; @arr = space_split_local($line); $ac = scalar @arr; #$ratthash = line_2_hash_on_equals($line,$lnnum); #$tag = $attribs[0]; %atthash = array_2_hash_on_equals(@arr); $find = 'Name'; $Name = (defined $atthash{$find} ? strip_quotes($atthash{$find}) : ""); $rng = "$bgn,$end"; if ($line =~ /^<VisualStudioProject\s+/) { # <VisualStudioProject ProjectType="Visual C++" Version="8.00" Name="testmem" ProjectGUID="{05A9204E-6130-4347-8C31-7A063C09C276}" > $actname = $Name; $find = 'Version'; $actvers = (defined $atthash{$find} ? strip_quotes($atthash{$find}) : ""); prt( "\n[v9] $vcprojcnt: Project Name = $actname (MSVC $actvers)...\n" ) if ($dbg45 || VERB9()); } elsif ($line =~ /^<Configurations>$/) { $incfgs = 1; # set inside Configurations prt( "Enter $line\n" ) if ($showenter); } elsif ($line =~ /^<\/Configurations>$/) { $incfgs = 0; # exit Configurations prt( "Exit $line\n" ) if ($showenter); } elsif ($line =~ /^<Files>$/) { $infiles = 1; prt( "Enter $line\n" ) if ($showenter); } elsif ($line =~ /^<\/Files>$/) { $infiles = 0; prt( "Exit $line\n" ) if ($showenter); } elsif ($line =~ /^<Configuration\s+/) { # <Configuration Name="Release|Win32" OutputDirectory=".\Release" IntermediateDirectory=".\Release" ConfigurationType="1" InheritedPropertySheets="$(VCInstallDir)VCProjectDefaults\UpgradeFromVC60.vsprops" UseOfMFC="0" ATLMinimizesCRunTimeLibraryUsage="false" CharacterSet="2" > $actcfg = $Name; # get active CONFIG @tarr = split(/\|/,$actcfg); $ConfigurationName = $tarr[0]; $cfgcnt++; $incfg = 1; prt( "$vcprojcnt:$cfgcnt: Config Name = $actcfg ..\n" ) if ($dbg46); $key = $actname.'|'.$actcfg; $msg = $key; $find = 'ConfigurationType'; if (defined $atthash{$find}) { $tmp = strip_quotes($atthash{$find}); if (defined $cfgtypes{$tmp}) { $cfgtypes{$tmp}++; } else { $cfgtypes{$tmp} = 1; } $tmp = get_configurationtype($tmp); $msg .= " as [$tmp]"; } $find = "OutputDirectory"; if (defined $atthash{$find}) { $tmp = strip_quotes($atthash{$find}); $tmp =~ s/\$\(SolutionDir\)//; $tmp =~ s/\$\(ConfigurationName\)/$ConfigurationName/ if (length($ConfigurationName)); $msg .= " out='$tmp'"; } prt("[v1] $msg\n") if (VERB1()); if (length($actcfg) == 0) { $wmsg = "WARNING: Got Configuration WITHOUT NAME!!! file=$fil"; prtw( "$wmsg\n" ); } } elsif ($line =~ /^<\/Configuration>/) { prt( "$vcprojcnt:$cfgcnt: End Configuration ...\n" ) if ($dbg35); $key = $actname.'|'.$actcfg; if (($rnt == -1) && $is_osg_ex) { # known cases where NO runtime found } else { if (defined $rthash{$rnt}) { $rthash{$rnt}++; } else { $rthash{$rnt} = 1; } } if (defined $runtimes{$key}) { $wmsg = "WARNING: $key ALREADY EXISTS!!! file=$fil"; prtw( "$wmsg\n" ); } else { prt("[v9] Setting runtimes key [$key], and [$rnt]\n") if (VERB9()); $runtimes{$key} = $rnt; # keep the RUNTIME $rtlines{$key} = $rtrng; # and the RANGE of LINES $rtfiles{$key} = $fil; # and the FILE } $actcfg = "NO ACTIVE CONFIG!!!"; $incfg = 0; } elsif ($line =~ /^<Tool\s+(.*)/) { #} elsif ($line =~ /^<Tool\s+Name=\"VCLinkerTool\"\s+.+OutputFile=\"([\.\\\/\w]*)\"/) { $ln = $1; # get balance of line, after <Tool ... if ($incfgs) { # if ($ln =~ /\s*Name=\"VCCLCompilerTool\"\s*/) { if ($Name eq "VCCLCompilerTool") { # <Tool # Name="VCCLCompilerTool" # Optimization="2" # InlineFunctionExpansion="1" # AdditionalIncludeDirectories=".,..\src,..\src\Include,..\src\FDM\JSBSim,C:\Projects\simgear,E:\Projects\boost-trunk,c:\Projects\OSG\OpenSceneGraph-2.9.9\include,C:\PROGRA~1\OPENAL~1.1SD\include,C:\Projects\freealut-1.1.0-src\include,C:\Projects\zlib-1.2.3,C:\Projects\freeglut\include,C:\Projects\PLIB,.." # PreprocessorDefinitions="WIN32;_DEBUG;_CONSOLE;_CRT_SECURE_NO_WARNINGS;FGFS;OSG_LIBRARY_STATIC;OSG_PNG_ENABLED;HAVE_VERSION_H;_USE_MATH_DEFINES;_CRT_SECURE_NO_DEPRECATE;HAVE_CONFIG_H;NOMINMAX;FREEGLUT_STATIC;FREEGLUT_LIB_PRAGMAS=0;OPENALSDK;_SCL_SECURE_NO_WARNINGS;__CRT_NONSTDC_NO_WARNINGS;ALUT_STATIC_LIB" # StringPooling="true" # RuntimeLibrary="0" # EnableFunctionLevelLinking="true" # PrecompiledHeaderFile=".\Release/testmem.pch" # AssemblerListingLocation=".\Release/" # ObjectFile=".\Release/" # ProgramDataBaseFileName=".\Release/" # WarningLevel="3" # SuppressStartupBanner="true" # /> $find = 'RuntimeLibrary'; if (defined $atthash{$find}) { $rnt = strip_quotes($atthash{$find}); $rts = rt_2_switch($rnt); if ($incfg) { ###prt( "$vcprojcnt:$cfgcnt: Runtime = $rt ($rts) ... for $actcfg ($bgn,$end)\n" ); prt( "[v1] $vcprojcnt:$cfgcnt: Runtime=[$rnt] ($rts)... for $actcfg ($rng)\n" ) if ($dbg49 || VERB1()); $rtrng = $rng; } else { $wmsg = "WARNING: NOT IN CONFIG BLOCK!!! file=$fil"; prtw( "$wmsg\n$vcprojcnt:$cfgcnt: Runtime=[$rnt] ($rts)... for $actcfg ($rng)\n" ); } } else { if ( $is_osg_ex ) { prt("WARNING:1: RuntimeLibrary NOT FOUND! but not expected in file=$fil\n"); } else { prtw("WARNING:1: RuntimeLibrary NOT FOUND! file=$fil\n"); } } $find = 'PreprocessorDefinitions'; # like WIN32;NDEBUG;_WINDOWS" $actpp = (defined $atthash{$find} ? strip_quotes($atthash{$find}) : ""); if (length($actpp)) { $vcproj_defs{$fil} = { } if (!defined $vcproj_defs{$fil}); $rh = $vcproj_defs{$fil}; ${$rh}{$actcfg} = $actpp; prt( "[v2] $vcprojcnt:$cfgcnt: Preprocessor = $actpp\n" ) if ($dbg47 || VERB2()); } else { prt( "$vcprojcnt:$cfgcnt:$i:$ac: ZERO Preprocessor = $ln ($line)\n" ); } $find = 'AdditionalIncludeDirectories'; if (defined $atthash{$find}) { $tmp = trim_all(strip_quotes($atthash{$find})); if (length($tmp)) { $vcproj_incs{$fil} = { } if (!defined $vcproj_incs{$fil}); $rh = $vcproj_incs{$fil}; ${$rh}{$actcfg} = $tmp; } } $cmptoolcnt++; # } elsif ($ln =~ /\s*Name=\"VCLinkerTool\"\s*/ ) { } elsif ($Name eq "VCLinkerTool") { #prt( "$vcprojcnt:$cfgcnt: VCLinkerTool = $ln\n" ); # <Tool # Name="VCLinkerTool" # AdditionalDependencies=""$(PERL5_LIB)" libtidy.lib" # OutputFile="Tidy.dll" # LinkIncremental="1" # SuppressStartupBanner="true" # AdditionalLibraryDirectories="C:\Projects\Tidy\tidycvs\build\msvc\releaseDLL" # ProgramDatabaseFile=".\Release/Tidy.pdb" # ImportLibrary=".\Release/Tidy.lib" # TargetMachine="1" /> $find = 'OutputFile'; if (defined $atthash{$find}) { $tmp = strip_quotes($atthash{$find}); $tmp =~ s/\$\(ProjectName\)/$actname/ if (length($actname)); prt( "[v5] $vcprojcnt:$cfgcnt:Link: Output = [$tmp]\n" ) if ($dbg50 || VERB5()); } @adld = (); for ($i = 0; $i < $ac; $i++) { $ln = $arr[$i]; # AdditionalLibraryDirectories="C:\Projects\Tidy\tidycvs\build\msvc\releaseDLL" if ($ln =~ /AdditionalLibraryDirectories=/) { $ind = index($ln,'"'); if ($ind > 0) { $ln = strip_quotes(substr($ln,$ind)); @adld = space_split_local($ln); } last; } } for ($i = 0; $i < $ac; $i++) { $ln = $arr[$i]; ###} elsif ($ln =~ /AdditionalDependencies="([&;\$\(\)\.\\\/\w]+)"/) { if ($ln =~ /AdditionalDependencies=/) { $ind = index($ln,'"'); if ($ind > 0) { $ln = strip_quotes(substr($ln,$ind)); @arr2 = space_split_local($ln); prt( "$vcprojcnt:$cfgcnt: AdditionalDependencies = \n" ) if ($dbg52); for (my $k = 0; $k < scalar @arr2; $k++) { $ln = $arr2[$k]; $ln =~ s/"/"/g; $ln = strip_quotes($ln); # eek, $key not yet done $wmsg = "$rnt: "; # if it LOOKS like an ENVIRONMENT variable if ($ln =~ /^\$\((.+)\)/) { $tmp1 = $1; $tmp2 = $ENV{$tmp1}; if (defined $tmp2) { $ln = $tmp2; } } $wmsg .= $ln; if (-f $ln) { $wmsg .= ' ok'; } elsif (@adld) { foreach $tmp1 (@adld) { $tmp2 = $tmp1; $ch = substr($tmp1,-1); if (($ch ne '/')&&($ch ne "\\")) { $tmp2 .= "\\"; } $tmp2 .= $ln; if (-f $tmp2) { $wmsg .= ' ok'; last; } } } prt( "$wmsg\n" ) if ($dbg52); } } else { prt( "$vcprojcnt:$cfgcnt: AdditionalDependencies = $ln\n" ) if ($dbg52); } } } $find = 'AdditionalDependencies'; if (defined $atthash{$find}) { $tmp = trim_all(strip_quotes($atthash{$find})); if (length($tmp)) { $vcproj_libs{$fil} = { } if (!defined $vcproj_libs{$fil}); $rh = $vcproj_libs{$fil}; ${$rh}{$actcfg} = $tmp; } } $find = 'AdditionalLibraryDirectories'; if (defined $atthash{$find}) { $tmp = trim_all(strip_quotes($atthash{$find})); if (length($tmp)) { $vcproj_linc{$fil} = { } if (!defined $vcproj_linc{$fil}); $rh = $vcproj_linc{$fil}; ${$rh}{$actcfg} = $tmp; } } #} elsif ($ln =~ /\s*Name=\"VCLibrarianTool\"\s*/ ) { } elsif ($Name eq "VCLibrarianTool") { $find = 'OutputFile'; if (defined $atthash{$find}) { $tmp = strip_quotes($atthash{$find}); $tmp =~ s/\$\(ProjectName\)/$actname/ if (length($actname)); prt( "[v5] $vcprojcnt:$cfgcnt:Lib: Output = [$tmp]\n" ) if ($dbg50 || VERB5()); } } } } elsif ($infiles) { if ($line =~ /^<Filter\s+(.*)/) { # <Filter Name="Source Files" Filter="cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" > $ln = $1; $grpname = ''; $grpfilter = ''; for ($i = 0; $i < $ac; $i++) { $ln = $arr[$i]; if ($ln =~ /\s*Name=\"(.*)\"/) { $grpname = $1; } elsif ($ln =~ /\s*Filter=\"(.*)\"/) { $grpfilter = $1; } } prt( "Filter for \"$grpname\" = [$grpfilter]\n" ) if ($showfilter); $ingrp = 1; } elsif ($line =~ /^<\/Filter.*/) { $ingrp = 0; } elsif ($line =~ /^<File\s+(.*)/) { #<File RelativePath="sprtf.cxx" > $ln = $1; $grpfile = ''; for ($i = 0; $i < $ac; $i++) { $ln = $arr[$i]; if ($ln =~ /\s*RelativePath=\"(.*)\"/) { $grpfile = $1; $ff = $fdir.$grpfile; $msg = ((-f $ff) ? "ok" : "NOT FOUND"); prt( "File \"$grpfile\" $msg\n" ) if ($showfiles); push(@vcsrcs, $ff); push(@srcs,$grpfile); last; } } prtw("WARNING: RelativePath NOT FOUND\n") if (length($grpfile) == 0); } } } prtw("WARNING: NO CONFIGURATIONS BLOCKS!!! file=$fil") if ($cfgcnt == 0); $cfgcnt = scalar @vcsrcs; prtw("WARNING: file=$fil has NO SOURCES!\n") if ($cfgcnt == 0); prtw("WARNING: NO COMPILER TOOL FOUND!!! file=$fil") if ($cmptoolcnt == 0); push(@src_list, [ $actname, [@vcsrcs], $fil, [@srcs] ]); if (length($new_runtime) || length($characterset)) { modify_vcproj_runtime(\%hash); } if (VERB1()) { $ac = 0; foreach $key (keys %cfgtypes) { $ac += $cfgtypes{$key}; } prt("[v1] For $ac configs "); foreach $key (keys %cfgtypes) { $ac = $cfgtypes{$key}; $tmp = get_configurationtype($key); prt("$ac=[$tmp] "); } prt("\n"); } return $cnt; } sub unix_2_dos { my ($f) = shift; $f =~ s/\//\\/g; return $f; } sub fix_rel { my ($path) = shift; $path = unix_2_dos( $path ); my @a = split(/\\/, $path); my $npath = ''; 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 { prtw( "WARNING: Got relative .. without previous!!!\n" ); } } else { push(@na,$p); } } foreach my $pt (@na) { $npath .= "\\" if length($npath); $npath .= $pt; } return $npath; } sub reline_xml { my (@lns) = @_; my ($i, $ln, $len, $j, $ch, $bgn, $end); my $cnt = scalar @lns; my $nline = ''; my @nlines = (); for ($i = 0; $i < $cnt; $i++) { $ln = trim_all( $lns[$i] ); $len = length($ln); for ($j = 0; $j < $len; $j++) { $ch = substr($ln,$j,1); $bgn = $i if (length($nline) == 0); $nline .= $ch; if ($ch eq '>') { $end = $i; push(@nlines, [$nline, $bgn, $end]); ###prt( "push(\@nlines, [$nline, $bgn, $end])\n" ); $nline = ''; } } $nline .= ' ' if (length($nline)); } push(@nlines, [$nline, $bgn, $end]) if length($nline); return @nlines; } sub xml_to_lines($$$) { my ($in_file, $rlm, @lns) = @_; my $intag = 0; my $text = ''; # gather TEXT between tags my @nlines = (); my ($fln, $ln, $ch, $pch, $nch, $len, $i, $i2, $tag, $xml, $dnx); my ($lnnm, $lnb, $nlnm); my ($ppch, $incomm); my $show_comm_dbg = 0; $pch = ''; $ppch = ''; $nch = ''; $tag = ''; $xml = ''; $dnx = 0; $lnnm = 0; $nlnm = 0; $lnb = 0; $incomm = 0; $text = ''; # start NO TEXT foreach $fln (@lns) { chomp $fln; $ln = trim_all($fln); $len = length($ln); $lnnm++; # count another xml line for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $ch = substr($ln,$i,1); $nch = (($i2 < $len) ? substr($ln,$i2,1) : ' '); if ($intag) { # on first GREATER THAN - SPACE $tag .= $ch; if ($ch eq '>') { if ( $incomm ) { prt("$lnnm: potential end of XML tag pch=$pch ppch=$ppch\n") if ($show_comm_dbg); if (($pch eq '-') && ($ppch eq '-')) { $nlnm++; push(@nlines,$tag); ### prt( "push(\@xlnmap, [ $nlnm, $lnb, $lnnm ]); # each NEW line has BEGIN and END\n" ); $$rlm{$nlnm} = "$lnb-$lnnm"; # each NEW line has BEGIN and END $tag = ''; $intag = 0; $xml = ''; $incomm = 0; prt( "$lnnm: Exit comment [$ln]\n" ) if ($show_comm_dbg); } } else { $nlnm++; push(@nlines,$tag); ### prt( "push(\@xlnmap, [ $nlnm, $lnb, $lnnm ]); # each NEW line has BEGIN and END\n" ); $$rlm{$nlnm} = "$lnb-$lnnm"; # each NEW line has BEGIN and END $tag = ''; $intag = 0; $xml = ''; $incomm = 0; } } } else { if ($ch eq '<') { if (length($text)) { $nlnm++; push(@nlines,$text); $$rlm{$nlnm} = "$lnb-$lnnm"; # each NEW line has BEGIN and END $text = ''; } $tag = $ch; # start a tag line $intag = 1; # signal in a tag $xml = ''; $dnx = 0; $lnb = $lnnm; # set the BEGIN xml line if ($nch eq '!') { # but watch out for <!DOCTYPE ...> if ($ln =~ /<!--/) { prt( "$lnnm: Entering comment [$ln]\n" ) if ($show_comm_dbg); $incomm = 1; } } } else { $text .= $ch; } } $ppch = $pch; $pch = $ch; } # done a line - this is like a SPACE if ($intag && length($tag)) { $tag .= ' ' if !($tag =~ /(=|\s)$/); } } prtw("WARNING: Exit STILL in comment!\n") if ($incomm); if (length($tag)) { prtw("WARNING: xml re-lining error! Left pending tag [$tag]\nin $in_file file ...\n"); } return @nlines; } sub rt_2_switch($) { my ($rt) = shift; if ($rt == 0) { return "Multi-threaded (/MT)"; } elsif ($rt == 1) { return "Multi-threaded Debug (/MTd)"; } elsif ($rt == 2) { return "Multi-threaded DLL (/MD)"; } elsif ($rt == 3) { return "Multi-threaded Debug DLL (/MDd)"; } return "rt=[$rt]???"; } ######################################### ### DSP handling sub chkrt_strip_quotes { my ($ln) = shift; if ($ln =~ /^".*"$/) { $ln = substr($ln,1,length($ln)-2); } return $ln; } sub expand_mac { my ($m) = shift; if (defined $macros{$m}) { return $macros{$m}; } return $m; } sub do_if_split { my ($ife) = shift; my @arr = split(/==/,$ife); my ($msg); if (scalar @arr == 2) { my $if0 = strip_quotes(trim_all($arr[0])); my $if1 = strip_quotes(trim_all($arr[1])); prt( "Split is [$if0] == [$if1]\n" ) if ($dbg6); if ($if0 =~ /^\$\((.+)\)$/) { my $mac = $1; my $emac = expand_mac($mac); if ($emac eq $if1) { prt( "Or [$emac] == [$if1] = TRUE\n" ) if ($dbg6); return "TRUE"; } else { prt( "Or [$emac] == [$if1] = FALSE\n" ) if ($dbg6); return "FALSE"; } } } else { $msg = "WARNING: Did NOT split! [$ife] - returning UNDETERMINED"; prtw( "$msg\n" ); } return "UNDETERMINED"; } sub flip_state { my ($st) = shift; if ($st eq 'TRUE') { $st = 'FALSE'; } elsif ($st eq 'FALSE') { $st = 'TRUE'; } return $st; } sub clear_per_dsp { %macros = (); # clear DSP macro set %dspmacros = (); $customdbg = ''; $custonrel = ''; } # scan the line, look for clues of the RUNTIME # and other things ... # it seems when MSVC8 loads and converts this MSVC6 file, # it will DEFAULT to /MT or /MTd if nothing is found. sub get_runtime { my ($txt) = shift; my $tl = length($txt); my $rt = 'Unknown'; my $tag = ''; ###my $crt = 'S'; my $crt = 'T'; # if NONE, default to this ... my $isdbg = -1; for (my $i = 0; $i < $tl; $i++) { my $ch = substr($txt,$i,1); if ($ch eq '/') { # got SWITCH $i++; for ( ; $i < $tl ; $i++) { $ch = substr($txt,$i,1); if ($ch eq 'D') { # got /D $i++; for ( ; $i < $tl ; $i++) { $ch = substr($txt,$i,1); if ($ch eq '"') { # got PARAM $i++; $tag = ''; for ( ; $i < $tl ; $i++) { $ch = substr($txt,$i,1); if ($ch eq '"') { last; # exit next SPACE } $tag .= $ch; } if ($tag eq '_DEBUG') { $isdbg = 1; } elsif ($tag eq 'NDEBUG') { $isdbg = 0; } last; # end /D "something" } } } elsif ($ch eq 'M') { # got /M $i++; my $ccrt = ''; for ( ; $i < $tl ; $i++) { $ch = substr($txt,$i,1); if ($ch eq 'D') { $crt = 'D'; $ccrt = 'D'; } elsif ($ch eq 'T') { $crt = 'T'; $ccrt = 'T'; } elsif ( ($ch eq 'd') && length($ccrt) ) { $isdbg = 1; } elsif ($ch =~ /\s/) { last; # exit on SPACE } } } } } } if ($crt eq 'S') { $rt = 'Single-thread'; } elsif ($crt eq 'D') { $rt = 'Multithreaded DLL'; } else { $rt = 'Multithreaded'; } if ($isdbg == 1) { $rt .= ' Debug'; } elsif ($isdbg == 0) { $rt .= ' Release'; } return $rt; } sub get_rtnum { my ($txt) = shift; my $rtn = 0; if ($txt =~ /DLL/) { if ($txt =~ /Debug/) { $rtn = 3; } else { $rtn = 2; } } else { if ($txt =~ /Debug/) { $rtn = 1; } else { $rtn = 0; } } return $rtn; } sub get_hyphen_split($) { my ($prop) = @_; my @arr = split("-",$prop); my $cnt = scalar @arr; for (my $i = 0; $i < $cnt; $i++) { $arr[$i] = trim_all($arr[$i]); } return @arr; } sub get_space_split_2($) { my ($cfg) = @_; my @arr = split(/\s/,$cfg); my $prj = $arr[0]; my $cfnm = ""; my $max = scalar @arr; if ($max > 1) { $cfnm = $arr[1]; for (my $j = 2; $j < $max; $j++) { $cfnm .= ' '; $cfnm .= $arr[$j]; } } my @narr = (); push(@narr,$prj); push(@narr,$cfnm); return @narr; } sub change_the_runtime($$$) { my ($fil,$rdlns,$rrtchg) = @_; # \@dlns,\@rtchange; if (length($new_runtime)) { my ($lncnt,$key,$len,$i,$is_debug,$fline,$line,$val,$i2); $lncnt = scalar @{$rrtchg}; if ($lncnt && (($new_runtime eq 'D')||($new_runtime eq 'T'))) { if ($new_runtime eq 'D') { $key = '/MD'; } elsif ($new_runtime eq 'T') { $key = '/MT'; } prt("Changing RUNTIME to [$key] ($new_runtime), on $lncnt lines...\n"); $len = 0; for ($i = 0; $i < $lncnt; $i++) { $i2 = ${$rrtchg}[$i][0]; $is_debug = ${$rrtchg}[$i][1]; $fline = ${$rdlns}[$i2]; # extract the LINE $line = $fline; if ($new_runtime eq 'D') { $key = '/MD'; $val = '/MT'; } elsif ($new_runtime eq 'T') { $key = '/MT'; $val = '/MD'; } if ($is_debug == 1) { $key .= 'd'; $val .= 'd'; } $fline =~ s/$val/$key/; if ($line ne $fline) { ${$rdlns}[$i2] = $fline; $len++; } } if ($len) { $key = $perl_root."\\temp$tot_dsp_count.dsp"; write2file(join("",@{$rdlns})."\n",$key); prt("Written changed $len lines to [$key]...\n"); $update_bat .= "\@copy $key $fil\n"; } else { prtw("WARNING: Processed $lncnt lines, BUT NO CHANGES made!\n"); } } else { if ($lncnt) { prtw("WARNING: No RUNTIME change, due new_runtime not 'T' or 'D'! It is [$new_runtime]\n"); } else { prtw("WARNING: No RUNTIME lines found, so no change to [$new_runtime]!\n"); } } } } # ========================================================= # Load a DSP file # =============== # # ADD CPP /nologo /MT /W3 /GR /GX /O2 /I "." /I "..\src" /I "..\src\Include" # /I "..\src\FDM\JSBSim" /I "C:\Projects\simgear" /I "E:\Projects\boost-trunk" # /I "c:\Projects\OSG\OpenSceneGraph-2.9.9\include" /I "C:\PROGRA~1\OPENAL~1.1SD\include" # /I "C:\Projects\freealut-1.1.0-src\include" /I "C:\Projects\zlib-1.2.3" # /I "C:\Projects\freeglut\include" /I "C:\Projects\PLIB" /I ".." # /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_CRT_SECURE_NO_WARNINGS" # /D "FGFS" /D "OSG_LIBRARY_STATIC" /D "OSG_PNG_ENABLED" /D "HAVE_VERSION_H" # /D "_USE_MATH_DEFINES" /D "_CRT_SECURE_NO_DEPRECATE" /D "HAVE_CONFIG_H" # /D "NOMINMAX" /D "FREEGLUT_STATIC" /D "FREEGLUT_LIB_PRAGMAS=0" /D "OPENALSDK" # /D "_SCL_SECURE_NO_WARNINGS" /D "__CRT_NONSTDC_NO_WARNINGS" /D "ALUT_STATIC_LIB" /FD /c sub get_cpp_defines($) { my ($line) = shift; my $defs = ''; my ($len,$i,$ch,$pc,$def,$i2,$nc); $len = length($line); $def = ''; $ch = ''; #prt("Get DEFINES from [$line]\n"); for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $pc = $ch; $ch = substr($line,$i,1); $nc = ($i2 < $len) ? substr($line,$i2,1) : ""; if (($ch eq 'D')&&(($pc eq '/')||($pc eq '-'))) { # start a DEFINE while (($i2 < $len)&&($ch ne '"')) { $i++; $i2 = $i + 1; $ch = substr($line,$i,1); } if ($ch eq '"') { $i++; $def = ''; for (; $i < $len; $i++) { $ch = substr($line,$i,1); last if ($ch eq '"'); $def .= $ch; } if (($ch ne '"')||(length($def)==0)) { prtw("WARNING: DEFS Ran out of char waiting for 2nd '\"'! line=[$line]\n"); return $defs; } $defs .= ';' if (length($defs)); $defs .= $def; } else { prtw("WARNING: DEFS Ran out of char waiting for '\"'! line=[$line]\n"); return $defs; } } } #prt("Got DEFINES [$defs]\n"); return $defs; } # # ADD CPP /nologo /MT /W3 /GR /GX /O2 /I "." /I "..\src" /I "..\src\Include" # /I "..\src\FDM\JSBSim" /I "C:\Projects\simgear" /I "E:\Projects\boost-trunk" # /I "c:\Projects\OSG\OpenSceneGraph-2.9.9\include" /I "C:\PROGRA~1\OPENAL~1.1SD\include" # /I "C:\Projects\freealut-1.1.0-src\include" /I "C:\Projects\zlib-1.2.3" # /I "C:\Projects\freeglut\include" /I "C:\Projects\PLIB" /I ".." # /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_CRT_SECURE_NO_WARNINGS" # /D "FGFS" /D "OSG_LIBRARY_STATIC" /D "OSG_PNG_ENABLED" /D "HAVE_VERSION_H" # /D "_USE_MATH_DEFINES" /D "_CRT_SECURE_NO_DEPRECATE" /D "HAVE_CONFIG_H" # /D "NOMINMAX" /D "FREEGLUT_STATIC" /D "FREEGLUT_LIB_PRAGMAS=0" /D "OPENALSDK" # /D "_SCL_SECURE_NO_WARNINGS" /D "__CRT_NONSTDC_NO_WARNINGS" /D "ALUT_STATIC_LIB" /FD /c sub get_cpp_incdirs($) { my ($line) = shift; my $defs = ''; my ($len,$i,$ch,$pc,$def,$i2,$nc); $len = length($line); $def = ''; $ch = ''; #prt("Get DIRS from [$line]\n"); for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $pc = $ch; $ch = substr($line,$i,1); $nc = ($i2 < $len) ? substr($line,$i2,1) : ""; if (($ch eq 'I')&&(($pc eq '/')||($pc eq '-'))) { # start a DEFINE while (($i2 < $len)&&($ch ne '"')) { $i++; $i2 = $i + 1; $ch = substr($line,$i,1); } if ($ch eq '"') { $i++; $def = ''; for (; $i < $len; $i++) { $ch = substr($line,$i,1); last if ($ch eq '"'); $def .= $ch; } if (($ch ne '"')||(length($def)==0)) { prtw("WARNING: DIRS Ran out of char waiting for 2nd '\"'! line=[$line]\n"); return $defs; } $defs .= ';' if (length($defs)); $defs .= $def; } else { prtw("WARNING: DIRS Ran out of char waiting for '\"'! line=[$line]\n"); return $defs; } } } #prt("Got DIRS [$defs]\n"); return $defs; } # # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib # shell32.lib ole32.lib oleaut32.lib uuid.lib OpenAl32.lib Winmm.lib ws2_32.lib # /libpath:"C:\PROGRA~1\OPENAL~1.1SD\libs\Win32" /libpath:"C:\Projects\freealut-1.1.0-src\msvc\lib" # libalut.lib libsgenvironment_a.lib libsgio_a.lib libsgbucket_a.lib libsgmisc_a.lib # libsgstructure_a.lib libsgdebug_a.lib # /libpath:"C:\Projects\simgear\msvc\lib" /nologo /subsystem:console /machine:I386 # /out:"bin\metar.exe" sub get_link_libs($) { my ($line) = @_; my ($len,$i,$ch,$pc,$lib,$i2,$nc); $line =~ s/\#//; $line =~ s/ADD//; $line =~ s/BASE//; $line =~ s/LINK32//; $len = length($line); my $libs = ''; for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $pc = $ch; $ch = substr($line,$i,1); $nc = ($i2 < $len) ? substr($line,$i2,1) : ""; if ( ($ch ne '/') && ($ch =~ /\w/) && ($pc =~ /\s/) ) { $lib = $ch; $i++; for (; $i < $len; $i++) { $ch = substr($line,$i,1); last if ($ch =~ /\s/); $lib .= $ch; } if (($ch =~ /\s/) && (length($lib) > 1)) { $libs .= " " if (length($libs)); $libs .= $lib; } else { prtw("WARNING: Error getting libs from [$line]\n"); return $libs; } } } return $libs; } # # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib # shell32.lib ole32.lib oleaut32.lib uuid.lib OpenAl32.lib Winmm.lib ws2_32.lib # /libpath:"C:\PROGRA~1\OPENAL~1.1SD\libs\Win32" /libpath:"C:\Projects\freealut-1.1.0-src\msvc\lib" # libalut.lib libsgenvironment_a.lib libsgio_a.lib libsgbucket_a.lib libsgmisc_a.lib # libsgstructure_a.lib libsgdebug_a.lib # /libpath:"C:\Projects\simgear\msvc\lib" /nologo /subsystem:console /machine:I386 # /out:"bin\metar.exe" sub get_link_dirs($) { my ($line) = @_; my ($len,$i,$ch,$pc,$def,$i2,$nc); $len = length($line); my $dirs = ''; $ch = ''; #prt("Get DIRS from [$line]\n"); for ($i = 0; $i < $len; $i++) { $i2 = $i + 1; $pc = $ch; $ch = substr($line,$i,1); $nc = ($i2 < $len) ? substr($line,$i2,1) : ""; if (($ch eq 'l')&&($nc eq 'i')&&(($pc eq '/')||($pc eq '-'))&&(substr($line,$i) =~ /^libpath:/)) { # start of a library path $i += 8; # $nc = substr($line,$i); $ch = substr($line,$i,1); if ($ch eq '"') { $i++; $def = ''; for (; $i < $len; $i++) { $ch = substr($line,$i,1); last if ($ch eq '"'); $def .= $ch; } if ( ($ch eq '"') && (length($def) > 0) ) { $dirs .= ";" if (length($dirs)); $dirs .= $def; } else { prtw("WARNING: Ran out fo chars waiting for 2nd \", line [$line]\n"); } } } } # pgm_exit(1,"Ok, got [$dirs]\n"); return $dirs; } sub load_dsp { my ($f) = shift; my @dlns = (); my $lncnt = 0; my @dsrcs = (); my @srcs = (); my $msg = ''; if (open FH, "<$f") { @dlns = <FH>; close FH; $lncnt = scalar @dlns; prt( "File $f contains $lncnt lines ...\n" ) if ($dbg11); } else { $msg = "WARNING: FAILED to OPEN [$f] ... $! ..."; prtw( "$msg\n" ); return @dsrcs; } $tot_dsp_count++; my $intarg = 0; my @arr = (); my $intrue = 0; my $inanif = 0; my $package = ''; my $insrc = 0; my $group = ''; my $ifstate = "INDETERMINATE"; my $prop = ''; my $ifstr = ''; my $form = ''; my $rtdebug = ''; my $rtrelease = ''; my $targtyp = ''; my $targw = ''; my ($rt, $rtc, $rngdbg, $rngrel, $rtn, $rtdbg, $rtrel, $wmsg); my ($dsp_name, $dsp_dir) = fileparse( $f ); clear_per_dsp(); # like %macros = (); # clear DSP macro set etc my ($i,$fline,$line,$ccnt,$prj,$cfg,$wtyp,$cfnm,$max,$j,$i2); my ($is_debug,$tmp,$rh,$actcfg); $ccnt = 0; $prj = ''; $actcfg = ''; my %cfghash = (); my %cfghash2 = (); my @rtchange = (); # list of (DSP) RUNTIME lines to CHANGE # pre-process # Begin Target # Name "testap6 - Win32 Release" # Name "testap6 - Win32 Debug" # Name "testap6 - Win32 Debug_MD" # Name "testap6 - Win32 Release_MD" $intarg = 0; for ($i = 0; $i < $lncnt; $i++) { $i2 = $i + 1; $fline = $dlns[$i]; # extract the LINE chomp $fline; $line = trim_tail($fline); if ($intarg) { if ($line =~ /^#\s+End\s+Target/) { $intarg = 0; } elsif ($line =~ /^#\s+Name\s+"(.+)"/) { $prop = $1; @arr = get_hyphen_split($prop); $ccnt++; if (length($prj)) { if ($prj ne $arr[0]) { prtw("WARNING: Next project name $arr[0] NOT same as [$prj]\n"); } } else { $prj = $arr[0]; } $cfg = $arr[1]; @arr = get_space_split_2($cfg); $wtyp = $arr[0]; $cfnm = $arr[1]; $actcfg = $wtyp."|".$cfnm; prt("[$actcfg]\n") if ($dbg56); if (defined $cfghash{$actcfg}) { prtw("WARNING: [$actcfg] already exists...\n"); } else { $cfghash{$actcfg} = 1; } } } else { if ($fline =~ /^#\s+Begin\s+Target/) { $intarg = 1; } else { # ignore these messages # !MESSAGE "testap6 - Win32 Release" (based on "Win32 (x86) Console Application") # !MESSAGE "testap6 - Win32 Debug" (based on "Win32 (x86) Console Application") # !MESSAGE "testap6 - Win32 Debug_MD" (based on "Win32 (x86) Console Application") # !MESSAGE "testap6 - Win32 Release_MD" (based on "Win32 (x86) Console Application") # pick up on the IF # !IF "$(CFG)" == "testap6 - Win32 Release" # !ELSEIF "$(CFG)" == "testap6 - Win32 Debug" # !ELSEIF "$(CFG)" == "testap6 - Win32 Debug_MD" # !ELSEIF "$(CFG)" == "testap6 - Win32 Release_MD" # !ENDIF if ($fline =~ /^!(I|E){1}(F|L|N){1}.+\s+==\s+"(.+)"/) { prt("[$1][$2] - $fline [$3]\n") if ($dbg55); $prop = $3; @arr = get_hyphen_split($prop); $ccnt++; if (length($prj)) { if ($prj ne $arr[0]) { prtw("WARNING: Next project name $arr[0] NOT same as [$prj]\n"); } } else { $prj = $arr[0]; } $cfg = $arr[1]; @arr = get_space_split_2($cfg); $wtyp = $arr[0]; $cfnm = $arr[1]; $actcfg = $wtyp."|".$cfnm; prt("[$actcfg]\n") if ($dbg56); if (defined $cfghash2{$actcfg}) { prtw("WARNING: [$actcfg] already exists...\n"); } else { $cfghash2{$actcfg} = 1; } } } } } $intarg = 0; $is_debug = 2; for ($i = 0; $i < $lncnt; $i++) { $i2 = $i + 1; $fline = $dlns[$i]; # extract the LINE chomp $fline; $line = trim_tail($fline); if ( $line =~ /$COMMENT_PATTERN/ ) { # starts with '#' $line = substr($line,1); if ($line =~ /\s+Microsoft\s+Developer\s+Studio\s+Project\s+File\s-\sName="(\w+)"\s+/ ) { $package = $1; $projcount++; } elsif ($line =~ /Microsoft Developer Studio Generated Build File, Format Version 6.00/) { # ignored } elsif (($line =~ /\*\* DO NOT EDIT \*\*/)||($line =~ /\*\*\s+NICHT\s+BEARBEITEN\s+\*\*/)) { # ignored } elsif ($line =~ /^\s+TARGTYPE\s+"(.*)"\s+/) { # # TARGTYPE "Win32 (x86) Console Application" 0x0103 $targtyp = $1; @arr = split(/\s/, $targtyp); $targw = $arr[0]; prt( "$package TARGET: $targtyp\n" ) if (VERB1()); } elsif ($line =~ /^\s+Begin\s+Target/) { $intarg = 1; } elsif ($line =~ /^\s+End\s+Target/) { $intarg = 0; } elsif ($line =~ /^\s+Begin\s+Group\s+(.+)/) { # like "Source Files" $group = strip_quotes($1); prt( "Begin Group: $1\n" ) if ($dbg10); } elsif ($line =~ /^\s+End\s+Group/) { $group = ''; } elsif ($line =~ /\s*Begin\s+Project/ ) { } elsif ($line =~ /\s*End\s+Project/ ) { } elsif ($line =~ /Begin\s+Special\s+Build\s+Tool/) { } elsif ($line =~ /End\s+Special\s+Build\s+Tool/) { } elsif ($line =~ /\s*Name\s+(.+)/) { } elsif ($line =~ /\s*Begin\s+Source\s+File/) { $insrc = 1; } elsif ($line =~ /\s*End\s+Source\s+File/) { $insrc = 0; } elsif ($line =~ /\s*PROP\s+(.*)/) { # like '# PROP BASE Use_Debug_Libraries 1' $prop = $1; if ($prop =~ /\s*BASE\s+(.*)/) { $prop = $1; } if ($prop =~ /Use_Debug_Libraries\s+(\d+)/) { prt( "Use_Debug_Libraries $1\n" ) if ($dgb32); } if ($excl_excluded && $insrc) { # PROP Exclude_From_Build 1 if ($prop =~ /Exclude_From_Build\s+(\d+)/) { if ($1) { if (@dsrcs) { my $ls = pop(@dsrcs); push(@discardedsrcs, [$ls, $package, $f]); prt( "Discarding [$ls] due to Exclude_From_Build ...\n" ) if ($dbg30); } pop @srcs if (@srcs); } } } } elsif ($line =~ /\s*ADD\s+(.*)/) { # like '# ADD BASE CPP /nologo /W3 /Gm /GX /ZI /Od /D # and '# ADD CPP /nologo /MDd ... # # ADD CPP /nologo /MT /W3 /GR /GX /O2 /I "." /I "..\src" /I "..\src\Include" /I "..\src\FDM\JSBSim" /I "C:\Projects\simgear" /I "E:\Projects\boost-trunk" /I "c:\Projects\OSG\OpenSceneGraph-2.9.9\include" /I "C:\PROGRA~1\OPENAL~1.1SD\include" /I "C:\Projects\freealut-1.1.0-src\include" /I "C:\Projects\zlib-1.2.3" /I "C:\Projects\freeglut\include" /I "C:\Projects\PLIB" /I ".." /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /D "_CRT_SECURE_NO_WARNINGS" /D "FGFS" /D "OSG_LIBRARY_STATIC" /D "OSG_PNG_ENABLED" /D "HAVE_VERSION_H" /D "_USE_MATH_DEFINES" /D "_CRT_SECURE_NO_DEPRECATE" /D "HAVE_CONFIG_H" /D "NOMINMAX" /D "FREEGLUT_STATIC" /D "FREEGLUT_LIB_PRAGMAS=0" /D "OPENALSDK" /D "_SCL_SECURE_NO_WARNINGS" /D "__CRT_NONSTDC_NO_WARNINGS" /D "ALUT_STATIC_LIB" /FD /c # # ADD BASE LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib /nologo /subsystem:console /machine:I386 # # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib OpenAl32.lib Winmm.lib ws2_32.lib /libpath:"C:\PROGRA~1\OPENAL~1.1SD\libs\Win32" /libpath:"C:\Projects\freealut-1.1.0-src\msvc\lib" libalut.lib libsgenvironment_a.lib libsgio_a.lib libsgbucket_a.lib libsgmisc_a.lib libsgstructure_a.lib libsgdebug_a.lib /libpath:"C:\Projects\simgear\msvc\lib" /nologo /subsystem:console /machine:I386 /out:"bin\metar.exe" $prop = $1; if (($line =~ /ADD\s+BASE\s+/) && ($i2 < $lncnt) && ($dlns[$i2] =~ /ADD\s+CPP\s+/)) { # NEXT line for saving the RUNTIME - NOT THIS BASE next; # just use the NEXT line } if (($line =~ /ADD\s+BASE\s+LINK32/) && ($i2 < $lncnt) && ($dlns[$i2] =~ /ADD\s+LINK32\s+/)) { # NEXT line for saving the LINK - NOT THIS BASE next; # just use the NEXT line } if ($prop =~ /\s*BASE\s+(.*)/) { $prop = $1; } if ($prop =~ /CPP\s+(.*)/) { $rt = $1; $rtc = get_runtime($rt); $rtn = get_rtnum($rtc); if (defined $rthash{$rtn}) { $rthash{$rtn}++; } else { $rthash{$rtn} = 1; } push(@rtchange,[$i,$is_debug]); # save RUNTIME line to change prt( "RUNTIME: $form $rt\n" ) if ($dgb33); if ($form eq 'Debug') { $rtdebug = $rtc; $rngdbg = $i + 1; $rtdbg = $rtn; } elsif ($form eq 'Release') { $rtrelease = $rtc; $rngrel = $i + 1; $rtrel = $rtn; } $cfghash2{$actcfg} = $rtc; # time to get the CPP additional INC DIRS, and DEFINES $tmp = get_cpp_defines($line); if (length($tmp) && length($actcfg) ) { $vcproj_defs{$f} = { } if (!defined $vcproj_defs{$f}); $rh = $vcproj_defs{$f}; ${$rh}{$actcfg} = $tmp; } else { prtw("WARNING: NO DEFINES for config [$actcfg]!\n"); } $tmp = get_cpp_incdirs($line); if (length($tmp) && length($actcfg) ) { $vcproj_incs{$f} = { } if (!defined $vcproj_incs{$f}); $rh = $vcproj_incs{$f}; ${$rh}{$actcfg} = $tmp; } } elsif ($prop =~ /LINK32\s+(.*)/) { # time to get the LINKER additional LIBS, and INC DIRS $tmp = get_link_libs($line); if (length($tmp) && length($actcfg)) { $vcproj_libs{$f} = { } if (!defined $vcproj_libs{$f}); $rh = $vcproj_libs{$f}; ${$rh}{$actcfg} = $tmp; } $tmp = get_link_dirs($line); if (length($tmp) && length($actcfg)) { $vcproj_linc{$f} = { } if (!defined $vcproj_linc{$f}); $rh = $vcproj_linc{$f}; ${$rh}{$actcfg} = $tmp; } } } elsif ($line =~ /\s*SUBTRACT\s+(.*)/) { $prop = $1; } elsif ($line =~ /\s*Begin\s+Custom\s+Build(.*)/) { $msg = $1; $i++; for (; $i < $lncnt; $i++) { $fline = $dlns[$i]; # extract the LINE chomp $fline; $line = trim_tail($fline); $msg .= "\n$fline"; if ($line =~ /\s*End\s+Custom\s+Build/) { last; } } } else { $msg = "WARNING: Line [$line] not handled!"; prtw("$msg\n"); } } elsif ($line =~ /^!/ ) { # starts with '!' if ($fline =~ /^!(I|E){1}(F|L|N){1}.+\s+==\s+"(.+)"/) { prt("[$1][$2] - $fline [$3]\n") if ($dbg55); $prop = $3; @arr = get_hyphen_split($prop); $ccnt++; if (length($prj)) { if ($prj ne $arr[0]) { prtw("WARNING: Next project name $arr[0] NOT same as [$prj]\n"); } } else { $prj = $arr[0]; } $cfg = $arr[1]; @arr = get_space_split_2($cfg); $wtyp = $arr[0]; $cfnm = $arr[1]; $actcfg = $wtyp."|".$cfnm; prt("[$actcfg]\n") if ($dbg56); if (defined $cfghash2{$actcfg}) { #prt("Found [$cc] in hash...\n"); } else { $cfghash2{$actcfg} = 1; prtw("WARNING: Adding [$actcfg] to hash - NOT SEEN BEFORE here\n"); } if ($fline =~ /Debug/i) { $is_debug = 1; } elsif ($fline =~ /Release/i) { $is_debug = 0; } else { $is_debug = 2; prtw("WARNING: Could NOT find 'Debug', or 'Release' in [$fline]\n"); } } $line = substr($line,1); if ($line =~ /^IF\s+(.*)/ ) { #' "$(CFG)" == "xmlrpc_sample_add_server - Win32 Release" $ifstr = $1; $ifstate = do_if_split($ifstr); $msg = "Entered IF [$ifstr] "; $msg .= $ifstate; if ($ifstr =~ /"\$\(CFG\)"/ ) { if ($ifstr =~ /\s+-\s+Win32\s+(.*)"/) { $form = $1; $msg .= " $form "; } } $inanif++; prt( "$msg $inanif\n" ) if ($dbg8); } elsif ($line =~ /^ELSEIF\s+(.*)/ ) { $ifstr = $1; $ifstate = do_if_split($ifstr); $msg = "Entered ELSEIF [$ifstr] "; $msg .= $ifstate; if ($ifstr =~ /"\$\(CFG\)"/ ) { if ($ifstr =~ /\s+-\s+Win32\s+(.*)"/) { $form = $1; $msg .= " $form "; } } prt( "$msg $inanif\n" ) if ($dbg8); } elsif ($line =~ /^ELSE\s*/ ) { $ifstate = flip_state($ifstate); prt( "Entered ELSE [$line]\n" ) if ($dbg8); } elsif ($line =~ /^ENDIF\s*/ ) { prt( "Out IF with ENDIF\n" ) if ($dbg8); $inanif = 0; $ifstate = 'OUTIF'; } elsif ($line =~ /^MESSAGE\s*/ ) { #prt( "MESSAGE LINE ...\n" ); } else { $msg = "WARNING: What is THIS [$fline]??? in [$f]"; prtw( "$msg\n" ); } } elsif ($intarg) { if( $line =~ /^SOURCE=(.+)/ ) { $line = strip_quotes($1); my $ff = fix_rel($dsp_dir . $line); if (($line =~ /\.cxx$/i) || ($line =~ /\.c$/i) || ($line =~ /\.cpp$/i)) { push(@dsrcs, $ff); push(@srcs,$line); } else { if ( !(($line =~ /\.hxx$/i) || ($line =~ /\.h$/i) || ($line =~ /\.hpp$/i)) ) { if ($dbg31) { $msg = "WARNING: CHECK Discarded [$fline]"; prtw( "$msg\n" ); } } } } } else { # NOT in Begin Target yet if ($line =~ /$MACRO_PATTERN2/) { if (defined $macros{$1}) { if ($macros{$1} ne $2) { if ($dbg34) { $msg = "WARNING: Duplicated MACRO $1, now $2, was $macros{$1} ..."; prtw( "$msg\n" ); } } } else { $macros{$1} = $2; prt( "SET: MACRO $1, to $2 ...\n" ) if ($dbg9); } } } } my ($key,$min,$len,$val); $min = 0; foreach $key (keys %cfghash2) { $len = length($key); $min = $len if ($len > $min); } foreach $key (keys %cfghash2) { $val = $cfghash2{$key}; $key .= ' ' while (length($key) < $min); prt("$package [$key] = $val\n") if (VERB5()); } $lncnt = scalar @dsrcs; prt( "File $f contains $lncnt SOURCES ...\n" ) if ($dbg11); prtw("WARNING: File $f has NO SOURCES!\n") if ($lncnt == 0); push(@src_list, [ $package, [@dsrcs], $f, [@srcs] ]); change_the_runtime($f,\@dlns,\@rtchange); return @dsrcs; } ################## ### utils sub trim_tail { my ($ln) = shift; while ($ln =~ /\s$/) { $ln = substr($ln,0,length($ln) - 1); # remove all TRAILING space } return $ln; } sub show_runtimes { prt( "\nIn $projcount projects, found following runtimes ...\n" ); my ($ky, $rt, $be, $min, $len, $msg, $fi, $lastfil, @arr, $lastpj, $i); my $rmsg = ''; my %rtimes = (); $min = 0; $lastfil = ''; $lastpj = ''; $rt = ''; foreach $ky (keys %runtimes) { $rt = $runtimes{$ky}; if (! defined $rt) { pgm_exit(1,"WHAT: key=[$ky] DOES NOT HAVE RUNTIME!!!\n"); } if (($rt == 0)||($rt == 1)) { $mtrts++; } elsif (($rt == 2)||($rt == 3)) { $dllrts++; } else { $otherrts++; } $len = length($ky); $min = $len if ($len > $min); } $rmsg = "Got NO RUNTIMES!"; if ($otherrts) { $rmsg = "Got $otherrts OTHER RUNTIMES??? MT=$mtrts MD=$dllrts"; } else { if ($mtrts && ($dllrts == 0)) { $rmsg = "Got ALL MT RUNTIMES ($mtrts)"; } elsif ( $dllrts && ($mtrts == 0) ) { $rmsg = "Got ALL MD RUNTIMES ($dllrts)"; } elsif ( ($dllrts == 0) && ($mtrts == 0)) { $rmsg = "Got NO RUNTIMES!"; } else { $rmsg = "Got MIXED RUNTIMES - MT=$mtrts MD=$dllrts"; } } prt( "$rmsg\n" ); foreach $ky (sort keys( %runtimes )) { @arr = split(/\|/,$ky); if ($arr[0] eq $lastpj) { $msg = ' '; $msg .= ' ' while (length($msg) < length($lastpj)); for ($i = 1; $i < scalar @arr; $i++) { $msg .= '|'; $msg .= $arr[$i]; } } else { $msg = $ky; } $lastpj = $arr[0]; $msg .= ' ' while (length($msg) < $min); # extract values # ====================================== $rt = $runtimes{$ky}; $be = $rtlines{$ky}; $fi = $rtfiles{$ky}; # ====================================== $msg .= " = ".rt_2_switch($rt); $msg .= ' ' while (length($msg) < ($min+3+28)); $msg .= " ($be) "; $msg .= ' ' while (length($msg) < ($min+3+28+12)); $msg .= $fi if ($lastfil ne $fi); prt( "$msg\n" ); $lastfil = $fi; if (defined $rtimes{$rt}) { $rtimes{$rt}++; } else { $rtimes{$rt} = 1; } } prt("\n"); return $rmsg; } sub show_rthash() { my ($k,$r); $r = scalar keys(%rthash); prt("\n") if (VERB1()); prt("Total DSP files = $tot_dsp_count... ") if ($tot_dsp_count); prt("Total VCPROJ files = $tot_vcproj_count... ") if ($tot_vcproj_count); prt("Got $r RUNTIME keys in rthash...\n"); foreach $k (sort keys %rthash) { $r = $rthash{$k}; prt("RT $k (".rt_2_switch($k).") = $r\n"); } } sub process_files() { my ($fil,$in_file); if (@sln_set && $do_set) { foreach $fil (@sln_set) { ($fil_nm,$fil_dir,$fil_ext) = fileparse( $fil, qr/\.[^.]*/ ); if (lc($fil_ext) eq '.dsw') { process_dsw( $fil ); } elsif (lc($fil_ext) eq '.dsp') { process_dsp( $fil ); } elsif (lc($fil_ext) eq '.sln') { process_sln( $fil ); } elsif (lc($fil_ext) eq '.vcproj') { process_vcproj( $fil ); } elsif (lc($fil_ext) eq '.csproj') { $wrnmsg = "WARNING: Input file [$fil] is C#, NOT handled ..."; prtw( "$wrnmsg\n" ); } else { $wrnmsg = "WARNING: Input file [$fil] NOT of know extension ..."; prtw( "$wrnmsg\n" ); } } } else { foreach $in_file (@inp_files) { ($fil_nm,$fil_dir,$fil_ext) = fileparse( $in_file, qr/\.[^.]*/ ); if (lc($fil_ext) eq '.dsw') { process_dsw( $in_file ); } elsif (lc($fil_ext) eq '.dsp') { process_dsp( $in_file ); } elsif (lc($fil_ext) eq '.sln') { process_sln( $in_file ); } elsif (lc($fil_ext) eq '.vcproj') { process_vcproj( $in_file ); } elsif (lc($fil_ext) eq '.csproj') { $wrnmsg = "WARNING: Input file [$in_file] is C#, NOT handled ..."; prtw( "$wrnmsg\n" ); } else { $wrnmsg = "WARNING: Input file [$in_file] NOT of known extension!"; prtw( "$wrnmsg\n" ); } } } } sub elim_debug_versions($) { my ($ra) = @_; my @narr = (); my ($i,$j,$cnt,$lib,$nm1,$dr1,$xt1,$lib2,$nm2,$dr2,$xt2,$lcn1,$lcn2,$fnd,$lcn1d,$lcn2d); $cnt = scalar @{$ra}; my %done = (); for ($i = 0; $i < $cnt; $i++) { $lib = ${$ra}[$i]; next if (defined $done{$lib}); $done{$lib} = 1; ($nm1,$dr1,$xt1) = fileparse($lib , qr/\.[^.]*/ ); $dr1 = '' if ($dr1 =~ /^\.(\\|\/)$/); $lcn1 = lc($nm1); $lcn1d = $lcn1.'d'; $fnd = 0; for ($j = 0; $j < $cnt; $j++) { if ($i != $j) { $lib2 = ${$ra}[$j]; ($nm2,$dr2,$xt2) = fileparse($lib2, qr/\.[^.]*/ ); $dr2 = '' if ($dr2 =~ /^\.(\\|\/)$/); if (($xt1 eq $xt2)&&($dr1 eq $dr2)) { $lcn2 = lc($nm2); $lcn2d = $lcn2.'d'; # debug version of name if ($lcn1d eq $lcn2) { # first, with 'd', equals 2nd $fnd = 1; $lib = $dr1.$nm1."[d]".$xt1; $done{$lib2} = 1; } elsif ($lcn1 eq $lcn2d) { # second, with 'd', equals first $fnd = 1; $lib = $dr2.$nm2."[d]".$xt2; $done{$lib2} = 1; } } } } push(@narr,$lib); } return \@narr; } sub show_depends() { my ($fil,$rh,$cfg,$val,@arr,$cnt); my %incs = (); my %deps = (); my %common_incs = (); my %common_defs = (); my %common_libs = (); my %common_linc = (); foreach $fil (keys %dups_vcprojs) { %incs = (); %deps = (); if (defined $vcproj_defs{$fil}) { $rh = $vcproj_defs{$fil}; foreach $cfg (keys %{$rh}) { $val = ${$rh}{$cfg}; #prt("$fil $cfg $val\n"); @arr = split(/[,;]+/,$val); foreach $val (@arr) { $val = trim_all($val); next if (length($val) == 0); $incs{$val} = 1; if (defined $common_defs{$val}) { $common_defs{$val}++; } else { $common_defs{$val} = 1; } } } } if (defined $vcproj_incs{$fil}) { $rh = $vcproj_incs{$fil}; foreach $cfg (keys %{$rh}) { $val = ${$rh}{$cfg}; #prt("$fil $cfg $val\n"); @arr = split(/[,;]+/,$val); foreach $val (@arr) { $val = trim_all($val); next if (length($val) == 0); $deps{$val} = 1; if (defined $common_incs{$val}) { $common_incs{$val}++; } else { $common_incs{$val} = 1; } } } } if (defined $vcproj_libs{$fil}) { $rh = $vcproj_libs{$fil}; foreach $cfg (keys %{$rh}) { $val = ${$rh}{$cfg}; #prt("$fil $cfg $val\n"); @arr = space_split_local($val); foreach $val (@arr) { $val = trim_all($val); next if (length($val) == 0); if (defined $common_libs{$val}) { $common_libs{$val}++; } else { $common_libs{$val} = 1; } } } } if (defined $vcproj_linc{$fil}) { $rh = $vcproj_linc{$fil}; foreach $cfg (keys %{$rh}) { $val = ${$rh}{$cfg}; #prt("$fil $cfg $val\n"); @arr = split(/[,;]+/,$val); ###@arr = space_split_local($val); foreach $val (@arr) { $val = trim_all($val); next if (length($val) == 0); if (defined $common_linc{$val}) { $common_linc{$val}++; } else { $common_linc{$val} = 1; } } } } } # show INCS/DEPS where count is GREATER than 1 my ($msg,$line,%done); @arr = (); %done = (); foreach $fil (keys %common_incs) { if ($common_incs{$fil} > 1) { push(@arr,$fil); } } ###prt("COM-INCS = ".join(';',@arr)."\n") if (@arr); if (@arr) { $msg = ''; $line = "\nCOM-INCS = "; %done = (); foreach $fil (sort @arr) { next if (defined $done{$fil}); $done{$fil} = 1; $line .= "$fil;"; if (length($line) > $max_line_wid) { $msg .= "\n" if (length($msg)); $msg .= $line; $line = ''; } } if (length($line)) { $msg .= "\n" if (length($msg)); $msg .= $line; $line = ''; } prt("$msg\n"); } @arr = (); foreach $fil (keys %common_defs) { if ($common_defs{$fil} > 1) { push(@arr,$fil); } } if (@arr) { $msg = ''; $line = "\nCOM-DEFS = "; %done = (); foreach $fil (sort @arr) { next if (defined $done{$fil}); $done{$fil} = 1; $line .= "$fil;"; if (length($line) > $max_line_wid) { $msg .= "\n" if (length($msg)); $msg .= $line; $line = ''; } } if (length($line)) { $msg .= "\n" if (length($msg)); $msg .= $line; $line = ''; } prt("$msg\n"); } @arr = keys %common_libs; if (@arr) { if (!VERB9()) { my $ra = elim_debug_versions(\@arr); @arr = @{$ra}; } $msg = ''; $line = "\nCOM-LIBS = "; foreach $fil (sort @arr) { $line .= "$fil "; if (length($line) > $max_line_wid) { $msg .= "\n" if (length($msg)); $msg .= $line; $line = ''; } } if (length($line)) { $msg .= "\n" if (length($msg)); $msg .= $line; $line = ''; } prt("$msg\n"); } @arr = keys %common_linc; if (@arr) { $msg = ''; $line = "\nCOM-LINC = "; foreach $fil (sort @arr) { $line .= "$fil;"; if (length($line) > $max_line_wid) { $msg .= "\n" if (length($msg)); $msg .= $line; $line = ''; } } if (length($line)) { $msg .= "\n" if (length($msg)); $msg .= $line; $line = ''; } prt("$msg\n"); } foreach $fil (keys %dups_vcprojs) { %incs = (); %deps = (); if (defined $vcproj_defs{$fil}) { $rh = $vcproj_defs{$fil}; foreach $cfg (keys %{$rh}) { $val = ${$rh}{$cfg}; #prt("$fil $cfg $val\n"); @arr = split(/[,;]+/,$val); foreach $val (@arr) { $val = trim_all($val); next if (length($val) == 0); if ((defined $common_defs{$val})&&($common_defs{$val} > 1)) { # $common_incs{$val}++; } else { $incs{$val} = 1; } } } } if (defined $vcproj_incs{$fil}) { $rh = $vcproj_incs{$fil}; foreach $cfg (keys %{$rh}) { $val = ${$rh}{$cfg}; #prt("$fil $cfg $val\n"); @arr = split(/[,;]+/,$val); foreach $val (@arr) { $val = trim_all($val); next if (length($val) == 0); if ((defined $common_incs{$val})&&($common_incs{$val} > 1)) { # $common_deps{$val}++; } else { $deps{$val} = 1; #$common_deps{$val} = 1; } } } } $cnt = 0; @arr = keys %incs; if (@arr) { prt("$fil - INCS = ".join(';',@arr)); $cnt++; } @arr = keys %deps; if (@arr) { prt("$fil - DEPS = ".join(';',@arr)); $cnt++; } } } sub write_copy_bat($) { my ($ra) = @_; # = \@g_change_list # write a batch file to do this update my $cnt = scalar @{$ra}; my $msg = ''; if (length($new_runtime)) { $msg = "'runtime'"; } if (length($characterset)) { $msg .= " and/or " if (length($msg)); $msg .= "'characterset'"; } prt("Got $cnt $msg changes...\n"); my $temp_bat = $perl_root."\\tempcopy.bat"; if (-d "C:\\MDOS") { $temp_bat = "C:\\MDOS\\tempcopy.bat"; } $msg = "\@echo WARNING: This will overwrite $cnt existing files!\n"; $msg .= "\@echo *** CONTINUE? ***\n"; $msg .= "\@pause\n"; $msg .= "\@echo ARE YOU VERY SURE? Have you back up the $cnt files?\n"; $msg .= "\@pause\n"; my ($i,$nfil,$fil); for ($i = 0; $i < $cnt; $i++) { # 0, 1 # push(@g_change_list, [$fil,$nfil]); $fil = ${$ra}[$i][0]; $nfil = ${$ra}[$i][1]; $fil = "\"$fil\"" if ($fil =~ /\s/); $nfil = "\"$nfil\"" if ($nfil =~ /\s/); $msg .= "\@copy $nfil $fil >nul\n"; } $msg .= "\@echo Done a copy oof $cnt files...\n"; write2file($msg,$temp_bat); prt("To UPDATE to $cnt changed VCPROJ file(s), use [$temp_bat]\n\n"); } # =========================================== # MAIN # # ========================================== parse_args(@ARGV); if (@inp_files) { } else { # if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input file located in command!\n"); } foreach my $f (@inp_files) { if (! -f $f) { pgm_exit(1,"ERROR: Unable to locate [$f] file ...\n" ); } } process_files(); foreach my $key (keys %dswprojs) { my $file = $dswprojs{$key}; process_dsp($file); } ##my $rtmsg = show_runtimes(); show_sources() if ($show_srcs); ##prt( "To repeat: $rtmsg\n" ); show_rthash(); show_depends() if ($show_deps); if (length($update_bat)) { my $out_file = $perl_root."\\tempupd.bat"; if (-d 'C:\MDOS') { $out_file = 'C:\MDOS\tempupd.bat'; } write2file("\@echo Copy updated DSP file(s) to destination?\n". "\@echo BE WARNED! Will OVERWRITE EXISTING!\n". "\@pause\n". "\@echo ARE YOU VERY SURE? LAST CHANCE!! Ctrl+C to abort\n". "\@pause\n". "$update_bat",$out_file); prt("To UPDATE to changed DSP file(s), use [$out_file]\n\n"); } if (@g_change_list) { write_copy_bat(\@g_change_list); # write a batch file to do this update } pgm_exit(0,"Normal End"); #################### sub give_help { prt("$pgmname: version 0.0.3 2010-07-03\n"); prt("Usage: $pgmname [options] input_file\n"); prt("Options:\n"); prt(" --help (-h -?) = This help, and exit 0\n"); prt(" -c(0|1|2) = Change the CharacterSet. 0=Not set, 1=Unicode, 2=MultiByte\n"); prt(" -d = Show dependents.\n"); prt(" -l = Load log at end.\n"); prt(" -s = Show source files.\n"); prt(" -r(T|D) = Change RUNTIME T=(/MT|/MTd) D=(/MD|/MDd).\n"); prt(" -v[nn] = Bump verbosity. (or set nn)\n"); prt("Read input file as MSVC solution type file, and show the truntime.\n"); prt("DOS wild card chars, '?' or '*' may be used as the input files.\n"); } sub has_wild($) { my $txt = shift; my $len = length($txt); my ($i,$c); for ($i = 0; $i < $len; $i++) { $c = substr($txt,$i,1); if (($c eq '?')||($c eq '*')) { return 1; } } return 0; } sub match_with_wild($$) { my ($fil1,$fil2) = @_; my $len1 = length($fil1); my $len2 = length($fil2); my ($i,$j,$c1,$c2); $i = 0; $j = 0; if (($len1 > 0) && ($len2 > 0)) { # both have LENGTH while (($i < $len1)&&($j < $len2)) { $c1 = substr($fil1,$i,1); $c2 = substr($fil2,$j,1); if (($c1 eq $c2)||($c2 eq '?')) { $i++; $j++; } elsif ($c2 eq '*') { $i++; # any $c1 matches asterick if (($j + 1) < $len2) { # but if more, maybe time to step past '*' $c2 = substr($fil2,($j+1),1); if ($c1 eq $c2) { $j += 2; } } } else { return 0; } } if (($i == $len1)&&($j == $len2)) { return 1; # both ran out of chars } elsif (($i == $len1)&&($c2 eq '*')&&(($j + 1) == $len2)){ return 1; # first ran out, and second is last '*' } } elsif ($len1 > 0) { # 1st is nul if ($fil2 eq '*') { return 1; # nul matches asterix } } elsif ($len2 > 0) { # 2nd is nul if ($fil1 eq '*') { return 1; # nul matches asterix } } return 0; } sub matches_wild($$) { my ($fil,$wild) = @_; my ($n1,$d1,$e1) = fileparse( $fil, qr/\.[^.]*/ ); my ($n2,$d2,$e2) = fileparse( $wild, qr/\.[^.]*/ ); my $lcn1 = lc($n1); my $lcn2 = lc($n2); my $lce1 = lc($e1); my $lce2 = lc($e2); return 1 if (($lcn1 eq $lcn2)&&($lce1 eq $lce2)); return 1 if (($lcn1 eq $lcn2)&&($lce2 eq '*')); return 1 if (($lcn2 eq '*')&&($lce1 eq $lce2)); return 1 if (match_with_wild($lcn1,$lcn2)&& match_with_wild($lce1,$lce2)); return 0; } sub add_this_file($) { my ($fil) = shift;; my $lcf = lc(path_u2d($fil)); if (!defined $lcdupes{$lcf}) { prt("Added input file [$fil]\n"); push(@inp_files,$fil); $lcdupes{$lcf} = 1; } } sub expand_wild($) { my $wild = shift; my ($nm,$dir) = fileparse($wild); prt("Got WILD name [$nm], directory [$dir]\n"); if (opendir(DIR,$dir)) { my @files = readdir(DIR); closedir(DIR); my ($fil,$ff); foreach $fil (@files) { next if (($fil eq '.')||($fil eq '..')); $ff = $dir.$fil; next if (-d $ff); if (matches_wild($fil,$wild)) { $ff = File::Spec->rel2abs($ff); add_this_file($ff); } } } else { pgm_exit(1,"ERROR: Unable to open DIRECTORY [$dir]\n"); } } sub parse_args { my (@av) = @_; my ($arg,$sarg,$in_file); while(@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg =~ /^\?/)) { give_help(); pgm_exit(0,"Help Exit"); } elsif ($sarg =~ /^c/i) { $sarg = substr($sarg,1); if (($sarg eq '0')||($sarg eq '1')||($sarg eq '2')) { $characterset = $sarg; } else { pgm_exit(1,"ERROR: arg $arg - CharacterSet must be '0', '1', or '2'!"); } } elsif ($sarg =~ /^d/i) { $show_deps = 1; } elsif ($sarg =~ /^s/i) { #$showfiles = 1; $show_srcs = 1; } elsif ($sarg =~ /^l/i) { $load_log = 1; } elsif ($sarg =~ /^r/) { $sarg = substr($sarg,1); if (($sarg eq 'T')||($sarg eq 'D')) { $new_runtime = $sarg; # ok } else { pgm_exit(1,"ERROR: arg $arg - Runtime MUST be 'T' or 'D'!"); } } elsif ($sarg =~ /^v/i) { if ($sarg =~ /^v(\d+)$/) { $verbosity = $1; prt("Set verbosity to [$verbosity]\n"); } else { while ($sarg =~ /^v/i) { $verbosity++; $sarg = substr($sarg,1); } prt("Bumped verbosity to [$verbosity]\n"); } } else { pgm_exit(1,"ERROR: Unknown [$arg]! Try -?\n"); } } else { $in_file = File::Spec->rel2abs($arg); if (has_wild($arg)) { expand_wild($arg); #pgm_exit(1,"ERROR: Wild [$arg] NOT yet implemented! [$in_file]\n"); } else { $dbg_inp = 0; add_this_file($in_file); } } shift @av; } if ($dbg_inp && length($def_file) && (-f $def_file)) { $in_file = File::Spec->rel2abs($def_file); prt("Set input file to DEFAULT [$in_file]\n"); push(@inp_files,$in_file); } } # eof - chkrt.pl