From: Damien MATTEI <Damien.Mattei@unice.fr>
To: Kawa mailing list <kawa@sourceware.org>
Subject: Re: xml literals
Date: Tue, 06 Jun 2017 09:26:00 -0000 [thread overview]
Message-ID: <201706061126.16579.Damien.Mattei@unice.fr> (raw)
In-Reply-To: <3fbfb5fb-fbcb-b772-45c5-e330112a8498@bothner.com>
[-- Attachment #1: Type: text/plain, Size: 13517 bytes --]
Le Monday 15 May 2017 20:51:11 Per Bothner, vous avez écrit :
> I checked in a fix, in both the master and kawa-2.4 branches.
>
> The bug only happened when the value of (html:td result) is not used.
> You might say: But it is used in:
> (set! html-literal-table-data-code
> (html:td result))
>
> No, because html-literal-table-data-code is not used, so the assignment
> is ignored (except for possible side-effects).
hello Per,
it seems the bug is still active under some circumstances,
i have made a few modif. in the code and even if the literal is used i have the same error:
mattei@moita Jkawa]$ java -cp /home/mattei/kawa-2.4/lib/kawa.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl --output-format html -C DBtoWebObserversKawa.scm
(compiling DBtoWebObserversKawa.scm to eu.oca.kawafunct.DBtoWebObserversKawa)
Exception in thread "main" java.lang.Error: gnu.kawa.xml.MakeElement does not implement Externalizable
at gnu.expr.LitTable.error(LitTable.java:122)
at gnu.expr.LitTable.writeObject(LitTable.java:282)
at gnu.expr.LitTable.emit(LitTable.java:85)
at gnu.expr.Compilation.generateBytecode(Compilation.java:2210)
at gnu.expr.Compilation.process(Compilation.java:1943)
at gnu.expr.ModuleInfo.loadByStages(ModuleInfo.java:306)
at gnu.expr.ModuleInfo.loadByStages(ModuleInfo.java:288)
at kawa.repl.compileFiles(repl.java:780)
at kawa.repl.processArgs(repl.java:441)
at kawa.repl.main(repl.java:820)
i have make some development in the code, and i cannot tell exactly what is the new instructions causing the same error again,
i compiled it with the latest stable kawa-2.4 binary, i suppose your fixs are in the binary too.
i have provided the source code in attachment, it should compile till it reach the error the same way on your host than on mine (i have commeted out some include scheme files from my library
but there is no concern about that to compile)
youn can compile it with your 2.4 kawa version like this:
java -cp kawa-2.4.jar kawa.repl --output-format html -C DBtoWebObserversKawa.scm
i suppose the news instructions causing the trouble are in those part of my code:
in a let i assign option-lst to '(DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs")
and use it here:
;; HTML table with options
;; Kawa offers simple slicing: @ not in Scheme R7RS
(set! html-literal-table
(html:table @option-lst @literal-rows-list))
;; HTML
(set! html-literal
(html:td align: "center" html-literal-table))
(set! html-literal-str (html-literal:toString))
(display-msg-var-nl "DBtoWebObserversKawa : work : html-literal-str = " html-literal-str)
(display-msg-var-nl "DBtoWebObserversKawa : work : res = " res)
(append-string-to-result html-literal-str)
but i also add some change in the literals in the WHILE loop before,
is uppose if i revert all the changes it will compile again at some point...
i had made some test in REPL before coding and all was good exept one time the REPL exit to shell after an error,
i have made a lot of test here is a sample that lead to error in shell (i admit my literal input was strange...):
[mattei@moita bin]$ ./kawa --output-format html
#|kawa:1|# (html:td "foo")
<td>foo</td>
#|kawa:2|# (define td1 (html:td "foo"))
#|kawa:3|# (define td-lst (list td1 td1 td1))
#|kawa:4|# td-lst
<list><td>foo</td> <td>foo</td> <td>foo</td></list>
#|kawa:5|# (car td-lst)
<td>foo</td>
#|kawa:6|# (eval `(html:table ,td-lst))
java.lang.NullPointerException
at gnu.xml.XMLPrinter.getHtmlTag(XMLPrinter.java:525)
at gnu.xml.XMLPrinter.startElement(XMLPrinter.java:498)
at gnu.lists.TreeList.consumeIRange(TreeList.java:1252)
at gnu.lists.TreeList.consumeNext(TreeList.java:1080)
at gnu.xml.XMLPrinter.writeObject(XMLPrinter.java:723)
at gnu.kawa.xml.NodeConstructor.popNodeContext(NodeConstructor.java:67)
at atEvalLevel-1.run(<eval>)
at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:292)
at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
at kawa.lang.Eval.evalBody(Eval.java:100)
at kawa.lang.Eval.evalForm$X(Eval.java:27)
at kawa.lib.scheme.eval.eval$X(eval.scm:9)
at kawa.lib.scheme.eval.eval$X(eval.scm)
at atInteractiveLevel-6.run(stdin:6)
at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:292)
at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
at kawa.Shell.run(Shell.java:283)
at kawa.Shell.run(Shell.java:196)
at kawa.Shell.run(Shell.java:183)
at kawa.repl.processArgs(repl.java:714)
at kawa.repl.main(repl.java:820)
<{null name}
#|kawa:7|# `(html:table td-lst)
#|kawa:8|# `(html:table ,td-lst)
#|kawa:9|# (apply html:table td-lst)
#|kawa:10|# (define bar (apply html:table td-lst))
#|kawa:11|# bar
#|kawa:12|# (display bar)
<table xmlns="http://www.w3.org/1999/xhtml"><td>foo</td><td>foo</td><td>foo</td></table>
#|kawa:13|# (define bar2 `(html:table ,td-lst))
#|kawa:14|# bar2
#|kawa:15|# (display bar2)
(html:table
(<td xmlns="http://www.w3.org/1999/xhtml">foo</td>
<td xmlns="http://www.w3.org/1999/xhtml">foo</td>
<td xmlns="http://www.w3.org/1999/xhtml">foo</td>))
#|kawa:16|# td-lst
#|kawa:17|# (display td-lst)
(<td xmlns="http://www.w3.org/1999/xhtml">foo</td>
<td xmlns="http://www.w3.org/1999/xhtml">foo</td>
<td xmlns="http://www.w3.org/1999/xhtml">foo</td>)
#|kawa:18|# DIR:
/dev/stdin:18:1: warning - keyword should be quoted if not in argument position
java.lang.RuntimeException: attribute 'DIR' follows non-attribute content
at gnu.xml.XMLFilter.error(XMLFilter.java:1474)
at gnu.xml.XMLFilter.startAttribute(XMLFilter.java:963)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:700)
at atInteractiveLevel-18.run(stdin:18)
at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:292)
at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
at kawa.Shell.run(Shell.java:283)
at kawa.Shell.run(Shell.java:196)
at kawa.Shell.run(Shell.java:183)
at kawa.repl.processArgs(repl.java:714)
at kawa.repl.main(repl.java:820)
#|kawa:19|# (define option-lst '(DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs"))
#|kawa:20|# option-lst
java.lang.RuntimeException: attribute 'DIR' follows non-attribute content
at gnu.xml.XMLFilter.error(XMLFilter.java:1474)
at gnu.xml.XMLFilter.startAttribute(XMLFilter.java:963)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:700)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:695)
at gnu.mapping.Values.writeValues(Values.java:226)
at atInteractiveLevel-20.run(stdin:20)
at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:292)
at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
at kawa.Shell.run(Shell.java:283)
at kawa.Shell.run(Shell.java:196)
at kawa.Shell.run(Shell.java:183)
at kawa.repl.processArgs(repl.java:714)
at kawa.repl.main(repl.java:820)
#|kawa:21|# td-lst
#|kawa:22|# (display td-lst
#|.....23|# )
(<td xmlns="http://www.w3.org/1999/xhtml">foo</td>
<td xmlns="http://www.w3.org/1999/xhtml">foo</td>
<td xmlns="http://www.w3.org/1999/xhtml">foo</td>)
#|kawa:24|# (append option-lst td-lst)
java.lang.RuntimeException: attribute 'DIR' follows non-attribute content
at gnu.xml.XMLFilter.error(XMLFilter.java:1474)
at gnu.xml.XMLFilter.startAttribute(XMLFilter.java:963)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:700)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:695)
at gnu.mapping.Values.writeValues(Values.java:226)
at atInteractiveLevel-24.run(stdin:24)
at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:292)
at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
at kawa.Shell.run(Shell.java:283)
at kawa.Shell.run(Shell.java:196)
at kawa.Shell.run(Shell.java:183)
at kawa.repl.processArgs(repl.java:714)
at kawa.repl.main(repl.java:820)
#|kawa:25|# (define option-lst '('DIR: "LTR" 'BORDER: 1 'width: 315 'id: "table_observateurs"))
#|kawa:26|# option-lst
java.lang.RuntimeException: attribute 'DIR' follows non-attribute content
at gnu.xml.XMLFilter.error(XMLFilter.java:1474)
at gnu.xml.XMLFilter.startAttribute(XMLFilter.java:963)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:700)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:695)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:695)
at gnu.mapping.Values.writeValues(Values.java:226)
at atInteractiveLevel-26.run(stdin:26)
at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:292)
at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
at kawa.Shell.run(Shell.java:283)
at kawa.Shell.run(Shell.java:196)
at kawa.Shell.run(Shell.java:183)
at kawa.repl.processArgs(repl.java:714)
at kawa.repl.main(repl.java:820)
#|kawa:27|# (list DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs")
java.lang.RuntimeException: attribute 'DIR' follows non-attribute content
at gnu.xml.XMLFilter.error(XMLFilter.java:1474)
at gnu.xml.XMLFilter.startAttribute(XMLFilter.java:963)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:700)
at gnu.xml.XMLFilter.writeObject(XMLFilter.java:695)
at gnu.mapping.Values.writeValues(Values.java:226)
at gnu.mapping.CallContext.writeValue(CallContext.java:333)
at gnu.mapping.Procedure.apply(Procedure.java:153)
at gnu.mapping.Procedure.apply(Procedure.java:118)
at gnu.mapping.CallContext.runUntilDone(CallContext.java:227)
at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:349)
at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
at kawa.Shell.run(Shell.java:283)
at kawa.Shell.run(Shell.java:196)
at kawa.Shell.run(Shell.java:183)
at kawa.repl.processArgs(repl.java:714)
at kawa.repl.main(repl.java:820)
#|kawa:28|# (define tbl-rows (apply html:tr td-lst))
#|kawa:29|# tbl-rows
#|kawa:30|# (display tbl-rows)
<tr xmlns="http://www.w3.org/1999/xhtml"><td>foo</td><td>foo</td><td>foo</td></tr>
#|kawa:31|# html:table
#|kawa:32|# list
#|kawa:33|# car
#|kawa:34|#
#|kawa:35|# (define option-lst '(DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs"))
#|kawa:36|# `(html-table ,@option-lst ,@tbl-rows)
Exception in thread "main" java.lang.Error: expected list in quasi-quote splicing
at kawa.lang.Quote.append$V(Quote.java:418)
at atInteractiveLevel-36.run(stdin:36)
at gnu.expr.ModuleExp.evalModule2(ModuleExp.java:292)
at gnu.expr.ModuleExp.evalModule(ModuleExp.java:211)
at kawa.Shell.run(Shell.java:283)
at kawa.Shell.run(Shell.java:196)
at kawa.Shell.run(Shell.java:183)
at kawa.repl.processArgs(repl.java:714)
at kawa.repl.main(repl.java:820)
shell exit here
another run that does not exit with error to shell:
[mattei@moita bin]$ ./kawa --output-format html
#|kawa:1|# (define option-lst '(DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs"))
#|kawa:2|# (define td1 (html:td "foo"))
#|kawa:3|# (define td-lst (list td1 td1 td1))
#|kawa:4|# td-lst
<list><td>foo</td> <td>foo</td> <td>foo</td></list>
#|kawa:5|# (car td-lst)
<td>foo</td>
#|kawa:6|# (display td-lst)
(<td xmlns="http://www.w3.org/1999/xhtml">foo</td>
<td xmlns="http://www.w3.org/1999/xhtml">foo</td>
<td xmlns="http://www.w3.org/1999/xhtml">foo</td>)
#|kawa:7|# (define tbl-rows (apply html:tr td-lst))
#|kawa:8|# (display tbl-rows)
<tr xmlns="http://www.w3.org/1999/xhtml"><td>foo</td><td>foo</td><td>foo</td></tr>
#|kawa:9|# (html:tr @td-lst)
<tr><td>foo</td><td>foo</td><td>foo</td></tr>
#|kawa:10|# (map html:tr td-lst)
<list><tr><td>foo</td></tr> <tr><td>foo</td></tr> <tr><td>foo</td></tr></list>
#|kawa:11|# (define tbl-row-lst (map html:tr td-lst))
#|kawa:12|# tbl-row-lst
<list><tr><td>foo</td></tr> <tr><td>foo</td></tr> <tr><td>foo</td></tr></list>
#|kawa:13|# (html:table DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs" @tbl-row-lst)
<table DIR="LTR" BORDER="1" width="315" id="table_observateurs"><tr><td>foo</td></tr><tr><td>foo</td></tr><tr><td>foo</td></tr></table>
#|kawa:14|# (html:table @option-lst @tbl-row-lst)
<table DIR="LTR" BORDER="1" width="315" id="table_observateurs"><tr><td>foo</td></tr><tr><td>foo</td></tr><tr><td>foo</td></tr></table>
#|kawa:15|# (display option-lst)
(DIR: LTR BORDER: 1 width: 315 id: table_observateurs)
#|kawa:16|# `(html-table ,@option-lst ,@tbl-row-lst)
<list>html-table DIR=" LTR " BORDER=" 1 " width=" 315 " id=" table_observateurs <tr<tdfoo></td></tr> <tr<tdfoo></td></tr> <tr<tdfoo></td></tr></list>
#|kawa:17|# (exit)
Vous avez du nouveau courrier dans /var/spool/mail/mattei
[mattei@moita bin]$ pwd
/home/mattei/kawa-2.4/bin
those examples are with kawa-2.4, the last one run well, but when i do similar thing in code i have the error
i also test if first with kawa-2.1 as i expected it to do not make error if the literal was used
regards,
damien
included file: DBtoWebObserversKawa.scm
[-- Attachment #2: DBtoWebObserversKawa.scm --]
[-- Type: text/plain, Size: 13258 bytes --]
;; Kawa Scheme code for java virtual machine and tomcat web server
;; author: Damien Mattei
;; compilation method:
;; java -cp /usr/local/share/java/kawa-2.1.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl -C DBtoWebObserversKawa.scm
;;
;; to add more tail-calls optimisations:
;; java -cp /usr/local/share/java/kawa-2.1.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl --full-tailcalls -C DBtoWebObserversKawa.scm
;; jar cf ~/Dropbox/KawaFunctProg.jar eu
;; java -cp /usr/local/share/java/kawa-2.1.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl --output-format html -C DBtoWebObserversKawa.scm
;;
;; java -cp /home/mattei/kawa-2.4/lib/kawa.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl --output-format html -C DBtoWebObserversKawa.scm
(module-name "eu.oca.kawafunct.DBtoWebObserversKawa")
(require 'regex)
;; (include-relative "../git/LOGIKI/lib/first-and-rest.scm")
;; (include-relative "../git/LOGIKI/lib/syntactic-sugar.scm") ;; YES in kawa you can include files from other schemes...
;; (include-relative "../git/LOGIKI/lib/display.scm")
;; (include-relative "../git/LOGIKI/lib/case.scm") ;; for CASE with STRINGS
;; (include-relative "../git/LOGIKI/lib/list.scm") ;; for remove-last used by map.scm
;; (include-relative "../git/LOGIKI/lib/set.scm") ;; for map-nil*
;; (include-relative "../git/LOGIKI/lib/map.scm") ;; for map-nil*
(define-simple-class DBtoWebObserversKawa ()
(Nom ::java.lang.String init-keyword: Nom:)
(res ::java.lang.String init-keyword: res:)
((*init*
(nomParam ::java.lang.String)
)
(set! Nom nomParam)
#;(work))
;; Need a default constructor as well.
((*init*) #!void)
((work) ::java.lang.String ;; do the job:
(eu.oca.DataBase:searchDriverStatic)
(display "DBtoWebObserversKawa : work : eu.oca.DataBase:searchDriverStatic PASSED")
(newline)
(eu.oca.DataBase:connectStatic)
(display "DBtoWebObserversKawa : work : eu.oca.DataBase:connectStatic PASSED")
(newline)
(eu.oca.DataBase:createStatementStatic) ;; i put the statement here if it's true it can be reused for multiple SQL queries
(display "DBtoWebObserversKawa : work : eu.oca.DataBase:createStatementStatic PASSED")
(newline)
(let* ((marequete "SELECT * FROM Obs ORDER BY Auteur")
(rs ::java.sql.ResultSet #!null)
(total '())
(result '())
;; first we fetch the data "outremer" and parse the file to get the observers code
(wds-url "http://ad.usno.navy.mil/wds/Webtextfiles/wdsnewref.txt")
;; (define wds-url "http://ad.usno.navy.mil/wds/Webtextfiles/wdsnewref.txt")
(wds-data-str &<{&[wds-url]}) ;; could take a few seconds to GET file
;; (define wds-data-str &<{&[wds-url]})
;;(str1 (substring wds-data-str 0 30))
(len-wds-data-str (string-length wds-data-str))
;; get and split using positions of the minus ----- lines
(pos-minus
(regex-match-positions
"-----------------------------------------------------------------------------------------------------------------------------"
wds-data-str))
(pos-minus-end (cdr (car pos-minus)))
(wds-data-str-minus-1 (substring
wds-data-str
pos-minus-end
(- (string-length wds-data-str) 1)))
(pos-minus2
(regex-match-positions
"-----------------------------------------------------------------------------------------------------------------------------"
wds-data-str-minus-1))
(pos-minus2-end (cdr (car pos-minus2)))
(wds-data-str-minus-2 (substring
wds-data-str-minus-1
pos-minus2-end
(- (string-length wds-data-str-minus-1) 1)))
;; get and split using positions of the equals ====== line
(pos-equals
(regex-match-positions
"========================================================================================================"
wds-data-str-minus-2))
(pos-equals-begin (car (car pos-equals)))
(wds-data-str-equals (substring
wds-data-str-minus-2
0
(- pos-equals-begin 1)))
;;(wds-data-str-split (regex-split (string #\return) wds-data-str))
(wds-data-str-split (regex-split (string #\linefeed) wds-data-str-equals))
;; (define wds-data-str-split (regex-split (string #\linefeed) wds-data-str))
;; remove null string
(rgx (begin
(display-nl "DBtoWebObserversKawa : work : creating regex.")
(regex "^[a-zA-Z]")))
(tst-space-string
(lambda (s)
(if (regex-match rgx s)
s
'())))
(wds-data-str-no-spaces
(begin
(display-nl "DBtoWebObserversKawa : work : running map-nil-iter-optim-tail-calls-call....")
( map-nil-iter-optim-tail-calls-call tst-space-string wds-data-str-split )))
;; variables used for creating HTML page using html/xml literals
(html-literal-table-rows '()) ;; rows list of the table of observers
(html-literal-table-data-observer '()) ;; table data : observer
(html-literal-table-data-code '()) ;; table data : code
(literal-rows-list '()) ;; list of the litterals rows
(html-literal-table '()) ;; table of observers
(html-literal '()) ;; the whole set of HTML literals
(html-literal-str "") ;; the string of the whole set of HTML literals
(option-lst '(DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs")) ;; various options for various html tags (here TABLE)
) ;; end of LET
;; debug display
(display-nl "DBtoWebObserversKawa : work : after let* declarations.")
;;(display-msg-var-nl "DBtoWebObserversKawa : work : str1 = " str1)
(display-msg-var-nl "DBtoWebObserversKawa : work : length wds-data-str = " len-wds-data-str)
(display-msg-var-nl "DBtoWebObserversKawa : work : (car wds-data-str-split) = " (car wds-data-str-split))
(display-msg-var-nl "DBtoWebObserversKawa : work : (substring wds-data-str-minus-1 0 50) = " (substring wds-data-str-minus-1 0 50))
(display-msg-var-nl "DBtoWebObserversKawa : work : (substring wds-data-str-minus-2 0 50) = " (substring wds-data-str-minus-2 0 50))
(display-msg-var-nl "DBtoWebObserversKawa : work : (substring wds-data-str-equals 0 50) = " (substring wds-data-str-equals 0 50))
(display-msg-var-nl "DBtoWebObserversKawa : work : (cadr wds-data-str-split) = " (cadr wds-data-str-split))
(display-msg-var-nl "DBtoWebObserversKawa : work : (car wds-data-str-no-spaces) = " (car wds-data-str-no-spaces))
;;(display-msg-var-nl "DBtoWebObserversKawa : work : option-lst = " option-lst)
;; partie HTML
(set! res
(gnu.lists.FString:toString
(string-append
"<HTML DIR=LTR>"
" <HEAD>"
" <META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html;\">"
#;"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">"
;;"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">"
" <TITLE>Observateurs - Codes</TITLE>"
" </HEAD>"
" <body bgcolor=\"#FFFFC0\">"
" <p align=center><b><font color=\"#000080\"><i>Codes utilisés pour les Observateurs : classement par ordre alphabétique des codes</i></font></b>"
" <p> "
" <TABLE align=center border=\"0\" width=\"80%\">"
" <TR>"
" <TD valign=left><a href=\"SidonieDescriptionF.html#codes\"><img src=\"retour_blanc.gif\" width=\"26\" height=\"26\" border=0></a>"
" <font size=\"2\"><em>Tout savoir...</em></font>"
" </TD>"
" </TR>"
" <TR>"
" <TD valign=left><a href=\"ObservateursCodes.html\"><img src=\"retour_blanc.gif\" width=\"26\" height=\"26\" border=0></a>"
" <font size=\"2\"><em>Classement par noms</em></font>"
" </TD>"
" </TR>")))
;;" <TD align=center>")))
(display-msg-var-nl "DBtoWebObserversKawa : work : res = " res)
;; converting from SQL server to MySQL (MariaDB)
(set! marequete (sql-server->mysql-server-syntax marequete))
(display-msg-var-nl "DBtoWebObserversKawa : work : Voila la valeur SQL de la requète : marequete = " marequete)
(eu.oca.DataBase:executeQueryStatic
marequete
"Observateurs")
(set! rs eu.oca.DataBase:resultSetObservateurs)
(rs:first)
(set! total 0)
(rs:beforeFirst)
(when (rs:next) ;; test SQL empty result set
;; DO WHILE LOOP
(while (not (rs:isAfterLast))
(set! total (+ total 1))
;;(append-string-to-result "<tr>")
;; 0 : code
(set! result (rs:getString 1))
(if (or (rs:wasNull) (string-null? result))
(display-nl "DBtoWebObserversKawa : work : result (code) : string or result set is null")
(begin
;;(append-string-to-result "<td>")
(set! html-literal-table-data-code
(html:td DIR: "LTR" ALIGN: "LEFT" result))
(display-msg-var-nl "DBtoWebObserversKawa : work : result (code) = " result)
;;(append-string-to-result (string-upcase result))
#;(append-string-to-result "</td>")))
;; 1 : auteur (Observer)
(set! result (rs:getString 2))
(if (rs:wasNull)
(set! result "NuLL"))
;;(append-string-to-result "<td>")
(set! html-literal-table-data-observer
(html:td DIR: "LTR" ALIGN: "LEFT" result))
(display-msg-var-nl "DBtoWebObserversKawa : work : result (Observer) = " result)
;;(append-string-to-result result)
;;(append-string-to-result "</td>")
(set! html-literal-table-rows
(html:tr
html-literal-table-data-code
html-literal-table-data-observer))
(display-msg-var-nl "DBtoWebObserversKawa : work : html-literal-table-rows = " html-literal-table-rows)
(set! literal-rows-list
(cons html-literal-table-rows literal-rows-list))
(rs:next)
) ;; end WHILE (Do While ... Loop)
) ;; end when (test empty SQL result set)
(display-msg-var-nl "DBtoWebObserversKawa : work : total = " total)
(display-msg-var-nl "DBtoWebObserversKawa : work :literal-rows-list = " literal-rows-list)
(set! literal-rows-list
(reverse literal-rows-list)) ;; revert the list so it's well ordered to display
(display-msg-var-nl "DBtoWebObserversKawa : work :(reverse literal-rows-list) = " literal-rows-list)
;; HTML table with options
;; Kawa offers simple slicing: @ not in Scheme R7RS
(set! html-literal-table
(html:table @option-lst @literal-rows-list))
;; HTML
(set! html-literal
(html:td align: "center" html-literal-table))
(set! html-literal-str (html-literal:toString))
(display-msg-var-nl "DBtoWebObserversKawa : work : html-literal-str = " html-literal-str)
(display-msg-var-nl "DBtoWebObserversKawa : work : res = " res)
(append-string-to-result html-literal-str)
;; we are in jersey/ path of the URL
(append-string-to-result
(string-append
" <TD valign=bottom><a href=\"SidonieDescriptionF.html#codes\"><img src=\"retour_blanc.gif\" width=\"26\" height=\"26\" border=0></a>"
" <font size=\"2\"><em>Tout savoir...</em></font></TD>"
;; unclosed table (verifier version anglaise)
;;" </TR>"
" </TABLE>"
" </BODY>"
"</HTML>"))
(display-msg-var-nl "DBtoWebObserversKawa : work : res = " res)
) ;; end let*
(eu.oca.DataBase:closeStatic)
(display "DBtoWebObserversKawa : work : eu.oca.DataBase:closeStatic PASSED")
(newline)
;; (eu.oca.DataBase:deregisterDriverStatic)
;; (display "ResultatGeneralFKawa : work : eu.oca.DataBase:deregisterDriverStatic PASSED")
;; (newline)
(display-msg-var-nl "DBtoWebObserversKawa : work : res = " res)
res) ;; return a String
;; other Class definition functions
((sql-server->mysql-server-syntax query) ;; replace [ and ] by `
(regex-replace* (regex "\\]") (regex-replace* (regex "\\[") query "`") "`"))
((append-string-to-result str) ;; append a string to result
(set! res
(gnu.lists.FString:toString
(string-append res str))))
((string-null? str)
(string=? str ""))
((fix x)
(display-nl "DBtoWebObserversKawa.scm :: entering fix")
(let ((r (inexact->exact (truncate x))))
(display "ResultatGeneralFKawa.scm :: fix :: r =")
(display r)
(newline)
r))
) ;; end of class
next prev parent reply other threads:[~2017-06-06 9:26 UTC|newest]
Thread overview: 23+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-05-15 14:11 Damien MATTEI
2017-05-15 16:06 ` Per Bothner
2017-05-15 16:50 ` Damien MATTEI
2017-05-15 16:57 ` Damien MATTEI
2017-05-15 18:51 ` Per Bothner
2017-05-22 9:26 ` Damien MATTEI
2017-05-22 10:14 ` Sudarshan S Chawathe
2017-05-22 13:44 ` Damien MATTEI
2017-05-22 13:55 ` Damien MATTEI
2017-05-22 15:44 ` Per Bothner
[not found] ` <CADEOadc_87ON2=Tsjd+Ca4d90GoeKABpR3vsrHiP=5SMTKPNZQ@mail.gmail.com>
2017-05-23 13:11 ` Fwd: " Damien Mattei
2017-05-23 19:36 ` Per Bothner
2017-06-06 9:26 ` Damien MATTEI [this message]
2017-06-07 14:17 ` Damien MATTEI
2017-06-07 14:36 ` Damien MATTEI
2017-06-07 16:24 ` Per Bothner
2017-06-07 18:16 ` Per Bothner
2017-06-09 15:13 ` Damien MATTEI
2017-06-09 18:17 ` Per Bothner
2017-06-10 17:22 ` Per Bothner
2017-06-13 9:15 ` Damien MATTEI
2017-06-13 9:37 ` Damien MATTEI
2017-06-13 17:21 ` Per Bothner
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=201706061126.16579.Damien.Mattei@unice.fr \
--to=damien.mattei@unice.fr \
--cc=kawa@sourceware.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).