#
# Dick Munroe (munroe@csworks.com)
#
# The following performs a simple conversion from an OSU specific
# CGI to a "server neutral" framework that can run (more or less)
# unchanged under:
#
#	1. OSU
#	2. WASD with OSU emulation.
#	3. WASD with (sub)processes.
#
# The script was designed to do a "good" not perfect job of
# conversion.  In other works, the output must be checked to make
# sure that it REALLY does what you want.  It may also need to be
# slightly modified to process your cgis as the coding
# conventions at your site are probably different from ours.
#
# Run it like this:
#
# perl framework.pl < cgi.com > convertedcgi.com
#

my @theFile ;
my @theStandard ;

sub dcl
{
	my $theLine = shift ;

	return '$ ' . $theLine . "\n" ;
}

sub update
{
	my $theLine = shift ;

	undef @theStandard ;

	push @theFile,dcl('theDecnetFlag = (f$type(wwwexec_rundown_string) .nes. "")') ;
	push @theFile,dcl('if (theDecnetFlag)') ;
	push @theFile,dcl('then') ;
	push @theFile,dcl('    nl = f$fao("!/")         !  CR/LF sequence') ;
	push @theFile,dcl('    say = "write net_link"') ;
	push @theFile,dcl('    say "<DNETRECMODE>"      ! Set implied carriage control.') ;
	push @theFile,dcl('    cgisymbols := $cgi-bin:[000000]osu-cgi_symbols.exe') ;
	push @theFile,$theLine ;
	push @theFile,dcl('else') ;
	push @theFile,dcl('    say = "write sys$output"') ;
	push @theFile,dcl('    cgiutl := $cgi-bin:[000000]cgiutl.exe') ;

	my $theCgiutlLine = $theLine ;

	$theCgiutlLine =~ s{cgisymbols}{cgiutl /URLDECODE /SYMBOL} ;
	$theCgiutlLine =~ s{[ \t]{2,}}{ }g ;
	$theCgiutlLine =~ s{"www_"\s+}{}i ;
	$theCgiutlLine =~ s{^\$ }{\$     } ;
	$theCgiutlLine =~ s{([^\s]+)='([^' ]+)'{0,1}}{/FIELD=$1 /OUTPUT=*$2}g ;

 	if ($theCgiutlLine =~ s{([^\s]+)>'([^' ]+)'{0,1}}{/FIELD=$1 /OUTPUT=*$2}g)
	{
		$theCgiutlLine =~ s{URLDECODE}{MULTIPART} ;
	}

	$theCgiutlLine =~ s{([^\s]+)=([^ \.]+\.[^ ]+)}{/FIELD=$1 /OUTPUT=$2}g ;

	if ($theCgiutlLine =~ s{([^\s]+)>([^ \.]+\.[^ ]+)}{/FIELD=$1 /OUTPUT=$2}g)
	{
		$theCgiutlLine =~ s{URLDECODE}{MULTIPART} ;
	}

	$theCgiutlLine =~ s{\"(.*?)\"}{/PREFIX=$1FLD}i ;

	if ($theCgiutlLine =~ m/\@/)
	{
		print STDERR 'Manual intervention is necessary due to @ in CGIUTL invocation',"\n" ;
		$theCgiutlLine =~ s{URLDECODE}{MULTIPART} ;
		
		my $theDefineLine = $theCgiutlLine ;

		$theDefineLine =~ s{cgiutl}{DEFINE/USER CGIUTL\$PARAM}i ;
		$theDefineLine =~ s{("\@'*.*?'*")}{} ;
	
		push @theFile,$theDefineLine ;
		push @theFile,'$     DEFINE/USER CGIUTL$PARAM_1 ' . $1 . "\n" ;

		$theCgiutlLine = '$     cgiutl' . "\n" ;
	}

	$theCgiutlLine =~ s{/FIELD}{-\n              /FIELD}gi ;

	$theCgiutlLine =~ s{^\$\s*}{          } ;

	push @theFile,'$     if (f$type(theNotAFormFlag) .eqs. "") then -' . "\n" ;

	push @theFile,$theCgiutlLine ;

	push @theFile,dcl('endif') ;
	push @theFile,dcl('') ;
	push @theFile,dcl('theOSUFlag = (f$extract(0,3,www_server_software) .eqs. "OSU")') ;
	push @theFile,dcl('theVerifyFlag = (f$trnlnm("httpd$verify") .nes. "")') ;
	push @theFile,dcl('theWASDFlag = (f$extract(0,10,www_server_software) .eqs. "HTTPd-WASD")') ;
	push @theFile,dcl('if (theWASDFlag) .and. (.not. theVerifyFlag)') ;
	push @theFile,dcl('then') ;
	push @theFile,dcl('    set message /nofacility /noidentification /noseverity /notext') ;
	push @theFile,dcl('endif') ;
	push @theFile,dcl('if (theVerifyFlag)') ;
	push @theFile,dcl('then') ;
	push @theFile,dcl('    if (theDecnetFlag)') ;
	push @theFile,dcl('    then') ;
	push @theFile,dcl('        say "Content-type: text/plain",nl,nl') ;
	push @theFile,dcl('        define sys$output net_link:') ;
	push @theFile,dcl('        set verify') ;
	push @theFile,dcl('    endif') ;
	push @theFile,dcl('    show symbol/global/all') ;
	push @theFile,dcl('    show symbol/local/all') ;
	push @theFile,dcl('endif') ;
} ;

use strict ;


my $theEnvironmentFlag = 1 ;
my $theExitFlag = 1 ;
my $theFormFlag = 1 ;
my $theLine ;
my $theLocationFlag = 0 ;
my $theNlFlag = 0 ;
my $theSayFlag = 0 ;

while (defined($theLine = <STDIN>))
{
	$theExitFlag = 1 ;

	if ($theLine =~ m/^\$\s*exit/i)
	{
		$theExitFlag = 0 ;
	}
	elsif ($theLine =~ m/f\$length\(www_path_info\)/i)
	{
		push @theStandard,'$ theNotAFormFlag = 1' . "\n" if ($theFormFlag) ;
		$theFormFlag = 0 ;
	}
	elsif ($theLine =~ s{say\s+"location:\s+}{call location "})
	{
		if ((! $theLocationFlag) && ($theEnvironmentFlag))
		{
			push @theStandard,'$ nl = f$fao("!/")' . "\n" if (! $theNlFlag) ;
			push @theStandard,'$ say = "write net_link"' . "\n" if (! $theSayFlag) ;
			push @theStandard,'$ cgisymbols := $cgi-bin:[000000]osu-cgi_symbols.exe' . "\n" ;
			push @theStandard,'$ cgiutl := $cgi-bin:[000000]cgiutl.exe' . "\n" ;
		} ;
		$theLine =~ s{,nl,nl}{} ;
		$theLocationFlag = 1 ;
	}
	elsif ($theLine =~ s{^\$\s*[mcr]*\s*cgi-bin:\[000000\]osu-cgi_symbols[\.ex]*}{\$     cgisymbols}i)
	{
		if ($theEnvironmentFlag)
		{
			update($theLine) ;
			$theEnvironmentFlag = 0 ;
			next ;
		}
	}
	elsif ($theLine =~ s{^\$\s*[mcr]*\s*www_root:\[bin\]cgi_symbols[\.ex]*}{\$     cgisymbols}i)
	{
		if ($theEnvironmentFlag)
		{
			update($theLine) ;
			$theEnvironmentFlag = 0 ;
			next ;
		}
	}
	elsif ($theLine =~ m/^(\$\s*)run/i)
	{
		push @theFile,$1,'if (theDecnetFlag) then define/user sys$output net_link:',"\n" if (! $theEnvironmentFlag) ;
	}
	else
	{
		if ($theLine =~ m/^\$\s*nl\s*=\s*f\$fao/i)
		{
			push @theStandard,$theLine ;
			$theNlFlag = 1 ;
			next ;
		}
		elsif ($theLine =~ m/^\$\s*say\s*=\s*"write/i)
		{
			push @theStandard,$theLine ;
			$theSayFlag = 1 ;
			next ;
		}
		elsif ($theLine =~ m/^\$\s*say\s*"<DNETRECMODE>"/i)
		{
			push @theStandard,$theLine ;
			next ;
		}
		elsif ($theLine =~ m/^\$\s*write\s*net_link\s*"<DNETRECMODE>"/i)
		{
			push @theStandard,'$ nl = f$fao("!/")' . "\n" if (! $theNlFlag) ;
			push @theStandard,'$ say = "write net_link"' . "\n" if (! $theSayFlag) ;
			push @theStandard,'$ say "<DNETRECMODE>"' . "\n" ;
			$theNlFlag = 1 ;
			$theSayFlag = 1 ;
			next ;
		}
		else
		{
			next if (($theLine =~ m/^\$\s*define.*?sys\$output.*?net_link/i) && (! $theEnvironmentFlag)) ;
		}
	} ;
	
	push @theFile,$theLine ;
} ;

print join '',@theStandard if (@theStandard) ;
print join '',@theFile ;

exit() if (($theEnvironmentFlag) && (!$theLocationFlag)) ;

if ($theExitFlag)
{
	print dcl('') ;
	print dcl('exit') ;
}

if ($theLocationFlag)
{
	print dcl('') ;
	print dcl('Location: subroutine') ;
	print dcl('if (theDecnetFlag)') ;
	print dcl('then say "Location: " + P1,nl,nl') ;
	print dcl('else cgiutl /location=*p1') ;
	print dcl('endif') ;
	print dcl('exit') ;
	print dcl('endsubroutine') ;
}
