(define-module html-form-fill
(use gauche.regexp)
(export
html-form-fill
html-form-fill-by-hash-table))
(select-module html-form-fill)
(define
html-form-fill-by-hash-table
(lambda
(body form-param)
(letrec
((inner-regexp
(string-append
"(?:"
"[^\\\s]+|"
"[^\\\s]+\\\s"
"(?:[^\"\'\>]*?(?:\"[^\"]*?\"|\'[^\']*?\'))*?"
"(?:[^\"\'>]*?)"
")"))
(
html-split
(lambda
(body)
(let
((
html-match
(rxmatch
(string->regexp
(string-append
"^(.*?)(\<\!\-\-.*?\-\-\>|\<" inner-regexp "\>)(.*?)$"))
body)))
(if
(not html-match)
(list body)
(cons
(rxmatch-substring html-match 1)
(cons
(rxmatch-substring html-match 2)
(html-split (rxmatch-substring html-match 3))))))))
(
form-fill
(lambda
(html-list form-param current-type current-name)
(let
(
(ctype current-type)
(cname current-name))
(if
(null? html-list)
""
(string-append
(if
(and
(form? (car html-list))
(hash-table-exists?
form-param
(if
(> (string-length cname) 0)
cname
(form-name-get (car html-list)))))
(begin
(let
(
(form-type
(form-type-get (car html-list))))
(cond
((or
(string=? form-type "text")
(string=? form-type "password")
(string=? form-type "hidden"))
(value-set
(value-clear (car html-list))
(form-name-get (car html-list))
form-param))
((string=? form-type "radio")
(checked-set
(checked-clear (car html-list))
(form-name-get (car html-list))
form-param))
((string=? form-type "checkbox")
(checked-set
(checked-clear (car html-list))
(form-name-get (car html-list))
form-param))
((string=? form-type "option")
(selected-set
(selected-clear (car html-list))
cname
form-param))
((string=? form-type "select")
(set! ctype "select")
(set! cname
(form-name-get (car html-list)))
(car html-list))
((string=? form-type "/select")
(set! ctype "")
(set! cname "")
(car html-list))
((string=? form-type "textarea")
(set! ctype "textarea")
(set! cname
(form-name-get (car html-list)))
(car html-list))
((string=? form-type "/textarea")
(let
((textarea-body
(hash-table-get
form-param
cname)))
(set! ctype "")
(set! cname "")
(string-append
textarea-body
(car html-list))))
(#t (car html-list)))))
(if
(string=? ctype "textarea")
""
(string-append (car html-list) "")))
(form-fill
(cdr html-list)
form-param
ctype
cname))))))
(
form?
(lambda
(html-str)
(if
(or
(rxmatch
(string->regexp
(string-append
"(?i:\)"))
html-str)
(rxmatch
(string->regexp
"(?i:\)")
html-str)
(rxmatch
(string->regexp
"(?i:\<)(?i:select|\/select)(?i:.*?\>)")
html-str)
(rxmatch
(string->regexp
"(?i:\<)(?i:textarea|\/textarea)(?i:.*?\>)")
html-str))
#t
#f)))
(
form-name-get
(lambda
(html-str)
(let
((
form-match
(or
(rxmatch
(string->regexp
(string-append
"(?i:\<"
inner-regexp
"name\=\")([^\"]*?)(?:\".*?\>)"))
html-str)
(rxmatch
(string->regexp
(string-append "(?i:\<"
inner-regexp
"name\=\')([^\']*?)(?:\'.*?\>)"))
html-str)
(rxmatch
(string->regexp
(string-append "(?i:\<"
inner-regexp
"name\=)([^ ]*?)(?:\s*?.*?\>)"))
html-str))))
(if
form-match
(rxmatch-substring form-match 1)
""))))
(
checked-clear
(lambda
(html-str)
(regexp-replace-all
(string->regexp "(?i:[ ]checked)")
html-str
"")))
(
selected-clear
(lambda
(html-str)
(regexp-replace-all
(string->regexp "(?i:[ ]selected)")
html-str
"")))
(
value-clear
(lambda
(html-str)
(regexp-replace-all
(string->regexp "(?i:value=(\"[^\"]*?\"|\'[^\']*?\'|[^ ]*?))")
html-str
"")))
(
form-type-get
(lambda
(html-str)
(cond
((rxmatch
(string->regexp
"(?i:[ ]type=(\"|\'|)text(\"|\'|\s*?).*?)")
html-str) "text")
((rxmatch
(string->regexp
"(?i:[ ]type=(\"|\'|)password(\"|\'|\s*?).*?)")
html-str) "password")
((rxmatch
(string->regexp
"(?i:[ ]type=(\"|\'|)radio(\"|\'|\s*?).*?)")
html-str) "radio")
((rxmatch
(string->regexp
"(?i:[ ]type=(\"|\'|)checkbox(\"|\'|\s*?).*?)")
html-str) "checkbox")
((rxmatch
(string->regexp
"(?i:\