Generated: Tue Feb 2 17:54:36 2010 from fgsln2dsw02.pl 2008/10/31 14.7 KB.
#!/perl -w # NAME: fgsln2dsw02.pl # AIM: Read solution file (SLN), and extract projects, # write appropriate DSP file, and finally write DSW file. # 30/10/2008 geoff mclane - http://geoffair.net/fg use strict; use warnings; use File::Basename; use Cwd; require 'fgutils.pl' or die "Unable to load fgutils.pl ...\n"; require 'fgdsphdrs.pl' or die "Unable to load fgdsphdrs.pl ...\n"; require 'fgscanvc.pl' or die "Unable to load fgscanvc.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = "temp.$pgmname.txt"; open_log($outfile); my $write_temp_only = 0; # Off to WRITE actual DSW/DSP file - any previous are backed up ... my $in_file = 'fgfs\fgfs.sln'; # $hash{'PROJECTS'} = { %sln_projects }; # PROJECTS = [ ul = PLIB\src\util\ul.vcproj ] # $hash{'PROJPATH'} = { %sln_projpath }; # PROJPATH = [ ul = ..\PLIB\src\util\ ] # $hash{'DEPENDS'} = { %sln_depends }; # DEPENDS = [ SimGear = zlib|puAux|libpng|ssg... ] # $hash{'PROJIDS'} = { %sln_projids }; # PROJIDS = [ ul = {A4CD75C6-3F7E-4497-8503-F9CEE50F7F41} ] my @hash_keys = qw( SOLUTION PROJECTS PROJPATH DEPENDS PROJIDS ); # DEBUG my $dbg_sl01 = 0; # show prt( "Got PROJECT name=$projname, file=$projff, rel=[$relpath]. my $dbg_sl02 = 0; # show prt( "Proj $projname, dependant on $arr[0] ... my $dbg_sl03 = 0; # show prt( "proj $projname, depends on $nmdeps ... my $dbg_sl04 = 0; # show show_solution( \%solution ) ... my @warnings = (); my %solution = process_SLN_file($in_file); #show_solution_simple(\%solution) if ($dbg_sl04); show_solution(\%solution) if ($dbg_sl04); set_dbg_props() if ($write_temp_only); # Off to WRITE actual DSW/DSP file - any previous are backed up ... process_solution_hash(0,\%solution); show_warnings(); close_log($outfile,1); exit(0); ############################################################################### ### SUBS ONLY sub fg_add_proj_begin { my ($fh, $prj, $fil) = @_; print $fh <<EOF; ############################################################################### Project: "$prj"=".\\$fil" - Package Owner=<4> Package=<5> {{{ }}} Package=<4> {{{ EOF } sub fg_add_proj_depends { my ($fh, $prj, $rd) = @_; my ($pdeps, @arr, $dpn); if (defined $$rd{$prj}) { $pdeps = $$rd{$prj}; if (length($pdeps)) { @arr = split( /\|/, $pdeps ); foreach $dpn (@arr) { print $fh " Begin Project Dependency\n"; print $fh " Project_Dep_Name $dpn\n"; print $fh " End Project Dependency\n"; } } } else { prtw( "WARNING: Project $prj NOT defined in sln_depends!!!\n" ); } } sub fg_add_proj_end { my ($fh) = shift; print $fh <<EOF; }}} EOF } sub process_solution_hash { # (\%solution); my ($dbg_bits, $sr) = @_; my ($key, $val, $k2); my ($proj, $file, $rpath, $id, $sln_file); my ($ref_proj, $ref_path, $ref_deps, $ref_ids); my ($out_file); my ($nam,$dir,$ext); my ($msg); my %dsw_projects = (); # output DSP file, by PROJECT key my %dsw_projpath = (); # blank - not used my @written = (); # 1. Extract the HASH REFERENCES of each key foreach $key (@hash_keys) { $val = $$sr{$key}; if ($key eq 'PROJECTS') { $ref_proj = $val; } elsif ($key eq 'PROJPATH') { $ref_path = $val; } elsif ($key eq 'DEPENDS') { $ref_deps = $val; } elsif ($key eq 'PROJIDS') { $ref_ids = $val; } elsif ($key eq 'SOLUTION') { $sln_file = $val; } else { prtw("WARNING: case for key [$key] NOT YET DONE!\n"); } } # 2. Process each PROJECT, extracting VCPROJ file, process it, and write DSP file foreach $k2 (keys %{$ref_proj}) { $proj = $k2; $file = $$ref_proj{$k2}; $rpath = $$ref_path{$k2}; $id = $$ref_ids{$k2}; my %h = process_VCPROJ( $file ); show_hash_results($dbg_bits,\%h) if ($dbg_bits); ($nam, $dir, $ext) = fileparse($file, qr/\.[^.]*/ ); $out_file = $rpath.$nam.'.dsp'; $dsw_projects{$proj} = $out_file; $dsw_projpath{$proj} = ''; $out_file = $dir.$nam.'.dsp'; # out to SAME directory/name, with DSP extension # but if $write_temp_only OUTPUT ONLY A TEMP file $out_file = 'temp.'.$proj.'.dsp' if ($write_temp_only); write_hash_to_DSP($out_file, \%h, $dbg_bits); # more for a DEBUG view $msg = $proj.'|'.$rpath.$nam.'.dsp'; $out_file = $dir.$nam.'.dsp'; $msg .= "|$out_file"; push(@written, $msg); } # 3. Output a DSW file ($nam, $dir, $ext) = fileparse($sln_file, qr/\.[^.]*/ ); $out_file = $dir.$nam.'.dsw'; # same directory, name, but with DSW extension prt( "\nFrom $sln_file to $out_file ...\n" ); # but if $write_temp_only OUTPUT ONLY A TEMP file $out_file = 'temp.'.$nam.'.dsw' if ($write_temp_only); my ($DSW, $i, $prj, $fil, $rfile, $rp); my @prjlist = sort keys(%{$ref_proj}); my $prjcnt = scalar @prjlist; my @donelist = (); if ($prjcnt == 0) { prtw( "WARNING: NO PROJECTS IN \%dsw_projects!!!\n". "SO NO DSW FILE CREATED! Why is hash (ref) blank???\n" ); return; } rename_2_old_bak($out_file); if (open $DSW, ">$out_file") { # WRITE DSW FILE $msg = get_dsw_head(); print $DSW $msg; for ($i = 0; $i < $prjcnt; $i++) { $prj = $prjlist[$i]; if ( !is_in_array($prj, @donelist) ) { $fil = $dsw_projects{$prj}; $rp = $dsw_projpath{$prj}; $fil = $rp."\\".$fil if (length($rp)); fg_add_proj_begin( $DSW, $prj, $fil ); # add any DEPENDENCIES NOW fg_add_proj_depends( $DSW, $prj, $ref_deps ); fg_add_proj_end( $DSW ); } } $msg = get_dsw_tail(); print $DSW $msg; close $DSW; # diagnostic OUTPUT foreach $file (@written) { prt( "$file\n" ); } prt( "Written [$out_file] file ... with $prjcnt projects ...\n" ); } else { prtw("ERROR: Unable to WRITE $out_file ...\n" ); } } sub show_solution { my ($sr) = shift; my ($key, $val, $k2); my ($proj, $file, $rpath, $id); my ($ref_proj, $ref_path, $ref_deps, $ref_ids,$sln_file); my ($msg, $part); my $mxplen = 0; my $mxfile = 0; my $mxrpath = 0; foreach $key (@hash_keys) { $val = $$sr{$key}; if ($key eq 'PROJECTS') { $ref_proj = $val; } elsif ($key eq 'PROJPATH') { $ref_path = $val; } elsif ($key eq 'DEPENDS') { $ref_deps = $val; } elsif ($key eq 'PROJIDS') { $ref_ids = $val; } elsif ($key eq 'SOLUTION') { $sln_file = $val; prt("\nShow for solution file $sln_file ...\n"); } else { prtw("WARNING: case for key [$key] NOT YET DONE!\n"); } } foreach $k2 (keys %{$ref_proj}) { $proj = $k2; $mxplen = length($proj) if (length($proj) > $mxplen); $file = $$ref_proj{$k2}; $mxfile = length($file) if (length($file) > $mxfile); $rpath = $$ref_path{$k2}; $mxrpath = length($rpath) if (length($rpath) > $mxrpath); $id = $$ref_ids{$k2}; } prt( "From processing $sln_file, got -\n" ); foreach $k2 (keys %{$ref_proj}) { $proj = $k2; $file = $$ref_proj{$k2}; $rpath = $$ref_path{$k2}; $id = $$ref_ids{$k2}; $part = (( -f $file ) ? "ok" : "NO"); while(length($proj) < $mxplen) {$proj .= ' ';} while(length($file) < $mxfile) {$file .= ' ';} $file .= " $part"; while(length($rpath) < $mxrpath) {$rpath .= ' ';} prt( "PROJECT $proj, file=[$file], rel=[$rpath]\n" ); #, id=[$id]\n" ); } } sub show_solution_simple { my ($sr) = shift; my ($key, $val, $k2, $v2); foreach $key (keys %{$sr}) { $val = $$sr{$key}; if ($key eq 'SOLUTION') { prt("Solution file = [$val]\n" ); } else { foreach $k2 (keys %{$val}) { $v2 = $$val{$k2}; prt( "$key = [ $k2 = $v2 ]\n" ); } } } } sub is_vcproj { my $fil = shift; if ($fil =~ /\.vcproj$/i) { return 1; } return 0; } # Read and store contents of SOLUTION (.sln) file # 22/04/2008 - Extract DEPENDENCIES from solution file, and add to DSW output sub process_SLN_file { my ($fil) = 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); my ($msg); open IF, "<$fil" or mydie( "ERROR: Unable to open $fil ... $! ...\n" ); my @lines = <IF>; close IF; $cnt = scalar @lines; my ($name,$sln_path) = fileparse($fil); my %hash = (); my %sln_projects = (); my %sln_projpath = (); my %sln_depends = (); my %sln_projids = (); prt( "\nProcessing $cnt lines ... n=[$name] p=[$sln_path] ...\n" ); $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( "Is MSVC Version $mver ...\n" ); } elsif ($line =~ /^Project\s*\(/) { # seek like #Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "abyss", "abyss.vcproj", "{8B384B8A-2B72-4DC4-8DF1-E3EF32F18850}" ###prt( "Got project [$line] ...\n" ); $inproj = 1; @arr = split( '=', $line ); $cnt = scalar @arr; if ($cnt == 2) { $par = $arr[1]; @arr = split(',', $par); $cnt = scalar @arr; if ($cnt == 3) { $projname = strip_quotes(trim_all($arr[0])); $projfile = strip_quotes(trim_all($arr[1])); $projid = strip_quotes(trim_all($arr[2])); $projff = fix_rel_path($sln_path.$projfile); if ((length($projname)) && (is_vcproj($projfile)) && (-f $projff)) { $gotproj = 1; ($tnm,$tpth) = fileparse($projff); $relpath = get_rel_dos_path($tpth, $sln_path); prt( "Got PROJECT name=$projname, file=$projff, rel=[$relpath].\n" ) if ($dbg_sl01); 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/' $sln_projids{$projname} = $projid; $sln_depends{$projname} = ''; # start dependencies, if any } } else { $msg = "WARNING: "; if (!length($projname)) { $msg .= "Failed to get a project name! "; } elsif ( !is_vcproj($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 # ===================================================================== if (!$gotproj) { prtw("WARNING: line [$line] ...\n"); } # ===================================================================== } 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( "Proj $projname, dependant on $arr[0] ...\n" ) if ($dbg_sl02); ##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" ); # resolve dependencies, if possible - warn if NOT ... #resolve_depends(); 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) { foreach $pn (keys %sln_projids) { if ($pn ne $projname) { $projid = $sln_projids{$pn}; if ($depid eq $projid) { $nmdeps .= '|' if (length($nmdeps)); $nmdeps .= $pn; last; } } } } @arr = split( /\|/, $nmdeps ); prt( "proj $projname, depends on $nmdeps ...\n" ) if ($dbg_sl03); if ($cnt != scalar @arr) { # YEEK - Does NOT match - OH WELL prtw( "WARNING: Failed to get SAME count $cnt - got ".scalar @arr."!\n" ); } $sln_depends{$projname} = $nmdeps; } } $hash{'SOLUTION'} = $fil; # keep the SOLUTION files also $hash{'PROJECTS'} = { %sln_projects }; $hash{'PROJPATH'} = { %sln_projpath }; $hash{'DEPENDS'} = { %sln_depends }; $hash{'PROJIDS'} = { %sln_projids }; return %hash; } sub prtw { my ($tx) = shift; if ($tx =~ /\n$/) { prt($tx); $tx =~ s/\n$//; } else { prt("$tx\n"); } push(@warnings,$tx); } sub show_warnings { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS ...\n" ); foreach my $line (@warnings) { prt("$line\n" ); } prt("\n"); } else { prt("\nNo warnings issued.\n\n"); } } # eof - fgsln2dsw02.pl