Annotation of gforth/webform.fs, revision 1.1

1.1     ! anton       1: \ Webform and CGI handling
        !             2: \
        !             3: \ Copyright (C) 2011 Free Software Foundation, Inc.
        !             4: 
        !             5: \ This file is part of Gforth.
        !             6: 
        !             7: \ Gforth is free software; you can redistribute it and/or
        !             8: \ modify it under the terms of the GNU General Public License
        !             9: \ as published by the Free Software Foundation, either version 3
        !            10: \ of the License, or (at your option) any later version.
        !            11: 
        !            12: \ This program is distributed in the hope that it will be useful,
        !            13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            15: \ GNU General Public License for more details.
        !            16: 
        !            17: \ You should have received a copy of the GNU General Public License
        !            18: \ along with this program. If not, see http://www.gnu.org/licenses/.
        !            19: 
        !            20: wordlist constant form-fields
        !            21: 
        !            22: : cut-string ( c-addr1 u1 c -- c-addr2 u2 c-addr3 u3 )
        !            23:     \ cut c-addr1 u1 using separator c; c-addr3 u3 is the part before
        !            24:     \ the first separator, c-addr2 u2 the rest.
        !            25:     >r 2dup r> scan over >r dup if
        !            26:         1 /string \ skip c
        !            27:     endif
        !            28:     2swap drop r> over - ;
        !            29: 
        !            30: : hex>u ( c-addr u -- u2 f )
        !            31:     \ convert hex string c-addr u into u2; f is true if the conversion
        !            32:     \ worked, otherwise it is false and u2 is anything
        !            33:     0. 2swap ['] >number $10 base-execute nip nip 0= ;
        !            34: 
        !            35: 
        !            36: \ basic CGI handling
        !            37: 
        !            38: : type-cgi ( c-addr u -- )
        !            39:     begin
        !            40:         dup while
        !            41:             over c@ case
        !            42:                 '% of
        !            43:                     dup 3 >= if
        !            44:                         over 1+ 2 hex>u if
        !            45:                             emit 3
        !            46:                         else
        !            47:                             drop 1
        !            48:                         then
        !            49:                     else
        !            50:                         1
        !            51:                     then
        !            52:                 endof
        !            53:                 '+ of
        !            54:                     space 1 endof
        !            55:                 dup emit 1 swap
        !            56:             endcase
        !            57:             /string
        !            58:     repeat
        !            59:     2drop ;
        !            60: 
        !            61: \ s" q=bla%26foo%25%23&test=field2%3Dxy&review=line1%0D%0Aline2%0D%0A" type-cgi
        !            62: 
        !            63: : cgi-field ( c-addr u -- )
        !            64:     \ process a cgi field
        !            65:     get-current >r form-fields set-current
        !            66:     '= cut-string 2>r ['] type-cgi >string-execute 2r> nextname 2constant
        !            67:     r> set-current ;
        !            68: 
        !            69: : cgi-input ( c-addr u -- )
        !            70:     \ process gci input: split into fields, and make the fields words
        !            71:     begin
        !            72:         '& cut-string dup while
        !            73:             cgi-field
        !            74:     repeat
        !            75:     2drop 2drop ;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>