#!/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
