[0001]
[0002]
[0003]
[0004]
[0005]
[0006]
[0007]
[0008]
[0009]
[0010]
[0011]
[0012]
[0013]
[0014]
[0015]
[0016]
[0017]
[0018]
[0019]
[0020]
[0021]
[0022]
[0023]
[0024]
[0025]
[0026]
[0027]
[0028]
[0029]
[0030]
[0031]
[0032]
[0033]
[0034]
[0035]
[0036]
[0037]
[0038]
[0039]
[0040]
[0041]
[0042]
[0043]
[0044]
[0045]
[0046]
[0047]
[0048]
[0049]
[0050]
[0051]
[0052]
[0053]
[0054]
[0055]
[0056]
[0057]
[0058]
[0059]
[0060]
[0061]
[0062]
[0063]
[0064]
[0065]
[0066]
[0067]
[0068]
[0069]
[0070]
[0071]
[0072]
[0073]
[0074]
[0075]
[0076]
[0077]
[0078]
[0079]
[0080]
[0081]
[0082]
[0083]
[0084]
[0085]
[0086]
[0087]
[0088]
[0089]
[0090]
[0091]
[0092]
[0093]
[0094]
[0095]
[0096]
[0097]
[0098]
[0099]
[0100]
[0101]
[0102]
[0103]
[0104]
[0105]
[0106]
[0107]
[0108]
[0109]
[0110]
[0111]
[0112]
[0113]
[0114]
[0115]
[0116]
[0117]
[0118]
[0119]
[0120]
[0121]
[0122]
[0123]
[0124]
[0125]
[0126]
[0127]
[0128]
[0129]
[0130]
[0131]
[0132]
[0133]
[0134]
[0135]
[0136]
[0137]
[0138]
[0139]
[0140]
[0141]
[0142]
[0143]
[0144]
[0145]
[0146]
[0147]
[0148]
[0149]
[0150]
[0151]
[0152]
[0153]
[0154]
[0155]
[0156]
[0157]
[0158]
[0159]
[0160]
[0161]
[0162]
[0163]
[0164]
[0165]
[0166]
[0167]
[0168]
[0169]
[0170]
[0171]
[0172]
[0173]
[0174]
[0175]
[0176]
[0177]
[0178]
[0179]
[0180]
[0181]
[0182]
[0183]
[0184]
[0185]
[0186]
[0187]
[0188]
[0189]
[0190]
[0191]
[0192]
[0193]
[0194]
[0195]
[0196]
[0197]
[0198]
[0199]
[0200]
[0201]
[0202]
[0203]
[0204]
[0205]
[0206]
[0207]
[0208]
[0209]
[0210]
[0211]
[0212]
[0213]
[0214]
[0215]
[0216]
[0217]
[0218]
[0219]
[0220]
[0221]
[0222]
[0223]
[0224]
[0225]
[0226]
[0227]
[0228]
[0229]
[0230]
[0231]
[0232]
[0233]
[0234]
[0235]
#
# 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') ;
}