#!/usr/local/bin/perl -w
#
$select = "progchoose.html";
open(SELECT,'<'.$select) || die("Sorry Couldnt create SELECT ",$select," \n");
@select = <SELECT>;
close(SELECT);
open(SELECT,'>'.$select) || die("Sorry Couldnt create SELECT ",$select," \n");
$selectrun=0;
while( $line = $select[$selectrun] )      {
        ++$selectrun;
        chomp($line);
        print SELECT $line,"\n";
        last if($line eq '<!-- STARTSELECT -->');
}
#
$table = "proghelp.html";
open(TABLE,'<'.$table) || die("Sorry Couldnt open TABLE ",$table," \n");
@table = <TABLE>;
close(TABLE);
open(TABLE,'>'.$table) || die("Sorry Couldnt create TABLE ",$table," \n");
$tablerun=0;
while( $line = $table[$tablerun] )	{
	++$tablerun;
	chomp($line);
	print TABLE $line,"\n";
	last if($line eq '<!-- STARTTABLE -->');
}
#
$proglist= "proglist";
open(PROGLIST,'<'.$proglist) || die("Sorry Couldnt read PROGLIST ",$proglist," \n");
#
while( $line = <PROGLIST> )	{
	chomp($line);
	next unless( $line =~ m%([^:]+):(.*)% );
	$prog = $1;
	$help = $2;
	$help = &tohtml($help);
	print SELECT "<option>$prog\n";
	print TABLE "<tr><td bgcolor='aliceblue' >$prog</td>\n";
	print TABLE "<td bgcolor='aliceblue' >$help</td></tr>\n";
	&processprog($prog,$help);
}
#
$getstarted=0;
while( $line = $table[$tablerun] )      {
        ++$tablerun;
        chomp($line);
	if( $line eq '<!-- ENDTABLE -->' )	{
		$getstarted = 1;
	}
	next unless $getstarted;
	print TABLE $line,"\n";
}
#
$getstarted=0;
while( $line = $select[$selectrun] )      {
        ++$selectrun;
        chomp($line);
	if( $line eq '<!-- ENDSELECT -->' )	{
		$getstarted = 1;
	}
	next unless $getstarted;
	print SELECT $line,"\n";
}
#
exit;
#
sub processprog	{
	my($prog,$help) = @_;
#
	die("Missing Directory $prog\n") unless(-e $prog);
	chdir $prog;
	$progpl = "$prog.pl";
	print "Missing invoke.html in $prog\n"	unless(-e 'invoke.html');
	die("Missing Perl Program $progpl in $prog\n") unless(-e $progpl);
        $com= "cp $progpl /home/A7F/www_gcf/cgi-bin/perlvpl";
	system($com);
	die("Missing Perl Program $progpl in $prog\n") unless(-e $progpl);
	$program = "program.html";
	open(LISTING,'>'.$program) || die("Sorry Couldnt create LISTING in $prog\n");
	open(PERLPROG,'<'.$progpl) || die("Sorry Couldnt read Perl Program $progpl in $prog\n");
	print LISTING <<EOF;
<html>
<head>
<title>Program Listing of $progpl</title>
<script language="JavaScript">
<!--scriptbegin
function processfontused()	{
	parent.bigboss.fontused = self.document.forms[0].elements[0].value;
	self.location.reload();
	return true;
}
//scriptend-->
</script>
</head>
<body bgcolor=white >
<script language="JavaScript">
<!--scriptbegin
document.writeln('<b><form onsubmit="self.processfontused()" >Program $progpl Illustrating $help </b><font color=red> set font size</font><input type="text" name="fontused" size="2" value="'+ parent.bigboss.fontused + '" onchange="self.processfontused();" ></form>');
document.writeln('<font size=' + parent.bigboss.fontused + ' >');
//scriptend-->
</script>
<b>
<pre>
EOF
	while( $perlline = <PERLPROG> )	{
		chomp($perlline);
		$perlline = &tohtml($perlline);
		if( $perlline =~ m%(.*)#([^'"]*)$%)	{
			$perlline = $1 . '<font color=blue>#'. $2. '</font>';
		}
		&reddenperl('print');
		&reddenperl('EOF');
		&reddenperl('exit');
		&reddenperl('require');
		&reddenperl('chomp');
		&reddenperl('eval');
		&reddenperl('open');
		&reddenperl('opendir');
		&reddenperl('closedir');
		&reddenperl('close');
		&reddenperl('while');
		&reddenperl('return');
		&reddenperl('sub');
		&reddenperl('defined');
		&reddenperl('exists');
		&reddenperl('die');
		&reddenperl('foreach');
		&reddenperl('sort');
		&reddenperl('split');
		&reddenperl('unless');
		&reddenperl('if');
		&reddenperl('else');
		&reddenperl('elsif');
		&reddenperl('last');
		&reddenperl('next');
		&reddenperl('system');
		&reddenperl('chdir');
		&reddenperl('quotemeta');
		&reddenperl('my');
		&reddenperlanywhere('$line');
		&reddenperlanywhere('&lt;CANNEDFILE&gt;');
		&reddenperlanywhere('=~ s');
		&reddenperlanywhere('=~ tr');
		&reddenperlanywhere('`');
		print LISTING $perlline,"\n";
	}
	print LISTING "</pre></font></body></html>\n";
	close(LISTING);
	close(PERLPROG);
#
	chdir "..";
	$direct = $prog.'.html';
	open(DIRECTACCESS,'>'.$direct) || die("Sorry Couldnt create direct access file $direct\n");
	print DIRECTACCESS <<EOF;
<head>
<title>Master Frameset for PERL VPL Initialized to $prog</title>
<script language="JavaScript">
<!--scriptbegin
var saveprog= "$prog";
var fontused = 7;
function set4frame()    {
        self.realstuff.location = "perl4frames.html";
        return true;
}
function set2frame()    {
        if(self.saveprog.substring(0,4) == 'PROG' )     {
                self.realstuff.location = "justprogram.html";
                return true;
        }
        self.realstuff.location = "perl2frames.html";
        return true;
}       // End set2frame
function setbigprog()   {
        self.realstuff.location = "justprogram.html";
        return true;
}       // End setbigprog
//scriptend-->
</script>
</head>
<frameset rows="0,*" >
<frame name="dummy" src="dummy.html" >
<frame name="realstuff" src="perl4frames.html" >
</frameset>
EOF
	close(DIRECTACCESS);
}
#
sub reddenperl	{
	my($test)=@_;
	my($testnew);
	$testnew = quotemeta($test);
	$perlline =~ m%(.*?)\b$testnew\b%;
	if( $begin=$1 )	{
		return if $begin =~ m%#%;
	}
	$perlline =~ s%\b$testnew\b%<font color=red >$test</font>%;
	return;
}
#
sub reddenperlanywhere	{
	my($test)=@_;
	my($testnew);
	$testnew = quotemeta($test);
	$perlline =~ m%(.*)$testnew%;
        if( $begin=$1 ) {
                return if $begin =~ m%#%;
        }
	$perlline =~ s%$testnew%<font color=red >$test</font>%g;
	return;
}
#
sub tohtml      { # Convert HTML magic characters in current line
        my($convline)=@_;

        return($convline)       unless $convline;
        $convline =~ s/&/&amp;/g;
        $convline =~ s/</&lt;/g;
        $convline =~ s/>/&gt;/g;
        $convline =~ s/"/&quot;/g;
        $convline;
}
#
1;
