#!/usr/bin/perl -w # NAME: vcopts.pl # AIM: Show compiler defines in a vc project # 22/02/2012 - Added 'Yc' and 'Yu' compiler switches use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; use File::Spec; # File::Spec->rel2abs($rel); my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } 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"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.1 2012-01-31"; my $load_log = 0; my $in_file = ''; my $verbosity = 0; my $out_xml = ''; my @in_objects = (); my $out_dsp_dir = ""; my $fix_rel_paths = 0; my $curr_app_type = ''; my $write_dsp = 0; my $adj_inter = 0; my $adj_rt = 0; my $adj_out = 0; my $del_ndl_all = 0; my $dbg4write = 0; my $comp_2_dsps = 0; our ($sh_vers,$sh_cfgs,$sh_odir,$sh_intr,$sh_incs,$sh_libs); our ($sh_out,$sh_post,$sh_rt,$sh_defs,$sh_proj,$sh_ccnt); our ($sh_fdir,$sh_inpf,$sh_srcs,$sh_ptyp,$sh_dspf,$sh_hash,$sh_atyp,$sh_pflg); my $show_flag = 0; ### program variables my @warnings = (); my $cwd = cwd(); my ($sln_path); my $g_had_dsp = 0; my $sln_root_dir = ""; my @project_list = (); my @dsp_file_list = (); my $act_file = ''; # debug my $debug_on = 0; #my $def_file = 'C:\FG\FGCOMXML\xmlrpc-c\Windows\xmlrpc.sln'; my $def_file = 'C:\FG\FGCOMXML\xmlrpc-c\Windows\xmlrpc.dsw'; my $dbg_sl_01 = 0; my $dbg_sl_02 = 0; my $dbg_sl_03 = 0; my $dbg_sl_04 = 1; # show the HASH my $dbg_sl_04b = 0; my $dbg_sl_05 = 0; my $dbg_sl_14 = 0; my $dbg_sl_15 = 0; my $dbg_sl_16 = 0; my $dbg5 = 0; my $dbg_01 = 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" ) if (VERB9()); } } 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 process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = ; 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"); } } } sub return_common_dir($$) { my ($d1,$d2) = @_; my ($ll,$k,$com); $com = ''; $ll = length($d1); $ll = length($d2) if (length($d2) < $ll); # get SHORTEST for ($k = 0; $k < $ll; $k++) { # process for SHORTEST length last if (lc(substr($d1,$k,1)) ne lc(substr($d2,$k,1))); # end on first NOT SAME $com .= substr($d1,$k,1); # else add to common } return $com; } sub get_common_dir($) { my ($rffh) = @_; my $commdir = ''; my @keys = keys %{$rffh}; my $kcnt = scalar @keys; my ($ky1,$ky2,$k,$com); for ($k = 0; ($k+1) < $kcnt; $k++) { $ky1 = $keys[$k]; $ky2 = $keys[$k+1]; $com = return_common_dir($ky1,$ky2); if (length($com) == 0) { return ""; # no COMMON } if (length($commdir)) { $com = return_common_dir($com,$commdir); if (length($com) == 0) { return ""; # no COMMON } } $commdir = $com; # update the COMMON } return $commdir; } sub is_sln_ext($) { my ($fil) = shift; my ($nm, $dir, $ext) = fileparse( $fil, qr/\.[^.]*/ ); my $lce = lc($ext); if ($lce eq '.sln') { return 1; } return 0; } sub is_vcproj_ext($) { my ($fil) = shift; my ($nm, $dir, $ext) = fileparse( $fil, qr/\.[^.]*/ ); my $lce = lc($ext); return 1 if ($lce eq '.vcproj'); return 1 if ($lce eq '.vcxproj'); # 24/11/2010 VC10 support return 0; } sub fix_rel_path2($$) { my ($root,$rel) = @_; my $cd = cwd(); my ($fp,$msg,$tmp); if (chdir($root)) { $fp = File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE chdir($cd); # and get us back to where we were... $msg = "1:File::Spec:"; } else { $fp = fix_rel_path3($root.$rel,'fix_rel_path2'); # else use internal service $msg = "2:fix_rel_path3:" } if (-f $fp) { $msg .= " ok"; } else { $msg .= " NOT FOUND"; if ($fp =~ /\\SimGear\.cs\\/) { $tmp = $fp; $tmp =~ s/\\SimGear\.cs\\/\\SimGear-cs\\/; if (-f $tmp) { $fp = $tmp; $msg = "ok $msg"; } } if ($msg =~ /^1/) { $tmp = fix_rel_path3($root.$rel,'fix_rel_path2'); # else use internal service if (-f $tmp) { $fp = $tmp; $msg .= ", but OK with fix_rel_path3!!!"; } else { $msg .= ", NOR from fix_rel_path3 [$tmp]" } } } prt("From: [$root] [$rel], got [$fp] $msg\n") if ($dbg_sl_14); return $fp; # hopefully, return ABSOLUTE path } # Read and store contents of SOLUTION (.sln) file # 22/04/2008 - Extract DEPENDENCIES from solution file, and add to DSW output # 24/11/2010 - Support for VC10 XML files sub process_SLN_file2($) { my ($sln_fil_in) = shift; my ($cnt, $line, $vers, @arr, $mver, $par, $ff, $itmnum); my ($projname, $projfile, $projff, $gotproj, $relpath); my ($tnm,$tpth); my ($inproj, $tline, $projid, $inpdeps, $projdeps); my ($nmdeps, $depid, $pn, $fnd, $list); my ($msg,$text,$dspfile,$fdspfil,$name); my $fil = File::Spec->rel2abs($sln_fil_in); open IF, "<$fil" or mydie( "ERROR: Unable to open [$fil]... $! ...\n" ); my @lines = ; close IF; $cnt = scalar @lines; ($name,$sln_path) = fileparse($fil); # get the NAME, and SOLUTION PATH (should be ABSOLUTE, NOT relative) my %hash = (); my %sln_projects = (); my %sln_projpath = (); my %sln_depends = (); my %sln_projids = (); my %missed_vcprojs = (); prt( "\nProcessing $cnt lines ... n=[$name] p=[$sln_path] ...\n" ) if (VERB1()); $projname = ''; $projfile = ''; $projff = ''; $gotproj = 0; $inproj = 0; $inpdeps = 0; foreach $line (@lines) { $tline = trim_all($line); if ($line =~ /.+Format\s+Version\s+(\d+\.\d+)$/i) { $vers = $1; # get n.nn version @arr = split(/\./,$vers); $mver = $arr[0]; prt("[v5] Is MSVC Version $mver ...\n")if (VERB5()); } elsif ($line =~ /^Project\s*\(/) { # seek like #Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "abyss", "abyss.vcproj", "{8B384B8A-2B72-4DC4-8DF1-E3EF32F18850}" #Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "fgadmin", "fgadmin\fgadmin.vcxproj", "{7004E589-7EA0-4AFD-B432-3D5E00B55049}" # ProjectSection(ProjectDependencies) = postProject # {22540CD3-D3CA-4C86-A773-80AEEE3ACDED} = {22540CD3-D3CA-4C86-A773-80AEEE3ACDED} # EndProjectSection #EndProject ###prt( "Got project [$line] ...\n" ); $inproj = 1; @arr = split( '=', $line ); $cnt = scalar @arr; if ($cnt == 2) { $par = $arr[1]; # get 2nd part, like say '"abyss", "abyss.vcproj", "{8B384B8A-2B72-4DC4-8DF1-E3EF32F18850}"' @arr = split(',', $par); $cnt = scalar @arr; if ($cnt == 3) { $projname = strip_quotes(trim_all($arr[0])); # project NAME $projfile = strip_quotes(trim_all($arr[1])); # vcproj FILE $projid = strip_quotes(trim_all($arr[2])); # project ID $projff = fix_rel_path2($sln_path,$projfile); # return ABSOLUTE # if ((length($projname)) && (is_vcproj_ext($projfile)) && (-f $projff)) { # 01/12/2010 - Remove need for the file to EXIST if ((length($projname)) && (is_vcproj_ext($projfile)) ) { if (-f $projff) { # and file } else { $missed_vcprojs{$projname} = $projff; } $gotproj = 1; ($tnm,$tpth,$text) = fileparse($projff,qr/\.[^.]*/); $fdspfil = $tpth.$tnm.".dsp"; # this is a DSP EQUIVALENT to the vcproj location # BUT, we may have been given a DIFFERENT DSP output dir through # -dsp= ($out_dsp_dir) and $g_had_dsp, and maybe '-fix-rel' ($fix_rel_paths) if ($g_had_dsp) { $fdspfil = $out_dsp_dir; $fdspfil .= "\\" if ( !($fdspfil =~ /(\\|\/)$/) ); $fdspfil .= $tnm.".dsp"; } $relpath = get_rel_dos_path($tpth, $sln_path); ($tnm,$tpth,$text) = fileparse($projfile,qr/\.[^.]*/); $dspfile = $tpth.$tnm.".dsp"; prt( "Got PROJECT name=$projname, file=[$projfile], ff=[$projff], rel=[$relpath].\n" ) if ($dbg_sl_01 || VERB9()); if (defined $sln_projects{$projname}) { mydie( "A PROBLEM: Already GOT this project name $projname!!!\n" ); } else { $sln_projects{$projname} = $projff; # $sln_projpath{$projname} = $relpath; # can be BLANK, or say 'BvMath/' # 0 1 2 3 4 $sln_projpath{$projname} = [$projfile,$projff,$relpath,$dspfile,$fdspfil]; # relative project file, like '..\alut\path\alut.vcproj' prt( "Stored \$sln_projpath{$projname} = [0:$projfile,1:$projff,2:$relpath,3:$dspfile,4:$fdspfil]\n") if ($dbg_sl_15 || VERB9()) ; $sln_projids{$projname} = $projid; $sln_depends{$projname} = ''; # start dependencies, if any if ($dbg_sl_16) { my $msg = $projname; $msg .= ' ' while (length($msg) < 24); $msg .= $projid; prt("[v5] $msg\n") if (VERB5()); } } ### pgm_exit(1,"TEMP EXIT"); } else { $msg = "WARNING: "; if (!length($projname)) { $msg .= "Failed to get a project name! "; } elsif ( !is_vcproj_ext($projfile) ) { $msg .= "Name [$projfile] NOT a VCPROJ name! "; } else { $msg .= "Unable to locate file [$projff]! "; } $msg .= " Line is (trimmed)\n$tline"; prtw("$msg\n"); } } else { prtw( "Warning: Part 2 of Project line did NOT split into 3 on comma!???\n" ); } } else { prtw( "Warning: Project line did NOT split in 2 on equal sign!???\n" ); } # to switch on $tryharder requires additional work on parsing this line # ===================================================================== prtw("WARNING: line [$line] ...\n") if (!$gotproj); # ===================================================================== } elsif ($inproj) { # in the Project section - look for END of section, and DEPENDENCIES # ProjectSection(ProjectDependencies) if ($tline eq 'EndProject') { ###if ($line =~ /^EndProject\s*/) $inproj = 0; } else { if ($inpdeps) { if ($tline eq 'EndProjectSection' ) { $inpdeps = 0; } else { # collect dependencies @arr = split( '=', $line ); $cnt = scalar @arr; if ($cnt == 2) { $arr[0] = trim_all($arr[0]); $arr[1] = trim_all($arr[1]); if ($arr[0] eq $arr[1]) { $projdeps = $sln_depends{$projname}; # extract dependencies, if any $projdeps .= '|' if (length($projdeps)); $projdeps .= $arr[0]; prt( "$pgmname: Proj $projname, dependant on $arr[0] ...\n" ) if ($dbg_sl_02); ##prt( "Proj $projname, dependant on $projdeps ...\n" ); $sln_depends{$projname} = $projdeps; } else { prtw( "Warning: Found different IDS '$arr[0]' NE '$arr[1]'!!! \n" ); } } else { prtw( "Warning: Project DEPENDENCY line did NOT split in 2 on equal sign!???\n" ); prtw( "line=$line" ); } } } elsif ($line =~ /ProjectSection\s*\(\s*ProjectDependencies\s*\)/) { $inpdeps = 1; } } } } ###prt( "Done $fil ... got ".scalar @proj_files." project files ...\n" ); prt( "Done $fil ... got ".scalar keys(%sln_projects)." project files ...\n" ) if (VERB5()); # resolve dependencies, if possible - warn if NOT ... #resolve_depends(); # Have STORED # $sln_projects{$projname} = $projff; # $sln_projpath{$projname} = $relpath; # can be BLANK, or say 'BvMath/' # 0 1 2 3 4 #$sln_projpath{$projname} = [$projfile,$projff,$relpath,$dspfile,$fdspfil]; # relative project file, like '..\alut\path\alut.vcproj' #prt( "Stored \$sln_projpath{$projname} = [0:$projfile,1:$projff,2:$relpath,3:$dspfile,4:$fdspfil]\n") if ($dbg_sl_15); # $sln_projids{$projname} = $projid; # $sln_depends{$projname} = ''; # start dependencies, if any foreach $projname (keys %sln_projects) { $projdeps = $sln_depends{$projname}; if (length($projdeps)) { # there is LENGTH, convert giant CID to simple project names @arr = split( /\|/, $projdeps ); # split em up $cnt = scalar @arr; # get count of split #prt( "Proj $projname, depends on $cnt = $projdeps ...\n" ); $nmdeps = ''; # build simple NAME set foreach $depid (@arr) { # find project MATCHING that ID, in full list of IDs $fnd = 0; $list = ''; foreach $pn (keys %sln_projids) { if ($pn ne $projname) { $projid = $sln_projids{$pn}; $list .= "|$projid"; if ($depid eq $projid) { $nmdeps .= '|' if (length($nmdeps)); $nmdeps .= $pn; $fnd = 1; last; } } } if (!$fnd) { prtw("Warning: Failed to FIND [$depid], in list \n[$list]\n!"); } } @arr = split( /\|/, $nmdeps ); prt( "$pgmname: proj $projname, depends on $nmdeps ...\n" ) if ($dbg_sl_03 || VERB9()); if ($cnt != scalar @arr) { # YEEK - Does NOT match - OH WELL prtw( "WARNING: proj [$projname] with depends [$projdeps] Failed to get SAME count $cnt - got ".scalar @arr." on split [$nmdeps]\n" ); pgm_exit(1,""); } $sln_depends{$projname} = $nmdeps; } } # ==================================================================== $hash{'SOLUTION'} = $fil; # keep the SOLUTION files also $hash{'PROJECTS'} = { %sln_projects }; $hash{'PROJPATH'} = { %sln_projpath }; # array refs [$projfile,$projff,$relpath] $hash{'DEPENDS'} = { %sln_depends }; $hash{'PROJIDS'} = { %sln_projids }; $hash{'MISSED_FILES'} = { %missed_vcprojs }; # not found on DISK return \%hash; } # 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 # 13/07/2011 - if ($out_dsp_dir ne $perl_base), then try to also ADJUST sources sub process_vcproj_file($$) { my ($in, $outd) = @_; my ($key,$pnam,$out,$cnt,$dsp); my ($prjf,$nm,$dir,$ext,$dspf,$tmp2); my ($msg); my ($rdspf,$fprjf,$fdspf,$dprjf); prt( "[dbg_sl_05] $pgmname: Scanning [$in]...\n" ) if ($dbg_sl_05); my ($vc_name,$vc_dir) = fileparse($in); $vc_dir = $cwd."\\" 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}) { $tmp2 = ${$rh}{$key}; ${$rh}{$key} = $curr_app_type; if ($tmp2 ne $curr_app_type) { prt("Overrode $key with [$curr_app_type], from [$tmp2]\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}) ) { $pnam = ${$rh}{$key}; # get the PROJECT NAME $dsp = $pnam.".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; if (length($out)) { 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.".$pnam.$cnt.".dsp"; # add a COUNT to name } } else { $out = $outd; $out .= "temp.".$pnam.$cnt.".dsp"; } if ($fix_rel_paths) { # ====================================================================================== # ok, need to change sources from perhaps '.\src.cxx' to '..\..\lib\src.cxx' - a big job # and LOTS of other things... # UGH - calling this HERE, is BEFORE the %results hash is built chk_relative_paths($rh,$outd,$vc_dir); # was $perl_base; # this can be changed by -dsp= # ====================================================================================== } else { prt("No relative path change: vcd=[$vc_dir] out=[$outd]\n") if (VERB9()); } # 2011-10-18 - Make other ADSJUTMENTS to DSP HASH adjust_inter_out_dirs($rh) if ($adj_inter); adjust_runtime_to($rh,$adj_rt) if (length($adj_rt)); adjust_output_name($rh) if ($adj_out); # remove like -NEW_LIBS- = [wsock32.lib comctl32.lib /libpath:"..\lib" /nodefaultlib:"libcmtd"] $tmp2 = ''; # clear $tmp2 delete_nodefaultlib_all($rh,\$tmp2) if ($del_ndl_all); if (length($tmp2) && VERB5()) { prt("[v5] Removed /nodefaultlib [$tmp2]\n"); } if ($dbg_sl_04) { show_hash_results4($rh,$show_flag); prt("[04] Done show_hash_results3(\$rh)...\n"); } # *** 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, [ $pnam, $fdspf, $out ]); $key = 'PROJECT_FILE'; if (defined ${$rh}{$key}) { $prjf = ${$rh}{$key}; prt( "For '$prjf' written '$out'\n" ) if (VERB5()); # 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 [$pnam] project.\n" ); } } else { if ($dbg_sl_04) { show_hash_results4($rh,$show_flag); prt("[04] Done show_hash_results3(\$rh)...\n") if ($dbg_sl_04b); } if ($write_dsp) { prtw("WARNING: NO PROJECT NAME! = NO DSP WRITTEN!\n"); } } return $rh; } # ============================================== # 10/04/2012 - begin to process files with a BOM # LOAD without a BOM my $strip_bom = 1; my $curr_file_bom = ''; my @BOM_list = ( [ "UTF-8", 3, [0xEF,0xBB,0xBF ] ], # 239 187 191 [ "UTF-16 (BE)", 2, [0xFE,0xFF ] ], # 254 255 [ "UTF-16 (LE)", 2, [0xFF,0xFE ] ], # 255 254 [ "UTF-32 (BE)", 4, [0x00,0x00,0xFE,0xFF] ], # 0 0 254 255 [ "UTF-32 (LE)", 4, [0xFF,0xFE,0x00,0x00] ], # 255 254 0 0 [ "UTF-7a" , 4, [0x2B,0x2F,0x76,0x38] ], # 2B 2F 76 39 2B 2F 76 2B 2B 2F 76 2F [ "UTF-7b" , 4, [0x2B,0x2F,0x76,0x39] ], # 2B 2F 76 39 2B 2F 76 2B 2B 2F 76 2F [ "UTF-7c" , 4, [0x2B,0x2F,0x76,0x2B] ], # 2B 2F 76 39 2B 2F 76 2B 2B 2F 76 2F [ "UTF-7d" , 4, [0x2B,0x2F,0x76,0x2F] ], # 2B 2F 76 39 2B 2F 76 2B 2B 2F 76 2F [ "UTF-1" , 3, [0xF7,0x64,0x4C ] ], # 247 100 76 [ "UTF-EBCDIC" , 4, [0xDD,0x73,0x66,0x73] ], # 221 115 102 115 [ "SCSU" , 3, [0x0E,0xFE,0xFF ] ], # 14 254 255 [ "BOCU-1" , 3, [0xFB,0xEE,0x28 ] ], # 251 238 40 [ "GB-18030" , 4, [0x84,0x31,0x95,0x33] ] # 132 49 149 51 ); sub line_has_bom($$) { my ($line,$rname) = @_; my $max = scalar @BOM_list; my $len = length($line); my ($i,$j,$name,$cnt,$ra,$ch,$val); for ($i = 0; $i < $max; $i++) { $name = $BOM_list[$i][0]; # name $cnt = $BOM_list[$i][1]; # length $ra = $BOM_list[$i][2]; # ref array of values if ($len > $cnt) { # make sure line length GT BOM for ($j = 0; $j < $cnt; $j++) { $ch = substr($line,$j,1); # extract CHAR $val = ord($ch); # get VALUE last if ($val != ${$ra}[$j]); # compare } if ($j == $cnt) { # if ALL values found ${$rname} = $name; # give back 'name' return $cnt; # and return count } } } return 0; # no BOM found } sub remove_utf_bom($$) { my ($ff,$ra) = @_; my $line = ${$ra}[0]; # get first line my $name = ''; my $len = line_has_bom($line,\$name); if ($len) { $curr_file_bom = substr($line,0,$len); $line = substr($line,$len); # truncate line ${$ra}[0] = $line; # and return minus BOM my ($nm,$dr) = fileparse($ff); # just show name prt("[v9] NOTE: File [$nm] is $name encoding. BOM($len) removed.\n") if (VERB9()); } } sub load_file_lines($$) { my ($ff,$ra) = @_; my $lncnt = 0; $curr_file_bom = ''; if (open INF, "<$ff") { @{$ra} = ; close INF; $lncnt = scalar @{$ra}; remove_utf_bom($ff,$ra) if ($strip_bom); } else { prtw("WARNING: Unable to open [$ff]!\n"); } return $lncnt; } sub process_VCXPROJ { my $fil = shift; my %hash = (); my @lines = (); my $lncnt = load_file_lines($fil,\@lines); prt("Process $lncnt line, from $fil...\n"); my ($line,$tag,$txt,$intag,$i,$ch,$attr,$inattr,$msg,$len,$pc,$tmp,$last_open,$ctag); my $lnn = 0; $intag = 0; $inattr = 0; $tag = ''; $txt = ''; $attr = ''; $ch = ''; my @tag_stack = (); my $stkcnt = 0; my $had_open = 0; # get a new line for each open my $ind = ''; foreach $line (@lines) { $lnn++; chomp $line; $line = trim_all($line); $len = length($line); next if ($len == 0); for ($i = 0; $i < $len; $i++) { $pc = $ch; $ch = substr($line,$i,1); if ($intag) { if ($ch eq '>') { $msg = ''; $msg .= "$txt" if (length($txt)); $ctag = $tag; $ctag =~ s/^\///; if (length($tag)) { $msg .= "<"; $msg .= $tag; $msg .= " $attr" if (length($attr)); $msg .= ">"; } if (length($tag)) { if ($had_open > 1) { if ( !(($pc eq '/')||($pc eq '?')||($tag =~ /^\//)) ) { prt("\n"); $had_open--; } } if (length($txt)) { $ind = ''; } else { $ind = ' ' x $stkcnt; } prt($ind."$msg"); if (($pc eq '/')||($pc eq '?')) { prt("\n"); $had_open = 0; } elsif ($tag =~ /^\//) { prt("\n"); $tag =~ s/^\///; if (@tag_stack) { $tmp = pop @tag_stack; if ($tmp ne $tag) { prtw("WARNING:$lnn: popped $tmp, but expected $tag\n"); } $last_open = ''; $last_open = $tag_stack[-1] if (@tag_stack); } else { prtw("WARNING:$lnn: got close tag, but none on stack\n"); } $had_open = 0; $stkcnt = scalar @tag_stack; } else { push(@tag_stack,$tag); $had_open++; $stkcnt = scalar @tag_stack; $last_open = $tag; } } $txt = ''; $tag = ''; $attr = ''; $intag = 0; $inattr = 0; } else { if ($inattr) { $attr .= $ch; } else { if ($ch =~ /\s/) { $inattr = 1; } else { $tag .= $ch; } } } } else { if ($ch eq '<') { $intag = 1; $tag = ''; ###$txt = ''; $attr = ''; $inattr = 0; } else { $txt .= $ch; } } } # for length of line } $tmp = scalar @tag_stack; if ($tmp) { prtw("EOF still $tmp tags on stack ".join(" ",@tag_stack)."\n"); } } sub process_in_vcxproj($) { my $fil = shift; my $rh = process_VCXPROJ($fil); } sub process_in_vcproj($) { my $file = shift; my $rh = process_VCPROJ3($file); show_hash_results4($rh,$show_flag); } sub process_in_sln($) { my $in = shift; my $out = ''; my $rsh = process_SLN_file2($in); my ($k,$k2,$val,$val2,$min,$cnt,$min1,$ff,$len); my ($val3,$relpf,$ok,$nm,$dir,$ext,$dspf); my ($refhash,$key,$captyp,$fdspf); my @results = (); if (VERB9()) { prt( "$pgmname: KEYS in SLN hash = " ); foreach $k (keys %{$rsh}) { prt( "$k " ); } prt("\n"); } # ===================================== $k = 'PROJECTS'; $k2 = 'PROJPATH'; if ((defined ${$rsh}{$k})&&(defined ${$rsh}{$k2})) { # $sln_projects{$projname} = $projff; $val = ${$rsh}{$k}; # extract projects HASH $val2 = ${$rsh}{$k2}; # extract project paths HASH $min = 0; $cnt = 0; $min1 = 0; my %ffhash = (); foreach $k (keys %{$val}) { $ff = ${$val}{$k}; $len = length($k); $min = $len if ($len > $min); if (is_vcproj_ext($ff)) { $ffhash{$ff} = 1; $cnt++; } else { $ffhash{$ff} = 0; } $len = length($ff); $min1 = $len if ($len > $min1); } my $commdir = get_common_dir( \%ffhash ); if (length($commdir)) { prt("All $cnt vcproj files in a COMMON PATH: [$commdir]\n"); if (length($commdir) < $min1) { $min1 -= length($commdir); } } prt("SLN path=[$sln_root_dir]\n") if ($commdir ne $sln_root_dir); if (VERB1()) { foreach $k (keys %{$val}) { $ff = ${$val}{$k}; # 0 1 2 3 # $sln_projpath{$projname} = [$projfile,$projff,$relpath,$dspfile]; # relative project file, like '..\alut\path\alut.dsp' # and later # push(@results, [$k, $nm, $captyp, $relpf, $fdspf]); # stored in 'RESULTS' $val3 = ${$val2}{$k}; $relpf = ${$val3}[3]; # relative DSP file, for DSW write $ok = (( -f $ff ) ? "ok" : "NOT FOUND!"); ($nm, $dir, $ext) = fileparse( $ff, qr/\.[^.]*/ ); $dspf = $dir.$nm.".dsp"; $ok .= "2" if (-f $dspf); $ff = remove_base_path($ff,$commdir) if (length($commdir)); $k .= ' ' while (length($k) < $min); $ff .= ' ' while (length($ff) < $min1); prt("$k - $ff ($ok) $relpf\n" ); # this DSP rel.path may need to be changed later, if -dsp= } prt( "\nNow to process EACH of the $cnt projects...\n" ); } # -------------------------------------------------- foreach $k (keys %{$val}) { $ff = ${$val}{$k}; # prt("$k - $ff\n" ); ($nm, $dir) = fileparse($ff); # if (is_vcproj_ext($ff)) # 01/12/2010 - add an existance check if (is_vcproj_ext($ff) && (-f $ff)) { $refhash = process_vcproj_file($ff, $out); $key = 'APP_TYPE'; $key = 'PROJECT_APTP' if (!defined ${$refhash}{$key}); if (defined ${$refhash}{$key}) { $captyp = ${$refhash}{$key}; } else { $captyp = "Unknown - key=[$key] NOT SET"; } # 0 1 2 3 4 # $sln_projpath{$projname} = [$projfile,$projff,$relpath,$rdsp,$fdsp]; # relative project file, like '..\alut\path\alut.dsp' $val3 = ${$val2}{$k}; $relpf = ${$val3}[3]; # relative DSP file, for DSW consumption (see write_proj_DSW3) $fdspf = ${$val3}[4]; if ($fix_rel_paths && $g_had_dsp) { my ($tn,$td) = fileparse($relpf); $relpf = ".\\$tn"; } # 0 1 2 3 4 5 6 push(@results, [$k, $nm, $captyp, $relpf, $fdspf, 0, 0]); # stored in 'RESULTS' } } } else { pgm_exit(1,"ERROR: key [$k] NOT found in hash!\n"); } $k = 'RESULTS'; ${$rsh}{$k} = [@results]; $k = 'PROJECT_LIST'; ${$rsh}{$k} = [@project_list]; # keep project list, including output DSP file, if written $k = 'PROJECT_FILE'; ${$rsh}{$k} = $in; return $rsh; } # APP_TYPE - PROJECT_APTP # $app_console_stg = 'Console Application' # $app_windows_stg = 'Application' # $app_dynalib_stg = 'Dynamic-Link Library' # $app_statlib_stg = 'Static Library' # DSP TYPES # TARGTYPE "Win32 (x86) Application" 0x0101 # TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 # TARGTYPE "Win32 (x86) Console Application" 0x0103 # TARGTYPE "Win32 (x86) Static Library" 0x0104 # from scanvc.pl library #sub get_default_ref_hash($) { # my ($fil) = @_; # my %hash = (); # my $rh = \%hash; # ${$rh}{'PROJECT_VERS'} = 1; # version of the HASH # ${$rh}{'PROJECT_FILE'} = $fil; # ${$rh}{'PROJECT_FLAG'} = 0; # ${$rh}{'PROJECT_APTP'} = ''; # ${$rh}{'PROJECT_CCNT'} = 0; # count of configurations # ${$rh}{'PROJECT_CFGS'} = [ ]; # ${$rh}{'PROJECT_SRCS'} = [ ]; # ${$rh}{'CURR_FLAG'} = 0; # ${$rh}{'CURR_LOFF'} = 0; # last/current source OFFSET # ${$rh}{'CURR_LINE'} = ''; # return $rh; #} sub get_def_dsp_hash_ref($) { my ($fil) = @_; my $rh = get_default_ref_hash($fil); #${$rh}{'PROJECT_VERS'} = 1; # version of the HASH #${$rh}{'PROJECT_FILE'} = $fil; #${$rh}{'PROJECT_FLAG'} = 0; #${$rh}{'PROJECT_APTP'} = ''; ${$rh}{'PROJECT_NAME'} = ''; #${$rh}{'PROJECT_CCNT'} = 0; # count of configurations #${$rh}{'PROJECT_CFGS'} = [ ]; #${$rh}{'PROJECT_SRCS'} = [ ]; #${$rh}{'CURR_FLAG'} = 0; #${$rh}{'CURR_LOFF'} = 0; # last/current source OFFSET #${$rh}{'CURR_LINE'} = ''; return $rh; } sub get_cpp_line($) { my ($stg) = @_; my @arr = split("\n",$stg); my ($line); foreach $line (@arr) { # # ADD CPP /nologo /W3 /GR /GX /O2 -NEW_RT- -NEW_INCS- /D "WIN32" /D "NDEBUG" /D "_MBCS" /D "_LIB" -NEW_DEFS- /FD /c if ($line =~ /^\#\s+ADD\s+CPP\s+(.+)$/) { return $1; } } return ''; } sub get_link_line($) { my ($stg) = @_; my @arr = split("\n",$stg); my ($line); foreach $line (@arr) { # # ADD LINK32 kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib odbccp32.lib odbc32.lib odbccp32.lib comctl32.lib Msimg32.lib Winmm.lib wsock32.lib SimGear.lib sg_d.lib pui_d.lib puAux_d.lib fnt_d.lib net_d.lib ul_d.lib js_d.lib zlibd.lib osgd.lib osgDBd.lib osgTextD.lib osgUtild.lib OpenThreadsd.lib OpenAL32.lib alut.lib pthreadVC2_d.lib osgViewerd.lib osgGAd.lib osgParticled.lib /libpath:"..\SimGear\Debug" /libpath:"..\PLIB" /libpath:"..\zlib-1.2.3\projects\visualc6\Win32_LIB_Debug" /libpath:"..\OpenSceneGraph\lib" /libpath:"..\OpenThreads\lib\Win32" /libpath:"C:\Program Files\OpenAL 1.1 SDK\libs\Win32" /libpath:"..\alut\admin\VisualStudioDotNET\alut\Debug" /libpath:"..\freeglut\$(IntDir)Static" /libpath:"..\pthreads" /libpath:"..\3rdparty\lib" /nologo /subsystem:console /debug /machine:I386 /out:..\bin\FlightGearD.exe if ($line =~ /^\#\s+ADD\s+LINK32\s+(.+)$/) { return $1; } } return ''; } # eliminate any 'old' from the 'new', and return any new remainder if any sub return_remainder_stg($$) { my ($old, $new) = @_; my $rch2 = get_config_stg_hash($old); my $rch1 = get_config_stg_hash($new); my $defs = ''; my ($key,$val,$opt,$dsp); my ($key2,$val2,$opt2,$v,$v2); my $cnt = 0; my $dcnt = 0; # for each NEW key foreach $key (sort keys %{$rch1}) { $val = ${$rch1}{$key}; $opt = $key; $opt =~ s/^\d+_//; $dsp = 1; if (ref($val) eq 'ARRAY') { my %dupes = (); foreach $v (@{$val}) { if (! defined $dupes{$v}) { # search same in OLD foreach $key2 (keys %{$rch2}) { $val2 = ${$rch2}{$key2}; $opt2 = $key2; $opt2 =~ s/^\d+_//; if (ref($val2) eq 'ARRAY') { foreach $v2 (@{$val2}) { if ($v eq $v2) { $dsp = 0; # FOUND SAME last; } } } } if ($dsp) { $defs .= ' ' if (length($defs)); $defs .= "/$opt $v"; $dcnt++; } $dupes{$v} = 1; } } } else { # search the OLD foreach $key2 (keys %{$rch2}) { $val2 = ${$rch2}{$key2}; $opt2 = $key2; $opt2 =~ s/^\d+_//; if (ref($val2) eq 'ARRAY') { # need only single items here } else { if ($opt eq $opt2) { $dsp = 0; # FOUND SAME last; } } } if ($dsp) { $defs .= ' ' if (length($defs)); $defs .= "/$opt"; $dcnt++; } } $cnt++; } return $defs; } sub no_case_file_defined($$) { my ($fil,$rh) = @_; my $lcf = lc($fil); my ($key); return 1 if ( defined ${$rh}{$fil} ); foreach $key (keys %{$rh}) { if (lc($key) eq $lcf) { return 1; } } return 0; } sub return_lib_remain_stg($$) { my ($def,$usr) = @_; my ($rordarr1,$rordarr2); my $rch1 = get_library_stg_hash($usr,\$rordarr1); # users suggestion my $rch2 = get_library_stg_hash($def,\$rordarr2); # current list my $adds = ''; my ($key,$dsp); my ($path,$key2,$path2); my %dupe = (); $dsp = 0; foreach $key (@{$rordarr1}) { next if (defined $dupe{$key}); $dupe{$key} = 1; $dsp = 1; if ($key =~ /^\/libpath:(.+)$/) { $path = $1; # compare with all other library paths in present if ( defined ${$rch2}{$key}) { $dsp = 0; } else { foreach $key2 (keys %{$rch2}) { if ($key2 =~ /^\/libpath:(.+)$/) { $path2 = $1; if (lc($path) eq lc($path2)) { $dsp = 0; # already have this 'libpath' last; } } } } #$rctxt = \$libpaths; } elsif ($key =~ /^\/out:(.+)$/) { # on the very ODD chance #$out = $1; if ( defined ${$rch2}{$key}) { $dsp = 0; } else { # set -NEW-OUT- to this } #$rctxt = \$output; } elsif ($key =~ /^\w/) { if ( no_case_file_defined($key,$rch2) ) { # already got this library $dsp = 0; } # $rctxt = \$newlibs; } else { # things like /nologo /subsystem:console /machine:I386 if ( defined ${$rch2}{$key}) { $dsp = 0; } # $rctxt = \$others; } if ($dsp) { $adds .= ' ' if (length($adds)); $adds .= $key; # ${$rctxt} .= ' ' if (length(${$rctxt})); # ${$rctxt} .= $key; } } return $adds; } sub get_library_stg_hash($$) { my ($cfg,$ra) = @_; my @arr = space_split_with_quotes2($cfg); my $cnt = scalar @arr; my ($i,$itm); my %h = (); # prt("Doing switch hash for [$cfg]\n" ); for ($i = 0; $i < $cnt; $i++) { $itm = $arr[$i]; $h{$itm} = 1; } ${$ra} = \@arr; return \%h; } # -NEW_LIBS- and -NEW_OUT- # sub process_library_stg2($$$) { sub process_LINK_stg2($$$) { my ($rh,$cfg,$add) = @_; my $got_dsp = 0; my $got_sub_sub = 0; my ($rsubsub,$rordarr1,$rordarr2,$rsa); my ($path,$out); if ( (defined ${$rh}{'TEMP_GOT_DSP'}) && (defined ${$rh}{'TEMP_DSP_STG'}) ) { $got_dsp = ${$rh}{'TEMP_GOT_DSP'}; } if (defined ${$rh}{'TEMP_DSP_SUB'} ) { $rsubsub = ${$rh}{'TEMP_DSP_SUB'}; # = $dsp_sub_sub; # direct access to substitution block -NEW_???- items $got_sub_sub = 1; } my $clibs = ''; my $libpaths = ''; my $output = ''; my $newlibs = ''; my $others = ''; my $libtxt = ''; my $rctxt = \$others; my ($val,$nval); if ($got_sub_sub && $got_dsp) { $clibs = get_link_line(${$rh}{'TEMP_DSP_STG'}); $rsa = get_list_of_subs($clibs); # collect list of '-NEW_...' tags my $rch1 = get_library_stg_hash($cfg,\$rordarr1); # users suggestion my $rch2 = get_library_stg_hash($clibs,\$rordarr2); # current list prt("[v9] CHG [$clibs]\n to [$cfg]\n") if (VERB9()); my $adds = ''; my ($key,$dsp); my %dupe = (); $dsp = 0; #foreach $key (keys %{$rch1}) { foreach $key (@{$rordarr1}) { next if (defined $dupe{$key}); $dupe{$key} = 1; $dsp = 1; $rctxt = \$others; if ($key =~ /^\/libpath:(.+)$/) { $path = $1; # compare with all other library paths in present if ( defined ${$rch2}{$key}) { $dsp = 0; } $rctxt = \$libpaths; } elsif ($key =~ /^\/out:(.+)$/) { # on the very ODD chance $out = $1; if ( defined ${$rch2}{$key}) { $dsp = 0; } else { # set -NEW-OUT- } $rctxt = \$output; } elsif ($key =~ /^\w/) { if ( no_case_file_defined($key,$rch2) ) { # already got this library $dsp = 0; } $rctxt = \$newlibs; } else { # things like /nologo /subsystem:console /machine:I386 if ( defined ${$rch2}{$key}) { $dsp = 0; } $rctxt = \$others; } if ($dsp) { $adds .= ' ' if (length($adds)); $adds .= $key; ${$rctxt} .= ' ' if (length(${$rctxt})); ${$rctxt} .= $key; } } if (VERB9()) { prt("[v9] ADD [$adds]\n"); prt("[v9] newlibs: $newlibs\n") if (length($newlibs)); prt("[v9] libpath: $libpaths\n") if (length($libpaths)); prt("[v9] output: $output\n") if (length($output)); prt("[v9] Others: $others\n") if (length($others)); $dsp = scalar @{$rsa}; prt("[v9] Got $dsp KEYS: "); foreach $key (@{$rsa}) { prt("$key "); } prt("\n"); } foreach $key (@{$rsa}) { if ($key eq '-NEW_LIBS-') { $libtxt = $newlibs; $libtxt .= ' ' if (length($libtxt) && length($libpaths)); $libtxt .= $libpaths; $rctxt = \$libtxt; } elsif ($key eq '-NEW_OUT-') { $rctxt = \$output; } else { pgm_exit(1,"ERROR Un-cased value! [$key] - FIX ME!!!\n"); } if (defined ${$rsubsub}{$key}) { $val = ${$rsubsub}{$key}; $nval = ${$rctxt}; if (length($val)) { if (length($nval)) { if ($key eq '-NEW_OUT-') { prt("[v5] $key = CHG [$nval] to [$val]\n") if (VERB5()); ${$rsubsub}{$key} = $nval; } else { prt("[v5] $key = MRG [$val] and [$nval]\n") if (VERB5()); $nval = return_lib_remain_stg($val,$nval); if (length($nval)) { prt("[v5] $key = ADD [$nval]\n") if (VERB5()); ${$rsubsub}{$key} .= " $nval"; } } } } else { # no current value, so just SET the new value if (length($nval)) { prt("[v5] $key = SET to [$nval]\n") if (VERB5()); ${$rsubsub}{$key} = $nval; } } } } } else { prtw("WARNING: Discarding [$cfg]\n"); } } sub process_LIB_stg2($$$) { my ($rh,$cfg,$add) = @_; my $got_dsp = 0; my $got_sub_sub = 0; my ($rsubsub,$rordarr1,$rordarr2); #my ($rsa); my ($path,$out); if ( (defined ${$rh}{'TEMP_GOT_DSP'}) && (defined ${$rh}{'TEMP_DSP_STG'}) ) { $got_dsp = ${$rh}{'TEMP_GOT_DSP'}; } if (defined ${$rh}{'TEMP_DSP_SUB'} ) { $rsubsub = ${$rh}{'TEMP_DSP_SUB'}; # = $dsp_sub_sub; # direct access to substitution block -NEW_???- items $got_sub_sub = 1; } if (!$got_sub_sub || !$got_dsp) { prtw("WARNING: Discarding [$cfg]\n"); return; } my $clibs = ''; my $libpaths = ''; my $output = ''; my $newlibs = ''; my $others = ''; my $libtxt = ''; my $rctxt = \$others; my ($val,$nval); if ($got_sub_sub && $got_dsp) { $clibs = get_link_line(${$rh}{'TEMP_DSP_STG'}); #$rsa = get_list_of_subs($clibs); # collect list of '-NEW_...' tags my $rch1 = get_library_stg_hash($cfg,\$rordarr1); # users suggestion my $rch2 = get_library_stg_hash($clibs,\$rordarr2); # current list prt("[v5] CHG [$clibs]\n to [$cfg]\n") if (VERB5()); my $adds = ''; my ($key,$dsp); my %dupe = (); $dsp = 0; #foreach $key (keys %{$rch1}) { foreach $key (@{$rordarr1}) { next if (defined $dupe{$key}); $dupe{$key} = 1; $dsp = 1; $rctxt = \$others; if ($key =~ /^\/libpath:(.+)$/) { $path = $1; # compare with all other library paths in present if ( defined ${$rch2}{$key}) { $dsp = 0; } $rctxt = \$libpaths; } elsif ($key =~ /^\/out:(.+)$/) { # on the very ODD chance $out = $1; if ( defined ${$rch2}{$key}) { $dsp = 0; } else { # set -NEW-OUT- } $rctxt = \$output; } elsif ($key =~ /^\w/) { if ( no_case_file_defined($key,$rch2) ) { # already got this library $dsp = 0; } $rctxt = \$newlibs; } else { # things like /nologo /subsystem:console /machine:I386 if ( defined ${$rch2}{$key}) { $dsp = 0; } $rctxt = \$others; } if ($dsp) { $adds .= ' ' if (length($adds)); $adds .= $key; ${$rctxt} .= ' ' if (length(${$rctxt})); ${$rctxt} .= $key; } } if (VERB9()) { prt("[v9] ADD [$adds]\n"); prt("[v9] newlibs: $newlibs\n") if (length($newlibs)); prt("[v9] libpath: $libpaths\n") if (length($libpaths)); prt("[v9] Others: $others\n") if (length($others)); } if (length($output)) { $key = '-NEW_OUT-'; prt("[v5] Output: [$output] $key\n") if (VERB5()); if (defined ${$rsubsub}{$key}) { $nval = ${$rsubsub}{$key}; prt("[v5] Replace: [$nval]\n") if (length($nval) && VERB5()); ${$rsubsub}{$key} = $output; } else { ${$rsubsub}{$key} = $output; } } } } # # Microsoft Developer Studio Project File - Name="FlightGear" - Package Owner=<4> # # Microsoft Developer Studio Generated Build File, Format Version 6.00 # # ** DO NOT EDIT ** # # TARGTYPE "Win32 (x86) Console Application" 0x0103 # CFG=FlightGear - Win32 Debug # !MESSAGE This is not a valid makefile. To build this project using NMAKE, # # Begin Project # PROP AllowPerConfigDependencies 0 # !IF "$(CFG)" == "someconfig" # # PROP Target_Dir "." # # ADD BASE CPP /nologo /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_CONSOLE" /YX /c # ... # !ELSIF "$(CFG)" == "someconfig" # ... # !ENDIF # # Begin Target # # Name "FlightGear - Win32 Release" # # Name "FlightGear - Win32 Debug" # # Begin Group "Lib_Aircraft" # # PROP Default_Filter "" # # Begin Source File # # End Target # # End Project sub set_default_group_and_filter($$$) { my ($fil,$rgroup,$rfilter) = @_; my $group = ''; # ${$rgroup}; my $filter = ''; # ${$rfilter}; my $ret = 0; if (is_c_source_extended($fil)) { $group = get_def_src_grp(); $filter = get_def_src_filt(); } elsif (is_text_ext_file($fil)) { # leave unchanged # can be blanks, to put this source by its self } elsif (is_h_source($fil)) { $group = get_def_hdr_grp(); $filter = get_def_hdr_filt(); } elsif (is_resource_file($fil)) { $group = get_def_rcs_grp(); $filter = get_def_rcs_filt(); } elsif (is_h_source_extended($fil)) { $group = get_def_hdr_grp(); $filter = get_def_hdr_filt(); #} else { # $group = get_def_spl_grp(); # $filter = get_def_spl_filt(); } if ((length($group) > 0) && (length(${$rgroup}) == 0)) { ${$rgroup} = $group; $ret |= 1; } if ((length($filter) > 0) && (length(${$rfilter}) == 0)) { ${$rfilter} = $filter; $ret |= 2; } return $ret; } sub set_group_and_filter($$$) { my ($src, $rgroup, $rfilter) = @_; my $group = ${$rgroup}; my $filter = ${$rfilter}; return 0 if (length($group) && length($filter)); if ( set_default_group_and_filter($src,\$group,\$filter) ) { prtw("WARNING: Set default filter of group [$group], src [$src], filter [$filter]\n"); ${$rgroup} = $group; ${$rfilter} = $filter; return 1; } return 0; } sub get_new_tag_list($) { my $stg = shift; my $len = length($stg); my ($tag,$ch,@tags,$i); $tag = ''; @tags = (); for ($i = 0; $i < $len; $i++) { $ch = substr($stg,$i,1); if ($ch =~ /\s/) { if (length($tag) && ($tag =~ /^-NEW_/)) { push(@tags,$tag); } $tag = ''; } else { $tag .= $ch; } } return \@tags; } sub set_per_cfg_name($$) { my ($rh,$test) = @_; my ($tmp); ${$rh}{'TEMP_GOT_DSP'} = 0; # go for more tests my $name = ''; my $type = ''; if ( get_project_name($rh, \$name) && (length(trim_all($name)) != 0)) { if ( get_project_type($rh, \$type) ) { # can get the FETCH FUNCTION my ($func); if ( get_fetch_function($type,$test,\$func,0) ) { ${$rh}{'TEMP_GOT_DSP'} = 1; # got the DSP string section fetch function my $stg = $func->(); # fetch that section my $ra = get_new_tag_list($stg); ${$rh}{'TEMP_DSP_STG'} = $stg; ${$rh}{'TEMP_FECTH_F'} = $func; ${$rh}{'TEMP_DSP_TAGS'} = $ra; if (VERB9()) { prt("[v9] vcopts:set_per_cfg_name: name [$name], type [$type] tags \n"); prt("[".join(" ",@{$ra})."]\n"); } } else { prtw("ERROR: [$test] Unable to get fetch function for type $type! name $name\n"); } } else { prtw("ERROR: Unable to get project type! for name $name\n"); } } else { prtw("ERROR: Unable to get project name!\n"); } } sub process_config_stg2($$$) { my ($rh,$cfg,$add) = @_; my ($key,$val,$cnt,$v,$opt,$cdefs,$rch2,$dsp); my ($key2,$val2,$v2,$opt2,$dcnt,$defs,$rsubsub,$rsa); $key = ($add == 1) ? "ADD" : "SUBTRACT"; prt("[v1] $key CPP $cfg\n") if (($show_flag & $sh_defs) && VERB1()); my $rch = get_config_stg_hash($cfg); my $got_dsp = 0; my $got_sub_sub = 0; if ( (defined ${$rh}{'TEMP_GOT_DSP'}) && (defined ${$rh}{'TEMP_DSP_STG'}) ) { $got_dsp = ${$rh}{'TEMP_GOT_DSP'}; } $cdefs = ''; if ($got_dsp) { $cdefs = get_cpp_line(${$rh}{'TEMP_DSP_STG'}); prt("[v5] Def defs: $cdefs\n") if (VERB5()); $rsa = get_list_of_subs($cdefs); # collect list of '-NEW_...' tags $rch2 = get_config_stg_hash($cdefs); if (defined ${$rh}{'TEMP_DSP_SUB'} ) { $rsubsub = ${$rh}{'TEMP_DSP_SUB'}; # = $dsp_sub_sub; # direct access to substitution block -NEW_???- items $got_sub_sub = 1; } } else { prtw("WARNING: No fetch of default type DSP definitions...\n"); } $cnt = 0; $dcnt = 0; $defs = ''; # collect any remainder in groups my $runtime = ''; my $includes = ''; my $defines = ''; my $others = ''; my $rcgrp = \$runtime; foreach $key (sort keys %{$rch}) { $val = ${$rch}{$key}; $opt = $key; $opt =~ s/^\d+_//; $dsp = 1; if (ref($val) eq 'ARRAY') { my %dupes = (); foreach $v (@{$val}) { if (! defined $dupes{$v}) { if ($got_dsp) { foreach $key2 (keys %{$rch2}) { $val2 = ${$rch2}{$key2}; $opt2 = $key2; $opt2 =~ s/^\d+_//; if (ref($val2) eq 'ARRAY') { foreach $v2 (@{$val2}) { if ($v eq $v2) { $dsp = 0; last; } } } } } if ($dsp) { prt("[v5] /$opt $v ") if (VERB5()); $defs .= ' ' if (length($defs)); $defs .= "/$opt $v"; if ($opt =~ /^D/) { $rcgrp = \$defines; } elsif ($opt =~ /^I/) { $rcgrp = \$includes; } elsif ($opt =~ /^M/) { $rcgrp = \$runtime; } else { $rcgrp = \$others; } $dcnt++; ${$rcgrp} .= ' ' if (length(${$rcgrp})); ${$rcgrp} .= "/$opt $v"; } $dupes{$v} = 1; } } } else { if ($got_dsp) { foreach $key2 (keys %{$rch2}) { $val2 = ${$rch2}{$key2}; $opt2 = $key2; $opt2 =~ s/^\d+_//; if (ref($val2) eq 'ARRAY') { # need only single items here } else { if ($opt eq $opt2) { $dsp = 0; last; } } } } if ($dsp) { prt("[v5] /$opt ") if (VERB5()); $defs .= ' ' if (length($defs)); $defs .= "/$opt"; if ($opt =~ /^D/) { $rcgrp = \$defines; } elsif ($opt =~ /^I/) { $rcgrp = \$includes; } elsif ($opt =~ /^M/) { $rcgrp = \$runtime; } else { $rcgrp = \$others; } ${$rcgrp} .= ' ' if (length(${$rcgrp})); ${$rcgrp} .= "/$opt"; $dcnt++; } } $cnt++; } prt("\n") if ($dcnt && VERB5()); #if ($dcnt < $cnt) { if ($cnt) { if (VERB5()) { prt("[v5] Of $cnt defines, eliminated ".($cnt - $dcnt).", remains [$defs]\n"); prt("[v5] Runtime: $runtime\n") if (length($runtime)); prt("[v5] Defines: $defines\n") if (length($defines)); prt("[v5] Includes: $includes\n") if (length($includes)); prt("[v5] Others: $others\n") if (length($others)); } if ($got_sub_sub) { # Others: /YX # -NEW_DEFS- = [/D "_CRT_SECURE_NO_WARNINGS"] # -NEW_INCS- = [] # -NEW_RT- = [/MT] my $nval = scalar @{$rsa}; if (VERB9()) { prt("[v9] Process $nval keys: "); foreach $key (@{$rsa}) { prt("$key "); } prt("\n"); } foreach $key (@{$rsa}) { if ($key eq '-NEW_DEFS-') { $rcgrp = \$defines; } elsif ($key eq '-NEW_INCS-') { $rcgrp = \$includes; } elsif ($key eq '-NEW_RT-') { $rcgrp = \$runtime; } else { $rcgrp = \$others; next; } $nval = ${$rcgrp}; # and load the NEW value if (defined ${$rsubsub}{$key}) { $val = ${$rsubsub}{$key}; # get the current sub value if (length($val)) { if (length($nval)) { if ($key eq '-NEW_RT-') { prt("[v5] $key = CHG [$nval] to [$val]\n") if (VERB5()); ${$rsubsub}{$key} = $nval; } else { prt("[v5] $key = MRG [$val] and [$nval]\n") if (VERB5()); $nval = return_remainder_stg($val,$nval); if (length($nval)) { prt("[v5] $key = ADD [$nval]\n") if (VERB5()); ${$rsubsub}{$key} .= " $nval"; } } } } else { # no current value, so just SET the new value if (length($nval)) { prt("[v5] $key = SET to [$nval]\n") if (VERB5()); ${$rsubsub}{$key} = $nval; } } } else { prtw("WARNING: key [$key] NOT FOUND! Discarding [$nval]\n"); } } # for each key in the 'substitution' set } else { prtw("WARNING: Unable to fix the sub sub hash!\nDiscarding: [$defs]\n"); } } } sub space_split_with_quotes2 { my ($txt) = shift; my @a = (); my $ll = length($txt); my ($j, $c, $wd, $inq, $pc); $wd = ''; $inq = 0; $c = ''; for ($j = 0; $j < $ll; $j++) { $pc = $c; $c = substr($txt,$j,1); #// char by char if ($inq) { $inq = 0 if ($c eq '"'); } elsif ($c eq '"') { $inq = 1; } if ($c =~ /\s/) { # if a SPACEY char if ($inq) { $wd .= $c; # keep spaces, if IN double quotes } else { push(@a,$wd) if length($wd); # stack word, if any $wd = ''; # and clear word } } else { $wd .= $c; # store it } } push(@a,$wd) if length($wd); # stack word, if any return @a; } # compiler flags my %compile_flags = ( 'nologo' => 0, 'W3' => 0, 'Gm' => 0, 'GR' => 0, 'GX' => 0, 'Od' => 0, 'MT' => 0, 'MTd' => 0, 'MD' => 0, 'MDd' => 0, 'I' => 1, 'D' => 1, 'FD' => 0, 'GZ' => 0, 'c' => 0, 'O2' => 0, 'Yc' => 0, 'Yu' => 0, 'YX' => 0, 'ZI' => 0, 'Zi' => 0, 'Fr' => 0 ); sub get_config_stg_hash($) { my ($cfg) = @_; my @arr = space_split_with_quotes2($cfg); my $cnt = scalar @arr; my ($i,$itm,$it2,$val,$tmp,$key,$ord); my %h1 = (); $ord = 0; # prt("Doing switch hash for [$cfg]\n" ); for ($i = 0; $i < $cnt; $i++) { $itm = $arr[$i]; if ($itm =~ /^[\/-]{1}/) { $it2 = substr($itm,1); $ord++; $key = sprintf("%04d_$it2",$ord); if (defined $compile_flags{$it2}) { if ($compile_flags{$it2}) { # need NEXT param $i++; # take next if (defined $h1{$key}) { $val = $h1{$key}; push(@{$val}, $arr[$i]); $h1{$key} = $val; } else { my @a = (); push(@a, $arr[$i]); $h1{$key} = [@a]; } } else { if (defined $h1{$key}) { prt( "[v5] Repeated switch [$it2]\n" ) if (VERB5()); $h1{$key}++; } else { $h1{$key} = 1; } } } elsif ($it2 =~ /^Yu"(\w|\.|-)+"/) { $tmp = $1; $it2 = 'Yu'; $key = sprintf("%04d_$it2",$ord); # we have a like [Yu"stdafx.h"] if (defined $h1{$key}) { prt( "[v5] Repeated switch [$it2] got [".$h1{$key}."], and now [$tmp]\n" ) if (VERB5()); } else { $h1{$key} = $tmp; } } elsif ($it2 =~ /^NEW_(\w+)/) { # skip the special substitute items '-NEW_BBB-' } else { prtw("WARNING: 1:WHAT is THIS switch [$it2]? full [$itm]!!!\n in file [$act_file]\n"); } } else { prtw("WARNING: 1:WHAT is THIS [$itm] non switch?\n in file [$act_file]"); } } return \%h1; } sub show_name_and_type($) { my ($rh) = @_; my $name = ''; my $type = ''; if ( !get_project_name($rh, \$name) || (length(trim_all($name)) == 0)) { prtw("ERROR: Unable to get project name!\n"); return 0; } if ( !get_project_type($rh, \$type) ) { prtw("ERROR: Unable to get project type!\n"); return 0; } if (! defined ${$rh}{'PROJECT_SRCS'} ) { prtw("WARNING: Project [$name], type [$type] hash has no SOURCES\n"); return 0; } my $rsrcs = ${$rh}{'PROJECT_SRCS'}; # = [ @dsp_sources ]; my $scnt = scalar @{$rsrcs}; prt("Project [$name], type [$type], with $scnt sources...\n"); return $scnt; # return number of sources } 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 scan_dsp_file_lines($$) { my ($file,$rlines) = @_; my $lncnt = scalar @{$rlines}; prt("\n") if (VERB5()); prt("[v1] Processing $lncnt lines from [$file] file...\n") if (VERB1()); my $got_project = 0; my $in_project = 0; my $in_target = 0; my $in_group = 0; my $projname = ''; my $rh = get_def_dsp_hash_ref($file); my ($oline,$line) = fileparse($file); # PROJECT_FDIR Input Directory: =[C:\FG\FGCOMXML\xmlrpc-c\Windows\] # PROJECT_FILE Input File: =[gennmtab.vcproj] ${$rh}{'PROJECT_FDIR'} = $line; ${$rh}{'PROJECT_FILE'} = $oline; my ($i,$lnn,$k,$tmp,$tmp2,$var1,$targnum,$version,@arr,$rcfgs); my ($key,$var); my @targtypes = (); # set target type string - san double quotes my $targtcnt = 0; my $targtype1 = ''; my $curr_cfg = ''; my $do_config = 0; my $cfg_msg = ''; my $isdebug = 0; my %cfgnames = (); my $cfgnamcnt = 0; my $cfgnmcnt = 0; # from lines '# Name blah blah blah' my ($cfg_proj,$cfg_plat,$cfg_type,$cfg_name,$dsp_sub_sub,$prop); my ($base,$flist,$tdir,$igexlib,$intdir,$outdir,$exfrmbld,$add,$post); my $bgnsrc = 0; my $custom = ''; my $customstg = ''; my $special = 0; my $specstg = ''; my $group = ''; my $have_prop = 0; my @dsp_sources = (); my $had_src = 0; my ($rsrca); # process line by line for ($i = 0; $i < $lncnt; $i++) { $lnn = $i + 1; $oline = ${$rlines}[$i]; $oline = substr($oline,0,length($oline)-1) while ($oline =~ /\s$/); next if (length($oline) == 0); $line = $oline; if ($got_project) { # had main project line if ($line =~ /^!IF\s+"\$\(CFG\)"\s+==\s+"(.+)"\s*$/) { $tmp = $1; prtw("WARNING: Discarded CONFIG [$curr_cfg]!\n") if (length($curr_cfg)); $curr_cfg = $tmp; $cfg_msg = 'Enter CFG'; $do_config = 1; } elsif ($line =~ /^!ELSEIF\s+"\$\(CFG\)"\s+==\s+"(.+)"\s*$/) { $tmp = $1; prtw("WARNING: Got ELSEIF before IF [$curr_cfg]!\n") if (length($curr_cfg) == 0); $curr_cfg = $tmp; $cfg_msg = 'ElseIf CFG'; $do_config = 1; next; } elsif ($line =~ /^!ENDIF\s*$/) { $curr_cfg = ''; next; } if ($do_config) { # "Spy5 - Win32 Debug" or # "minigzip - Win32 DLL ASM Release" if ($curr_cfg =~ /Debug/i) { $tmp2 = "Debug"; $isdebug = 1; $dsp_sub_sub = get_default_sub3(1); } elsif ($curr_cfg =~ /Release/i) { $tmp2 = "Release"; $isdebug = 0; $dsp_sub_sub = get_default_sub3(0); } elsif ($curr_cfg =~ /DLL/) { # exception for DLL $tmp2 = "ReleaseDLL"; $isdebug = 0; $dsp_sub_sub = get_default_sub3(0); } else { pgm_exit(1,"ERROR: Did NOT find 'Debug' or 'Release' in [$curr_cfg]!\n"); } @arr = split(/\s/,$curr_cfg); $tmp = scalar @arr; if ($tmp < 4) { pgm_exit(1,"ERROR: UNmanaged split of [$curr_cfg]. Expected min 4, got $tmp! FIX CODE!\n"); } $cfg_proj = $arr[0]; $cfg_plat = $arr[2]; # Platform $cfg_type = $arr[3]; # Release, Debug, etc 'DLL Universal Unicode Release', or ... $cfg_name = $cfg_type; # from : C:\FG\27\wxWidgets-2.8.10\build\msw\wx_adv.dsp # adv - Win32 DLL Universal Unicode Release if ($tmp > 4) { $cfg_type = ''; for ($k = 3; $k < $tmp; $k++) { if (($arr[$k] =~ /Release/i)||($arr[$k] =~ /Debug/i)) { $cfg_type = $arr[$k]; $arr[$k] = ''; } } $cfg_type = 'Release' if (length($cfg_type)==0); $cfg_name = $cfg_type; for ($k = 3; $k < $tmp; $k++) { $cfg_type .= $arr[$k]; } } ${$rh}{'TEMP_DSP_SUB'} = $dsp_sub_sub; # direct access to substitution block -NEW_???- items if ($in_target) { # change of CFG item for a specific source - NOT HANDLED ${$rh}{'TEMP_LAST_CFG'} = [ $cfg_name, $var1, $tmp2, $dsp_sub_sub ]; ${$rh}{'TEMP_GOT_LAST'} = 1; } else { #prt("[dbg_01] Enter CFG [$curr_cfg] [$cfg_name]\n") if ($dbg_01); prt("[dbg_01] $cfg_msg [$curr_cfg] [$cfg_name]\n") if ($dbg_01); ### check_cfg_name($rh, $curr_cfg, \%cfgnames, $cfgnamcnt ); set_per_cfg_name( $rh, $curr_cfg ); $var1 = "-NEW_OUTD-"; $tmp2 = "$cfg_type|$cfg_plat"; $rcfgs = ${$rh}{'PROJECT_CFGS'}; # 0 1 2 3 # push(@{$rcfgs}, [ $pname, $var1, $conf, $dsp_sub_sub ]); push(@{$rcfgs}, [ $cfg_name, $var1, $tmp2, $dsp_sub_sub ]); ${$rh}{'TEMP_LAST_CFG'} = ${$rcfgs}[-1]; # store this LAST config ${$rh}{'TEMP_GOT_LAST'} = 1; } $do_config = 0; next; } $line =~ s/^\#\s+//; if ($in_project) { if ($line =~ /^End\s+Project\s*$/) { $in_project = 0; } elsif ($in_target) { if ($line =~ /^End\s+Target\s*$/) { $in_target = 0; } else { # handle ALL lines until 'End Target' # Name - "FlightGear - Win32 Release" # Name - "FlightGear - Win32 Debug" # Begin Group "Source Files" # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" # etc # if ($line =^ /^Name\s+-\s+(.+)\s*$/) if ($line =~ /^Name\s+(.+)\s*$/) { $tmp = strip_quotes($1); # # Name - "FlightGear - Win32 Release" # # Name "minigzip - Win32 DLL Release" $tmp =~ s/^-\s+//; # dump any '- ' lead $tmp = strip_quotes($tmp); $cfgnmcnt++; prt("[v2] $cfgnmcnt: CFG Name: [$tmp]\n") if (VERB2()); } elsif ($line =~ /^End\s+Source\s+File\s*$/) { $bgnsrc = 0; } elsif ($line =~ /^Begin\s+Source\s+File\s*$/) { $bgnsrc = 1; $had_src = 0; } elsif ($line =~ /^Begin\s+Custom\s+Build\s+(.+)\s*$/) { $custom = $1; } elsif ($line =~ /^End\s+Custom\s+Build\s*$/) { $custom = ''; $customstg = ''; } elsif ($line =~ /^Begin Special Build Tool$/) { $special = 1; $specstg = ''; # # Begin Special Build Tool # OutDir=.\Release # SOURCE="$(InputPath)" # PostBuild_Cmds=$(outdir)\VisualPng.exe ..\..\contrib\pngsuite\basn6a16.png # # End Special Build Tool } elsif ($line =~ /^End Special Build Tool$/) { $special = 0; } elsif ($line =~ /^PROP\s+(.+)\s*$/) { $prop = $1; $have_prop = 1; # ALL THE '# PROP ' TYPE ENTRIES } elsif ($line =~ /^End\s+Group\s*$/) { $group = ''; # clear GROUP $flist = ''; # and clear FILTER list $in_group = 0; # and NOT in group } elsif ($line =~ /^Begin\s+Group\s+(.+)\s*$/) { # # Begin Group "Source Files" $group = strip_quotes($1); # usually with quotes $in_group = 1; } else { # ================================== if ($special) { $specstg .= "\n" if (length($specstg)); $specstg .= $line; } elsif (length($custom)) { $customstg .= "\n" if (length($customstg)); $customstg .= $line; } elsif ($bgnsrc) { if ($line =~ /^SOURCE=(.+)$/) { $var = $1; # 0 1 2 3 4 # push(@{$src_ref}, [ $src, $group, $flist, 0, '' ]); # and PUSH onto SOURCE stack # push(@dsp_sources, [ $var, $group, $flist, 0, '' ]); set_group_and_filter($var, \$group, \$flist); push(@dsp_sources, [ $var, $group, $flist, 0, '' ]); $rsrca = $dsp_sources[-1]; $had_src = 1; } elsif ($oline =~ /^\s*\#\s+ADD\s+CPP\s+(.+)$/) { $var = $1; if ($had_src) { ${$rsrca}[4] = $var; } else { prtw("WARNING:$lnn: Discarded [$oline] no SOURCE line\n file [$file]\n"); } } elsif ($oline =~ /^\s+\#\s+PROP\s(.+)$/) { $var = $1; if ($var =~ /Exclude_From_Build\s+(\d+)/) { $var = $1; if ($had_src) { ${$rsrca}[3] = $var; } else { prtw("WARNING:$lnn: Discarded [$oline] no SOURCE line\n file [$file]\n"); } } else { prtw("WARNING:$lnn: Discarded PROP [$oline]\n file [$file]\n"); } } else { pgm_exit(1,"ERROR:$lnn: Unhandled in source line [$oline] [$line]\n file [$file]"); } } else { pgm_exit(1,"ERROR:$lnn: Unhandled in target line [$oline] [$line]\n file [$file]\n"); } } } } else { # Items BEFORE '# Begin Target' if ($line =~ /^Begin\s+Target\s*$/) { $in_target = 1; } else { # if ($oline =~ /^(\w+{1})(.+)=(.+)$/ ) if ($oline =~ /^(\w+)\s*=\s*(.+)\s*$/) { # got something=that, but can be # LIB32=link.exe -lib $key = $1; $var = $2; # have a MACRO A=B } else { $base = 0; $add = 0; if ($line =~ /^PROP\s+(.+)$/) { $prop = $1; # Setup PROPS $have_prop = 1; } elsif ($line =~ /^ADD\s+(.+)$/) { $line = $1; # Adds $add = 1; } elsif ($line =~ /^SUBTRACT\s+(.+)$/) { $line = $1; # Subtracts $add = -1; } elsif ($line =~ /^Begin\sSpecial/) { # # Begin Special Build Tool # SOURCE="$(InputPath)" # PostBuild_Desc=Copy test files # PostBuild_Cmds=if not exist bin\data md bin\data copy ..\test\data\*.* bin\data # # End Special Build Tool # PROJECT_CFGS Configs found: =(ARRAY of count 2) # 1: Debug -NEW_OUTD- Debug|Win32 8 and -NEW_OUTD- = ["Debug\gennmtab"] # -NEW_POST- = [# Begin Special Build Tool #SOURCE="$(InputPath)" #PostBuild_Desc="(R) Generating nametab.h ..." #PostBuild_Cmds=bin\gennmtab.exe >..\lib\expat\xmltok\nametab.h # End Special Build Tool #] $post = "$oline\n"; $i++; for (; $i < $lncnt; $i++) { $oline = ${$rlines}[$i]; $post .= $oline; last if ($oline =~ /^\s*\#\s+End\s+Special\s+/); } if ($i < $lncnt) { if (defined ${$rh}{'TEMP_DSP_SUB'} ) { my $rsubsub = ${$rh}{'TEMP_DSP_SUB'}; # = $dsp_sub_sub; # direct access to substitution block -NEW_???- items ${$rsubsub}{'-NEW_POST-'} = $post; } else { prtw("WARNING:$lnn: Post Special NOT ADDED [$post] file $file\n"); } } else { pgm_exit(1,"ERROR:$lnn: End of [$line] NOT FOUND! file [$file]\n"); } } else { pgm_exit(1,"ERROR:$lnn: Unhandled pre Begin Target marker! [$oline] [$line]\n file [$file\n"); } if ($add != 0) { if ($line =~ /^BASE\s+/) { $line =~ s/^BASE\s+//; $base = 1; } if ($line =~ /^CPP\s+/) { $line =~ s/^CPP\s+//; process_config_stg2($rh,$line,$add); } elsif ($line =~ /^RSC\s+/) { $line =~ s/^RSC\s+//; # 2010-01-19 IS NEEDED - like # c:\FG\32\zips\temp\pthread.dsp # # ADD BASE RSC /l 0x809 /d "NDEBUG" # # ADD RSC /l 0x809 /d "NDEBUG" /d "PTW32_RC_MSC" # OR LIKE - c:\FG\32\lpng\projects\visualc6\libpng.dsp # # ADD RSC /l 0x409 /i "..\.." /d "_DEBUG" /d PNG_DEBUG=1 # # ADD RSC /l 0x409 /i "..\.." /d "NDEBUG" /d PNG_LIBPNG_SPECIALBUILD=""""Use MMX instructions"""" # # ADD RSC /l 0x409 /i "..\.." /d "NDEBUG" /dPNG_LIBPNG_DLLFNAME_POSTFIX=""""VB"""" /dPNG_LIBPNG_SPECIALBUILD=""""__stdcall calling convention used for exported functions"""" } elsif ($line =~ /^BSC32\s+/) { } elsif ($line =~ /^LINK32\s+/) { $line =~ s/^LINK32\s+//; process_LINK_stg2($rh,$line,$add); } elsif ($line =~ /^MTL\s+/) { } elsif ($line =~ /^LIB32\s+/) { $line =~ s/^LIB32\s+//; #prtw("WARNING:$lnn: LIB32 [$line] CHECK NEW FUNCTION!\n"); process_LIB_stg2($rh,$line,$add); } elsif ($line =~ /^F90\s+/) { } else { pgm_exit(1,"ERROR:$lnn: Unhandled ADD/SUBTRACT pre Begin Target marker! [$oline] [$line]\n file [$file]\n"); } } } } } } else { # Items BEFORE '# Begin Project' if ($line =~ /^Begin\s+Project\s*$/) { $in_project = 1; } else { if ($line =~ /^Microsoft\s+Developer\s+Studio\s+Generated\s+Build\s+File,\s+Format\s+Version\s+(.+)\s*$/) { $version = $1; } elsif (($line =~ /^\*\*\s+DO\s+NOT\s+EDIT\s+\*\*\s*$/)|| ($line =~ /\*\* NICHT BEARBEITEN \*\*/)) { # skip it } elsif ($line =~ /^!MESSAGE/) { # skip these } elsif ($line =~ /^TARGTYPE\s+"(.+)"\s+(.+)\s*$/) { $tmp = $1; $targnum = $2; push(@targtypes, $tmp); # set target type string - san double quotes $targtcnt++; if (length($targtype1) == 0) { # DSP TYPES 0 1 2 3 # TARGTYPE "Win32 (x86) Application" 0x0101 # TARGTYPE "Win32 (x86) Dynamic-Link Library" 0x0102 # TARGTYPE "Win32 (x86) Console Application" 0x0103 # TARGTYPE "Win32 (x86) Static Library" 0x0104 @arr = split(/\s/,$tmp); $tmp2 = scalar @arr; for ($k = 2; $k < $tmp2; $k++) { $targtype1 .= ' ' if length($targtype1); $targtype1 .= $arr[$k]; } ${$rh}{'PROJECT_APTP'} = $targtype1; prt("[v5] $targtcnt: TARGTYPE = [$tmp] num [$targnum]\n") if (VERB5()); } } elsif ($line =~ /^CFG=(.+)$/) { # default config } else { pgm_exit(1,"ERROR:$lnn: Unhandled pre Begin Project marker! [$oline]\n"); } } } } else { # this should be the FIRST line in the file if ($line =~ /^\#\s+Microsoft\s+Developer\s+Studio\s+Project\s+File\s+-\s+Name="(.+)"\s+-\s+/) { $projname = $1; prt("[v2] Project name = [$projname]\n") if (VERB2()); $got_project = 1; ${$rh}{'PROJECT_NAME'} = $projname; } # ignore ALL lines before the above FIRST } if ($have_prop) { $have_prop = 0; # ALL THE '# PROP ' TYPE ENTRIES if ($prop =~ /^BASE\s+/) { $prop = substr($prop,5); $base = 1; } if ($prop =~ /^Default_Filter\s+(.+)$/) { # PROP Default_Filter "cpp;c;cxx;rc;def;r;odl;idl;hpj;bat" # PROP Default_Filter "h;hpp;hxx;hm;inl" # PROP Default_Filter "" $flist = strip_quotes($1); } elsif ($prop =~ /^Target_Dir\s+(.+)$/) { # PROP BASE Target_Dir "" # PROP Target_Dir "" $tdir = strip_quotes($1); } elsif ($prop =~ /^Ignore_Export_Lib\s+(.+)$/) { # PROP Ignore_Export_Lib 0 $igexlib = $1; } elsif ($prop =~ /^Intermediate_Dir\s+(.+)$/) { # PROP BASE Intermediate_Dir "Release" # PROP Intermediate_Dir "Release" # PROP BASE Intermediate_Dir "Debug" # PROP Intermediate_Dir "Debug" $intdir = strip_quotes($1); } elsif ($prop =~ /^Output_Dir\s+(.+)$/) { # PROP BASE Output_Dir "Debug" # PROP Output_Dir "Debug" # PROP BASE Output_Dir "Release" # PROP Output_Dir "Release" $outdir = strip_quotes($1); } elsif ($prop =~ /^Output_Dir\s*$/) { $outdir = ''; } elsif ($prop =~ /^Use_Debug_Libraries\s+(.+)$/) { # PROP BASE Use_Debug_Libraries 0 # PROP Use_Debug_Libraries 0 # PROP BASE Use_Debug_Libraries 1 # PROP Use_Debug_Libraries 1 } elsif ($prop =~ /^Use_MFC\s+(.+)$/) { # PROP BASE Use_MFC 0 # PROP Use_MFC 0 } elsif ($prop =~ /^AllowPerConfigDependencies\s+(.+)$/) { # PROP AllowPerConfigDependencies 0 } elsif ($prop =~ /^Scc_ProjName\s+(.+)$/) { # PROP Scc_ProjName "" } elsif ($prop =~ /^Scc_LocalPath\s+(.+)$/) { # PROP Scc_LocalPath "" } elsif ($prop =~ /^Exclude_From_Build\s+(.+)$/) { # PROP Exclude_From_Build 1 $exfrmbld = $1; } else { pgm_exit(1,"ERROR:$lnn: Uncased PROP [$prop] [$oline]\n in file [$file]\n"); } } } ${$rh}{'PROJECT_SRCS'} = \@dsp_sources; prt("[v9] Done $lncnt lines from [$file] file...\n") if (VERB9()); show_name_and_type($rh); ### pgm_exit(1,"TEMP EXIT"); return $rh; } sub process_dsp_file($) { my ($dsp) = @_; if (! open INF, "<$dsp") { prt("ERROR: Unable to open [$dsp] file!\n"); pgm_exit(1,""); } my @lines = ; close INF; return scan_dsp_file_lines($dsp,\@lines); } sub process_in_dsp($) { my $dsp = shift; my $rh = process_dsp_file($dsp); prt("\n") if (VERB5()); # just for DEBUG show_hash_results4($rh,$show_flag); return $rh; } sub process_in_dsw { my ($fil) = shift; my ($msg, $lc, $lin, $pcnt, $ln, $bal, $pn, $pf, $ff, $ok); prt( "Processing DSW file [$fil] ...\n" ); if ( !open INF, "<$fil" ) { $msg = "WARNING: Unable to open [$fil] ..."; prtw( "$msg\n" ); return 0; } my @lines = ; close INF; $lc = scalar @lines; prt( "Processing $lc lines ...\n" ) if (VERB9()); my ($nm, $dir, $ext) = fileparse( $fil, qr/\.[^.]*/ ); $pcnt = 0; $ln = 0; my %dswprojs = (); 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] " ); $ok = "NOT FOUND"; $ok = "ok" if (-f $ff); prt( "Got Project: $pn, $ff $ok\n" ) if ($dbg5 || VERB9()); 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" ); my @projs = (); my ($rh); foreach $pn (keys %dswprojs) { $ff = $dswprojs{$pn}; $act_file = $ff; $rh = process_in_dsp($ff); push(@projs, [$pn,$ff,$rh]); } return \@projs; } sub is_build_type($) { my $fil = shift; return 1 if ($fil =~ /\.sln$/i); return 2 if ($fil =~ /\.vcproj$/i); return 3 if ($fil =~ /\.dsw$/i); return 4 if ($fil =~ /\.dsp$/i); return 5 if ($fil =~ /\.vcxproj$/i); return 0; } sub process_in_objects() { my ($file,$type); foreach $file (@in_objects) { $act_file = $file; $type = is_build_type($file); if ($type == 1) { process_in_sln($file); } elsif ($type == 2) { process_in_vcproj($file); } elsif ($type == 3) { process_in_dsw($file); } elsif ($type == 4) { process_in_dsp($file); } elsif ($type == 5) { process_in_vcxproj($file); } else { prtw("WARNING: file [$file] is NOT a known build type! Ignoring...\n"); } } } ######################################### ### MAIN ### parse_args(@ARGV); #process_in_file($in_file); process_in_objects(); 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"); prt(" --verb[n] (-v) = Bump [or set] verbosity. def=$verbosity\n"); prt(" --load (-l) = Load LOG at end. ($outfile)\n"); prt(" --out (-o) = Write output to this file.\n"); prt(" --show (-s) = Items to show. Semi-colon separated list of-\n"); prt(get_show_list(-1)."\n"); prt(" or a value. Use -1 for all, or all.\n"); prt("Purpose: Load a MSVC build file, dsw,dsp,sln,vcproj, and show contents.\n"); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av); } sub parse_args { my (@av) = @_; my ($arg,$sarg,@arr,$val); $show_flag = 0; while (@av) { $arg = $av[0]; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^v/) { if ($sarg =~ /^v.*(\d+)$/) { $verbosity = $1; } else { while ($sarg =~ /^v/) { $verbosity++; $sarg = substr($sarg,1); } } prt("Verbosity = $verbosity\n") if (VERB1()); } elsif ($sarg =~ /^l/) { $load_log = 1; prt("Set to load log at end.\n") if (VERB1()); } elsif ($sarg =~ /^o/) { need_arg(@av); shift @av; $sarg = $av[0]; $out_xml = $sarg; prt("Set out file to [$out_xml].\n") if (VERB1()); } elsif ($sarg =~ /^s/) { need_arg(@av); shift @av; $sarg = $av[0]; if ($sarg =~ /^-1$/) { $show_flag = 1; } elsif ($sarg =~ /^\d+$/) { $show_flag = $sarg; } else { @arr = split(/;+/,$sarg); foreach $sarg (@arr) { $val = get_show_value($sarg); if ($val == 0) { pgm_exit(1,"ERROR: Invalid argument [$arg $sarg]! Try -?\n"); } $show_flag |= $val; } } $val = ''; if ($show_flag) { $val = get_show_list($show_flag); } if (length($val)) { prt("Show [$val] items. ($show_flag)\n") if (VERB1()); } else { $sarg = $av[0]; prt("WARNING: $arg $sarg yielded NO show bits!\n"); } } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = $arg; push(@in_objects,File::Spec->rel2abs($arg)); prt("Set input to [$in_file]\n") if (VERB1()); } shift @av; } $arg = $def_file; if ((length($in_file) == 0) && $debug_on) { $in_file = $def_file; push(@in_objects,File::Spec->rel2abs($arg)); prt("Set DEFAULT input to [$in_file]\n"); if ($show_flag == 0) { $show_flag = ($sh_cfgs | $sh_defs); $val = get_show_list($show_flag); prt("Set DEFAULT show [$val] items. ($show_flag)\n"); } $load_log = 1; } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (! -f $in_file) { pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n"); } if ($show_flag == 0) { $show_flag = ($sh_cfgs | $sh_defs); $val = get_show_list($show_flag); prt("Set DEFAULT show [$val] items. ($show_flag)\n"); } } # eof - vcopts.pl