#!/usr/bin/perl -w
# NAME: sln2x64.pl
# AIM: Given a MSVC10 solution file, convert to an X64 soltuion set
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use Cwd;
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";
# 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-04-09";
my $load_log = 0;
my $in_file = '';
my $verbosity = 0;
my $out_xml = '';

# ### DEBUG ###
my $debug_on = 1;
my $def_file = 'C:\Projects\jpeg-8d\build\libjpeg.sln';


### program variables
my @warnings = ();
my $cwd = cwd();
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 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);
}

# LOAD without a BOM
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("NOTE: File [$nm] is $name encoding. BOM($len) removed.\n");
    }
}

sub load_file_lines($$) {
    my ($ff,$ra) = @_;
    my $lncnt = 0;
    $curr_file_bom = '';
    if (open INF, "<$ff") {
        @{$ra} = <INF>;
        close INF;
        $lncnt = scalar @{$ra};
        remove_utf_bom($ff,$ra) if ($strip_bom);
    } else {
        prtw("WARNING: Unable to open [$ff]!\n");
    }
    return $lncnt;
}

sub is_valid_uuid($) {
    my $id = shift;
    my $msg = '';
    # B60DCFA1-5436-6CFE-234C-A98ED962E54E
    # 8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942
    if ($id =~ /^[A-F0-9]{8}-[A-F0-9]{4}-[A-F0-9]{4}-[A-F0-9]{4}-[A-F0-9]{12}$/) {
        return 1;
    }
    if ( !($id =~ /^[A-F0-9]{8}-/) ) {
        $msg .= "Does not commence with 8 HEX [".substr($id,0,9)."]";
    } elsif ( !($id =~ /^[A-F0-9]{8}-[A-F0-9]{4}-/ ) ) {
        $msg .= "Fails first 4 HEX [".substr($id,9,5)."]";
    } elsif ( !($id =~ /^[A-F0-9]{8}-[A-F0-9]{4}-[A-F0-9]{4}-/ ) ) {
        $msg .= "Fails second 4 HEX [".substr($id,14,5)."]";
    }
    prtw("WARNING: UUID FAILED [$id] $msg\n");
    return 0;
}

sub sub_win32($) {
    my $rt = shift;
    if (${$rt} =~ /\|Win32\b/i) {
        ${$rt} =~ s/\|Win32\b/\|x64/;
    }
}

sub get_new_uuid($) {
    my $txt = shift;
    if ($txt =~ /^A64/) {
        if ($txt =~ /^B64/) {
            if ($txt =~ /^C64/) {
                pgm_exit(1,"ERROR: Need to EXPAND list of substitutions!\n");
            } else {
                $txt =~ s/^.{3}/C64/;
            }
        } else {
            $txt =~ s/^.{3}/B64/;
        }
    } else {
        $txt =~ s/^.{3}/A64/;
    }
    return $txt;
}


sub process_in_sln($) {
    my ($inf) = @_;
    my @lines = ();
    my ($name,$dir) = fileparse($inf);
    my $lncnt = load_file_lines($inf,\@lines);
    prt("Processing $lncnt lines, from [$inf]...\n");
    my ($line,$hdrcnt,$lnn,$inglobal,$dnheader,$id1,$id2,$proj,$file,$done,$len,$tline,$ok,$ff);
    my ($type,$conf,$itm,$val,$ind,$msg,$nid);
    $lnn = 0;
    $inglobal = 0;
    $dnheader = 0;
    $hdrcnt = 0;
    $done = 0;
    my @nlines = ();
    my $sln_out = $temp_dir.$PATH_SEP."temp.".$name;
    my %uuids = ();
    my %sln_hash = ();
    my %prj_hash = ();
    foreach $line (@lines) {
        chomp $line;
        $tline = trim_all($line);
        $lnn++;
        $len = length($tline);
        if ($len == 0) {
            push(@nlines,"");
            next;
        }
        $done = 0;
        $ind = '';
        if ($line =~ /^(\s+)\S/) {
            $ind = $1;
        }
        if ($dnheader) {
            if ($line =~ /\bEndGlobal\b/i) {
                $done = 1;
                $dnheader = 0;
                prt("$lnn: $line END\n") if (VERB9());
                push(@nlines,$line);
            } elsif ($line =~ /GlobalSection/) {
                $done = 1;
                $inglobal = 1;
                push(@nlines,$line);
            } elsif ($inglobal) {
                # GlobalSection(SolutionConfigurationPlatforms) = preSolution
                #		Debug|Win32 = Debug|Win32
                #		Release|Win32 = Release|Win32
                #	EndGlobalSection
                #	GlobalSection(ProjectConfigurationPlatforms) = postSolution
            	#   	{B60DCFA1-5436-6CFE-234C-A98ED962E54E}.Debug|Win32.ActiveCfg = Debug|Win32
		        #       {B60DCFA1-5436-6CFE-234C-A98ED962E54E}.Debug|Win32.Build.0 = Debug|Win32
		        #       {B60DCFA1-5436-6CFE-234C-A98ED962E54E}.Release|Win32.ActiveCfg = Release|Win32
                #		{B60DCFA1-5436-6CFE-234C-A98ED962E54E}.Release|Win32.Build.0 = Release|Win32
                #	EndGlobalSection
	            # GlobalSection(SolutionProperties) = preSolution
		        #    HideSolutionNode = FALSE
	            # EndGlobalSection
                if ($line =~ /EndGlobalSection/) {
                    $done = 1;
                    $inglobal = 0;
                    push(@nlines,$line);
                } elsif ($line =~ /^\s*\{(.+)\}\.(.+)\s*=\s*(.+)\s*$/) {
                    $id1 = $1;
                    $ok = is_valid_uuid($id1) ? "ok" : "NOT VALID";
                    if (defined $uuids{$id1}) {
                        $id1 = $uuids{$id1};
                    } else {
                        pgm_exit(1,"ERROR: UUID [$id1] NOT IN HASH\n");
                    }
                    $type = $2;
                    $conf = $3;
                    sub_win32(\$type);
                    sub_win32(\$conf);
                    $msg = "$ind"."{".$id1."}.$type = $conf";
                    prt("$msg $ok\n");
                    push(@nlines,$msg);
                    $done = 1;
                } elsif ($line =~ /^\s*(.+)\s*=\s*(.+)\s*$/) {
                    $itm = $1;
                    $val = $2;
                    sub_win32(\$itm);
                    sub_win32(\$val);
                    $msg = $ind."$itm = $val";
                    prt("$msg\n");
                    push(@nlines,$msg);
                    $done = 1;
                }
            }
            # ....
        } else {
            # seeking 
            # Microsoft Visual Studio Solution File, Format Version 11.00
            # # Visual Studio 2010
            if ($line =~ /^Microsoft Visual Studio Solution File, Format Version 11.00$/) {
                $hdrcnt++;
                $done = 1;
                push(@nlines,$line);
            } elsif ($line =~ /^\# Visual Studio 2010/) {
                $hdrcnt++;
                $done = 1;
                push(@nlines,$line);
            # } elsif ($line =~ /^Project\s*\(/) {
            } elsif ($line =~ /^Project\(\"\{(.+)\}\"\)\s*=\s*\"(.+)\"\s*,\s*\"(.+)\"\s*,\s*\"\{(.+)\}/) {
#            } elsif ($line =~ /^Project\(\"\{(.+){36}\}\"\)\s*=\s+\"(.+)\",\s*\"(.+)\"\s*,\s*\"\{(.+){36}\}\"$/) {
                $id1 = $1;
                $proj = $2;
                $file = $3;
                $id2 = $4;
                $nid = get_new_uuid($id2);
                if (defined $uuids{$id2}) {
                    prtw("WARNING: UUID {".$id2."} already exists!\n");
                }
                $uuids{$id2} = $nid;
                $ff = $dir.$file;
                $ok = (-f $ff) ? "ok" : "NF";
                $ok .= is_valid_uuid($id1) ? "ok" : "NOT VALID";
                $ok .= is_valid_uuid($id2) ? "ok" : "NOT VALID";
                # Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "libjpeg", "libjpeg.vcxproj", "{B60DCFA1-5436-6CFE-234C-A98ED962E54E}"
                $msg = $ind."Project(\"{".$id1."}\") = \"$proj\", \"$file\", \"{".$nid."}\"";
                prt("$msg $ok\n");
                $done = 1;
                $hdrcnt++;
                push(@nlines,$msg);
                $prj_hash{$proj} = $file;
            } elsif ($line =~ /^EndProject/i) {
                $hdrcnt++;
                $done = 1;
                push(@nlines,$line);
            } elsif ($line =~ /^Global/i) {
                $hdrcnt++;
                $done = 1;
                $dnheader = 1;
                push(@nlines,$line);
            }
        }
        if (!$done) {
            prt("$lnn: $line\n");
            push(@nlines,$line);
        }
    }
    $sln_hash{'SLN_FILE_NAME'} = $inf;
    $sln_hash{'SLN_LINES_NEW'} = \@nlines;
    $sln_hash{'SLN_LINES_OLD'} = \@lines;
    $sln_hash{'SLN_UUID_HASH'} = \%uuids;
    $sln_hash{'SLN_PROJ_HASH'} = \%prj_hash;
    #write2file(join("\n",@nlines)."\n",$sln_out);
    #prt("New lines written to [$sln_out]\n");
    return \%sln_hash;
}

sub get_xml_ref_array($$) {
    my ($ff,$rla) = @_;
    my $max = scalar @{$rla};
    my ($i,$line,$len,$ch,$inquote,$qc,$tag,$txt,$intag,$lnn,$dnline);
    $inquote = 0;
    $intag = 0;
    my @xlines = ();
    $lnn = 0;
    $tag = '';
    $txt = '';
    $dnline = 0;
    foreach $line (@{$rla}) {
        chomp $line;    # = trim_all($line);
        $len = length($line);
        $lnn++;
        $dnline = 0;
        for ($i = 0; $i < $len; $i++) {
            $ch = substr($line,$i,1);
            if ($inquote) {
                if ($intag) {
                    $tag .= $ch;
                } else {
                    $txt .= $ch;
                }
                if ($ch eq $qc) {
                    $inquote = 0;
                }
            } else {
                if ($intag) {
                    $tag .= $ch;
                    if ($ch eq '>') {
                        $intag = 0;
                        push(@xlines,[$lnn,$txt,$tag,$dnline]);
                        $txt = '';  # clear text
                        $tag = '';  # and tag
                        $dnline++;
                    } elsif (($ch eq '"') || ($ch eq "'")) {
                        $qc = $ch;
                        $inquote = 1;
                    }
                } else {
                    if ($ch eq '<') {
                        $tag = $ch;
                        $intag = 1;
                    } else {
                        $txt .= $ch;
                        if (($ch eq '"') || ($ch eq "'")) {
                            $qc = $ch;
                            $inquote = 1;
                        }
                    }
                }
            }
        }
        if ($inquote) {
            prtw("WARNING:$lnn: Going to next line while in quotes [$qc]!\n");
            $inquote = 0;
        }
        if (!$intag && (length($txt) || !$dnline)) {
            push(@xlines,[$lnn,$txt,$tag,$dnline]);
            $txt = '';  # clear any text
        }
    }
    return \@xlines;
}

sub write_xml_lines($$) {
    my ($ff,$rxml) = @_;
    my ($name,$dir) = fileparse($ff);
    my $tmp_out = $temp_dir.$PATH_SEP."temp.$name.xml";
    my $cnt = scalar @{$rxml};
    if ($cnt == 0) {
        prt("Array for [$ff] is BLANK!\n");
        return;
    }
    my ($i,$rt,$msg,$lnn,$plnn,$txt,$tag);
    $msg = $curr_file_bom;
    $rt = ${$rxml}[0];
    $plnn = ${$rt}[0];
    $txt = '';
    $tag = '';
    for ($i = 0; $i < $cnt; $i++) {
        $rt = ${$rxml}[$i];
        #                0    1    2    3
        #  push(@xlines,[$lnn,$txt,$tag,$dnline]);
        $lnn = ${$rt}[0];
        $txt = ${$rt}[1];
        $tag = ${$rt}[2];
        if ($lnn != $plnn) {
            $msg .= "\n";
            $plnn = $lnn;
        }
        $msg .= $txt;
        $msg .= $tag;
    }
    $msg .= "\n";
    write2file($msg,$tmp_out);
    prt("Array written to [$tmp_out], for [$ff]\n");
}

sub load_vcproj_file($$) {
    my ($rh,$ff) = @_;
    my @lines = ();
    my $lncnt = load_file_lines($ff,\@lines);
    prt("Loaded $lncnt lines, from $ff\n");
    my $rxml = get_xml_ref_array($ff,\@lines);
    write_xml_lines($ff,$rxml);

}

sub load_vcxproj_files($) {
    my $rh = shift;
    if (! defined ${$rh}{'SLN_FILE_NAME'}) {
        prtw("WARNING: Input file name NOT in solution ref hash!\n");
        return;
    }
    if (!defined ${$rh}{'SLN_PROJ_HASH'}) {
        prtw("WARNING: Porjects ref hash NOT in solution ref hash!\n");
        return;
    }
    my $sln_in = ${$rh}{'SLN_FILE_NAME'};
    my ($name,$dir) = fileparse($sln_in);
    my $rph = ${$rh}{'SLN_PROJ_HASH'};
    my $pcnt = scalar keys(%{$rph});
    prt("Solution $name had $pcnt projects.\n");
    return if ($pcnt == 0);
    my ($proj,$file,$ff,$ok);
    foreach $proj (keys %{$rph}) {
        $file = ${$rph}{$proj};
        $ff = $dir.$file;
        $ok = (-f $ff) ? "ok" : "NF";
        prt("Project: $proj - file [$ff] $ok\n");
        if (-f $ff) {
            load_vcproj_file($rh,$ff);
        }
    }

}

sub write_new_sln($) {
    my $rh = shift;
    if (! defined ${$rh}{'SLN_FILE_NAME'}) {
        # prtw("WARNING: Input file name NOT in solution ref hash!\n");
        return;
    }
    if (!defined ${$rh}{'SLN_LINES_NEW'}) {
        prtw("WARNING: New lines ref arrary NOT in solution ref hash!\n");
        return;
    }
    my $sln_in = ${$rh}{'SLN_FILE_NAME'};
    my ($name,$dir) = fileparse($sln_in);
    my $rsa = ${$rh}{'SLN_LINES_NEW'};
    my $lcnt = scalar @{$rsa};
    my $sln_out = $temp_dir.$PATH_SEP."temp.".$name;
    write2file(join("\n",@{$rsa})."\n",$sln_out);
    prt("New $lcnt lines written to [$sln_out]\n");
}


#########################################
### MAIN ###
parse_args(@ARGV);
my $ref_hash = process_in_sln($in_file);
load_vcxproj_files($ref_hash);
write_new_sln($ref_hash);
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 <file>  (-o) = Write output to this file.\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);
    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());
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = $arg;
            prt("Set input to [$in_file]\n") if (VERB1());
        }
        shift @av;
    }

    if ((length($in_file) ==  0) && $debug_on) {
        $in_file = $def_file;
        prt("Set DEFAULT input to [$in_file]\n");
    }
    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");
    }
}

# eof - sln2x64.pl