#!/perl -w
# NAME: mruvc8-02.pl
# AIM: To enumerate the Microsoft Visual Studio 8 Express (MSVC8) from registry
# geoff mclane - http://geoffmclane.com/mperl/samples/index.htm - 20070402
# 02/11/2011 - Avoid duplicate outputs...
# 01/02/2011 - Drop the FILE list - only the project list, and check the sln file still exists
# 2009/09/15 - Also include VC9
# 25/09/2007 - see mruvc8.pl, for simple sample - this add a LINK to the .SLN
# file, if it EXISTS now ...
#
use strict;
use warnings;
use File::Basename;
use File::Copy;
use File::stat;
use Win32::Registry;
use Win32::TieRegistry( Delimiter => "#", ArrayValues => 0 );
my $perl_dir = "C:\\GTools\\perl";
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl ...\n";
####require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
our ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
	my @tmpsp = split(/(\\|\/)/,$pgmname);
	$pgmname = $tmpsp[-1];
}
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);
### prt( "$0 ... Hello, World ...\n" );
my $regcnt = 0;
my %PathMap = ();
my %KeysVal = ();
my $htmout = $perl_dir.'\mruvc8-02.htm';

my $donetcopy = 0; # no copy to the NET
my $netcpy = "\\\\PRO-2\\PSAVES\\.";
my $netcpy2 = "\\\\Dell02\\Public\\SAVES\\.";
my @inform = ();
my $g_add_files = 0;
my @found_projs = ();
my @found_names = ();
my $g_max_fn = 0;

my ($FH);
# debug
my $do_reg = 1;		# to turn OFF registry reading
my $write_file = 1;	# to turn OFF file writing
my $load_htm = 1;	# to trun OFF the final HTML loading
my $dbg1 = 0;	# show entry DURING enumeration
my $dbg2 = 0;	# show entry already in list DURING enumeration
my $dbg3 = 0;	# show output during FILE WRITE

# 20070402 - MSVC8 MRU Files and Projects - these entries are in UNICODE
##my $MSVC8MRUP = 'HKEY_CURRENT_USER\Software\Microsoft\VCExpress\8.0\ProjectMRUList';
#my $MSVC8MRUP = 'CUser\Software\Microsoft\VCExpress\8.0\ProjectMRUList';
my $MSBASE = 'CUser/Software/Microsoft/';
my $PROJMRU = "ProjectMRUList";
my $MSVC8MRUP = $MSBASE.'VCExpress/8.0/'.$PROJMRU;
my $MSVC8MRUF = $MSBASE.'VCExpress/8.0/FileMRUList';
my $MSVC9MRUP = $MSBASE.'VCExpress/9.0/'.$PROJMRU;
my $MSVC9MRUF = $MSBASE.'VCExpress/9.0/FileMRUList';

my $pound = $Registry->Delimiter("/");
my $ymd = YYYYMMDD2( time(), '' );
# my $cnt = 0;
my $reg_found = 0;

sub mycmp_decend_n0 {
   return 1 if (${$a}[0] < ${$b}[0]);
   return -1 if (${$a}[0] > ${$b}[0]);
   return 0;
}

sub show_REG_list($) {
	my ($tx) = shift;
	my ($tkey, $ind, $ecnt, $added);
	my $lcnt = 0;
	prt2( "Probe of [$tx] ..." );
	my $tx2 = $tx;
	$tx2 =~ s/ /_/g;
	$tx2 =~ s/\//\./g;
	$regcnt++;
	$tx2 = "Reg" . $regcnt;
	$added = 0;
	if ( $tkey = $Registry->{$tx} ) {
		$PathMap{$tx2} = $tx;
		$ecnt = 0;
		foreach my $ent (  keys(%$tkey)  ) {
			$ecnt++;
			my $dat1 = $tkey->{$ent};
			$ent =~ s/^\///;	# drop any leading separator
			my $tx3 = $ymd . '#' . exclmsbase($tx) . '#' . $ent;	# establish DATED entry
			my @aent = split(/\x00/, $dat1);
			my $ct = scalar @aent;
			my $vl = join(' ',@aent);
			if ($ct == 1) {
				$vl = $dat1;
				$ind = rindex($vl, '|{');
				if (($ind != -1) && ($vl =~ /.*\|{.*}/)) {
					$vl = substr($vl,0,$ind);
				}
				prt( "ent = [$ent], dat1 = [$vl] (1)\n" ) if ($dbg1);
			} else {
				###prt( "ent = $ent - $ct items\n" );
				$lcnt = 0;
				$vl = join('#', @aent);
				###prt( "[$vl]\n" );
				my $sval = '';
				foreach my $d (@aent) {
					$d =~ s/^\///;
					$lcnt++;
					###prt( "dat".$lcnt." = [$d]\n" );
					if (length($d) == 0) {
						if ( length($sval) && (substr($sval,-1) eq ' ') ) {
							$d = '';
						} else {
							$d = ' ';
						}
					}
					$sval .= $d;
				}
				prt( "ent = [$ent] $lcnt [$sval] (2)\n" );
				$vl = $sval;
			}
			if ( Is_In_List($tx3, $vl) ) {
				prt( "NOTE: Already in LIST - $tx3 = $vl ...\n" ) if ($dbg2);
			} else {
				if (defined $KeysVal{$tx3}) {
					prt( "Adding [$vl] to " . $KeysVal{$tx3} . "...\n" );
					$KeysVal{$tx3} .= ' ' . $vl;
				} else {
					$KeysVal{$tx3} = $vl;
				}
				$added++;
			}
		}
		prt2( "Extracted $ecnt entries from this key ... adding $added to hash." );
	} else {
		prt( "\nERROR: Can't open [$tx] value: $^E\n" );
	}
    return $added;
}



prt2( "Using DATE [$ymd] ..." );

if ($do_reg) {
    $reg_found = 0;
	$reg_found += show_REG_list( $MSVC8MRUP );
    if ($g_add_files) {
    	$reg_found += show_REG_list( $MSVC8MRUF );
    }
    if (! $reg_found) {
        prt("Failed on MSVC8, trying MSVC9...\n");
    	$reg_found += show_REG_list( $MSVC9MRUP );
        if ($g_add_files) {
    	    $reg_found += show_REG_list( $MSVC9MRUF );
        }
        if (! $reg_found) {
            prt("ERROR: No entries found!\n");
            prt("ERROR: Can NOT locate \n[$MSVC8MRUP], nor \n[$MSVC9MRUP]! \nAborting...\n\n");
            exit(1);
        }
    }
	#$cnt = 0;
}

Read_Previous( $htmout );

if ($write_file) {
	rename_2_old_bak( $htmout );
	if (open $FH, ">$htmout") {
		Out_2_File($FH);
		close $FH;
		if ($donetcopy) {
			prt( "Attempting COPY of $htmout to $netcpy ... moment ...\n" );
			if ( copy( $htmout, $netcpy ) ) {
				prt( "$htmout COPIED to $netcpy ...\n" );
			} else {
				prt( "WARNING: $htmout COPY to $netcpy FAILED!\n" );
			}
			prt( "Attempting COPY of $htmout to $netcpy2 ... moment ...\n" );
			if ( copy( $htmout, $netcpy2 ) ) {
				prt( "$htmout COPIED to $netcpy2 ...\n" );
			} else {
				prt( "WARNING: $htmout COPY to $netcpy2 FAILED!\n" );
			}
		}
	} else {
		prt( "Creation of $htmout FAILED! ... $! ...\n" );
		if ( !$dbg1 ) {
			prt( "Simple listing of components read from registry ...\n" );
            my $cnt = 0;
			foreach my $key (sort keys %KeysVal) {
				$cnt++;
				my $val = $KeysVal{$key};
				prt( "$cnt $key $val\n" );
			}
		}
	}
}

if ($load_htm) {
	close_log($outfile,0);
	system( $htmout );
} else {
	close_log($outfile,1);
}
exit(0);

########################################
sub Is_In_List {
	my ($k, $v) = @_;
	my ($key, $val, @ks, $k1, $k2, $k3, @iks, $ik1, $ik2, $ik3, $cnt);
	@iks = split('#', $k);
	$ik1 = $iks[0];	# date of entry
	$ik2 = $iks[1]; # path (shortened - $MSBASE)
	$ik3 = $iks[2];	# key, like 'File1', 2, ...
	$cnt = 0;
	foreach $key (sort keys %KeysVal) {
		$cnt++;
		$val = $KeysVal{$key};
		@ks = split('#', $key);
		$k1 = $ks[0];
		$k2 = $ks[1];
		$k3 = $ks[2];
		if (uc($v) eq uc($val)) {
			return $cnt;
		}
	}
	return 0;
}

sub get_tag {
	my ($l) = shift;
	my $tg = '';
	my $c = '';
	my $ln = length($l);
	for (my $j = 0; $j < $ln; $j++) {
		$c = substr($l,$j,1);
		if ($c eq '>') {
			return $tg;
		}
		$tg .= $c;
	}
	return '';
}

sub remove_href {
	my ($ln) = shift;
	if ($ln =~ /href/i) {
		my $nln = '';
		my $len = length($ln);
		my $ch = '';
		for (my $i = 0; $i < $len; $i++) {
			$ch = substr($ln, $i, 1);
			if ($ch eq '<') {
				my $tg = get_tag( substr($ln, ($i+1)) );
				if (($tg =~ /^a\s+/i)||
					($tg =~ /^\/a$/i)) {
					$i += length($tg)+1;
					next;
				}
			}

			$nln .= $ch;
		}
		return $nln;
	}
	return $ln;
}


sub Read_Previous {
	my ($fil) = shift;
	my ($IF, $ch, $tag, $len, $i, $pt1, $pt2, $pt3, $key, @arr);
	if ( open $IF, "<$fil" ) {
		prt( "Reading previous $fil ... " );
		my @lines = <$IF>;
		close $IF;
		prt( scalar @lines . " lines ...\n" );
		# <DD>20070403#VCExpress/8.0/FileMRUList
		# <LI>File1 = c:\GTools\ConApps\DateFile\DateFile.cpp
		foreach my $line (@lines) {
			chomp $line;			# remove CR (\n)
			$line =~ s/\r$//;		# remove LF (\r), if any
			$line = remove_href($line);
			$len = length($line);
			for ($i = 0; $i < $len; $i++) {
				$ch = substr($line, $i, 1);
				if ($ch eq '<') {
					$tag = '';
				} elsif( $ch eq '>' ) {
					if ($tag =~ /^<DD/i ) {
						$pt1 = substr($line, ($i + 1));
					} elsif ($tag =~ /^<LI/i ) {
						$pt2 = substr($line, ($i + 1));
						@arr = split(/=/, $pt2);
						if (scalar @arr == 2) {
							$pt2 = RTrim( $arr[0] );
							$pt3 = LTrim( $arr[1] );
                            $pt3 =~ s/\s+\*.*$//; # trim off any tail info stuff
							$key = $pt1 . '#' . $pt2;
                            if ($g_add_files) {
                                #add em all
    							$KeysVal{$key} = $pt3;
                            } elsif ($pt1 =~ /$PROJMRU/) { # = ProjectMRUList
    							$KeysVal{$key} = $pt3;
                            }
						} else {
							prt( "WARNING: [$pt2] did NOT split on = sign!\n" );
						}
					}
				}
				$tag .= $ch;
			}
		}
		$len = scalar keys %KeysVal;
		if ($len) {
			prt2( "Collected $len old components ..." );
		} else {
			prt( "Failed to get any componets from this file ...\n" );
		}
	} else {
		prt( "NO PREVIOUS $fil FILE ...\n" );
	}
}

sub Out_2_File {
	my ($fh) = shift;
	my ($key, $val, @ks, $k1, $k2, $k3, $cnt);
	my ($nm,$dir,$ext);	### = fileparse( $fil, qr/\.[^.]*/ );
    my ($sb,$msg,$len,$lcdval);
	prt( "Writing $htmout file ...\n" );

	print $fh <<"EOF";
<html>
<head>
<title>VC8 MRU List</title>
</head>
<body>
<h1 align="center">VC8 MRU List</h1>
EOF

	print $fh "<p>Update:";
	print $fh " ".scalar localtime(time());
	print $fh "</p>\n";
	# fill in entries
	$cnt = 0;
	$k1 = '';
	$k2 = '';
    print $fh "<DL>\n";
    my %dupes = ();
    my %names = ();
    # do just one, to get the FIRST heading
    foreach $key (sort keys %KeysVal) {
        $cnt++;
        $val = $KeysVal{$key};
        ($nm,$dir,$ext) = fileparse( $val, qr/\.[^.]*/ );
        @ks = split('#', $key);
        $k1 = $ks[0];
        $k2 = $ks[1];
        $k3 = $ks[2];
        print $fh "<DD>$k1#$k2\n";
        print $fh "<UL>\n";
        $msg = '';
        if ($sb = stat($val)) {
            $msg = '*ok '.YYYYMMDD2($sb->mtime,"/");
            $lcdval = lc(path_u2d($val));
            if (!defined $dupes{$lcdval}) {
                $dupes{$lcdval} = 1;
                push(@found_projs, [ $sb->mtime, $val ]);
                if (!defined $names{$nm}) {
                    $names{$nm} = 1;
                    push(@found_names, $nm);
                }
                $len = length($val);
                $g_max_fn = $len if ($len > $g_max_fn);
            }
        } else {
            $msg = "*Not Found";
        }
        if ((lc($ext) eq '.sln')&&( -f $val )) {
            print $fh "<LI>$k3 = <a href=\"".dos_2_unix($val)."\">$val</a> $msg\n";
        } else {
            print $fh "<LI>$k3 = $val $msg\n";
        }
        prt( "$cnt $key $val $msg\n" ) if ($dbg3);
        last;	# exit after FIRST done
    }
	$cnt = 0;
	# done the FIRST, so can CLOSE and add new HEADING on change
	foreach $key (sort keys %KeysVal) {
		$cnt++;
		if ($cnt == 1) {
			next;	# already done FIRST
		}
		$val = $KeysVal{$key};
		($nm,$dir,$ext) = fileparse( $val, qr/\.[^.]*/ );
		@ks = split('#', $key);
		if (($k1 ne $ks[0]) || ($k2 ne $ks[1])) {
			$k1 = $ks[0];
			$k2 = $ks[1];
			print $fh "</UL>\n";	# close LIST
			print $fh "<DD>$k1#$k2\n";	# set NEW HEADING
			print $fh "<UL>\n";			# and OPEN list again
		}
		$k3 = $ks[2];
        $msg = '';
        if ($sb = stat($val)) {
            $msg = '*ok '.YYYYMMDD2($sb->mtime,"/");
            $lcdval = lc(path_u2d($val));
            if (!defined $dupes{$lcdval}) {
                $dupes{$lcdval} = 1;
                push(@found_projs, [ $sb->mtime, $val ]);
                if (!defined $names{$nm}) {
                    $names{$nm} = 1;
                    push(@found_names, $nm);
                }
                $len = length($val);
                $g_max_fn = $len if ($len > $g_max_fn);
            }
        } else {
            $msg = "*Not Found";
        }
		if ((lc($ext) eq '.sln') && ( -f $val ) ) {
			print $fh "<LI>$k3 = <a href=\"".dos_2_unix($val)."\">$val</a> $msg\n";
		} else {
			print $fh "<LI>$k3 = $val $msg\n";
		}
		prt( "$cnt $key $val $msg\n" ) if ($dbg3);
	}
	print $fh "</UL>\n";
	print $fh "</DL>\n";

    if (@found_projs) {
        my ($tm,$i,$num);
        my @arr = sort mycmp_decend_n0(@found_projs);
        my $fcnt = scalar @arr;
        my $form = '%0'.(length($fcnt)+1).'d';
        print $fh "<p>Found up to $fcnt valid projects... listed in DATE order, latest first...\n" if ($fcnt);
        $cnt = 0;
        for ($i = 0; $i < $fcnt ; $i++) {
            $val = $arr[$i][1];
            $cnt++;
            $num = sprintf($form,$cnt);
            # $num = sprintf("%3d",$cnt);
            $tm = YYYYMMDD2($arr[$i][0],'/');
            print $fh "<br>$num $tm <b>$val</b>\n"
        }
        if ($fcnt) {
            print $fh "</p>\n";
            if (@found_names) {
                my @arr = sort @found_names;
                print $fh "<p>Alpabetic: ";
                print $fh join(" ",@arr);
                print $fh "</p>\n";
            }
        }
    }
	if (@inform) {
		print $fh "<p>\n";
		foreach $key (@inform) {
			print $fh "$key<br>\n";
		}
		print $fh "Written $cnt components to file $htmout ...\n";
		print $fh "</p>\n";
	}

	print $fh "<!-- generated by $pgmname on ". scalar localtime(time()) . " -->\n";
	print $fh <<"EOF";
</body>
</html>
EOF

	prt( "Written $cnt components to file $htmout ...\n" );
}

sub exclmsbase {
	my ($t) = shift;
	if ($t =~ /^$MSBASE/) {
		$t = substr($t, length($MSBASE));
	}
	return $t;
}
	

################################################
# My particular time 'translation'
sub YYYYMMDD2 {
	#  0    1    2     3     4    5     6     7     8
	my ($tm, $sep) = @_;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tm);
	$year += 1900;
	$mon += 1;
	my $ymd = "$year";
	$ymd .= $sep;
	if ($mon < 10) {
		$ymd .= '0'.$mon;
	} else {
		$ymd .= "$mon";
	}
	$ymd .= $sep;
	if ($mday < 10) {
		$ymd .= '0'.$mday;
	} else {
		$ymd .= "$mday";
	}
	return $ymd;
}

# RENAME A FILE TO .OLD, or .BAK
# 0 - do nothing if file does nto exist.
# 1 - rename to .OLD if .OLD does NOT exist
# 2 - rename to .BAK, if .OLD already exists,
# 3 - deleting any previous .BAK ...
sub rename_2_old_bak {
	my ($fil) = shift;
	my $ret = 0;
	if ( -f $fil ) {
		my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ );
		my $nmbo = $dir . $nm . '.old';
		$ret = 1;
		if ( -f $nmbo) {
			$ret = 2;
			$nmbo = $dir . $nm . '.bak';
			if ( -f $nmbo ) {
				$ret = 3;
				unlink $nmbo;
			}
		}
		rename $fil, $nmbo;
	}
	return $ret;
}

sub LTrim {
	my ($ln) = shift;
	while ($ln =~ /^\s/) {
		$ln = substr($ln,1); # remove all LEADING space
	}
	return $ln;
}

sub RTrim {
	my ($ln) = shift;
	while ($ln =~ /\s$/) {
		$ln = substr($ln,0, length($ln) - 1); # remove all TRAILING space
	}
	return $ln;
}

sub prt2 {
	my ($msg) = shift;
	prt( "$msg\n" );
	push(@inform, $msg);
}

sub dos_2_unix {
	my ($p) = shift;
	$p =~ s/\\/\//g;
	return $p;
}

# eof - mruvc8-02.pl
