* RPG ILE MODULE CGIDEV2/COOKIE1
*
* After compiling this RPG MODULE,
* create the related program with the following command:
*
* CRTPGM CGIDEV2/COOKIE1 MODULE(CGIDEV2/COOKIE1)
* ACTGRP(CGI) AUT(*USE)
*
* To execute this program,
* enter the following in your WEB browser command line:
* http://.../cgidev2p/cookie1.pgm
*
*=====================================================================
/copy CGIDEV2/qrpglesrc,hspecs
/copy CGIDEV2/qrpglesrc,hspecsbnd
*=====================================================================
* Includes to be used in CGIs
*=====================================================================
/copy CGIDEV2/qrpglesrc,prototypeb
/copy CGIDEV2/qrpglesrc,usec
/copy CGIDEV2/qrpglesrc,variables3
*=====================================================================
* Variables specific to this module
*=====================================================================
D Timenow s z
* Expiration date
D Expdate s d datfmt(*iso)
D Sunday s d datfmt(*iso)
D ds
D ExpDateC 1 10
D ExpYYYY 1 4
D ExpMM 6 7
D ExpDD 9 10
D Months s 36 inz('JanFebMarAprMayJunJulAugSepOct+
D NovDec')
D MonthNbr s 2s 0
D Month s 3
D Days s 21 inz('SunMonTueWedThuFriSat')
D Dayselp s 10i 0
D Dayselp7 s 15s 0
D DayNbr s 1s 0
D Day s 3
D Expires s 29
*
D CookieSent s 512 varying
D CookieReceived s 512 varying
D CookieRLn s 10i 0
D String s 32767
D StringLn s 10i 0
D char s 1
D work s 32767 varying
D i s 10u 0
D seq s 10i 0
D cookienam s 512a
D cookieval s 32767 varying
D i1 s 10i 0
D i2 s 10i 0
D i3 s 10i 0
D i4 s 10i 0
*=====================================================================
* Main line
*=====================================================================
* Write qualified job name to debug file. The *on
* parameter forces output even if debugging is off.
* Remove this parameter or change it to *off if you
* want the output only if debugging is on.
C* callp wrtjobdbg(*on)
C callp wrtjobdbg
* Get a timestamp
C time timenow
* Load external html, if not loaded yet
C callp gethtml('DEMOHTML':'CGIDEV2':'COOKIE1':
C '')
* Create a new cookie
* Start the output html
C exsr CrtMyCook
C callp wrtsection('top')
* Display the new cookie just created
C callp wrtsection('dspncookie')
* Retrieve available cookies
C eval CookieReceived = getenv('HTTP_COOKIE':qusec)
C callp wrtdebug('Cookie received ' + CookieReceived)
* Display the cookies received
C exsr DspCookies
* End the output html
* Time stamp (for the "submit" form)
C callp UpdHtmlVar('timenow':
C %trim(%char(Timenow)))
C callp wrtsection('endhtml *fini')
* Quit
C return
*=====================================================================
* Create a new cookie
* Set-Cookie: Timenow=...; expires=...; domain=...; path=...;
*=====================================================================
C CrtMyCook begsr
* Cookie name
C callp updhtmlvar('ncookienam':'TimeNow')
* Cookie value
C callp updhtmlvar('ncookieval':
C %trim(%char(Timenow)))
* Expiration date (expires=...) is one year from now
* Example: 'Mon, 12-Nov-2001 00:00:01 GMT'
C time ExpDate
C ExpDate adddur 1:*Y ExpDate
C eval ExpDateC = %char(ExpDate)
C move ExpMM MonthNbr
C eval Month = %subst(Months:
C (%dec(MonthNbr)-1)*3+1:3)
C eval Expires = ExpDD + '-' + Month + '-' +
C ExpYYYY + ' 00:00:01 GMT'
C move '2001-06-03' Sunday
C ExpDate subdur Sunday Dayselp:*D
C* eval DayNbr = %REM(Dayselp:7)
C DaysElp div 7 Dayselp7 for V4R3
C mvr DayNbr for V4R3
C eval Day = %subst(Days:
C DayNbr*3+1:3)
C eval Expires = Day + ', ' + %trimr(Expires)
*
C callp updhtmlvar('ncookieexp':Expires)
* Domain (domain=...)
C callp updhtmlvar('ncookiedom':
C %trimr(getenv('SERVER_NAME':qusec)))
* Path (domain=...)
C callp updhtmlvar('ncookiepth':
C '/')
C endsr
*=====================================================================
* Display the cookies received
*=====================================================================
C DspCookies begsr
*------------------
* If no cookies received
C if %len(CookieReceived) = 0
C callp wrtsection('nocookies')
C endif
*------------------
* If some cookies received
C IF %len(CookieReceived) > 0
C callp wrtsection('tabstr')
C eval seq = 0
* Convert escape sequences to characters
C exsr LstCookies
C callp wrtsection('tabend')
C endif
*
C endsr
*=====================================================================
* List cookies
*=====================================================================
C LstCookies begsr
C eval i1 = 1
C eval i4 = %len(CookieReceived)
C DOW i1 < i4
C eval i2 = %scan('=':CookieReceived:i1)
C IF i2 > 2
C eval cookienam = %subst(CookieReceived:
C i1:i2-i1)
C eval i3 = %scan(';':CookieReceived:i2+1)
C if i3 > 0
C eval cookieval = %subst(CookieReceived:
C i2+1:i3-i2-1)
C eval i1 = i3 +1
C else
C eval cookieval = %subst(CookieReceived:
C i2+1:i4-i2)
C eval i1 = i4 +1
C endif
C ENDIF
C eval seq = seq +1
C callp updhtmlvar('seq':
C %trim(%editc(seq:'J')))
C callp updhtmlvar('cookienam':cookienam)
C exsr CvtEsc
C callp updhtmlvar('cookieval':cookieval)
C callp wrtsection('tabrow')
C ENDDO
C endsr
*=====================================================================
* Convert escape sequences to characters
*
* Modifies escape sequences of a cookie value ("cookieval")
* %XX ASCII hexadecimal notations are converted to
* the corresponding EBCDIC characters
*=====================================================================
C CvtEsc begsr
C eval String = cookieval
C eval Stringln = %len(cookieval)
* Move input string to varying length work field, work (for performance reasons)
C eval work = %subst(String:1:Stringln) + ' '
*
* Handle 3-character ASCII escape sequences, %XX, where XX is the hexadecimal ASCII code.
* point. If the escape sequence occurs in variable name, convert it to one EBCDIC character,
* else, convert it to the equivalent 3-character EBCDIC escape sequence, %XX, where XX is
* the hexadecimal EBCDIC code point.
*
C eval i = %scan('%':work)
C dow i > 0
C eval char = hex2char(%subst(work:i+1:2))
C eval char = xlatwCCSIDs(*on:char + '') cvt to EBCDIC char
C eval work = %replace(char:work:i:3)
C eval i = %scan('%':work:i+1)
C enddo
* Move work to "cookieval"
C eval Stringln = %len(%trimr(work))
C eval cookieval =
C %subst(work:1:Stringln)
C endsr
|