//",WWW_HTTP_HOST,WWW_PATH

$! $! HTDIR.COM $! This is an example DCL CGI+ script. $! It has the same main functionality as the WASD directory listing $! with HTdir script set features included. $! $ ON ERROR THEN GOTO ERROR_HANDLER $ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENTIFICATION/NOTEXT $ HT_IDENT="HTdir V1.1C" $ SAY:="WRITE/SYMBOL SYS$OUTPUT" $ CGIUTL:=$CGI-BIN:[000000]CGIUTL $ CGIEOF=F$TRNLNM("CGIPLUSEOF","LNM$PROCESS") $ CGIESC=F$TRNLNM("CGIPLUSESC","LNM$PROCESS") $ CGIEOT=F$TRNLNM("CGIPLUSEOT","LNM$PROCESS") $ EMPTY=" " $ OPEN/READ/ERROR=IVENV CGIPLUSIN CGIPLUSIN: $ IF CGIEOF .EQS. "" THEN GOTO CGI_VARS_END $! $ REQUEST_LOOP: $ DELETE/SYMBOL/GLOBAL/ALL $ READ/ERROR=DONE/END=DONE CGIPLUSIN LINE $! $ CGI_VARS_LOOP: $ READ/ERROR=DONE/END=DONE CGIPLUSIN LINE $ IF LINE .EQS. "" THEN GOTO CGI_VARS_END $ CGI_VAR_NAME=F$ELEMENT(0,"=",LINE) $ CGI_VAR_VALUE=LINE-(CGI_VAR_NAME+"=") $ 'CGI_VAR_NAME'=="''CGI_VAR_VALUE'" $ GOTO CGI_VARS_LOOP $ CGI_VARS_END: $! $ UNICON="" $ UPD="" $ IF F$TYPE(WWW_FORM_UPD) .NES. "" THEN UPD="*" $ IF WWW_REQUEST_METHOD .EQS. "POST" THEN UPD="*" $ QUERY="" $ IF F$TYPE(WWW_QUERY_STRING) .NES. "" THEN IF WWW_QUERY_STRING .NES. "" THEN - QUERY="?"+WWW_QUERY_STRING $ TARG="" $ IF F$TYPE(WWW_FORM_TARGET) .NES. "" THEN TARG=" TARGET="+WWW_FORM_TARGET $! $ IF WWW_PATH_INFO .EQS. "" $ THEN $ SAY "Location: //",WWW_SCRIPT_NAME,"/",QUERY $ SAY "" $ GOTO NEXT $ ENDIF $ LINE=F$PARSE(WWW_PATH_TRANSLATED,"*.*") $ LINE=F$PARSE(LINE,,,"NAME")+F$PARSE(LINE,,,"TYPE")+F$PARSE(LINE,,,"VERSION") $ IF F$LOCATE("*",LINE) .GE. F$LENGTH(LINE) $ THEN $ SAY "Location: ",WWW_PATH_INFO $ SAY "" $ GOTO NEXT $ ENDIF $! $ IF WWW_REQUEST_METHOD .EQS. "POST" THEN - CGIUTL/URLDECODE/SYMBOLS/PREFIX=WWW_FORM $ IF F$TYPE(WWW_FORM_SEL$$0) .EQS. "" $ THEN $ WWW_FORM_SEL$$0=="0" $ IF F$TYPE(WWW_FORM_SEL) .NES. "" THEN WWW_FORM_SEL$$0=="1" $ ENDIF $! $ SAY "Content-type: text/html" $ SAY "" $! $ PEER="" $ IF F$TYPE(WWW_FORM_DIR) .NES. "" $ THEN $ SAY CGIESC $ SAY "MAP-PATH: ",WWW_FORM_DIR $ SAY CGIEOT $ READ CGIPLUSIN PEER $ IF F$ELEMENT(0," ",PEER) .EQS. "200" $ THEN $ PEER=PEER-"200 " $ PEER=F$EDIT(PEER,"TRIM") $ ELSE $ PEER="" $ ENDIF $ ENDIF $! $ SAY "" $ SAY "" $ SAY "" $ SAY "" $ SAY "" $ SAY "" $ SAY "//",WWW_HTTP_HOST,WWW_PATH_INFO,"" $ IF UPD .NES. "" $ THEN $ SAY "" $ ENDIF $ SAY "" $ LINE="" $ IF F$TYPE(WWW_HTML_BODYTAG) .NES. "" THEN LINE="" $ SAY LINE $ IF F$TYPE(WWW_HTML_HEADERTAG) .NES. "" $ THEN $ LINE=WWW_HTML_HEADERTAG $ IF (F$LENGTH(LINE) .EQ. 0) .OR. (F$LOCATE("<",LINE) .NE. 0) THEN - LINE="

" $ SAY LINE $ ENDIF $ IF F$TYPE(WWW_HTML_HEADER) .NES. "" THEN SAY WWW_HTML_HEADER $! $ REF=WWW_SCRIPT_NAME+"/" $ LINE="//"+WWW_HTTP_HOST+"/" $ REST=WWW_PATH_INFO-"/" $ HDR_LOOP: $ IF F$ELEMENT(1,"/",REST) .EQS. "/" THEN GOTO HDR_END $ TMP=F$ELEMENT(0,"/",REST) $ REST=REST-TMP-"/" $ REF=REF+TMP+"/" $ LINE=LINE+""+TMP+"/" $ GOTO HDR_LOOP $ HDR_END: $ SAY "

",LINE,"",REST,"","

" $ LINE=F$PARSE(WWW_PATH_TRANSLATED,,,"DEVICE")+ - F$PARSE(WWW_PATH_TRANSLATED,,,"DIRECTORY") $ IF F$SEARCH("''LINE'README.HTML") .NES. "" $ THEN $ TYPE 'LINE'README.HTML $ ELSE $ IF F$SEARCH("''LINE'README.TXT") .NES. "" $ THEN $ SAY "

"
$     TYPE 'LINE'README.TXT
$     SAY "

" $ ENDIF $ ENDIF $! $ IF F$TYPE(WWW_HTML_HEADERTAG) .NES. "" THEN SAY "

" $ IF UPD .NES. "" $ THEN $ SAY "

" $ ENDIF $ SAY "

"
$!
$ SAY CGIESC
$ SAY "ICON-TYPE: x-internal/unknown"
$ SAY CGIEOT
$ READ CGIPLUSIN UNICON
$ IF F$ELEMENT(0," ",UNICON) .EQS. "200"
$   THEN
$   UNICON=UNICON-"200 "
$   UNICON=F$EDIT(UNICON,"TRIM")
$   ENDIF
$ SAY CGIESC
$ SAY "ICON-TYPE: x-internal/blank"
$ SAY CGIEOT
$ READ CGIPLUSIN ICON
$ IF F$ELEMENT(0," ",ICON) .EQS. "200"
$   THEN
$   ICON=ICON-"200 "
$   ICON=F$EDIT(ICON,"TRIM")
$   ELSE
$   ICON=UNICON
$   ENDIF
$ SAY CGIESC
$ SAY "ICON-TYPE: x-internal/directory"
$ SAY CGIEOT
$ READ CGIPLUSIN DIRICON
$ IF F$ELEMENT(0," ",DIRICON) .EQS. "200"
$   THEN
$   DIRICON=DIRICON-"200 "
$   DIRICON=F$EDIT(DIRICON,"TRIM")
$   ELSE
$   DIRICON=UNICON
$   ENDIF
$ IF UNICON .NES. "" THEN ICON=ICON+"  "
$!
$ BOX=""
$ IF UPD .NES. "" THEN -
    BOX=" "
$ SAY BOX,ICON,"Name                                Revised        Size",""
$!
$ OLINE=""
$ FILE_LOOP:
$ LINE=F$SEARCH(F$PARSE(WWW_PATH_TRANSLATED,"*.*"),1)
$ IF LINE .EQS. "" THEN GOTO FILE_END
$ IF LINE .EQS. OLINE THEN GOTO FILE_END
$ OLINE=LINE
$ LINE=F$ELEMENT(0," ",F$EDIT(LINE,"TRIM"))
$ IF LINE .EQS. "" THEN GOTO FILE_LOOP
$ FSIZE=F$FAO("!10UL",F$FILE(OLINE,"EOF")*512)
$ FDATE=F$FILE(OLINE,"RDT")
$ FDATE=FDATE-(":"+F$ELEMENT(2,":",FDATE))
$ LINE=F$PARSE(LINE,,,"NAME")+F$PARSE(LINE,,,"TYPE")+F$PARSE(LINE,,,"VERSION")
$ IF F$PARSE(WWW_PATH_TRANSLATED,,,"VERSION") .EQS. ";" THEN -
    LINE=LINE-F$PARSE(LINE,,,"VERSION")
$ LINE=F$EDIT(LINE,"LOWERCASE")
$ REF=LINE
$ IF F$PARSE(LINE,,,"TYPE") .NES. ".DIR"
$   THEN
$   SAY CGIESC
$   SAY "ICON-TYPE: ",LINE
$   SAY CGIEOT
$   READ CGIPLUSIN ICON
$   IF F$ELEMENT(0," ",ICON) .EQS. "200"
$     THEN
$     ICON=ICON-"200 "
$     ICON=F$EDIT(ICON,"TRIM")
$     ELSE
$     ICON=UNICON
$     ENDIF
$   IF F$LENGTH(LINE) .GT. 24 THEN LINE=F$EXTRACT(0,23,LINE)+"+"
$   FILL=F$EXTRACT(0,24-F$LENGTH(LINE),EMPTY)
$   ELSE
$   LINE=F$PARSE(LINE,,,"NAME")
$   LINE=F$EDIT(LINE,"LOWERCASE")
$   LINE=LINE+"/"
$   NAM=LINE
$   REF=LINE+REST
$   ICON=DIRICON
$   IF F$LENGTH(LINE) .GT. 24 THEN LINE=F$EXTRACT(0,23,LINE)+"+"
$   FILL=F$EXTRACT(0,24-F$LENGTH(LINE),EMPTY)
$   LINE=""+LINE+""
$   FSIZE=F$FAO("!10UL",0)
$   ENDIF
$ IF UNICON .NES. "" THEN ICON=""+ICON+"  "
$ BOX=""
$ IF UPD .NES. "" THEN -
    BOX=" "
$ SAY "",BOX,ICON,"",LINE,"",FILL,"  ",FDATE,"  ",FSIZE
$ GOTO FILE_LOOP
$ FILE_END:
$!
$ SAY "

" $ IF UPD .NES. "" THEN SAY "

" $ IF F$TYPE(WWW_HTML_FOOTERTAG) .NES. "" $ THEN $ LINE=WWW_HTML_FOOTERTAG $ IF (F$LENGTH(LINE) .EQ. 0) .OR. (F$LOCATE("<",LINE) .NE. 0) THEN - LINE="

" $ SAY LINE $ ENDIF $ IF F$TYPE(WWW_HTML_FOOTER) .NES. "" THEN SAY WWW_HTML_FOOTER $ IF F$TYPE(WWW_HTML_FOOTERTAG) .NES. "" THEN SAY "

" $ SAY "" $ SAY "" $! $ NEXT: $ IF CGIEOF .NES. "" $ THEN $ SAY CGIEOF $ GOTO REQUEST_LOOP $ ENDIF $ DONE: $ CLOSE CGIPLUSIN $ EXIT $! $ IVENV: $ CALL ERROR_REPORT 500 "Invalid environment" "''HT_IDENT'" $ GOTO DONE $! $ ERROR_HANDLER: $ CALL ERROR_REPORT 500 "''F$FAO(F$MESSAGE($STATUS),"","","","")'" "''HT_IDENT'" $ GOTO DONE $! $! Error report subroutine. $! P1 - HTTP status (required) $! P2 - error text (required) $! P3 - module name (optional) $! P4 - line number (optional) $! Uses WASD Script-control: X-error-... extensions. $! If the current version doesn't support them, $! Then it will be a simple error report. $! $ ERROR_REPORT: SUBROUTINE $ SAY "Status: ",P1 $ SAY "Script-control: X-error-text=""",P2,"""" $ IF P3 .NES. "" THEN SAY "Script-control: X-error-module=""",P3,"""" $ IF P4 .NES. "" THEN SAY "Script-control: X-error-line=",P4 $ SAY P1,": ",P2 $ EXIT $ ENDSUBROUTINE