;; 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) ;;(require 'xml) (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) (options-and-arguments-lst '()) #;(option-lst-lit '(DIR: "LTR" BORDER: 1 width: 315 id: "table_observateurs")) ) ;; 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 "" "
" " " #;"" ;;"" "Codes utilisés pour les Observateurs : classement par ordre alphabétique des codes" "
" "