# When running Aubit programs as CGI in web server, use A4GL_UI=CONSOLE # $Id: libahtmllib.4gl,v 1.9 2009/08/19 18:00:46 fortiz Exp $ ######################################################################## #ANSI C libraryes for CGI programing: # #own main()!!!! #http://www.boutell.com/cgic/ # #C, not free #http://www.iexp.com/products/cgi-lib/ # #cpp, free # # #C, free #http://www.newbreedsoftware.com/cgi-util/ # #C, free #http://www.eekim.com/software/cgihtml/ # #c(?) simple, free #http://www.csclub.uwaterloo.ca/~yhchan/download/qcgidoc.html # #W3C protocol library #http://www.w3.org/Library/ # #no main() #http://www.geocities.com/SiliconValley/Bay/1927/yacgi.html # #http://kitsumi.xware.cx/xcgi/ # # #http://www.global-owl.de/ecgi/ # #nice... #http://catchen.org/gcgi/ ######################################################################## ########### globals ########### define do_debug, showpage smallint, item, form_method char(20), HTTP_POST_VAR, HTTP_GET_VAR char(1000), www record GATEWAY_INTERFACE char (20), SERVER_NAME char (60), SERVER_SOFTWARE char (100), SERVER_PROTOCOL char (20), REQUEST_METHOD char (10), QUERY_STRING char (300), DOCUMENT_ROOT char (200), HTTP_ACCEPT char (200), HTTP_ACCEPT_CHARSET char (40), HTTP_ACCEPT_ENCODING char (20), HTTP_ACCEPT_LANGUAGE char (10), HTTP_CONNECTION char (20), HTTP_HOST char (200), HTTP_REFERER char (600), HTTP_USER_AGENT char (300), REMOTE_ADDR char (20), REMOTE_PORT char (10), SCRIPT_FILENAME char (300), SERVER_ADMIN char (100), SERVER_PORT char (10), SERVER_SIGNATURE char (100), PATH_TRANSLATED char (300), SCRIPT_NAME char (300), REQUEST_URI char (600) end record, HTTPvar array [100] of record vname char(20), value char(60) end record, g_css char (40) end globals #==================== HTML Library ========================== ####################### function html_init(cssfilename) ####################### define cssfilename char (40), lv_debug, lv_do_debug varchar(3) call html_headers() display "" let form_method="POST" call get_webserver_vars() if www.REQUEST_METHOD = "POST" then call getstdin() end if if www.REQUEST_METHOD = "POST" then call html_params(HTTP_POST_VAR) else call html_params(HTTP_GET_VAR) end if let lv_do_debug = vread("do_debug") clipped if lv_do_debug = "on" then let do_debug = true end if if lv_do_debug = "off" then let do_debug = false end if let lv_debug = vread("debug") clipped if lv_debug = "on" then let do_debug = true end if if lv_debug = "off" then let do_debug = false end if if do_debug then display "HTTP_POST_VAR=[",HTTP_POST_VAR clipped, "]" display "
HTTP_GET_VAR=[",HTTP_GET_VAR clipped,"]" display "
" end if if vread("g_css") <> "0" then let g_css = vread("g_css") let cssfilename = g_css end if if do_debug then call vreadall() end if call html_css(cssfilename) end function ################################ function html_css(cssfilename) ################################ define cssfilename, tmp_cssfilename char (40) let tmp_cssfilename = vread("css") { display "xxx",tmp_cssfilename clipped,"xxx" if vread("css") <> false then display "not false" end if if vread("css") <> "0" then display "not '0'" end if if vread("css") <> 0 then display "not 0" end if } if tmp_cssfilename <> '0' # if vread("css") <> '0' then # let tmp_cssfilename = vread("css") # display "xxx",tmp_cssfilename clipped,"xxx" let cssfilename = tmp_cssfilename let g_css = tmp_cssfilename end if if cssfilename <> "none" then display " " end if end function ############################ function html_headers() ############################ #We cannot use DISPLAY for first line, because of bug (?) in Aubit that #prints newline BEFORE it prints string, creating one empty line after program #starts, so we heve to use this: code //printf("HTTP/1.1 200 OK"); //Pragma: no-cache printf("Content-type: text/html\n\n"); endcode return { if [ "$REQUEST_METHOD" = "HEAD" ]; then echo HTTP/1.1 200 OK echo Date: `date` echo Server: $SERVER_SOFTWARE echo Connection: close echo Content-type: multipart/x-mixed-replace echo elif [ "$REQUEST_METHOD" = "GET" ]; then echo HTTP/1.1 200 OK echo Date: `date` echo Server: $SERVER_SOFTWARE echo Connection: close exec $PATH_TO_WEBCAM $WEBCAM_OPTIONS else cat < 405 Method Not Allowed

Method Not Allowed

The requested method $REQUEST_METHOD is not allowed for the URL $REQUEST_URI.

EOF fi print "Content-type: text/html\n\n"; } { display "HTTP/1.1 200 OK" display "Date: Tue Oct 16 12:16:03 NZDT 2001" display "Server: ",www.SERVER_SOFTWARE clipped display "Connection: close" #display "Content-type: multipart/x-mixed-replace" } #echo Content-type: text/plain #HTTP/1.1 405 Method Not Allowed #Allow: GET, HEAD end function ################################### function html_start_body() ################################### #black falout.com scheme: #display "" #light blue scheme fro Maximise "add user" #display "" # display "" end function ################################### function html_end_body() ################################### display "" end function ################################### function html_start_para() ################################### display "

" end function ################################### function html_end_para() ################################### display "

" end function ################################### function html_display_para(mytext) ################################### #FIXME: why is "text" reserved word? define mytext char (10000) call html_start_para() display mytext clipped call html_end_para() end function ################################### function html_meta() ################################### display "" display "" display "" display "" end function ################################### function html_link(URL,target,mytext) ################################### define URL,mytext char (300), target char(10) display "",mytext clipped,"" end function ################################### function html_head(page_title) ################################### define page_title char (300) display "" display " " call html_title(page_title) call html_meta() display "" display " " end function ################################### function html_title(p_string) ################################### define p_string char(512) display "",p_string clipped,"" end function ################################### function html_heading(p_string,p_level) ################################### define p_string char(512) define p_level integer display "",p_string clipped, "" end function ################################### function html_hline() ################################### display "
" end function ################################### function html_image(URL,W,H) ################################### define URL char (200), W,H integer display "" end function ################################### function html_start_center() ################################### display "
" end function ################################### function html_end_center() ################################### display "
" end function ################################### function html_params(allparams) ################################### define cnt,numparams,startpos,endpos,arglength, allparamslength, gotit, i, varlen smallint, ARGUMENT ARRAY[50] OF CHAR (60), prg_name char(20), allparams, resto, cutstring char (1000) #let prg_name = ARG_VAL(0) let prg_name = www.script_name #let allparams = ARG_VAL(1) #let allparams = www.query_string #if NUM_ARGS() = 0 if length (allparams) = 0 then if do_debug then display "No args
" end if return end if let numparams = 0 let startpos = 1 let allparamslength = length(allparams) #from arg_val(1): something\&blah\&4444 #from www.query_string: something&blah&4444 ################################ FOR cnt = 1 TO length(allparams) ################################ if allparams[cnt] = "&" then let numparams = numparams + 1 let endpos = cnt - 1 let ARGUMENT[numparams] = allparams[startpos,endpos] let startpos = cnt + 1 end if ####### end for ####### if startpos < allparamslength then let resto = allparams[startpos,allparamslength] if length (resto) > 0 then #last one don't have "&" on end let numparams = numparams + 1 let endpos = length(allparams) let ARGUMENT[numparams] = allparams[startpos,endpos] end if end if ############################ #FOR cnt = 1 TO NUM_ARGS() FOR cnt = 1 TO numparams ############################ if do_debug then display "Param ",cnt," = [",ARGUMENT[cnt], "]
" end if # IF # ARGUMENT[cnt] IS NOT NULL # THEN # LET ARGUMENT[cnt] = UPSHIFT(ARGUMENT[cnt]) # END IF let varlen=length(ARGUMENT[cnt]) let cutstring = ARGUMENT[cnt] let gotit = false ################## for i=1 to varlen ################## if cutstring[i] = "=" then let HTTPvar[cnt].vname = cutstring[1,i-1] let HTTPvar[cnt].value = cutstring[i+1,varlen] let gotit = true exit for end if ####### end for ####### if not gotit then let HTTPvar[cnt].vname = ARGUMENT[cnt] let HTTPvar[cnt].value = "" end if let varlen=length(HTTPvar[cnt].value) let cutstring = HTTPvar[cnt].value ################## for i=1 to varlen ################## #spaces are sent as "+" if cutstring[i] = "+" then #display "xxxx+
" #let cutstring[i] = " " <---bug - this is not working let cutstring = cutstring[1,i-1]," ",cutstring[i+1,varlen] end if #Netscape sends "@" as "%40" if cutstring[i,i+2] = "%40" then #display "xxxx@
" #let cutstring[i] = "@" <--- bug - not working let cutstring = cutstring[1,i-1],"@",cutstring[i+3,varlen] end if ####### end for ####### #display "eeee",cutstring,"
" let HTTPvar[cnt].value = cutstring ####### END FOR ####### let item = vread("item") end function #params() ################################ function vread(varname) ################################ define cnt smallint, tmpvarname, varname char(60) #all variable names in 4gl are case insensitive let varname = upshift(varname) #################### for cnt = 1 to 100 #################### let tmpvarname = upshift(HTTPvar[cnt].vname) if tmpvarname = varname then if length (HTTPvar[cnt].value) > 0 then return HTTPvar[cnt].value else #varibale was defined, but no value was assigned return TRUE end if end if ######## end for ######## #did not find this variable name: return false end function ##################### function vreadall() ##################### define cnt smallint for cnt = 1 to 100 if length (HTTPvar[cnt].vname) > 0 then display HTTPvar[cnt].vname clipped, " = ", HTTPvar[cnt].value clipped, "
" else exit for end if if length (HTTPvar[cnt].value) = 0 then #bug in DISPLAY display "
" end if end for end function ############################## function get_webserver_vars() ############################## #http://hoohoo.ncsa.uiuc.edu/cgi/overview.html #http://www.php.net/manual/en/language.variables.predefined.php #http://httpd.apache.org/docs-2.0/howto/cgi.html #$HTTP_POST_VARS['username'] let www.GATEWAY_INTERFACE = FGL_GETENV("GATEWAY_INTERFACE") #What revision of the CGI specification the server is using; i.e. 'CGI/1.1'. let www.SERVER_NAME = FGL_GETENV("SERVER_NAME") #The name of the server host under which the current script is executing. #If the script is running on a virtual host, this will be the value defined #for that virtual host. let www.SERVER_SOFTWARE = FGL_GETENV("SERVER_SOFTWARE") #Server identification string, given in the headers when responding to requests. let www.SERVER_PROTOCOL = FGL_GETENV("SERVER_PROTOCOL") #Name and revision of the information protocol via which the page was #requested; i.e. 'HTTP/1.0'; let www.REQUEST_METHOD = FGL_GETENV("REQUEST_METHOD") #Which request method was used to access the page; i.e. 'GET', 'HEAD', #'POST', 'PUT'. let www.QUERY_STRING = FGL_GETENV("QUERY_STRING") let HTTP_GET_VAR = FGL_GETENV("QUERY_STRING") #The query string, if any, via which the page was accessed. let www.DOCUMENT_ROOT = FGL_GETENV("DOCUMENT_ROOT") #The document root directory under which the current script is executing, #as defined in the server's configuration file. let www.HTTP_ACCEPT = FGL_GETENV("HTTP_ACCEPT") #Contents of the Accept: header from the current request, if there is one. let www.HTTP_ACCEPT_CHARSET = FGL_GETENV("HTTP_ACCEPT_CHARSET") #Contents of the Accept-Charset: header from the current request, if #there is one. Example: 'iso-8859-1,*,utf-8'. let www.HTTP_ACCEPT_ENCODING = FGL_GETENV("HTTP_ACCEPT_ENCODING") #Contents of the Accept-Encoding: header from the current request, if #there is one. Example: 'gzip'. let www.HTTP_ACCEPT_LANGUAGE = FGL_GETENV("HTTP_ACCEPT_LANGUAGE") #Contents of the Accept-Language: header from the current request, if #there is one. Example: 'en'. let www.HTTP_CONNECTION = FGL_GETENV("HTTP_CONNECTION") #Contents of the Connection: header from the current request, if #there is one. Example: 'Keep-Alive'. let www.HTTP_HOST = FGL_GETENV("HTTP_HOST") #Contents of the Host: header from the current request, if there is one. let www.HTTP_REFERER = FGL_GETENV("HTTP_REFERER") #The address of the page (if any) which referred the browser to the #current page. This is set by the user's browser; not all browsers will set this. let www.HTTP_USER_AGENT = FGL_GETENV("HTTP_USER_AGENT") #Contents of the User_Agent: header from the current request, if there #is one. This is a string denoting the browser software being used to #view the current page; i.e. Mozilla/4.5 [en] (X11; U; Linux 2.2.9 i586). #Among other things, you can use this value with get_browser() to tailor #your page's functionality to the capabilities of the user's browser. let www.REMOTE_ADDR = FGL_GETENV("REMOTE_ADDR") #The IP address from which the user is viewing the current page. let www.REMOTE_PORT = FGL_GETENV("REMOTE_PORT") #The port being used on the user's machine to communicate with the web #server. let www.SCRIPT_FILENAME = FGL_GETENV("SCRIPT_FILENAME") #The absolute pathname of the currently executing script. let www.SERVER_ADMIN = FGL_GETENV("SERVER_ADMIN") #The value given to the SERVER_ADMIN (for Apache) directive in the web #server configuration file. If the script is running on a virtual host, #this will be the value defined for that virtual host. let www.SERVER_PORT = FGL_GETENV("SERVER_PORT") #The port on the server machine being used by the web server for #communication. For default setups, this will be '80'; using SSL, #for instance, will change this to whatever your defined secure HTTP port is. let www.SERVER_SIGNATURE = FGL_GETENV("SERVER_SIGNATURE") #String containing the server version and virtual host name which are #added to server-generated pages, if enabled. let www.PATH_TRANSLATED = FGL_GETENV("PATH_TRANSLATED") #Filesystem- (not document root-) based path to the current script, #after the server has done any virtual-to-real mapping. let www.SCRIPT_NAME = FGL_GETENV("SCRIPT_NAME") #Contains the current script's path. This is useful for pages which #need to point to themselves. let www.REQUEST_URI = FGL_GETENV("REQUEST_URI") #The URI which was given in order to access this page; for instance, #'/index.html'. end function ############################## function show_webserver_vars() ############################## display "HTTP_POST_VAR=[",HTTP_POST_VAR clipped, "]" display "
HTTP_GET_VAR=[",HTTP_GET_VAR clipped,"]" display "
" display "
" display "All www variables:
" display "GATEWAY_INTERFACE = ",www.GATEWAY_INTERFACE,"
" display "SERVER_NAME = ",www.SERVER_NAME,"
" display "SERVER_SOFTWARE = ",www.SERVER_SOFTWARE,"
" display "SERVER_PROTOCOL = ",www.SERVER_PROTOCOL,"
" display "REQUEST_METHOD = ",www.REQUEST_METHOD,"
" display "QUERY_STRING = ",www.QUERY_STRING,"
" display "DOCUMENT_ROOT = ",www.DOCUMENT_ROOT,"
" display "HTTP_ACCEPT = ",www.HTTP_ACCEPT,"
" display "HTTP_ACCEPT_CHARSET = ",www.HTTP_ACCEPT_CHARSET,"
" display "xxx
" display "HTTP_ACCEPT_ENCODING = ",www.HTTP_ACCEPT_ENCODING,"
" display "HTTP_ACCEPT_LANGUAGE = ",www.HTTP_ACCEPT_LANGUAGE,"
" display "HTTP_CONNECTION = ",www.HTTP_CONNECTION,"
" display "HTTP_HOST = ",www.HTTP_HOST,"
" display "xxx
" display "HTTP_REFERER = ",www.HTTP_REFERER,"
" display "HTTP_USER_AGENT = ",www.HTTP_USER_AGENT,"
" display "REMOTE_ADDR = ",www.REMOTE_ADDR,"
" display "REMOTE_PORT = ",www.REMOTE_PORT,"
" display "SCRIPT_FILENAME = ",www.SCRIPT_FILENAME,"
" display "SERVER_ADMIN = ",www.SERVER_ADMIN,"
" display "SERVER_PORT = ",www.SERVER_PORT,"
" display "SERVER_SIGNATURE = ",www.SERVER_SIGNATURE,"
" display "PATH_TRANSLATED = ",www.PATH_TRANSLATED,"
" display "xxx
" display "SCRIPT_NAME = ",www.SCRIPT_NAME,"
" display "REQUEST_URI = ",www.REQUEST_URI,"
" display "
" end function #################################### function show_webserver_vars_page() #################################### call html_start_body() # call page_menu() #page_menu function is supposed to be defined in the ptogram itself - and on Windows this would #cause undefined error. anyway, library should not depend on the functions defined in ptogram using it call show_webserver_vars() # call standard_footer() #same comment sa for page_menu() call html_end_body() end function ###################################################################### # This have a variable number of parameters # so we'll have to pop them off in C # NOTE: List is in reverse order - thats the order they will be pulled # off the stack.. ###################################################################### code aclfgl_html_list(int a) { int c; char s[1000]; for (c=0;c%s\n",s); } return 0; } endcode ###################################################################### ##################### function xxxgetstdin() ##################### define c char (256) code { // //char c; // while( (c = fgetc(stdin)) != EOF ) { // //fputc( c, stdout ); // } // // //return c; //char *fgets( char *s, int n, FILE *stream ); /* stdin abbreviation */ char *gets( char *c ); //int fputs( char *s, FILE *stream ); /* stdout abbreviation */ //int puts( char *s ); } endcode return c end function ##################### function getstdin() ##################### define charvar char (1000), len smallint if www.REQUEST_METHOD <> "POST" then initialize HTTP_POST_VAR to null return end if code { fgets (charvar, sizeof (charvar), stdin); trim (charvar); } endcode { let len = length (charvar) if len > 1 then #strip CR let charvar = charvar[1,len-1] else initialize charvar to null end if } let HTTP_POST_VAR = charvar clipped end function ############################# function html_redirect(URL) ############################# define URL char (300) display '' display '' display '' display 'End program' display '' display '' call html_end_body() display '' exit program end function #==================================================================== # JavaScript functions #==================================================================== ############################### function JS_windowname() ############################### display "" end function ############################### function JS_launchHelpWin() ############################### display "" end function ############################### function JS_launchNewWin() ############################### display "" end function ######################## function JS_startcode() ######################## display "" display "" end function ########################### function JS_ValidateEmail() ########################### display "function ValidateEmail(theinput)" display "{" display " s=theinput.value" display " if(s.search)" display " {" display " return (s.search(new RegExp('^([a-z0-9_]|\-|\\\.)+@(([a-z0-9_]|\-)+\\\.)+[a-z]{2,4}$','gi'))>=0)" #|______________________________________________________________________________________________^ #| Error at line 213, character 96 #| parse error () display " }" display " if(s.indexOf)" display " {" display " at_character=s.indexOf('@')" display " if(at_character<=0 || at_character+4>s.length)" display " return false" display " }" display " if(s.length<6)" display " return false" display " else" display " return true" display "}" end function ########################## function JS_ValidateForm() ########################## display "function ValidateForm(theform)" display "{ if (window.SkipVerify==true) {return true }" display " if(theform.email.value==''" display " || ValidateEmail(theform.email)==false)" display " {" display " alert('Valid e-mail address was not specified')" display " theform.elements[1].focus()" display " form_submitted=false" display " return false" display " }" display " if(theform.confirm_email.value==''" display " || theform.confirm_email.value!=theform.email.value" display " || ValidateEmail(theform.confirm_email)==false)" display " {" display " alert('E-mail addres confirmation is not the same as e-mail specified')" display " theform.elements[2].focus()" display " form_submitted=false" display " return false" display " }" display " if(theform.country.selectedIndex==-1 || theform.country.options[theform.country.selectedIndex].value=='')" display " { " display " alert('Valid country name was not specified')" display " theform.elements[3].focus()" display " form_submitted=false" display " return false" display " }" display " if(theform.first_name.value=='')" display " {" display " alert('Valid first name was not specified')" display " theform.elements[4].focus()" display " form_submitted=false" display " return false" display " }" display " if(theform.last_name.value=='')" display " {" display " alert('Valid last name was not specified')" display " theform.elements[5].focus()" display " form_submitted=false" display " return false" display " }" display " if((theform.alias.value.search" # #!!!!!!!!!!!!!!!!!!!!!! # display " && theform.alias.value.search(new RegExp('^[a-zA-Z0-9\-_]+$','g'))<0)" # #!!!!!!!!!!!!!!!!!!!!!! # display " || theform.alias.value=='')" display " {" display " alert('You did not specified a login name')" display " theform.elements[6].focus()" display " form_submitted=false" display " return false" display " }" display " if(theform.elements[9].checked==false && theform.elements[10].checked==false && theform.elements[11].checked==false)" display " {" display " alert('Subscription type was not specified')" display " theform.elements[9].focus()" display " form_submitted=false" display " return false" display " }" display " return true" display "}" display "" end function ################################# function JS_PageLoad() ################################# display "function PageLoad()" display "{" display " document.adduser.elements[1].focus()" display "}" end function #===================================================================== # HTML Form fields #===================================================================== ################################# function HTMLF_email() ################################# display " E-mail address:" display " " display "" display " " display "" display "" display " Help" display "" end function ################################# function HTMLF_email_confirm() ################################# display " Confirm E-mail:" display " " display "" display " " display "" display "" display " Help" display "" end function ############################### function HTMLF_form_header() ############################### # display "
" display "" end function ############################### function HTMLF_form_footer() ############################### display "
" end function ############################### function HTMLF_tableFrameStart() ############################### display "
" display " " display " " display " " display " " display "
" display "
" display " " display " " end function ############################### function HTMLF_TableFrameEnd() ############################### display " " display "
" display "
" display "
" display "
" end function ################################### function HTMLF_countrylist() ################################### display " Country:" display " " display "" display "" display "" display "" display " Help" display "" end function ################################# function HTMLF_firstName() ################################# display " First name:" display " " display " " display " " display " " display " " display " Help" display " " end function ################################# function HTMLF_lastname() ################################# display " Last name:" display " " display " " display " " display " " display " " display " Help" display " " end function ################################# function HTMLF_loginname() ################################# display " Access name (login):" display " " display " " display " " display " " display " " display " Help" display " " end function ################################# function HTMLF_checkASPnews() ################################# display " " display " " display " " display " Receive ASP system newsletter" display " " display " " display " Help" display " " end function ################################# function HTMLF_checkSiteNews() ################################# display " " display " " display " " display " Receive site newsletter" display " " display " " display " Help" display " " end function ################################# function HTMLF_radioItems() ################################# display "" display " " display " " display " " display " Administrator - create new database" display " " display "" display "" display " " display " " display " " display " User - join your company database" display " " display "" display "" display " " display " " display " " display " Guest - join public test database" display " " display "" end function ################################# Function HTMLF_TitleLine() ################################# display "Subscription type:" # display " " display "" display "" display " Help" display "" end function ################################# function HTMLF_SubmitButton() ################################# define s1,s2,s3,s4,s5,s6,s7,s8,s9 char (200) #4glc dums core on this one: # display "" #------------------------------------------------------------ #must be on one line? display "" let s1 = "" end function function HTMLF_transferValue() display "" end function #--------------------------- EOF --------------------------------