$! Display Webcount counter - generate datafile based on www_http_referer
$ ON ERROR THEN $ CONTINUE
$! Don't use DECnet record mode, add crlf. This avoids buffer length problems
$ CGI_SYMBOLS
$! Convert referring URL to unique file spec for count data file
$ IF F$TYPE(www_http_referer).EQS."" THEN $ www_http_referer = ""
$ CALL urlconverter "''www_http_referer'" ! Return wcount_data_file symbol
$ IF F$TYPE(www_query_string).EQS.""
$ THEN
$   www_query_string = "df=''wcount_data_file'|dd=B|ft=0"
$ ELSE
$!  Query string provided - get rid of any df=file specs and override
$   GOSUB remove_df_spec
$   IF www_query_string.EQS.""
$   THEN
$     www_query_string = "df=''wcount_data_file'|dd=B|ft=0"
$   ELSE
$!    Don't add data file for clock, literal or image
$     len_query_string = F$LENGTH(www_query_string)
$     IF F$LOCATE("display=clock",www_query_string).EQ.len_query_string .AND. -
         F$LOCATE("image=",www_query_string).EQ.len_query_string .AND. -
         F$LOCATE("lit=",www_query_string).EQ.len_query_string
$     THEN
$!      Add data file if not clock, literal or image
$       www_query_string = "df=''wcount_data_file'|''www_query_string'"
$     ENDIF
$   ENDIF
$ ENDIF
$ pid = F$GETJPI("","PID")
$ bufio = F$GETJPI("","BUFIO")
$ gif_file_spec = "COUNTER_''pid'_''bufio'.GIF;"
$! Create GIF of counter image
$ DEFINE/USER SYS$OUTPUT 'gif_file_spec'
$ MC WWW_ROOT:[BIN]COUNT_PROG.EXE
$! Write CGI header
$ crlf = f$fao("!/")
$ say = "WRITE net_link"
$ say "Content-type: image/gif",crlf
$ say "",crlf
$ IF www_request_method .EQS. "HEAD" THEN EXIT
$! Copy actual GIF to server
$ MCR WWW_SYSTEM:COPY_BIN 'gif_file_spec'
$ DELETE/NOLOG 'gif_file_spec'
$!
$ EXIT
$!----------------------- Subroutines ------------------------------------------
$!
$urlconverter: SUBROUTINE
$!========================================================================
$! Name      : URLCONVERTER
$! Purpose   : Convert a valid URL string to a unique VMS filename
$! Arguments : URL
$! Created  15-OCT-1996   Gonzalo San Martin
$! Modified  2-APR-1997   Gonzalo San Martin
$!                        Treat "%7E" as "~" in URLs
$!========================================================================
$   ON ERROR     THEN $ GOTO exit_urlconverter
$   ON CONTROL_Y THEN $ GOTO exit_urlconverter
$!
$!  Get rid of http:// ftp:// etc... if present, otherwise assume "relative" URL
$!
$   full_url = F$EDIT(P1,"UPCASE,COLLAPSE")
$   offset = F$LOCATE("//",full_url)+2
$   IF (offset .NE. F$LENGTH(full_url)+2 )
$   THEN
$     url = F$EXTRACT(offset,F$LENGTH(full_url)-offset,full_url)
$   ELSE
$     IF ( full_url .EQS. "" )
$     THEN
$       url = "SAMPLE"
$     ELSE
$       url = full_url
$     ENDIF
$   ENDIF
$!
$!  If last character is a "/", get rid of it
$!
$   last_char = F$EXTRACT(F$LENGTH(url)-1,1,url)
$   IF ( last_char .EQS. "/" )
$   THEN
$     url = F$EXTRACT(0,F$LENGTH(url)-1,url)
$   ENDIF
$!
$! Replace "%7E" string by "~"
$!
$   offset = F$LOCATE("%7E",url)
$   IF ( offset .LT. F$LENGTH(url) )
$   THEN
$     url = F$EXTRACT(0,offset,url)+"~"+F$EXTRACT(offset+3,F$LENGTH(url)-offset-3,url)
$   ENDIF
$!
$!  Accept only alphanumeric characters. Replace "/" and "." by "_".
$!
$   allowed = "01234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ_"
$   charnum = 0
$   new_url = ""
$!
$next_char:
$     char = F$EXTRACT(charnum,1,url)
$     IF ( char .EQS. "/" .OR. char .EQS. "." )
$     THEN
$       new_url = new_url + "_"
$     ELSE
$       IF ( F$LOCATE(char,allowed) .NE. F$LENGTH(allowed) )
$       THEN
$         new_url = new_url + char
$       ENDIF
$     ENDIF
$     charnum = charnum + 1
$     IF ( charnum .EQ. F$LENGTH(url) )
$     THEN
$       GOTO write_url
$     ELSE
$       GOTO next_char
$     ENDIF
$!
$write_url:
$!
$! VMS filenames/types are only allowed a maximum of 39 characters each. Spread
$! the new URL over both.
$!
$     IF ( F$LENGTH(new_url) .GT. 39 )
$     THEN
$       IF ( F$LENGTH(new_url) .GT. 74 )
$       THEN
$         final_url = F$EXTRACT(F$LENGTH(new_url)-74,39,new_url) + "." +  -
              F$EXTRACT(F$LENGTH(new_url)-35,35,new_url) +  -
              "_DAT"
$       ELSE
$         final_url = F$EXTRACT(0,39,new_url) + "." +  -
                      F$EXTRACT(39,F$LENGTH(new_url)-39,new_url) + "_DAT"
$       ENDIF
$     ELSE
$       final_url = new_url+".DAT"
$     ENDIF
$     wcount_data_file == final_url
$exit_urlconverter:
$ RETURN
$ ENDSUBROUTINE
$!========================================================================
$!
$remove_df_spec:
$!========================================================================
$! Name      : remove_df_spec
$! Purpose   : Remove any df=file specs from query string
$! Arguments : None, uses and returns the www_query_string local symbol
$! Created  15-OCT-1996  Phil Ottewell
$!========================================================================
$ qs = F$EDIT(www_query_string,"COLLAPSE")
$qs_loop:
$   qsu = F$EDIT(qs,"UPCASE")
$   len_qs = F$LENGTH(qsu)
$!  Check uppercased version to allow for df=, DF= etc.
$   next_df = F$LOCATE("DF=",qsu)
$   IF next_df.LT.len_qs
$   THEN
$     rest_of_qs = F$EXTRACT(next_df,len_qs,qs)
$     len_rest_of_qs = F$LENGTH(rest_of_qs)
$!    End of df=file is &, | or end of string
$     end_df = F$LOCATE("&",rest_of_qs)
$     IF end_df.EQ.len_rest_of_qs THEN end_df = F$LOCATE("|",rest_of_qs)
$!    Get rst of qs after the df=file
$     rest_of_qs = F$EXTRACT(end_df,len_rest_of_qs,rest_of_qs)
$     IF next_df.GT.0
$     THEN
$!      If &df= or |df= get rid of preceding & or |
$       IF F$EXTRACT(next_df-1,1,qs).EQS."&" .OR. F$EXTRACT(next_df-1,1,qs).EQS."|"
$       THEN
$         start_of_qs = F$EXTRACT(0,next_df-1,qs)
$       ELSE
$         start_of_qs = F$EXTRACT(0,next_df,qs)
$       ENDIF
$     ELSE
$       start_of_qs = ""
$     ENDIF
$!    Don't want qs to start with & or |
$     IF start_of_qs.EQS.""
$     THEN
$       IF F$EXTRACT(0,1,rest_of_qs).EQS."|" .OR. F$EXTRACT(0,1,rest_of_qs).EQS."|"
$       THEN
$         rest_of_qs = F$EXTRACT(1,len_rest_of_qs,rest_of_qs)
$       ENDIF
$     ENDIF
$     qs = start_of_qs + rest_of_qs
$     qsu = F$EDIT(qs,"UPCASE")
$     len_qs = F$LENGTH(qsu)
$     next_df = F$LOCATE("DF=",qsu)
$   ENDIF
$ IF next_df.LT.len_qs THEN $ GOTO qs_loop
$! Return query string without df=file anywhere in it
$ www_query_string = qs
$ RETURN
$!========================================================================