|
|
|
Damien Mattei
This document describe the development,compilation and integration of Schemes modules developped in Bigloo and Kawa in a JVM (Java Virtual Machine) framework hosted on a Java application server (Tomcat) using the Netbeans IDE (Interface Development Environment) for a web application accessing a relational database.
This web page is a partial technical documentation of the Sidonie web site. (i wanted to make it shorter and i added a lot more things documented,but the subject and the work is so complex and big i can not explain all the things here, for the one who want to code in functional programming for web there is a lot of others things to learn by it self or he can email me for more informations)
This page is intended for :
software developers that want to learn how functional programming could be use to develops web sites
people that want to know how it works from behind the page
This program use the Scheme functional programming language , a LisP dialect to generate web page.
Main composants of the project are :
a Tomcat web server (Apache project)
a Java language (Sun Microsystem)
a Scheme language and compiler named Bigloo and developed at INRIA Sophia-Antipolis
another Scheme language named Kawa
a Database that use SQL language (anciently MySQL now named MariaDB). (Note: previous versions of system used Ms Access, data are now handle by MariaDB with backward compatibility with the old system)
the Netbeans IDE (Interface Development Environment)
the Linux operating system to host all those technologies
libraries for database, scheme, etc …
… all the little bricks I forgot for now.... and the glue that tight them together...
Description of problem: web servers were not designed at the beginning to host functional programming developped applications. In the past, scripts, or imperative languages has been used such as Perl and now PHP,
it exists few atempts to use functional languages such as LisP or Scheme on a web server. It exists an Apache Scheme module but it is long time deprecated.
Even if Scheme or LisP language can be used on an Apache web servers I will focus here on the use of those languages with a Tomcat web server.
Tomcat web server host Java Virtual Machine precompiled applications and this is this features that will be exploited to host Scheme application in Tomcat.
Because it exists Scheme compilers that generates Java Virtual Machine byte code the scheme application can run in the Tomcat web engine as a normal Java application would do it.
But this is purely theoretical... there is a lot of technical knowledge to find and learn for doing this: running a scheme source code compiled in java byte code and running with tomcat....
create purely java web applications (web services) : this means to know how to use an IDE (Interface Develpment Environment) such as Netbeans or Eclipse to create the java web service, here I will talk about Netbeans but I will let this to the Java tutorial on the internet as this purely a Java problem...
find some Scheme compilers, I have used Bigloo and Kawa ,those compilers targets to JVM byte code as ouput.
Create JVM modules containing the Bigloo and Kawa code to import them in the existing Java code.
But this is not enough , Schemes have their own runtime libraries to execute and we have to package and integrate those libraries in the Java development project and on the Tomcat web server.
Learn how to convert java types to scheme types, this is paradoxal as Scheme is not a typed language ! ( a Scheme variable can contains a string and later an integer, this is the same in Microsoft ASP language, I mention it here because the original version of Sidonie was written in ASP scripts!!! but by another people)
Note that it exists also some independant systems that do not needs the tomcat web server (because they integrate themself their own application server): DrRacket from MIT or Kawa itself could act as a web server for Scheme, also HOP from INRIA can do it, here i will focus only to Scheme with Java Application Server (such as Tomcat or GlassFish).
I will present in this document technical tips for
Kawa and Bigloo, to go directly to the Bigloo section click here.
Kawa technical tips:
The Kawa project is documented here.
Kawa is a scheme implementation that targets Java Virtual Machine byte code, it has greta facilities and compatibility with a pure Java code.
In Kawa Scheme I use modules. I will explain here how to defines modules, compiles them and import the generated library in the Java Netbeans project:
The first example is a simple web page counter. For this we create a scheme file named Counter.scm and want to create a module in eu/oca/kawafunct (because your domain name is oca.eu) where you put your java class generated with kawa from the source scheme file.
First you have to create directory tree (perheaps kawa will create it for you but I can not remember if it is true).
In the source kawa scheme file you have to enter a module clause like this:
(module-name "eu.oca.kawafunct.Counter")
Here is the program doing a simple counter for web page itself:
;; java -jar /usr/local/share/java/kawa-2.1.jar -C Counter.scm ;; jar cf KawaFunctProg.jar eu (module-name "eu.oca.kawafunct.Counter") (require 'regex) (define-simple-class Counter () ;; (x ::double init-keyword: x:) (dataDir ::java.lang.String init-keyword: dataDir:) (htmlCounterPage ::java.lang.String init-keyword: htmlCounterPage:) (counterPathFileName ::gnu.lists.FString init-keyword: counterPathFileName:) ;;(counterPathFileName ::java.lang.String init-keyword: counterPathFileName:) ;; ;; Alternative type-specification syntax. ;; (y type: double init-keyword: y:) ;; (zero-2d :: KawaCode allocation: 'static ;; init-value: (KawaCode 0)) ;; ;; An object initializer (constructor) method. ;; ((*init* (x0 ::double) (y0 ::double)) ;; (set! x x0) ;; (set! y y0)) ((*init* (pc ::java.lang.String)) ;; pc : path to counter (set! dataDir pc)) ((*init* (pc ::java.lang.String) (htmlPage ::java.lang.String)) ;; pc : path to counter, htmlPage : page to display (set! dataDir pc) (set! htmlCounterPage htmlPage) (work)) ;; ((*init* (xy0 ::double)) ;; ;; Call above 2-argument constructor. ;; (invoke-special Counter (this) '*init* xy0 xy0)) ;; Need a default constructor as well. ((*init*) #!void) ;; ((add (other ::Counter)) ::Counter ;; ;; Kawa compiles this using primitive Java types! ;; (Counter ;; x: (+ x other:x) ;; y: (+ y other:y))) ;; ((scale (factor ::double)) ::Counter ;; (Counter x: (* factor x) y: (* factor y))) ;; ((norm) ::double ;; 7.0 ) ;; ((plus L) ::int ;; (+ (car L) (cadr L))) ;; ((carre L) ::gnu.lists.LList ;; (map (lambda (x) (* x x )) L)) ((getDataDir) ::java.lang.String dataDir) ((pwd) ::java.lang.String (gnu.kawa.io.FilePath:toString (current-path))) ((computeTemplateDir) ::java.lang.String (gnu.kawa.io.FilePath:toString (current-path))) ((getCounterPathFileName) ::java.lang.String (gnu.lists.FString:toString counterPathFileName)) ;;" be bop a lulaa") ((setCounterPathFileName (cpf ::gnu.lists.FString)) ;; setter method (set! counterPathFileName cpf)) ((existTemplate?) ::int ;;(file-exist? 0) ((existCounterFileTxt?) ::java.lang.String (if (file-exists? (getCounterPathFileName)) "YES" "NO")) ((existHtmlPageTxt?) ::java.lang.String (if (file-exists? htmlCounterPage) "YES" "NO")) ((work) ::int ;; do the job: count,display web page (setCounterPathFileName (computeCounterPathFileName dataDir)) ;; compute and set the counter filename ;;(define response (path-data htmlCounterPage)) 0) ((getHtmlCounterPage) ::java.lang.String (display "in (getHtmlCounterPage)") (newline) (display htmlCounterPage) (newline) (define dir "/Users/mattei") (define HCP &<{&[htmlCounterPage]}) ;;(define toStrHCP (->string HCP)) ;; (display "------------------------------------") ;; (newline) ;; (write toStrHCP) ;; (newline) ;; (display "------------------------------------") ;; (newline) ;; (display toStrHCP) ;; (newline) ;; (display "------------------------------------") (newline) (display "string replacement:") (newline) (define cpt (update-counter)) (define response (insert-counter-in-html-page HCP cpt));;toStrHCP 7)) (display response) (display "------------------------------------") (newline) ;;(gnu.lists.FString:toString (read-string 65535 (open-input-file htmlCounterPage))) ;;(gnu.lists.Blob:toString (path-data htmlCounterPage))) response) ((update-counter) (display "in update-counter") (newline) (let ((cv 1) (fn (getCounterPathFileName))) (if (file-exists? fn) (begin (set! cv (read-counter-value fn)) (delete-file fn) (write-counter-value fn (+ 1 cv))) (begin (display "------------------------------------") (newline) (display "Warning : no counter file !!!") (newline))) cv)) ((computeCounterPathFileName dataDir) (string-append dataDir "/counter.txt")) ((insert-counter-in-html-page str n) (regex-replace "ShowDigits" str n)) ((read-counter-value fn) (define cf &<{&[fn]}) ;; (define toStringCF (gnu.lists.Blob:toString (->string cf))) ;; (display "------------------------------------") ;; (newline) ;; (display "counter value string:") ;; (display toStringCF) ;; (display "|") ;; (newline) ;; ;;(define toIntegerCF (->int cf)) ;; (if (string? toStringCF) ;; (display "toStringCF is a string !") ;; (display "toStringCF is NOT a string !")) ;; (newline) (define toFStringCF cf);(gnu.lists.FString toStringCF)) (display "------------------------------------") (newline) (display "last char string:") (define lastCS (string-ref toFStringCF (- (string-length toFStringCF) 1))) (display (char->integer lastCS)) (display "|") (newline) ;; (string-set! toFStringCF (- (string-length toFStringCF) 1) #\space) ;; replace the trailing CR by a space ;; (display "counter value Fstring:") ;; (display toFStringCF) ;; (display "|") ;; (newline) (define strCount (regex-split (string lastCS) toFStringCF)) (display "counter value strCount:") (display strCount) (display "|") (newline) (define rv (string->number (car strCount))) (display "------------------------------------") (newline) (display "counter value:") (newline) (display rv) (newline) rv) ((write-counter-value fn val) (define op (open-output-file fn)) (write val op) (newline op) (close-output-port op)) ;; ((blabla) ::java.lang.String ;;gnu.lists.FString ;; (begin ;; (fct 2) ;; "be bop a lula")) ((pwd) ::java.lang.String (gnu.kawa.io.FilePath:toString (current-path))) ) ;; (define counterFileName "counter.txt") ;; (define (computeCounterPathFileName dataDir) ;; (string-append dataDir "/counter.txt")) ;; (define (fct x) ;; (+ x 3)) ;; (define (insert-counter-in-html-page str n) ;; (regex-replace "ShowDigits" str n)) ;; (define (read-counter-value fn) ;; (define cf &<{&[fn]}) ;; ;; (define toStringCF (gnu.lists.Blob:toString (->string cf))) ;; ;; (display "------------------------------------") ;; ;; (newline) ;; ;; (display "counter value string:") ;; ;; (display toStringCF) ;; ;; (display "|") ;; ;; (newline) ;; ;; ;;(define toIntegerCF (->int cf)) ;; ;; (if (string? toStringCF) ;; ;; (display "toStringCF is a string !") ;; ;; (display "toStringCF is NOT a string !")) ;; ;; (newline) ;; (define toFStringCF cf);(gnu.lists.FString toStringCF)) ;; (display "------------------------------------") ;; (newline) ;; (display "last char string:") ;; (define lastCS (string-ref toFStringCF (- (string-length toFStringCF) 1))) ;; (display (char->integer lastCS)) ;; (display "|") ;; (newline) ;; ;; (string-set! toFStringCF (- (string-length toFStringCF) 1) #\space) ;; replace the trailing CR by a space ;; ;; (display "counter value Fstring:") ;; ;; (display toFStringCF) ;; ;; (display "|") ;; ;; (newline) ;; (define strCount (regex-split (string lastCS) toFStringCF)) ;; (display "counter value strCount:") ;; (display strCount) ;; (display "|") ;; (newline) ;; (define rv (string->number (car strCount))) ;; (display "------------------------------------") ;; (newline) ;; (display "counter value:") ;; (newline) ;; (display rv) ;; (newline) ;; rv) ;; (define (write-counter-value fn val) ;; (define op (open-output-file fn)) ;; (write val op) ;; (newline op) ;; (close-output-port op))
You compile the program the usual way:
java -jar /usr/local/share/java/kawa-2.1.jar -C Counter.scm
and you get the class files generated not in the current directory but in eu/oca/kawafunct:
[mattei@moita Jkawa]$ zd eu/oca/kawafunct/
total 32
drwxrwxr-x. 2 mattei mattei 52 23 févr. 20:56 .
drwxrwxr-x. 3 mattei mattei 22 23 févr. 20:56 ..
-rw-rw-r--. 1 mattei mattei 8476 16 déc. 11:41 Counter.class
-rw-rw-r--. 1 mattei mattei 2053 16 déc. 11:41 Counter$frame.class
You now can make the class files available in a java library issuying the command:
jar cf KawaFunctProg.jar eu
This library file can now be used in an external java application , by inserting in the java file this:
package eu.oca;
import eu.oca.kawafunct.Counter;
The Scheme Counter class will be instansiated and called from a
Java program, here is the source code:
/* * To change this license header, choose License Headers in Project Properties. * To change this template file, choose Tools | Templates * and open the template in the editor. */ package eu.oca; import javax.ws.rs.core.Context; import javax.ws.rs.core.UriInfo; import javax.ws.rs.Consumes; import javax.ws.rs.Produces; import javax.ws.rs.GET; import javax.ws.rs.Path; import javax.ws.rs.PUT; import javax.ws.rs.core.MediaType; import javax.servlet.ServletContext; import javax.servlet.http.HttpServletRequest; import kawa.standard.Scheme; import eu.oca.kawafunct.Counter; /** * REST Web Service * * @author mattei */ @Path("SidonieWelcomeR") public class SidonieWelcomeR { @Context private UriInfo context; @Context private HttpServletRequest servletRequest; /** * Creates a new instance of ServiceenglishResource */ public SidonieWelcomeR() { } /** * Retrieves representation of an instance of eu.oca.SidonieWelcomeR * @return an instance of java.lang.String */ @GET @Produces(MediaType.TEXT_HTML) public String getHtml() { // return proper representation object ServletContext servletContext = servletRequest.getSession().getServletContext(); String servletRealPath = servletContext.getRealPath("/scripts/SidonieWelcomeR.htm"); Scheme.registerEnvironment(); // if you do not do that you will be sooner or later in serious troubles... Counter cnt = new Counter("/data_sidonie",servletRealPath); String response = cnt.getHtmlCounterPage(); return response; } /** * PUT method for updating or creating an instance of SidonieWelcomeR * @param content representation for the resource */ @PUT @Consumes(MediaType.TEXT_HTML) public void putHtml(String content) { } }
If you use an IDE (Interface Development Environment) you have to import the library in the project, in Netbeans , in your project,right click on the library icon and select 'add jar file' to import the library created with Kawa, then your project should looks like this (notice in the right panel,under "projects" in the "libraries" the KawaFunctProg jar file and the module eu.oca.kawafunct whis is now in the Netbeans project with the Counter class appearing and being now ready to be use in a pure Java source file program) :
Here is another example from the Sidonie 2 code showing the interfacing of Java code with Kawa Scheme code ,i present first the Java code calling the Kawa Scheme code (later i will show how to call back Java code from Kawa Scheme code) , ResultatGeneralF is the Java class, and ResultatGeneralFKawa is the Scheme class instansiated and called by the Java program:
/* * To change this license header, choose License Headers in Project Properties. * To change this template file, choose Tools | Templates * and open the template in the editor. */ package eu.oca; import javax.ws.rs.core.Context; import javax.ws.rs.core.UriInfo; import javax.ws.rs.Produces; import javax.ws.rs.Consumes; import javax.ws.rs.GET; import javax.ws.rs.Path; import javax.ws.rs.PUT; import javax.ws.rs.POST; // added import javax.ws.rs.core.MediaType; import javax.ws.rs.FormParam; // added import kawa.standard.Scheme; import eu.oca.kawafunct.ResultatGeneralFKawa; /** * REST Web Service * * @author mattei */ @Path("ResultatGeneralF") public class ResultatGeneralF { @Context private UriInfo context; /** * Creates a new instance of ResultatGeneralF */ public ResultatGeneralF() { } /** * Retrieves representation of an instance of eu.oca.ResultatGeneralF * @return an instance of java.lang.String */ @GET @Produces(MediaType.TEXT_HTML) public String getHtml() { // return proper representation object String response = "<h1> you have used GET method ! <br> instead you should use POST method with valid parameters !</h1> "; return response; } /** * PUT method for updating or creating an instance of ResultatGeneralF * @param content representation for the resource */ @PUT @Consumes(MediaType.TEXT_HTML) public void putHtml(String content) { } @POST @Consumes("application/x-www-form-urlencoded") //@Produces("text/plain") @Produces(MediaType.TEXT_HTML) public String postHandler(@FormParam("CocherNom") String cochernom, @FormParam("Nom") String nom, @FormParam("CocherHIP") String cocherhip, @FormParam("CocherOrb") String cocherorb, @FormParam("CocherAlpha") String cocheralpha, @FormParam("AlphaMin") String alphamin, @FormParam("AlphaMax") String alphamax, @FormParam("CocherDelta") String cocherdelta, @FormParam("DeltaMin") String deltamin, @FormParam("DeltaMax") String deltamax, @FormParam("CocherMag1") String cochermag1, @FormParam("Mag1Min") String mag1min, @FormParam("Mag1Max") String mag1max, @FormParam("CocherMag2") String cochermag2, @FormParam("Mag2Min") String mag2min, @FormParam("Mag2Max") String mag2max, @FormParam("CocherDiffMag") String cocherdiffmag, @FormParam("Mag2Mag1") String mag2mag1, @FormParam("CocherAnnee") String cocherannee, @FormParam("annee") String annee, @FormParam("CocherSepar") String cochersepar, @FormParam("SeparMin") String separmin, @FormParam("CocherType") String cochertype, @FormParam("type1") String type1, @FormParam("type2") String type2, @FormParam("CocherNbMes") String cochernbmes, @FormParam("NbMes") String nbmes ) { // for debugging N°XXXX System.out.println("Sidonie : ResultatGeneralF : postHandler : cochernom :" + cochernom); Scheme.registerEnvironment(); // if you do not do that you will be sooner or later in serious troubles... ResultatGeneralFKawa rgf = new ResultatGeneralFKawa(cochernom, nom, cocherhip, cocherorb, cocheralpha, alphamin, alphamax, cocherdelta, deltamin, deltamax, cochermag1, mag1min, mag1max, cochermag2, mag2min, mag2max, cocherdiffmag, mag2mag1, cocherannee, annee, cochersepar, separmin, cochertype, type1, type2, cochernbmes, nbmes); String res = rgf.work(); // res = res + "<h1> CocherNom = " + cochernom // + " , Nom = " + nom // + " , CocherHIP = " + cocherhip // + " , CocherOrb = " + cocherorb // + " , CocherAlpha = " + cocheralpha // + " , AlphaMin = " + alphamin // + " , AlphaMax = " + alphamax // + " , CocherDelta = " + cocherdelta // + " , DeltaMin = " + deltamin // + " , DeltaMax = " + deltamax // + " , CocherMag1 = " + cochermag1 // + " , Mag1Min = " + mag1min // + " , Mag1Max = " + mag1max // + " , CocherMag2 = " + cochermag2 // + " , Mag2Min = " + mag2min // + " , Mag2Max = " + mag2max // + " , CocherDiffMag = " + cocherdiffmag // + " , Mag2Mag1 = " + mag2mag1 // + " , CocherAnnee = " + cocherannee // + " , annee = " + annee // + " , CocherSepar = " + cochersepar // + " , SeparMin = " + separmin // + " , CocherType = " + cochertype // + " , type1 = " + type1 // + " , type2 = " + type2 // + " , CocherNbMes = " + cochernbmes // + " , NbMes = " + nbmes // + "</h1>"; return res; } }
Below is the Kawa Scheme code of a class implementing the web service named ResultatGeneralF (in Java code ResultatGeneralFKawa in Scheme code)
getting the parameters transmitted from the HTML request by the Java code to the Scheme code. All the core of processing is then make by the Scheme code, and the resulting web page is also generated by the Scheme code and returned to the Java code.
;; compilation method: ;; java -cp /usr/local/share/java/kawa-2.1.jar:/home/mattei/NetBeansProjects/Sidonie/build/web/WEB-INF/classes kawa.repl -C ResultatGeneralFKawa.scm ;; jar cf ~/Dropbox/KawaFunctProg.jar eu ;; old and other method,depending jdk version: ;; (java -jar ~/Dropbox/kawa-2.1-jdk8.jar -C ResultatGeneralFKawa.scm) ;; (java -jar /usr/local/share/java/kawa-2.1.jar -C ResultatGeneralFKawa.scm) ;; (other method to compile: kawa -C ResultatGeneralFKawa.scm ) ;; (jar cf KawaFunctProg.jar eu) (module-name "eu.oca.kawafunct.ResultatGeneralFKawa") (require 'regex) (include-relative "../info/syntactic-sugar.scm") ;; YES in kawa you can include files from other schemes... (define-simple-class ResultatGeneralFKawa () (CocherNom ::java.lang.String init-keyword: CocherNom:) (Nom ::java.lang.String init-keyword: Nom:) (CocherHIP ::java.lang.String init-keyword: CocherHIP:) (CocherOrb ::java.lang.String init-keyword: CocherOrb:) (CocherAlpha ::java.lang.String init-keyword: CocherAlpha:) (AlphaMin ::java.lang.String init-keyword: AlphaMin:) (AlphaMax ::java.lang.String init-keyword: AlphaMax:) (CocherDelta ::java.lang.String init-keyword: CocherDelta:) (DeltaMin ::java.lang.String init-keyword: DeltaMin:) (DeltaMax ::java.lang.String init-keyword: DeltaMax:) (CocherMag1 ::java.lang.String init-keyword: CocherMag1:) (Mag1Min ::java.lang.String init-keyword: Mag1Min:) (Mag1Max ::java.lang.String init-keyword: Mag1Max:) (CocherMag2 ::java.lang.String init-keyword: CocherMag2:) (Mag2Min ::java.lang.String init-keyword: Mag2Min:) (Mag2Max ::java.lang.String init-keyword: Mag2Max:) (CocherDiffMag ::java.lang.String init-keyword: CocherDiffMag:) (Mag2Mag1 ::java.lang.String init-keyword: Mag2Mag1:) (CocherAnnee ::java.lang.String init-keyword: CocherAnnee:) (annee ::java.lang.String init-keyword: annee:) (CocherSepar ::java.lang.String init-keyword: CocherSepar:) (SeparMin ::java.lang.String init-keyword: SeparMin:) (CocherType ::java.lang.String init-keyword: CocherType:) (type1 ::java.lang.String init-keyword: type1:) (type2 ::java.lang.String init-keyword: type2:) (CocherNbMes ::java.lang.String init-keyword: CocherNbMes:) (NbMes ::java.lang.String init-keyword: NbMes:) ;;(rs ::java.sql.ResultSet init-keyword: rs:) (res ::java.lang.String init-keyword: res:) ;; ;; Alternative type-specification syntax. ;; (y type: double init-keyword: y:) ;; (zero-2d :: ResultatGeneralFKawa allocation: 'static ;; init-value: (ResultatGeneralFKawa 0)) ;; ;; An object initializer (constructor) method. ;; ((*init* (x0 ::double) (y0 ::double)) ;; (set! x x0) ;; (set! y y0)) ((*init* (nomParam ::java.lang.String)) ;; juste pour garder la surcharge (set! Nom nomParam)) ((*init* (cochernomParam ::java.lang.String) (nomParam ::java.lang.String) (cocherhipParam ::java.lang.String) (cocherorbParam ::java.lang.String) (cocheralphaParam ::java.lang.String) (alphaminParam ::java.lang.String) (alphamaxParam ::java.lang.String) (cocherdeltaParam ::java.lang.String) (deltaminParam ::java.lang.String) (deltamaxParam ::java.lang.String) (cochermag1Param ::java.lang.String) (mag1minParam ::java.lang.String) (mag1maxParam ::java.lang.String) (cochermag2Param ::java.lang.String) (mag2minParam ::java.lang.String) (mag2maxParam ::java.lang.String) (cocherdiffmagParam ::java.lang.String) (mag2mag1Param ::java.lang.String) (cocheranneeParam ::java.lang.String) (anneeParam ::java.lang.String) (cocherseparParam ::java.lang.String) (separminParam ::java.lang.String) (cochertypeParam ::java.lang.String) (type1Param ::java.lang.String) (type2Param ::java.lang.String) (cochernbmesParam ::java.lang.String) (nbmesParam ::java.lang.String) ) (set! CocherNom cochernomParam) (set! Nom nomParam) (set! CocherHIP cocherhipParam) (set! CocherOrb cocherorbParam) (set! CocherAlpha cocheralphaParam) (set! AlphaMin alphaminParam) (set! AlphaMax alphamaxParam) (set! CocherDelta cocherdeltaParam) (set! DeltaMin deltaminParam) (set! DeltaMax deltamaxParam) (set! CocherMag1 cochermag1Param) (set! Mag1Min mag1minParam) (set! Mag1Max mag1maxParam) (set! CocherMag2 cochermag2Param) (set! Mag2Min mag2minParam) (set! Mag2Max mag2maxParam) (set! CocherDiffMag cocherdiffmagParam) (set! Mag2Mag1 mag2mag1Param) (set! CocherAnnee cocheranneeParam) (set! annee anneeParam) (set! CocherSepar cocherseparParam) (set! SeparMin separminParam) (set! CocherType cochertypeParam) (set! type1 type1Param) (set! type2 type2Param) (set! CocherNbMes cochernbmesParam) (set! NbMes nbmesParam) #;(work)) ;; ((*init* (xy0 ::double)) ;; ;; Call above 2-argument constructor. ;; (invoke-special ResultatGeneralFKawa (this) '*init* xy0 xy0)) ;; Need a default constructor as well. ((*init*) #!void) ;; ((add (other ::ResultatGeneralFKawa)) ::ResultatGeneralFKawa ;; ;; Kawa compiles this using primitive Java types! ;; (ResultatGeneralFKawa ;; x: (+ x other:x) ;; y: (+ y other:y))) ;; ((scale (factor ::double)) ::ResultatGeneralFKawa ;; (ResultatGeneralFKawa x: (* factor x) y: (* factor y))) ((work) ::java.lang.String ;; do the job: (eu.oca.DataBase:searchDriverStatic) (display "ResultatGeneralFKawa : work : eu.oca.DataBase:searchDriverStatic PASSED") (newline) ;;(eu.oca.DataBase:helloStatic) (eu.oca.DataBase:connectStatic) (display "ResultatGeneralFKawa : 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 "ResultatGeneralFKawa : work : eu.oca.DataBase:createStatementStatic PASSED") (newline) ;; (set! rs eu.oca.DataBase:resultSet) ;; (display "ResultatGeneralFKawa : work : eu.oca.DataBase:resultSet PASSED") ;; (newline) (let* ((marequete (sql-server->mysql-server-syntax (string-append "SELECT DISTINCT Coordonnées.Nom, Coordonnées.[Alpha 2000], Coordonnées.[Delta 2000]" ", Coordonnées.[N° BD], Coordonnées.[N° ADS], Coordonnées.[N° HIP], Coordonnées.mag1, Coordonnées.mag2" ", Coordonnées.Spectre" " FROM Coordonnées INNER JOIN Mesures ON Coordonnées.[N° Fiche] = Mesures.[N° Fiche] ") )) (monordre (sql-server->mysql-server-syntax " ORDER by Coordonnées.[Alpha 2000]")) (cocher 0) (flagerreur 0) (erreurgeneral 0) (baraterreur "Veuillez re-initialiser la page et recommencer la requète : ") (Et " AND ") (dont "WHERE ") (Group (sql-server->mysql-server-syntax (string-append "GROUP BY Coordonnées.Nom, Coordonnées.[Alpha 2000], Coordonnées.[Delta 2000]" ", Coordonnées.[N° BD], Coordonnées.[N° ADS], Coordonnées.[N° HIP], Coordonnées.mag1, Coordonnées.mag2" ", Coordonnées.Spectre, Coordonnées.Orb, Coordonnées.[N°Type] HAVING "))) (baratin "Liste des objets") (Clause dont) (caseannee CocherAnnee) (casenbmes CocherNbMes) (casesepar CocherSepar) (casenom CocherNom) (caseHIP CocherHIP) (caseorb CocherOrb) (casealfa CocherAlpha) (casedelta CocherDelta) (casemag1 CocherMag1) (casemag2 CocherMag2) (casediffmag CocherDiffMag) (casetype CocherType) (separmin '()) (objet '()) (data "") (alfamin '()) (alfamax '()) (deltamin '()) (deltamax '()) (sign '()) (resultd '()) (resultmi '()) (deminresult '()) (demaxresult '()) (iminresult '()) (imaxresult '()) (resultm '()) ;; minutes (resulth '()) ;; hours (results '()) ;; seconds (mag1min '()) (mag1max '()) (mag2min '()) (mag2max '()) (diffmag '()) (nutype1 '()) (nutype2 '()) (rs ::java.sql.ResultSet #!null) (total '()) (result '()) (iresult '()) (aresult '()) ) (set! res (gnu.lists.FString:toString (string-append "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\">" "<html>" "<head>" #;"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=iso-8859-1\">" "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">" "<meta name=\"GENERATOR\" content=\"Java Kawa Scheme\">" "<title>SIDONIe-Résultats statistiques</title>" "</head>" "<LINK rel=\"stylesheet\" href=\"../Style.css\" type=\"text/css\">" "<body <!--bgcolor=\"#FFFFA6\" text=\"#004040\" link=\"#0000FF\" vlink=\"#808000\" alink=\"#800000\"-->"))) (display-msg-var-nl "ResultatGeneralFKawa : work : marequete = " marequete) (display-msg-var-nl "ResultatGeneralFKawa : work : caseannee = " caseannee) (if-t (and (string? caseannee) (string=? caseannee "ON")) (display-nl "ResultatGeneralFKawa : work : dans if-t ... caseannee") (set! erreurgeneral 1) (set! data annee) (display-msg-var-nl "ResultatGeneralFKawa : work : annee = " annee) (display-msg-var-nl "ResultatGeneralFKawa : work : data = " data) (if (string=? data "") (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous avez oublié de rentrer l'année !"))) ;; else (if (or (<= (string->number data) 1750) (>= (string->number data) 2050)) (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous avez rentré une année impossible !"))) ;; else (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " non observés depuis " data)) ;;(set! marequete (string-append marequete Group "Max(Cdbl(Mesures.Date)) <= " "Cdbl(" data ")"))) (set! marequete (string-append marequete Group "Max(Mesures.Date) <= " data ))) ;; else (set! res (gnu.lists.FString:toString (string-append res "Veuillez re-initialiser la page et recommencer la requète, il y a une erreur de choix !!"))))))) ;; enf if-t (display-msg-var-nl "ResultatGeneralFKawa : work : casenbmes = " casenbmes) (if-t (and (string? casenbmes) (string=? casenbmes "ON")) (set! erreurgeneral 1) (set! data NbMes) (if (string=? data "") (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous avez oublié de donner un nombre de mesures max !"))) ;; else (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " dont le nombre de mesures est <= à " data)) ;;(set! marequete (string-append marequete Group "Count(Mesures.Date) <= " "Cdbl(" data ")"))) (set! marequete (string-append marequete Group "Count(Mesures.Date) <= " data ))) ;; else (begin (set! baratin (string-append baratin ", dont le nombre de mesures est <= à " data)) ;;(set! marequete (string-append marequete Et "Count(Mesures.Date) <= " "Cdbl(" data ")")))))) ;; enf if-t (set! marequete (string-append marequete Et "Count(Mesures.Date) <= " data)))))) ;; enf if-t (display-msg-var-nl "ResultatGeneralFKawa : work : casesepar = " casesepar) (if-t (and (string? casesepar) (string=? casesepar "ON")) (set! erreurgeneral 1) (set! separmin SeparMin) (if (string=? separmin "") (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous n'avez pas donné de séparation minimum ! "))) ;; else (if (= cocher 0) (begin (set! cocher 1) ;; (set! baratin (string-append baratin " (Requète séparation non encore opérationnelle !) ")) (set! baratin (string-append baratin " avec une séparation <= à " separmin " sec d'arc")) (set! marequete (string-append marequete Group)) ;;(set! marequete (string-append marequete "Min(Cdbl(Mesures.Sépar)) <= " "Cdbl(" separmin ")" (set! marequete (string-append marequete "Min(Mesures.Sépar) <= " separmin))) ;; else (begin ;;(set! baratin (string-append baratin " (Requète séparation non encore opérationnelle !) ")) (set! baratin (string-append baratin ", avec une séparation <= à " separmin " sec d'arc")))))) (display-msg-var-nl "ResultatGeneralFKawa : work : casenom = " casenom) (if-t (and (string? casenom) (string=? casenom "ON")) (set! erreurgeneral 1) (set! objet Nom) (if (string=? objet "") (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous n'avez pas donné de nom ! "))) ;; else (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " dont le nom commence par " objet)) (set! marequete (string-append marequete dont "Coordonnées.Nom like '" objet " _%" "'"))) ;; else (begin (set! baratin (string-append baratin ", dont le nom commence par " objet)) (set! marequete (string-append marequete Et "Coordonnées.Nom like '" objet " _%" "'")))))) (display-msg-var-nl "ResultatGeneralFKawa : work : caseHIP = " caseHIP) (if-t (and (string? caseHIP) (string=? caseHIP "ON")) (set! erreurgeneral 1) (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " avec un numéro HIP")) (set! marequete (string-append marequete dont "Coordonnées.[N° HIP] not like '*'"))) ;; else (begin (set! baratin (string-append baratin ", avec un numéro HIP")) (set! marequete (string-append marequete Et "Coordonnées.[N° HIP] not like '*'"))))) (display-msg-var-nl "ResultatGeneralFKawa : work : caseorb = " caseorb) (if-t (and (string? caseorb) (string=? caseorb "ON")) (set! erreurgeneral 1) (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " avec une orbite calculée")) (set! marequete (string-append marequete dont "Coordonnées.Orb like 'OUI'"))) ;; else (begin (set! baratin (string-append baratin ", avec une orbite calculée")) (set! marequete (string-append marequete Et "Coordonnées.Orb like 'OUI'"))))) (display-msg-var-nl "ResultatGeneralFKawa : work : casealfa = " casealfa) (if-t (and (string? casealfa) (string=? casealfa "ON")) (set! erreurgeneral 1) (set! alfamin AlphaMin) (set! alfamax AlphaMax) (if (or (string=? alfamin "") (string=? alfamax "")) (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous n'avez pas donné de Alpha minimum ou de Alpha maximum ! "))) ;; else (begin (set! iminresult (string->number alfamin)) (set! resulth (floor (/ iminresult 1000))) (set! resultm (- iminresult (* resulth 1000))) (set! resultm (floor (/ resultm 10))) (set! results (- iminresult (* resulth 1000) (* resultm 10))) (if-t (< resulth 1) (set! resulth "00")) (if-t (and (>= resulth 1) (< resulth 10)) (set! resulth (string-append "0" (number->string resulth)))) (if-t (< resultm 10) (set! resultm (string-append "0" (number->string resultm)))) (set! iminresult (string-append resulth " h " resultm "." results " mn")) (set! imaxresult (string->number alfamax)) (set! resulth (floor (/ imaxresult 1000))) (set! resultm (- imaxresult (* resulth 1000))) (set! resultm (floor (/ resultm 10))) (set! results (- imaxresult (* resulth 1000) (* resultm 10))) (if-t (< resulth 1) (set! resulth "00")) (if-t (and (>= resulth 1) (< resulth 10)) (set! resulth (string-append "0" (number->string resulth)))) (if-t (< resultm 10) (set! resultm (string-append "0" (number->string resultm)))) (set! imaxresult (string-append resulth " h " resultm "." results " mn")) (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " avec Alpha compris entre " iminresult)) (set! baratin (string-append baratin " et " imaxresult)) (set! marequete (string-append marequete dont)) (set! marequete (string-append marequete "Coordonnées.[Alpha 2000] >= " alfamin " AND Coordonnées.[Alpha 2000] <= " alfamax))) ;; else (begin (set! baratin (string-append baratin ", avec Alpha compris entre " iminresult)) (set! baratin (string-append baratin " et " imaxresult)) (set! marequete (string-append marequete Et "Coordonnées.[Alpha 2000] >= " alfamin " AND Coordonnées.[Alpha 2000] <= " alfamax))))))) ;; casedelta (display-msg-var-nl "ResultatGeneralFKawa : work : casedelta = " casedelta) (if-t (and (string? casedelta) (string=? casedelta "ON")) (set! erreurgeneral 1) (set! deltamin DeltaMin) (set! deltamax DeltaMax) (if (or (string=? deltamin "") (string=? deltamax "")) (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous n'avez pas donné de Delta minimum ou de Delta maximum ! "))) ;; else (begin (if (< (string->number deltamin) 0) (set! sign "-") (set! sign " ")) (set! deminresult (abs (string->number deltamin))) (set! resultd (floor (/ deminresult 100))) (set! resultmi (- deminresult (* resultd 100))) (if-t (< resultd 1) (set! resultd "00")) (if-t (and (>= resultd 1) (< resultd 10)) (set! resultd (string-append "0" (number->string resultd)))) (if-t (< resultmi 10) (set! resultmi (string-append "0" (number->string resultmi)))) (if-t (number? resultd) (set! resultd (number->string resultd))) (if-t (number? resultmi) (set! resultmi (number->string resultmi))) (set! deminresult (string-append sign resultd " ° " resultmi " '")) (if (< (string->number deltamax) 0) (set! sign "-") (set! sign " ")) (set! demaxresult (abs (string->number deltamax))) (set! resultd (floor (/ demaxresult 100))) (set! resultmi (- demaxresult (* resultd 100))) (if-t (< resultd 1) (set! resultd "00")) (if-t (and (>= resultd 1) (< resultd 10)) (set! resultd (string-append "0" (number->string resultd)))) (if-t (< resultmi 10) (set! resultmi (string-append "0" (number->string resultmi)))) (if-t (number? resultd) (set! resultd (number->string resultd))) (if-t (number? resultmi) (set! resultmi (number->string resultmi))) (set! demaxresult (string-append sign resultd " ° " resultmi " '")) (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " avec Delta compris entre " deminresult)) (set! baratin (string-append baratin " et " demaxresult)) (set! marequete (string-append marequete dont)) (set! marequete (string-append marequete "Coordonnées.[Delta 2000] >= " deltamin " AND Coordonnées.[Delta 2000] <= " deltamax))) ;; else (begin (set! baratin (string-append baratin ", avec Delta compris entre " deminresult)) (set! baratin (string-append baratin " et " demaxresult)) (set! marequete (string-append marequete Et "Coordonnées.[Delta 2000] >= " deltamin " AND Coordonnées.[Delta 2000] <= " deltamax))))))) (display-msg-var-nl "ResultatGeneralFKawa : work : casemag1 = " casemag1) (if-t (and (string? casemag1) (string=? casemag1 "ON")) (set! erreurgeneral 1) (set! mag1min Mag1Min) (set! mag1max Mag1Max) (if (or (string=? mag1min "") (string=? mag1max "")) (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous n'avez pas donné de magnitude minimum ou de magnitude maximum ! "))) ;; else (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " avec mag1 comprise entre " mag1min " et " mag1max)) (set! marequete (string-append marequete dont)) (set! marequete (string-append marequete "Cdbl(Coordonnées.mag1) >= " "Cdbl(" mag1min ")")) (set! marequete (string-append marequete Et "Cdbl(Coordonnées.mag1) <= " "Cdbl(" mag1max ")"))) ;; else (begin (set! baratin (string-append baratin ", avec mag1 comprise entre " mag1min)) (set! baratin (string-append baratin " et " mag1max)) (set! marequete (string-append marequete Et "Cdbl(Coordonnées.mag1) >= " "Cdbl(" mag1min ")")) (set! marequete (string-append marequete Et "Cdbl(Coordonnées.mag1) <= " "Cdbl(" mag1max ")")))))) (display-msg-var-nl "ResultatGeneralFKawa : work : casemag2 = " casemag2) ;; casemag2 (if-t (and (string? casemag2) (string=? casemag2 "ON")) (set! erreurgeneral 1) (set! mag2min Mag2Min) (set! mag2max Mag2Max) (if (or (string=? mag2min "") (string=? mag2max "")) (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous n'avez pas donné de magnitude minimum ou de magnitude maximum ! "))) ;; else (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " avec mag2 comprise entre " mag2min " et " mag2max)) (set! marequete (string-append marequete dont)) (set! marequete (string-append marequete "Cdbl(Coordonnées.mag2) >= " "Cdbl(" mag2min ")")) (set! marequete (string-append marequete Et "Cdbl(Coordonnées.mag2) <= " "Cdbl(" mag2max ")"))) ;; else (begin (set! baratin (string-append baratin ", avec mag2 comprise entre " mag2min)) (set! baratin (string-append baratin " et " mag2max)) (set! marequete (string-append marequete Et "Cdbl(Coordonnées.mag2) >= " "Cdbl(" mag2min ")")) (set! marequete (string-append marequete Et "Cdbl(Coordonnées.mag2) <= " "Cdbl(" mag2max ")")))))) (display-msg-var-nl "ResultatGeneralFKawa : work : casediffmag = " casediffmag) ;; casediffmag (if-t (and (string? casediffmag) (string=? casediffmag "ON")) (set! erreurgeneral 1) (set! diffmag Mag2Mag1) (if (string=? diffmag "") (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous n'avez pas donné de différence de magnitude ! "))) ;; else (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " avec mag2 - mag1 >= " diffmag)) (set! marequete (string-append marequete dont)) (set! marequete (string-append marequete "(Cdbl(Coordonnées.mag2) - Cdbl(Coordonnées.mag1)) >= " "Cdbl(" diffmag ")"))) ;; else (begin (set! baratin (string-append baratin ", avec mag2 - mag1 >= " diffmag)) (set! marequete (string-append marequete Et "(Cdbl(Coordonnées.mag2) - Cdbl(Coordonnées.mag1)) >= " "Cdbl(" diffmag ")" )))))) (display-msg-var-nl "ResultatGeneralFKawa : work : casetype = " casetype) (if-t (and (string? casetype) (string=? casetype "ON")) (set! erreurgeneral 1) (if (or (string=? type1 "") (string=? type2 "")) (begin (set! flagerreur 1) (set! baraterreur (string-append baraterreur " vous n'avez pas donné de type spectral minimum ou maximum ! "))) ;; else (begin (set! nutype1 (case type1 (("O") 1) (("O0") 2) (("O1") 3) (("O2") 4) (("O3") 5) (("O4") 6) (("O5") 7) (("O6") 8) (("O7") 9) (("O8") 10) (("O9") 11) (("B") 12) (("B0") 13) (("B1") 14) (("B2") 15) (("B3") 16) (("B4") 17) (("B5") 18) (("B6") 19) (("B7") 20) (("B8") 21) (("B9") 22) (("A") 23) (("A0") 24) (("A1") 25) (("A2") 26) (("A3") 27) (("A4") 28) (("A5") 29) (("A6") 30) (("A7") 31) (("A8") 32) (("A9") 33) (("F") 34) (("F0") 35) (("F1") 36) (("F2") 37) (("F3") 38) (("F4") 39) (("F5") 40) (("F6") 41) (("F7") 42) (("F8") 43) (("F9") 44) (("G") 45) (("G0") 46) (("G1") 47) (("G2") 48) (("G3") 49) (("G4") 50) (("G5") 51) (("G6") 52) (("G7") 53) (("G8") 54) (("G9") 55) (("K") 56) (("K0") 57) (("K1") 58) (("K2") 59) (("K3") 60) (("K4") 61) (("K5") 62) (("K6") 63) (("K7") 64) (("K8") 65) (("K9") 66) (("M") 67) (("M0") 68) (("M1") 69) (("M2") 70) (("M3") 71) (("M4") 72) (("M5") 73) (("M6") 74) (("M7") 75) (("M8") 76) (("M9") 77) (else => (begin (display "WARNING : ResultatGeneralFKawa : work : CASE type1 in else") (newline) '())))) (set! nutype2 (case type2 (("O") 1) (("O0") 2) (("O1") 3) (("O2") 4) (("O3") 5) (("O4") 6) (("O5") 7) (("O6") 8) (("O7") 9) (("O8") 10) (("O9") 11) (("B") 12) (("B0") 13) (("B1") 14) (("B2") 15) (("B3") 16) (("B4") 17) (("B5") 18) (("B6") 19) (("B7") 20) (("B8") 21) (("B9") 22) (("A") 23) (("A0") 24) (("A1") 25) (("A2") 26) (("A3") 27) (("A4") 28) (("A5") 29) (("A6") 30) (("A7") 31) (("A8") 32) (("A9") 33) (("F") 34) (("F0") 35) (("F1") 36) (("F2") 37) (("F3") 38) (("F4") 39) (("F5") 40) (("F6") 41) (("F7") 42) (("F8") 43) (("F9") 44) (("G") 45) (("G0") 46) (("G1") 47) (("G2") 48) (("G3") 49) (("G4") 50) (("G5") 51) (("G6") 52) (("G7") 53) (("G8") 54) (("G9") 55) (("K") 56) (("K0") 57) (("K1") 58) (("K2") 59) (("K3") 60) (("K4") 61) (("K5") 62) (("K6") 63) (("K7") 64) (("K8") 65) (("K9") 66) (("M") 67) (("M0") 68) (("M1") 69) (("M2") 70) (("M3") 71) (("M4") 72) (("M5") 73) (("M6") 74) (("M7") 75) (("M8") 76) (("M9") 77) (else => (begin (display "WARNING : ResultatGeneralFKawa : work : CASE type2 in else") (newline) '())))) (if (= cocher 0) (begin (set! cocher 1) (set! baratin (string-append baratin " avec types spectraux compris entre " type1 " et " type2)) (set! marequete (string-append marequete dont)) (set! marequete (string-append marequete "Coordonnées.[N°Type] >= " nutype1 " AND Coordonnées.[N°Type] <= " nutype2))) ;; else (begin (set! baratin (string-append baratin ", avec types spectraux compris entre " type1 " et " type2)) (set! marequete (string-append marequete Et "Coordonnées.[N°Type] >= " nutype1 " AND Coordonnées.[N°Type] <= " nutype2))))))) ;; partie HTML (if (or (= flagerreur 1) (= erreurgeneral 0)) (then (if-t (= erreurgeneral 0) (set! baraterreur (string-append baraterreur " Vous n'avez coché aucune case !! "))) (set! res (gnu.lists.FString:toString (string-append res "<h1 align=\"center\"><font color=\"#0000FF\">SIDONIe - Résultats statistiques</font></h1>" "<div align=\"center\">" "<center>" "<table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\">" " <tr>" " <th width=\"82%\"><font color=\"#0000FF\">" baraterreur "<br>" "</font></th>" " </tr>" "</table>" "</center>" "</div>")))) (else (set! marequete (string-append marequete monordre)) (display-msg-var-nl "ResultatGeneralFKawa : work : Voila la valeur SQL de la requète : marequete = " marequete) (eu.oca.DataBase:executeQueryStatic marequete ;;(gnu.lists.FString:toString marequete) "Stats") (set! rs eu.oca.DataBase:resultSetStats) (rs:first) (set! total 0) (set! res (gnu.lists.FString:toString (string-append res "<h1 align=\"center\"><font color=\"#0000FF\">SIDONIe - Résultats statistiques</font></h1>" "<div align=\"center\">" " <center>" " <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\">" " <tr>" " <th width=\"82%\"><font color=\"#0000FF\">" baratin "<br></font></th>" " </tr>" " </table>" " </center>" "</div>" "<P>" "<P>" "<table border=\"1\" cellpadding=\"0\" cellspacing=\"0\" width=\"100%\">" "<tr>" " <th><font color=\"#000080\">Nom</font></th>" " <th><font color=\"#000080\">Alpha 2000</font></th>" " <th><font color=\"#000080\">Delta 2000</font></th>" " <th><font color=\"#000080\">N° BD</font></th>" " <th><font color=\"#000080\">N° ADS</font></th>" " <th><font color=\"#000080\">N° HIP</font></th>" " <th><font color=\"#000080\">mag 1</font></th>" " <th><font color=\"#000080\">mag 2</font></th>" " <th><font color=\"#000080\">Spectre</font></th>" "</tr>"))) ;; DO WHILE LOOP (while (not (rs:isAfterLast)) (set! total (+ total 1)) (append-string-to-result "<tr>") ;; 0 (set! result (rs:getString 1)) (if (or (rs:wasNull) (string-null? result)) (then (set! result " ") (append-string-to-result "<td>") (append-string-to-result result) (append-string-to-result "</td>")) (else (append-string-to-result "<td>") (append-string-to-result (string-upcase result)) (append-string-to-result "</td>"))) ;; 1 (set! result (rs:getDouble 2)) (if (rs:wasNull) (set! result " ") (begin (set! iresult (floor result)) (set! resulth (floor (/ iresult 1000))) (set! resultm (- iresult (* resulth 1000))) (set! resultm (floor (/ resultm 10))) (set! results (- iresult (* resulth 1000) (* resultm 10))) (if-t (< resulth 1) (set! resulth "00")) (if-t (and (>= resulth 1) (< resulth 10)) (set! resulth (string-append "0" (number->string resulth)))) (if-t (< resultm 10) (set! resultm (string-append "0" (number->string resultm)))) (if-t (number? resulth) (set! resulth (number->string resulth))) (if-t (number? resultm) (set! resultm (number->string resultm))) (set! results (number->string results)) (set! result (string-append resulth " h " resultm "." results " mn")))) (append-string-to-result "<td>") (append-string-to-result result) (append-string-to-result "</td>") ;; 2 : Delta (set! result (rs:getDouble 3)) (if (rs:wasNull) (set! result " ") (begin (if (< result 0) (set! sign "-") (set! sign " ")) (set! aresult (abs result)) (set! resultd (floor (/ aresult 100))) (set! resultmi (- aresult (* resultd 100))) (if-t (< resultd 1) (set! resultd "00")) (if-t (and (>= resultd 1) (< resultd 10)) (set! resultd (string-append "0" (number->string resultd)))) (if-t (< resultmi 10) (set! resultmi (string-append "0" (number->string resultmi)))) (if-t (number? resultd) (set! resultd (number->string resultd))) (if-t (number? resultmi) (set! resultmi (number->string resultmi))) (set! result (string-append sign resultd " ° " resultmi " '")))) (append-string-to-result "<td>") (append-string-to-result result) (append-string-to-result "</td>") ;; 3 (set! result (rs:getString 4)) (if-t (rs:wasNull) (set! result " ")) (append-string-to-result "<td>") (append-string-to-result result) (append-string-to-result "</td>") ;; 4 (set! result (rs:getString 5)) (if-t (rs:wasNull) (set! result " ")) (append-string-to-result "<td>") (append-string-to-result result) (append-string-to-result "</td>") ;; 5 (set! result (rs:getString 6)) (if-t (rs:wasNull) (set! result " ")) (if-t (string=? result "*") (set! result " ")) (append-string-to-result "<td>") (append-string-to-result result) (append-string-to-result "</td>") ;; 6 : mag1 (set! result (rs:getString 7)) (if-t (rs:wasNull) (set! result " ")) (if-t (string=? result "00.") (set! result " ")) (append-string-to-result "<td>") (append-string-to-result result) (append-string-to-result "</td>") ;; 7 : mag2 (set! result (rs:getString 8)) (if-t (rs:wasNull) (set! result " ")) (if-t (string=? result "00.") (set! result " ")) (append-string-to-result "<td>") (append-string-to-result result) (append-string-to-result "</td>") ;; 8 : Spectre (set! result (rs:getString 9)) (if (rs:wasNull) (set! result " ") (if (string=? result "-") (set! result " ") (set! result (string-upcase result)))) (append-string-to-result "<td>") (append-string-to-result result) (append-string-to-result "</td>") (append-string-to-result "</tr>") (rs:next) ;; rs.Movenext in ASP ) ;; end WHILE (Do While ... Loop) (append-string-to-result (string-append "</table> <P> <P> <table width=\"60%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th><font color=\"#0000FF\">Nombre d'objets répondant à la sélection<br></font></th> <th>" (number->string total) "</th> </tr> </table>")) ) ;; end (else ) ;; end (if (or (= flagerreur 1) (= erreurgeneral 0)) (display-msg-var-nl "ResultatGeneralFKawa : work : baraterreur = " baraterreur) (display-msg-var-nl "ResultatGeneralFKawa : work : baratin = " baratin) (append-string-to-result "<P> <P> <table border=\"0\" width=\"95%\"> <tr> <td valign=\"top\"><a href=\"http://sidonie.obs-nice.fr/SidonieDonneesF.html\"> <img border=\"0\" src=\"http://sidonie.obs-nice.fr/retour_blanc.gif\" width=\"26\" height=\"26\"></a> <font size=\"2\"><em>Recherche sur un objet</em></font></td> <td valign=\"top\"><a href=\"http://sidonie.obs-nice.fr/ParametresF.html\"><img border=\"0\" src=\"http://sidonie.obs-nice.fr/retour_blanc.gif\" width=\"26\" height=\"26\"></a> <font size=\"2\"><em>Recherche statistique</em></font></td> </td> </tr> </table> </body> </html>") ) ;; end let* (eu.oca.DataBase:closeStatic) (display "ResultatGeneralFKawa : work : eu.oca.DataBase:closeStatic PASSED") (newline) (display-msg-var-nl "ResultatGeneralFKawa : 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 "")) ) ;; end of class
Here is now what the code was in ASP , i really prefer the Scheme code :
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> <%@ LANGUAGE = "VBScript" %> <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> <meta name="GENERATOR" content="Microsoft FrontPage 4.0"> <title>SIDONIe-Résultats statistiques</title> </head> <LINK rel="stylesheet" href="http://sidonie.obs-nice.fr/Style.css" type="text/css"> <body <!--bgcolor="#FFFFA6" text="#004040" link="#0000FF" vlink="#808000" alink="#800000"--> <% If IsObject(Session("Sidonie_conn")) Then Set conn = Session("Sidonie_conn") Else Set conn = Server.CreateObject("ADODB.Connection") conn.open "Sidonie","","" Set Session("Sidonie_conn") = conn End If Set rs = Server.CreateObject("ADODB.Recordset") marequete = "SELECT DISTINCT Coordonnées.Nom, Coordonnées.[Alpha 2000], Coordonnées.[Delta 2000]" marequete = marequete & ", Coordonnées.[N° BD], Coordonnées.[N° ADS], Coordonnées.[N° HIP], Coordonnées.mag1, Coordonnées.mag2" marequete = marequete & ", Coordonnées.Spectre" marequete = marequete & " FROM Coordonnées INNER JOIN Mesures ON Coordonnées.[N° Fiche] = Mesures.[N° Fiche] " monordre = " ORDER by Coordonnées.[Alpha 2000]" cocher = 0 flagerreur = 0 erreurgeneral = 0 baraterreur = "Veuillez re-initialiser la page et recommencer la requète : " Et = " AND " Dont = "WHERE " Group = "GROUP BY Coordonnées.Nom, Coordonnées.[Alpha 2000], Coordonnées.[Delta 2000]" Group = Group & ", Coordonnées.[N° BD], Coordonnées.[N° ADS], Coordonnées.[N° HIP], Coordonnées.mag1, Coordonnées.mag2" Group = Group & ", Coordonnées.Spectre, Coordonnées.Orb, Coordonnées.[N°Type] HAVING " baratin = "Liste des objets" Clause = Dont caseannee = request.form("CocherAnnee") if (caseannee = "ON") then erreurgeneral = 1 data = request.form("annee") if (data = "") then flagerreur = 1 baraterreur = baraterreur & " vous avez oublié de rentrer l'année !" else if (Cdbl(data)<=1750) OR (Cdbl(data)>=2050) Then flagerreur = 1 baraterreur = baraterreur & " vous avez rentré une année impossible !" else if cocher = 0 then cocher = 1 baratin = baratin & " non observés depuis " & data marequete = marequete & Group & "Max(Cdbl(Mesures.Date)) <= " & "Cdbl(" & data & ")" else Response.Write("Veuillez re-initialiser la page et recommencer la requète, il y a une erreur de choix !!") end if end if end if end if casenbmes = request.form("CocherNbMes") if (casenbmes = "ON") then erreurgeneral = 1 data = request.form("NbMes") if (data = "") then flagerreur = 1 baraterreur = baraterreur & " vous avez oublié de donner un nombre de mesures max !" else if cocher = 0 then cocher = 1 baratin = baratin & " dont le nombre de mesures est <= à " & data marequete = marequete & Group & "Count(Mesures.Date) <= " & "Cdbl(" & data & ")" else baratin = baratin & ", dont le nombre de mesures est <= à " & data marequete = marequete & Et & "Count(Mesures.Date) <= " & "Cdbl(" & data & ")" end if end if end if casesepar = request.form("CocherSepar") if (casesepar = "ON") then erreurgeneral = 1 separmin = request.form("SeparMin") if (separmin = "") then flagerreur = 1 baraterreur = baraterreur & " vous n'avez pas donné de séparation minimum ! " else if cocher = 0 then cocher = 1 'baratin = baratin & " (Requète séparation non encore opérationnelle !) " baratin = baratin & " avec une séparation <= à " & separmin baratin = baratin & " sec d'arc" marequete = marequete & Group marequete = marequete & "Min(Cdbl(Mesures.Sépar)) <= " & "Cdbl(" & separmin & ")" else 'baratin = baratin & " (Requète séparation non encore opérationnelle !) " baratin = baratin & ", avec une séparation <= à " & separmin baratin = baratin & " sec d'arc" marequete = marequete & Et & "Min(Cdbl(Mesures.Sépar)) <= " & "Cdbl(" & separmin & ")" end if end if end if casenom = request.form("CocherNom") if (casenom = "ON") then erreurgeneral = 1 objet = request.form("Nom") if (objet = "") then flagerreur = 1 baraterreur = baraterreur & " vous n'avez pas donné de nom ! " else if cocher = 0 then cocher = 1 baratin = baratin & " dont le nom commence par " & objet marequete = marequete & dont marequete = marequete & "Coordonnées.Nom like '" & objet & " _%" & "'" else baratin = baratin & ", dont le nom commence par " & objet marequete = marequete & Et & "Coordonnées.Nom like '" & objet & " _%" & "'" end if end if end if caseHIP = request.form("CocherHIP") if (caseHIP = "ON") then erreurgeneral = 1 if cocher = 0 then cocher = 1 baratin = baratin & " avec un numéro HIP" marequete = marequete & dont marequete = marequete & "Coordonnées.[N° HIP] not like '*'" else baratin = baratin & ", avec un numéro HIP" marequete = marequete & Et & "Coordonnées.[N° HIP] not like '*'" end if end if caseorb = request.form("CocherOrb") if (caseorb = "ON") then erreurgeneral = 1 if cocher = 0 then cocher = 1 baratin = baratin & " avec une orbite calculée" marequete = marequete & dont marequete = marequete & "Coordonnées.Orb like 'OUI'" else baratin = baratin & ", avec une orbite calculée" marequete = marequete & Et & "Coordonnées.Orb like 'OUI'" end if end if casealfa = request.form("CocherAlpha") if (casealfa = "ON") then erreurgeneral = 1 alfamin = request.form("AlphaMin") alfamax = request.form("AlphaMax") if (alfamin = "") OR (alfamax = "") then flagerreur = 1 baraterreur = baraterreur & " vous n'avez pas donné de Alpha minimum ou de Alpha maximum ! " else iminresult = CInt(alfamin) resulth = Fix(iminresult/1000) resultm = iminresult - resulth*1000 resultm = Fix(resultm/10) results = iminresult - resulth*1000 -resultm*10 if (resulth < 1) then resulth = "00" end if if (resulth >= 1 AND resulth < 10) then resulth = "0" & resulth end if if (resultm < 10) then resultm = "0" & resultm end if iminresult = resulth & " h " & resultm & "." & results & " mn" imaxresult = Int(alfamax) resulth = Fix(imaxresult/1000) resultm = imaxresult - resulth*1000 resultm = Fix(resultm/10) results = imaxresult - resulth*1000 -resultm*10 if (resulth < 1) then resulth = "00" end if if (resulth >= 1 AND resulth < 10) then resulth = "0" & resulth end if if (resultm < 10) then resultm = "0" & resultm end if imaxresult = resulth & " h " & resultm & "." & results & " mn" if cocher = 0 then cocher = 1 baratin = baratin & " avec Alpha compris entre " & iminresult baratin = baratin & " et " baratin = baratin & imaxresult marequete = marequete & dont marequete = marequete & "Coordonnées.[Alpha 2000] >= " & alfamin & " AND Coordonnées.[Alpha 2000] <= " & alfamax else baratin = baratin & ", avec Alpha compris entre " & iminresult baratin = baratin & " et " baratin = baratin & imaxresult marequete = marequete & Et & "Coordonnées.[Alpha 2000] >= " & alfamin & " AND Coordonnées.[Alpha 2000] <= " & alfamax end if end if end if casedelta = request.form("CocherDelta") if (casedelta = "ON") then erreurgeneral = 1 deltamin = request.form("DeltaMin") deltamax = request.form("DeltaMax") if (deltamin = "") OR (deltamax = "") then flagerreur = 1 baraterreur = baraterreur & " vous n'avez pas donné de Delta minimum ou de Delta maximum ! " else if (deltamin < 0) then sign = "-" else sign = " " end if deminresult = Abs(deltamin) resultd = Fix(deminresult/100) resultmi = deminresult - resultd*100 if (resultd < 1) then resultd = "00" end if if (resultd >= 1 AND resultd < 10) then resultd = "0" & resultd end if if (resultmi < 10) then resultmi = "0" & resultmi end if deminresult = sign & resultd & " ° " & resultmi & " '" if (deltamax < 0) then sign = "-" else sign = " " end if demaxresult = Abs(deltamax) resultd = Fix(demaxresult/100) resultmi = demaxresult - resultd*100 if (resultd < 1) then resultd = "00" end if if (resultd >= 1 AND resultd < 10) then resultd = "0" & resultd end if if (resultmi < 10) then resultmi = "0" & resultmi end if demaxresult = sign & resultd & " ° " & resultmi & " '" if cocher = 0 then cocher = 1 baratin = baratin & " avec Delta compris entre " & deminresult baratin = baratin & " et " baratin = baratin & demaxresult marequete = marequete & dont marequete = marequete & "Coordonnées.[Delta 2000] >= " & deltamin & " AND Coordonnées.[Delta 2000] <= " & deltamax else baratin = baratin & ", avec Delta compris entre " & deminresult baratin = baratin & " et " baratin = baratin & demaxresult marequete = marequete & Et & "Coordonnées.[Delta 2000] >= " & deltamin & " AND Coordonnées.[Delta 2000] <= " & deltamax end if end if end if casemag1 = request.form("CocherMag1") if (casemag1 = "ON") then erreurgeneral = 1 mag1min = request.form("Mag1Min") mag1max = request.form("Mag1Max") if (mag1min = "") OR (mag1max = "") then flagerreur = 1 baraterreur = baraterreur & " vous n'avez pas donné de magnitude minimum ou de magnitude maximum ! " else if cocher = 0 then cocher = 1 baratin = baratin & " avec mag1 comprise entre " & mag1min baratin = baratin & " et " baratin = baratin & mag1max marequete = marequete & dont marequete = marequete & "Cdbl(Coordonnées.mag1) >= " & "Cdbl(" & mag1min & ")" marequete = marequete & Et & "Cdbl(Coordonnées.mag1) <= " & "Cdbl(" & mag1max & ")" else baratin = baratin & ", avec mag1 comprise entre " & mag1min baratin = baratin & " et " baratin = baratin & mag1max marequete = marequete & Et & "Cdbl(Coordonnées.mag1) >= " & "Cdbl(" & mag1min & ")" marequete = marequete & Et & "Cdbl(Coordonnées.mag1) <= " & "Cdbl(" & mag1max & ")" end if end if end if casemag2 = request.form("CocherMag2") if (casemag2 = "ON") then erreurgeneral = 1 mag2min = request.form("Mag2Min") mag2max = request.form("Mag2Max") if (mag2min = "") OR (mag2max = "") then flagerreur = 1 baraterreur = baraterreur & " vous n'avez pas donné de magnitude minimum ou de magnitude maximum ! " else if cocher = 0 then cocher = 1 baratin = baratin & " avec mag2 comprise entre " & mag2min baratin = baratin & " et " baratin = baratin & mag2max marequete = marequete & dont marequete = marequete & "Cdbl(Coordonnées.mag2) >= " & "Cdbl(" & mag2min & ")" marequete = marequete & Et & "Cdbl(Coordonnées.mag2) <= " & "Cdbl(" & mag2max & ")" else baratin = baratin & ", avec mag2 comprise entre " & mag2min baratin = baratin & " et " baratin = baratin & mag2max marequete = marequete & Et & "Cdbl(Coordonnées.mag2) >= " & "Cdbl(" & mag2min & ")" marequete = marequete & Et & "Cdbl(Coordonnées.mag2) <= " & "Cdbl(" & mag2max & ")" end if end if end if casediffmag = request.form("CocherDiffMag") if (casediffmag = "ON") then erreurgeneral = 1 diffmag = request.form("Mag2Mag1") if (diffmag = "") then flagerreur = 1 baraterreur = baraterreur & " vous n'avez pas donné de différence de magnitude ! " else if cocher = 0 then cocher = 1 'baratin = baratin & " (Requète Mag2 - Mag1 non encore opérationnelle !) " baratin = baratin & " avec mag2 - mag1 >= " & diffmag marequete = marequete & dont marequete = marequete & "(Cdbl(Coordonnées.mag2) - Cdbl(Coordonnées.mag1)) >= " & "Cdbl(" & diffmag & ")" else 'baratin = baratin & " (Requète Mag2 - Mag1 non encore opérationnelle !) " baratin = baratin & ", avec mag2 - mag1 >= " & diffmag marequete = marequete & Et & "(Cdbl(Coordonnées.mag2) - Cdbl(Coordonnées.mag1)) >= " & "Cdbl(" & diffmag & ")" end if end if end if casetype = request.form("CocherType") if (casetype = "ON") then erreurgeneral = 1 type1 = request.form("type1") type2 = request.form("type2") if (type1 = "") OR (type2 = "") then flagerreur = 1 baraterreur = baraterreur & " vous n'avez pas donné de type spectral minimum ou maximum ! " else Select Case (type1) case "O" nutype1 = 1 case "O0" nutype1 = 2 case "O1" nutype1 = 3 case "O2" nutype1 = 4 case "O3" nutype1 = 5 case "O4" nutype1 = 6 case "O5" nutype1 = 7 case "O6" nutype1 = 8 case "O7" nutype1 = 9 case "O8" nutype1 = 10 case "O9" nutype1 = 11 case "B" nutype1 = 12 case "B0" nutype1 = 13 case "B1" nutype1 = 14 case "B2" nutype1 = 15 case "B3" nutype1 = 16 case "B4" nutype1 = 17 case "B5" nutype1 = 18 case "B6" nutype1 = 19 case "B7" nutype1 = 20 case "B8" nutype1 = 21 case "B9" nutype1 = 22 case "A" nutype1 = 23 case "A0" nutype1 = 24 case "A1" nutype1 = 25 case "A2" nutype1 = 26 case "A3" nutype1 = 27 case "A4" nutype1 = 28 case "A5" nutype1 = 29 case "A6" nutype1 = 30 case "A7" nutype1 = 31 case "A8" nutype1 = 32 case "A9" nutype1 = 33 case "F" nutype1 = 34 case "F0" nutype1 = 35 case "F1" nutype1 = 36 case "F2" nutype1 = 37 case "F3" nutype1 = 38 case "F4" nutype1 = 39 case "F5" nutype1 = 40 case "F6" nutype1 = 41 case "F7" nutype1 = 42 case "F8" nutype1 = 43 case "F9" nutype1 = 44 case "G" nutype1 = 45 case "G0" nutype1 = 46 case "G1" nutype1 = 47 case "G2" nutype1 = 48 case "G3" nutype1 = 49 case "G4" nutype1 = 50 case "G5" nutype1 = 51 case "G6" nutype1 = 52 case "G7" nutype1 = 53 case "G8" nutype1 = 54 case "G9" nutype1 = 55 case "K" nutype1 = 56 case "K0" nutype1 = 57 case "K1" nutype1 = 58 case "K2" nutype1 = 59 case "K3" nutype1 = 60 case "K4" nutype1 = 61 case "K5" nutype1 = 62 case "K6" nutype1 = 63 case "K7" nutype1 = 64 case "K8" nutype1 = 65 case "K9" nutype1 = 66 case "M" nutype1 = 67 case "M0" nutype1 = 68 case "M1" nutype1 = 69 case "M2" nutype1 = 70 case "M3" nutype1 = 71 case "M4" nutype1 = 72 case "M5" nutype1 = 73 case "M6" nutype1 = 74 case "M7" nutype1 = 75 case "M8" nutype1 = 76 case "M9" nutype1 = 77 End Select Select Case (type2) case "O" nutype2 = 1 case "O0" nutype2 = 2 case "O1" nutype2 = 3 case "O2" nutype2 = 4 case "O3" nutype2 = 5 case "O4" nutype2 = 6 case "O5" nutype2 = 7 case "O6" nutype2 = 8 case "O7" nutype2 = 9 case "O8" nutype2 = 10 case "O9" nutype2 = 11 case "B" nutype2 = 12 case "B0" nutype2 = 13 case "B1" nutype2 = 14 case "B2" nutype2 = 15 case "B3" nutype2 = 16 case "B4" nutype2 = 17 case "B5" nutype2 = 18 case "B6" nutype2 = 19 case "B7" nutype2 = 20 case "B8" nutype2 = 21 case "B9" nutype2 = 22 case "A" nutype2 = 23 case "A0" nutype2 = 24 case "A1" nutype2 = 25 case "A2" nutype2 = 26 case "A3" nutype2 = 27 case "A4" nutype2 = 28 case "A5" nutype2 = 29 case "A6" nutype2 = 30 case "A7" nutype2 = 31 case "A8" nutype2 = 32 case "A9" nutype2 = 33 case "F" nutype2 = 34 case "F0" nutype2 = 35 case "F1" nutype2 = 36 case "F2" nutype2 = 37 case "F3" nutype2 = 38 case "F4" nutype2 = 39 case "F5" nutype2 = 40 case "F6" nutype2 = 41 case "F7" nutype2 = 42 case "F8" nutype2 = 43 case "F9" nutype2 = 44 case "G" nutype2 = 45 case "G0" nutype2 = 46 case "G1" nutype2 = 47 case "G2" nutype2 = 48 case "G3" nutype2 = 49 case "G4" nutype2 = 50 case "G5" nutype2 = 51 case "G6" nutype2 = 52 case "G7" nutype2 = 53 case "G8" nutype2 = 54 case "G9" nutype2 = 55 case "K" nutype2 = 56 case "K0" nutype2 = 57 case "K1" nutype2 = 58 case "K2" nutype2 = 59 case "K3" nutype2 = 60 case "K4" nutype2 = 61 case "K5" nutype2 = 62 case "K6" nutype2 = 63 case "K7" nutype2 = 64 case "K8" nutype2 = 65 case "K9" nutype2 = 66 case "M" nutype2 = 67 case "M0" nutype2 = 68 case "M1" nutype2 = 69 case "M2" nutype2 = 70 case "M3" nutype2 = 71 case "M4" nutype2 = 72 case "M5" nutype2 = 73 case "M6" nutype2 = 74 case "M7" nutype2 = 75 case "M8" nutype2 = 76 case "M9" nutype2 = 77 End Select if cocher = 0 then cocher = 1 baratin = baratin & " avec types spectraux compris entre " & type1 baratin = baratin & " et " baratin = baratin & type2 marequete = marequete & dont marequete = marequete & "Coordonnées.[N°Type] >= " & nutype1 & " AND Coordonnées.[N°Type] <= " & nutype2 else baratin = baratin & ", avec types spectraux compris entre " & type1 baratin = baratin & " et " baratin = baratin & type2 marequete = marequete & Et & "Coordonnées.[N°Type] >= " & nutype1 & " AND Coordonnées.[N°Type] <= " & nutype2 end if end if end if if (flagerreur = 1) OR (erreurgeneral = 0) then if (erreurgeneral = 0) then baraterreur = baraterreur & " Vous n'avez coché aucune case !! " end if %> <h1 align="center"><font color="#0000FF">SIDONIe - Résultats statistiques</font></h1> <div align="center"><center> <table width="85%" border="3" align="center" cellpadding="0" cellspacing="0"> <tr> <th width="82%"><font color="#0000FF"><%=baraterreur%><br> </font></th> </tr> </table> </center></div> <% else marequete = marequete & monordre 'Response.Write("Voila la valeur SQL de la requète : " & marequete) rs.open marequete, conn, 3, 3 on Error Resume Next rs.MoveFirst total = 0 %> <h1 align="center"><font color="#0000FF">SIDONIe - Résultats statistiques</font></h1> <div align="center"><center> <table width="85%" border="3" align="center" cellpadding="0" cellspacing="0"> <tr> <th width="82%"><font color="#0000FF"><%=baratin%><br> </font></th> </tr> </table> </center></div> <P> <P> <table border="1" cellpadding="0" cellspacing="0" width="100%"> <tr> <th><font color="#000080">Nom</font></th> <th><font color="#000080">Alpha 2000</font></th> <th><font color="#000080">Delta 2000</font></th> <th><font color="#000080">N° BD</font></th> <th><font color="#000080">N° ADS</font></th> <th><font color="#000080">N° HIP</font></th> <th><font color="#000080">mag 1</font></th> <th><font color="#000080">mag 2</font></th> <th><font color="#000080">Spectre</font></th> </tr> <% do while not rs.eof total = total + 1 %> <tr> <% result = rs(0) If isnull (result) then result = " " %> <td><%=result%></td> <% else %> <td><%=UCASE(result)%></td> <% end if %> <% result = rs(1) If isnull (result) then result = " " else iresult = Int(result) resulth = Fix(iresult/1000) resultm = iresult - resulth*1000 resultm = Fix(resultm/10) results = iresult - resulth*1000 -resultm*10 if (resulth < 1) then resulth = "00" end if if (resulth >= 1 AND resulth < 10) then resulth = "0" & resulth end if if (resultm < 10) then resultm = "0" & resultm end if result = resulth & " h " & resultm & "." & results & " mn" end if %> <td><%=result%></td> <% result = rs(2) If isnull (result) then result = " " else if (result < 0) then sign = "-" else sign = " " end if aresult = Abs(result) resultd = Fix(aresult/100) resultmi = aresult - resultd*100 if (resultd < 1) then resultd = "00" end if if (resultd >= 1 AND resultd < 10) then resultd = "0" & resultd end if if (resultmi < 10) then resultmi = "0" & resultmi end if result = sign & resultd & " ° " & resultmi & " '" end if %> <td><%=result%></td> <% result = rs(3) If isnull (result) then result = " " end if %> <td><%=result%></td> <% result = rs(4) If isnull (result) then result = " " end if %> <td><%=result%></td> <% result = rs(5) If isnull (result) then result = " " end if if result = "*" then result = " " end if %> <td><%=result%></td> <% result = rs(6) If isnull (result) then result = " " end if if result = "00." then result = " " end if %> <td><%=result%></td> <% result = rs(7) If isnull (result) then result = " " end if if result = "00." then result = " " end if %> <td><%=result%></td> <% result = rs(8) If isnull (result) then result = " " else if result = "-" then result = " " else result = UCASE(result) end if end if %> <td><%=result%></td> </tr> <% rs.Movenext Loop %> </table> <P> <P> <table width="60%" border="3" align="center" cellpadding="0" cellspacing="0"> <tr> <th><font color="#0000FF">Nombre d'objets répondant à la sélection<br> </font></th> <th><%=total%> </th> </tr> </table> <% rs.close set rs = nothing end if %> <P> <P> <table border="0" width="95%"> <tr> <td valign="top"><a href="http://sidonie.obs-nice.fr/SidonieDonneesF.html"> <img border="0" src="http://sidonie.obs-nice.fr/retour_blanc.gif" width="26" height="26"></a> <font size="2"><em>Recherche sur un objet</em></font></td> <td valign="top"><a href="http://sidonie.obs-nice.fr/ParametresF.html"><img border="0" src="http://sidonie.obs-nice.fr/retour_blanc.gif" width="26" height="26"></a> <font size="2"><em>Recherche statistique</em></font></td> </h5> </td> </tr> </table> </body> </html>
/* * To change this license header, choose License Headers in Project Properties. * To change this template file, choose Tools | Templates * and open the template in the editor. */ package eu.oca; import java.sql.Connection; import java.sql.DriverManager; import java.sql.PreparedStatement; import java.sql.ResultSet; import java.sql.SQLException; import java.sql.Statement; import java.util.Date; import java.net.InetAddress; import java.net.UnknownHostException; /** * * @author mattei */ public class DataBase { private static Connection connect = null; private static Statement statement = null; private static PreparedStatement preparedStatement = null; public static ResultSet resultSet = null; //private static ResultSet resultSet = null; public static ResultSet resultSet2 = null; public static ResultSet resultSetRequete = null; public static ResultSet resultSetOrbite = null; public static ResultSet resultSetStats = null; public static int val = 1; public DataBase() { System.out.println("Sidonie : DataBase : constructor"); } public int getval() { return val; } public ResultSet getresultSet() { return resultSet; } public static void helloStatic() { System.out.println("Sidonie : DataBase : helloStatic : Hello !"); } public static void searchDriverStatic() throws Exception { try { // This will load the MySQL driver, each DB has its own driver Class.forName("com.mysql.jdbc.Driver"); System.out.println("Sidonie : DataBase : searchDriver : driver found"); } catch (Exception e) { System.out.println("Sidonie : DataBase : searchDriver : "+e.getMessage()); throw new IllegalStateException("Driver not found: com.mysql.jdbc.Driver"); } } public void searchDriverDynamic() throws Exception { try { // This will load the MySQL driver, each DB has its own driver Class.forName("com.mysql.jdbc.Driver"); System.out.println("Sidonie : DataBase : searchDriver : driver found"); } catch (Exception e) { System.out.println("Sidonie : DataBase : searchDriver : "+e.getMessage()); throw new IllegalStateException("Driver not found: com.mysql.jdbc.Driver"); } } // creation compte sur BDD: // // MariaDB [(none)]> create user 'mattei'@'localhost' identified by 'glouglou'; // MariaDB [(none)]> grant all privileges on *.* to 'mattei'@'localhost' with grant option; // MariaDB [(none)]> commit; // MariaDB [(none)]> select host, user, password from mysql.user; // +------------------+---------+-------------------------------------------+ // | host | user | password | // +------------------+---------+-------------------------------------------+ // | localhost | root | | // | moita.oca.eu | root | | // | 127.0.0.1 | root | | // | asteroide.oca.eu | sidonie | *94D289876FED3EFABF12FD8F7B39695A378A82F5 | // | dhcp2-21.oca.eu | sidonie | *94D2898E9AED367EBF1274FF7B39695A378A82F5 | // | moita.oca.eu | sidonie | *94D2898E9AED367EBF12FD8F7B39695A378A82F5 | // | localhost | mattei | *94D289845DED367EBF12FD8F7B39695A378A82F5 | // +------------------+---------+-------------------------------------------+ // 10 rows in set (0.00 sec) // show processlist; // // mysql> CREATE DATABASE sidonie; // mysql> commit; // // mysqldump --password=glouglou sidonie | mysql --password=glouglou -h asteroide sidonie public static void connectStatic() throws Exception { String hostname = "Unknown"; boolean local = false; //true; // false for SIT database host try { InetAddress addr; addr = InetAddress.getLocalHost(); hostname = addr.getHostName(); System.out.println("Sidonie : DataBase : connectStatic : Hostname = " + hostname); if (hostname.equals("sidonie2.oca.eu")) local = false; else local = true; } catch (UnknownHostException ex) { System.out.println("Sidonie : DataBase : connectStatic : Hostname can not be resolved"); } if (connect == null) try { // Setup the connection with the DB if (local) { System.out.println("Sidonie : DataBase : connectStatic : using localhost as computer name and mattei as user for sidonie database"); connect = DriverManager .getConnection("jdbc:mysql://localhost/sidonie?" + "user=mattei&password=glouglou"); } else { System.out.println("Sidonie : DataBase : connectStatic : using sidonie2 as computer name"); connect = DriverManager .getConnection("jdbc:mysql://sidonie2/sidonie?" + "user=sidonie&password=glouglou"); } // System.out.println("Sidonie : DataBase : connectStatic : using localhost as computer name"); // connect = DriverManager // .getConnection("jdbc:mysql://localhost/sidonie?" // + "user=sidonie&password=glouglou"); if (connect != null) System.out.println("Sidonie : DataBase : connectStatic : connection established"); } catch (Exception e) { System.out.println("Sidonie : DataBase : connectStatic : Exception : "+e.getMessage()); throw e; } else System.out.println("Sidonie : DataBase : connectStatic : already connected !"); } public void connectDynamic() throws Exception { if (connect == null) try { // Setup the connection with the DB connect = DriverManager .getConnection("jdbc:mysql://localhost/sidonie?" + "user=mattei&password=glouglou"); if (connect != null) System.out.println("Sidonie : DataBase : connectDynamic : connection established"); } catch (Exception e) { System.out.println("Sidonie : DataBase : connectDynamic : Exception : "+e.getMessage()); throw e; } else System.out.println("Sidonie : DataBase : connectDynamic : already connected !"); } // checkin connections on the server side: // MariaDB [(none)]> show processlist; // +----+--------+-----------------+---------+---------+------+-------+------------------+----------+ // | Id | User | Host | db | Command | Time | State | Info | Progress | // +----+--------+-----------------+---------+---------+------+-------+------------------+----------+ // | 4 | mattei | localhost:56538 | sidonie | Sleep | 8551 | | NULL | 0.000 | // | 5 | mattei | localhost:56578 | sidonie | Sleep | 8405 | | NULL | 0.000 | // | 6 | mattei | localhost | NULL | Query | 0 | NULL | show processlist | 0.000 | // | 7 | mattei | localhost:59325 | sidonie | Sleep | 123 | | NULL | 0.000 | // +----+--------+-----------------+---------+---------+------+-------+------------------+----------+ public static void closeStatic() throws Exception { try { if (resultSet != null) { resultSet.close(); resultSet = null; System.out.println("Sidonie : DataBase : closeStatic : resultSet closed. "); } if (resultSet2 != null) { resultSet2.close(); resultSet2 = null; System.out.println("Sidonie : DataBase : closeStatic : resultSet2 closed. "); } if (resultSetOrbite != null) { resultSetOrbite.close(); resultSetOrbite = null; System.out.println("Sidonie : DataBase : closeStatic : resultSetOrbite closed. "); } if (resultSetRequete != null) { resultSetRequete.close(); resultSetRequete = null; System.out.println("Sidonie : DataBase : closeStatic : resultSetRequete closed. "); } if (resultSetStats != null) { resultSetStats.close(); resultSetStats = null; System.out.println("Sidonie : DataBase : closeStatic : resultSetStats closed. "); } if (statement != null) { statement.close(); statement = null; System.out.println("Sidonie : DataBase : closeStatic : statement closed. "); } if (connect != null) { connect.close(); connect = null; System.out.println("Sidonie : DataBase : closeStatic : connect closed. "); } System.out.println("Sidonie : DataBase : closeStatic : connection to database closed. "); } catch (SQLException e) { System.out.println("Sidonie : DataBase : closeStatic : Exception : "+e.getMessage()); throw e; } } public void closeDynamic() throws Exception { try { if (resultSet != null) { resultSet.close(); resultSet = null; System.out.println("Sidonie : DataBase : closeDynamic : resultSet closed. "); } if (statement != null) { statement.close(); statement = null; System.out.println("Sidonie : DataBase : closeDynamic : statement closed. "); } if (connect != null) { connect.close(); connect = null; System.out.println("Sidonie : DataBase : closeDynamic : connect closed. "); } System.out.println("Sidonie : DataBase : closeDynamic : connection to database closed. "); } catch (SQLException e) { System.out.println("Sidonie : DataBase : closeDynamic : Exception : "+e.getMessage()); throw e; } } // Statements allow to issue SQL queries to the database public static void createStatementStatic() throws Exception { try { // Statements allow to issue SQL queries to the database statement = connect.createStatement(); System.out.println("Sidonie : DataBase : createStatementStatic : done"); } catch (Exception e) { System.out.println("Sidonie : DataBase : createStatementStatic : Exception : "+e.getMessage()); throw e; } } // Statements allow to issue SQL queries to the database public void createStatementDynamic() throws Exception { try { // Statements allow to issue SQL queries to the database statement = connect.createStatement(); System.out.println("Sidonie : DataBase : createStatementDynamic : done"); } catch (Exception e) { System.out.println("Sidonie : DataBase : createStatementDynamic : Exception : "+e.getMessage()); throw e; } } // Result set get the result of the SQL query1 public static void executeQueryStatic(String query) throws Exception { try { System.out.println("Sidonie : DataBase : executeQueryStatic : "+query); // Result set get the result of the SQL query resultSet = statement.executeQuery(query); } catch (Exception e) { System.out.println("Sidonie : DataBase : executeQueryStatic : Exception : "+e.getMessage()); throw e; } } // Result set get the result of the SQL query1 public void executeQueryDynamic(String query) throws Exception { try { // Result set get the result of the SQL query resultSet = statement.executeQuery(query); System.out.println("Sidonie : DataBase : executeQueryDynamic : " + query); // ResultSet is initially before the first data set // while (resultSet.next()) { // // It is possible to get the columns via name // // also possible to get the columns via the column number // // which starts at 1 // // e.g. resultSet.getSTring(2); // String nom = resultSet.getString("Nom"); // System.out.println("Sidonie : DataBase : executeQueryDynamic : Nom: " + nom); // } } catch (Exception e) { System.out.println("Sidonie : DataBase : executeQueryDynamic : Exception : "+e.getMessage()); throw e; } } // Result set get the result of the SQL query1 public static void executeQueryStatic(String query,int rsnum) throws Exception { try { // Result set get the result of the SQL query if (rsnum == 1) resultSet = statement.executeQuery(query); else resultSet2 = statement.executeQuery(query); System.out.println("Sidonie : DataBase : executeQueryStatic : "+query); } catch (Exception e) { System.out.println("Sidonie : DataBase : executeQueryStatic : Exception : "+e.getMessage()); throw e; } } // une fonction qui prend un chaine comme parametre ex: name = "Requete" public static void executeQueryStatic(String query,String name) throws Exception { try { // Result set get the result of the SQL query //DataBase.class.getField("resultSet" + name).set(this, statement.executeQuery(query) ); if (name.equals("Requete")) resultSetRequete = statement.executeQuery(query); if (name.equals("Orbite")) resultSetOrbite = statement.executeQuery(query); if (name.equals("Stats")) resultSetStats = statement.executeQuery(query); System.out.println("Sidonie : DataBase : executeQueryStatic(String,String) : "+query+" "+name); } catch (Exception e) { System.out.println("Sidonie : DataBase : executeQueryStatic(String,String) : Exception : "+e.getMessage()); System.err.println("Sidonie : DataBase : executeQueryStatic(String,String) : query = "+query+" name = "+name); throw e; } } public static void readDataBase() throws Exception { try { // Setup the connection with the DB connect = DriverManager .getConnection("jdbc:mysql://localhost/sidonie?" + "user=mattei&password=glouglou"); // Statements allow to issue SQL queries to the database statement = connect.createStatement(); // Result set get the result of the SQL query resultSet = statement .executeQuery("select * from feedback.comments"); writeResultSet(resultSet); // PreparedStatements can use variables and are more efficient preparedStatement = connect .prepareStatement("insert into feedback.comments values (default, ?, ?, ?, ? , ?, ?)"); // "myuser, webpage, datum, summery, COMMENTS from feedback.comments"); // Parameters start with 1 preparedStatement.setString(1, "Test"); preparedStatement.setString(2, "TestEmail"); preparedStatement.setString(3, "TestWebpage"); //preparedStatement.setDate(4, new java.sql.Date(2009, 12, 11)); preparedStatement.setString(5, "TestSummary"); preparedStatement.setString(6, "TestComment"); preparedStatement.executeUpdate(); preparedStatement = connect .prepareStatement("SELECT myuser, webpage, datum, summery, COMMENTS from feedback.comments"); resultSet = preparedStatement.executeQuery(); writeResultSet(resultSet); // Remove again the insert comment preparedStatement = connect .prepareStatement("delete from feedback.comments where myuser= ? ; "); preparedStatement.setString(1, "Test"); preparedStatement.executeUpdate(); resultSet = statement .executeQuery("select * from feedback.comments"); writeMetaData(resultSet); } catch (Exception e) { throw e; } finally { close(); } } private static void writeMetaData(ResultSet resultSet) throws SQLException { // Now get some metadata from the database // Result set get the result of the SQL query System.out.println("The columns in the table are: "); System.out.println("Table: " + resultSet.getMetaData().getTableName(1)); for (int i = 1; i<= resultSet.getMetaData().getColumnCount(); i++){ System.out.println("Column " +i + " "+ resultSet.getMetaData().getColumnName(i)); } } private static void writeResultSet(ResultSet resultSet) throws SQLException { // ResultSet is initially before the first data set while (resultSet.next()) { // It is possible to get the columns via name // also possible to get the columns via the column number // which starts at 1 // e.g. resultSet.getSTring(2); String user = resultSet.getString("myuser"); String website = resultSet.getString("webpage"); String summery = resultSet.getString("summery"); Date date = resultSet.getDate("datum"); String comment = resultSet.getString("comments"); System.out.println("User: " + user); System.out.println("Website: " + website); System.out.println("Summery: " + summery); System.out.println("Date: " + date); System.out.println("Comment: " + comment); } } // You need to close the resultSet private static void close() { try { if (resultSet != null) { resultSet.close(); } if (resultSet2 != null) { resultSet2.close(); } if (statement != null) { statement.close(); } if (connect != null) { connect.close(); } } catch (Exception e) { } } public static void setResultSetNull() { resultSet = null; } public static void setResultSet2Null() { resultSet2 = null; } }
public static void deregisterDriverStatic() throws Exception { // This manually deregisters JDBC driver, which prevents Tomcat 7 from complaining about memory leaks wrto this class Enumeration<Driver> drivers = DriverManager.getDrivers(); while (drivers.hasMoreElements()) { Driver driver = drivers.nextElement(); try { DriverManager.deregisterDriver(driver); System.out.println("Sidonie : DataBase : deregister : " + String.format("deregistering jdbc driver: %s", driver)); } catch (SQLException e) { System.out.println("Sidonie : DataBase : deregister : " + String.format("Error deregistering driver %s", driver)); System.out.println("Sidonie : DataBase : deregister : SQLException : " + e.getMessage()); } } }
27-Sep-2016 15:06:18.599 SEVERE [http-nio-192.168.109.87-8080-exec-43] org.apache.catalina.loader.WebappClassLoaderBase.checkThreadLocalMapForLeaks The web application [Sidonie] created a ThreadLocal with key of type [java.lang.InheritableThreadLocal] (value [java.lang.InheritableThreadLocal@7d1e2545]) and a value of type [kawa.standard.Scheme] (value [kawa.standard.Scheme@2b017b2b]) but failed to remove it when the web application was stopped. Threads are going to be renewed over time to try and avoid a probable memory leak. 27-Sep-2016 15:06:18.601 SEVERE [http-nio-192.168.109.87-8080-exec-43] org.apache.catalina.loader.WebappClassLoaderBase.checkThreadLocalMapForLeaks The web application [Sidonie] created a ThreadLocal with key of type [gnu.mapping.ThreadLocation.ThreadLocalWithDefault] (value [gnu.mapping.ThreadLocation$ThreadLocalWithDefault@3d19a9e0]) and a value of type [gnu.math.IntNum] (value [10]) but failed to remove it when the web application was stopped. Threads are going to be renewed over time to try and avoid a probable memory leak. 27-Sep-2016 15:06:18.601 SEVERE [http-nio-192.168.109.87-8080-exec-43] org.apache.catalina.loader.WebappClassLoaderBase.checkThreadLocalMapForLeaks The web application [Sidonie] created a ThreadLocal with key of type [gnu.mapping.ThreadLocation.ThreadLocalWithDefault] (value [gnu.mapping.ThreadLocation$ThreadLocalWithDefault@1c4159e2]) and a value of type [gnu.kawa.io.BinaryOutPort] (value [gnu.kawa.io.BinaryOutPort@4a4b6938]) but failed to remove it when the web application was stopped. Threads are going to be renewed over time to try and avoid a probable memory leak. 27-Sep-2016 15:06:18.601 SEVERE [http-nio-192.168.109.87-8080-exec-43] org.apache.catalina.loader.WebappClassLoaderBase.checkThreadLocalMapForLeaks The web application [Sidonie] created a ThreadLocal with key of type [gnu.mapping.Environment.InheritedLocal] (value [gnu.mapping.Environment$InheritedLocal@2c8a05d2]) and a value of type [gnu.mapping.InheritingEnvironment] (value [#This is not a problem, applications is stable enought , instead Bigloo Scheme compiler produce no warnings.]) but failed to remove it when the web application was stopped. Threads are going to be renewed over time to try and avoid a probable memory leak. 27-Sep-2016 15:06:18.601 SEVERE [http-nio-192.168.109.87-8080-exec-43] org.apache.catalina.loader.WebappClassLoaderBase.checkThreadLocalMapForLeaks The web application [Sidonie] created a ThreadLocal with key of type [gnu.kawa.io.Path$1] (value [gnu.kawa.io.Path$1@cac615]) and a value of type [gnu.kawa.io.FilePath] (value [/root]) but failed to remove it when the web application was stopped. Threads are going to be renewed over time to try and avoid a probable memory leak. 27-Sep-2016 15:06:18.602 SEVERE [http-nio-192.168.109.87-8080-exec-43] org.apache.catalina.loader.WebappClassLoaderBase.checkThreadLocalMapForLeaks The web application [Sidonie] created a ThreadLocal with key of type [java.lang.InheritableThreadLocal] (value [java.lang.InheritableThreadLocal@7d1e2545]) and a value of type [kawa.standard.Scheme] (value [kawa.standard.Scheme@2b017b2b]) but failed to remove it when the web application was stopped. Threads are going to be renewed over time to try and avoid a probable memory leak. 27-Sep-2016 15:06:41.061 INFO [http-nio-192.168.109.87-8080-exec-45] org.apache.catalina.util.LifecycleBase.stop The stop() method was called on component [StandardEngine[Catalina].StandardHost[localhost].StandardContext[/Sidonie]] after stop() had already been called. The second call will be ignored. 27-Sep-2016 15:06:41.585 INFO [http-nio-192.168.109.87-8080-exec-45] org.apache.catalina.startup.HostConfig.undeploy Repli (undeploy) de l'application web ayant pour chemin de contexte /Sidonie
Bigloo technical tips:
With Bigloo, things have been harder than with Kawa, Kawa was written for use with Java code, Bigloo was written first for C(++) interaction, the Java virtual machine back-end is an option, to have this feature enabled with Bigloo you have to issue a command like this when building bigloo from sources:
./configure --jvm=yes
A good starting point for using Bigloo an Java isto have a look at the examples provided in the source code of Bigloo, those example are in the examples sub directory of the Bigloo distribution,
for me there were in bigloo4.2c/examples .
There is a lot of examples related to C(++) and Java, the ones for Java begins with the capital letter J: you can have a look at Jclass or Jawt, i started building my own project sub directory named Jbigl from the example files find under examples, as this you can use and modify the Makefile provided (see below) and use example source code in this subdirectory.
As in Kawa, in Bigloo the scheme class definitions will be put in a module.
In the example i have a module named bigloofunct, my domain name is oca.eu and i will use the standart reverse notation for Java module which is here eu.oca.bigloofunct.
The scheme class is named bigloocode, so you will create a file named .jfile containing something like this:
(
(eu.oca.bigloofunct.BiglooCode "eu.oca.bigloofunct.BiglooCode")
)
the use of .jfiles is well documented here : https://www-sop.inria.fr/indes/fp/Bigloo/doc/bigloo-29.html
in my Scheme file named BiglooCode.scm i will have first the module definition:
;; Bigloo Scheme code for java virtual machine and tomcat web server ;; author: Damien Mattei ;; compile with: ;; ;; cd bigloo4.2c/examples/Jbigl ;; make ;; ;; ;; building a jar library for netbeans: ;; jar cf ~/Dropbox/BiglFunctProg.jar eu ;; how to make bigloo_s.zip usable by tomcat server: ;; mkdir tmp ;; cd tmp ;; unzip /usr/local/lib/bigloo/4.1a/bigloo_s.zip ;; jar cf bigloo-4.1.jar bigloo/ ;; deploy bigloo*.jar with web application (module eu.oca.bigloofunct.BiglooCode (include "../../../Dropbox/info/syntactic-sugar.scm") ;; YES in bigloo you can include files from other schemes... ;;(include "ResultSet.scm") ;; java jigloo -r -skip-nested-classes -no-transient -no-volatile -o ../examples/Jbigl/jigloo-generated-ResultSet.scm java.sql.ResultSet (include "jigloo-generated-ResultSet.scm") ;; java jigloo -r -skip-nested-classes -no-transient -no-volatile -o ../examples/Jbigl/jigloo-generated-String.scm java.lang.String ;;(include "jigloo-generated-String.scm") (java ;;(class %jobject "java.lang.Object") ;;(class %jstring::%jobject "java.lang.String") ;; (class %jresultset ;; (method next::bool (::%jresultset) "next") ;; (method abstract public last::bool (::%jresultset ) "last") ;; (method abstract public getRow::int (::%jresultset ) "getRow") ;; "java.sql.ResultSet") ;;(array int* ::int) (array byte* ::byte) ;; peux t'on utiliser string a la place (cf awt.scm) (array byte** ::byte*) ;;(array string* ::string) ;;(array jstring* ::%jstring) (class eu.oca.bigloofunct.JavaForBigloo (method static hello::int (::int*) "hello") (method static displayByteArrayString::void (::byte**) "displayByteArrayString") ;; java name ;;(method static bstring->jstring::%jstring (::byte*) "bstring_to_jstring");; java name ;;(method static bstring->jstring::%jstring (::string) "bstring_to_jstring");; java name (method static bstring->jstring::java.lang.String (::string) "bstring_to_jstring");; java name (method static jstring->bstring::string (::java.lang.String) "jstring_to_bstring");; java name (method static pi2dec::double () "pi2dec") (method static piFloat::float () "piFloat") (method static jdouble->bstring::string (::double) "jdouble_to_bstring");; java name (method static displayByteStringNL::void (::string) "displayByteStringNL");; java name (method static displayDoubleNL::void (::double) "displayDoubleNL");; java name (method static displayInt::void (::int) "displayInt");; java name "eu.oca.bigloofunct.JavaForBigloo") ;; (class eu.oca.bigloofunct.JavaForGlooGloo ;; (method static hello::int (::int*) "hello") ;; (method static displayByteArrayString::void (::byte**) "displayByteArrayString") ;; "eu.oca.bigloofunct.JavaForGlooGloo") (class eu.oca.DataBase ;;(method static DataBase::void (::void) "DataBase") (constructor new ()) ;;(field static resultSet::%jresultset "resultSet") (field static resultSet::java.sql.ResultSet "resultSet") (field static resultSet2::java.sql.ResultSet "resultSet2") (field static resultSetRequete::java.sql.ResultSet "resultSetRequete") (field static resultSetOrbite::java.sql.ResultSet "resultSetOrbite") (field static val::int "val") (method getval::int (::eu.oca.DataBase) "getval") ;;(method getresultSet::%jresultset (::eu.oca.DataBase) "getresultSet") (method getresultSet::java.sql.ResultSet (::eu.oca.DataBase) "getresultSet") (method static searchDriverStatic::void () "searchDriverStatic") (method static setResultSetNull::void () "setResultSetNull") (method static setResultSet2Null::void () "setResultSet2Null") (method searchDriverDynamic::void (::eu.oca.DataBase) "searchDriverDynamic") (method static connectStatic::void () "connectStatic") (method connectDynamic::void (::eu.oca.DataBase) "connectDynamic") (method static closeStatic::void () "closeStatic") (method closeDynamic::void (::eu.oca.DataBase) "closeDynamic") (method static createStatementStatic::void () "createStatementStatic") (method createStatementDynamic::void (::eu.oca.DataBase) "createStatementDynamic") ;;(method static executeQueryStatic::void (::%jstring) "executeQueryStatic") (method static executeQueryStatic::void (::java.lang.String) "executeQueryStatic") (method static executeQueryStatic2args::void (::java.lang.String ::int) "executeQueryStatic") (method static executeQueryStaticStringString::void (::java.lang.String ::java.lang.String) "executeQueryStatic") ;;(method executeQueryDynamic::void (::eu.oca.DataBase ::%jstring) "executeQueryDynamic") (method executeQueryDynamic::void (::eu.oca.DataBase ::java.lang.String) "executeQueryDynamic") (method static readDataBase::void () "readDataBase") ;;(method setResultSetNull::void () "setResultSetNull") "eu.oca.DataBase") ) ;; end java (export (callback::int ::int)) ;(export (affichen::nil ::bstring)) (export (affichen::nil ::byte*)) (export (affiche::nil ::byte*)) (export (squareJavaArray::int* ::int*)) (export (displayArrayByteStar::nil ::byte**)) (export (displayReverseArrayByteStar::nil ::byte**)) (export (reverseArrayByteStar::byte** ::byte**)) (export (ResultatMesuresF::byte* ::byte* ::byte* ::byte*)) (export (ResultatMesuresFbeta::byte* ::byte* ::byte*)) (export (ResultatMesuresF2::byte* ::eu.oca.DataBase)) (main start)) ;; define the main routine called at startup ;; end module
#*=====================================================================*/ #* serrano/prgm/project/bigloo/examples/Jbigl/Makefile */ #* ------------------------------------------------------------- */ #* Author : Manuel Serrano */ #* Creation : Tue Jan 30 15:19:19 1996 */ #* Last change : Dim 6 dec 2015 10:35:08 CET (mattei) */ #* Copyright : 1996-2004 Manuel Serrano, see LICENSE file */ #* ------------------------------------------------------------- */ #* The makefile to build socket */ #*=====================================================================*/ #*---------------------------------------------------------------------*/ #* The default configuration */ #*---------------------------------------------------------------------*/ include ../../Makefile.config #*---------------------------------------------------------------------*/ #* flags */ #*---------------------------------------------------------------------*/ BIGLOO = $(BOOTBINDIR)/bigloo BGLOPTFLAGS = -O +rm -shapem BFLAGS = $(BGLOPTFLAGS) #*---------------------------------------------------------------------*/ #* Objects and sources */ #*---------------------------------------------------------------------*/ #*--- scm -------------------------------------------------------------*/ SCM_FILE = BiglooCode #bigloocode #main SCM_OBJ = $(SCM_FILE:%=%.class) SCM_SRC = $(SCM_OBJ:%.class=%.scm) SCM_PKG = eu/oca/bigloofunct #*--- java ------------------------------------------------------------*/ JVM_FILE = JavaForBigloo JVM_OBJ = $(JVM_FILE:%=%.class) JVM_SRC = $(JVM_OBJ:%.class=%.java) #*---------------------------------------------------------------------*/ #* All objects and sources */ #*---------------------------------------------------------------------*/ OBJ = $(SCM_OBJ) $(JVM_OBJ) SRC = $(JVM_SRC) $(SCM_SRC) POPULATION = $(SRC:%=examples/Jbigl/%) \ examples/Jbigl/Makefile \ examples/Jbigl/README #*---------------------------------------------------------------------*/ #* the goals. */ #*---------------------------------------------------------------------*/ java-test: $(OBJ) $(BIGLOO) -jvm $(OBJ) -o java-test test: java-test ./java-test pop: @ echo $(POPULATION) #*---------------------------------------------------------------------*/ #* Cleaning */ #*---------------------------------------------------------------------*/ .PHONY: clean clean: @ find . \( -name '*[~%]' \ -o -name '.??*[~%]' \ -o -name '#*#' \ -o -name '?*#' \ -o -name \*core \) \ -type f -exec $(RM) {} \; @- $(RM) -f $(OBJ) @- $(RM) -f java-test *.jas *.jast *.jar $(RM) -f $(SCM_PKG)/*.class #*---------------------------------------------------------------------*/ #* Suffixes */ #*---------------------------------------------------------------------*/ .SUFFIXES: .SUFFIXES: .scm .java .class #*---------------------------------------------------------------------*/ #* .java.class */ #*---------------------------------------------------------------------*/ #* added -d . flag for creation of directory for java package */ #*---------------------------------------------------------------------*/ .java.class: echo $*.java: (export CLASSPATH=.:$(BOOTLIBDIR)/bigloo_s.zip:$$CLASSPATH; \ $(JAVAC) $(JCFLAGS) -d . -Xdiags:verbose $*.java) #*---------------------------------------------------------------------*/ #* .scm.class */ #*---------------------------------------------------------------------*/ .scm.class: $(BIGLOO) -jvm -c $(BFLAGS) $*.scm -o $(SCM_PKG)/$*.class
(define (square x) (* x x)) (define (square-list L) (map square L)) (define (square-vector V) (vector-map square V)) (define (sum-vector V) (apply + (vector->list V))) (define (squareJavaArray A) (scheme-vector->java-array-int (square-vector (java-array-int->scheme-vector A)))) (define (java-array-int->scheme-vector A) (let* ((len (int*-length A)) (res (make-vector len))) (display len) (newline) ;(display A) ;(newline) (let loop ((i 0)) (vector-set! res i (int*-ref A i)) (if (= i (- len 1)) res (loop (+ i 1)))))) (define (scheme-vector->java-array-int V) (let* ((len (vector-length V)) (res (make-int* len))) (let loop ((i 0)) (int*-set! res i (vector-ref V i)) (if (= i (- len 1)) res (loop (+ i 1)))))) (define (java-array-byte*->scheme-vector A) (let* ((len (byte**-length A)) (result (make-vector len))) (let loop ((i 0)) (vector-set! result i (byte**-ref A i)) (if (= i (- len 1)) result (loop (+ i 1)))))) (define (scheme-vector->java-array-byte* V) (let* ((len (vector-length V)) (res (make-byte** len))) (let loop ((i 0)) (byte**-set! res i (vector-ref V i)) (if (= i (- len 1)) res (loop (+ i 1)))))) (define (displayArrayByteStar jab*) (display (java-array-byte*->scheme-vector jab*)) (newline) '()) (define (displayReverseArrayByteStar jab*) (display (reverseArrayByteStar jab*)) (newline) '()) (define (reverseArrayByteStar jab*) (scheme-vector->java-array-byte* (list->vector (reverse (vector->list (java-array-byte*->scheme-vector jab*)))))) (define (affichen s) (display s) (newline) ;;1 '() ) (define (affiche s) (display s) '() )
public static String bstring_to_jstring( byte[] str ) { return new String( str ); } public static byte[] jstring_to_bstring( String str ) { if( str == null ) { return new byte[ 0 ]; } else { return str.getBytes(); } } public static byte[][] jstringArray_to_bstringArray( String[] Astr ) { byte[][] result = new byte[Astr.length][]; int i=0; for (String s : Astr) { result[i] = jstring_to_bstring(s); i++; } return result; } public static void displayByteArrayString( byte[][] bastr ) { for (byte[] bs : bastr) //BiglooCode.affiche( bs ); System.out.println( bstring_to_jstring(bs) ); } public static double pi2dec() { return 3.14; } public static float piFloat() { return (float) 3.14; } public static byte[] jdouble_to_bstring( double x ) { System.out.println( "eu.oca.bigloofunct :: JavaForBigloo :: jdouble_to_bstring :: x = " + x ); String str = Double.toString(x); if( str == null ) { return new byte[ 0 ]; } else { return str.getBytes(); } } public static void displayByteStringNL( byte[] bstr ) { System.out.println( bstring_to_jstring(bstr) ); } public static void displayDoubleNL( double x ) { System.out.println( x ); } public static void displayInt(int i ) { System.out.println( "eu.oca.bigloofunct :: JavaForBigloo :: displayInt i = " +i); System.out.print( i ); }
(define res '()) ;; will be result ( string,HTML page) (define (ResultatMesuresF bstr_identificateur bstr_objet bstr_choixres) ;;(define (ResultatMesuresF identificateur objet) (let* ( (len_bstr_identificateur (byte*-length bstr_identificateur)) (identificateur (make-string len_bstr_identificateur)) (len_bstr_objet (byte*-length bstr_objet)) (objet (make-string len_bstr_objet)) (len_bstr_choixres (byte*-length bstr_choixres)) (choixres (make-string len_bstr_choixres)) (essai "") (baraterreur "Veuillez re-initialiser la page et recommencer la requète : ") ;; baratin erreur (baratexiste "Veuillez re-initialiser la page et recommencer la requète, l'objet demandé existe, mais avec le nom suivant :") ;; baratin existe (baratobjet " L'objet demandé existe, mais il existe aussi d'autres objets correspondants à cet identificateur (voir la liste ci-dessous) !") (baratuni "Veuillez re-initialiser la page et recommencer la requète : Plusieurs objets correspondent à votre requète, choisissez en un seul dans la liste ") (flagerreur 0) ;; flag erreur (flaguni 0) ;; flag unique (flagexiste 0) ;; flag existe (char-set "UTF-8") ;; "ISO-8859-1") ;; HTML 5 char set (len 0) (dyna #f) (db (if dyna (eu.oca.DataBase-new) '())) ;; database (monchoix "") (flagnom 0) (flaguni 0) (flagobjet 0) (requeteuni::java.lang.String (begin (set! objet bstr_objet) (eu.oca.bigloofunct.JavaForBigloo-bstring->jstring (string-append "SELECT DISTINCTROW Coordonnées.Nom FROM Coordonnées WHERE Coordonnées.Nom Like '" objet " %'")))) (requetexiste "") ;;(requetexiste::java.lang.String (java.lang.String-java.lang.String8 (string-append "SELECT DISTINCTROW Coordonnées.Nom FROM Coordonnées WHERE Coordonnées.Nom Like '" objet "'"))) ;;(jstr::%jstring (eu.oca.bigloofunct.JavaForBigloo-bstring->jstring "hello boy")) (jstr::java.lang.String (eu.oca.bigloofunct.JavaForBigloo-bstring->jstring "hello boy")) (nombreobjets 0) (objetexiste 0) (rsuni::java.sql.ResultSet eu.oca.DataBase-resultSet2) (rsexiste::java.sql.ResultSet eu.oca.DataBase-resultSet) ;;(rs::java.sql.ResultSet eu.oca.DataBase-resultSetRequete) (rs::java.sql.ResultSet eu.oca.DataBase-resultSet) (marequete (sql-server->mysql-server-syntax (string-append "SELECT DISTINCTROW Coordonnées.Nom, Coordonnées.[N° Fiche], Coordonnées.[N° BD], Coordonnées.[N° ADS]" ", Coordonnées.[Alpha 2000], Coordonnées.[Delta 2000], Coordonnées.mag1, Coordonnées.mag2, Coordonnées.Spectre" ", Coordonnées.[N° HIP], Coordonnées.[Orb]" ", Mesures.Date, Mesures.Angle, Mesures.Sépar, Mesures.[Nb Nuits], Mesures.CodeObs," " Mesures.dimension, Mesures.Instrument, Mesures.Réf, Mesures.Nota" " FROM Coordonnées INNER JOIN Mesures ON Coordonnées.[N° Fiche] = Mesures.[N° Fiche] WHERE"))) (monordremes " ORDER BY Mesures.Date") (sqlorbite (sql-server->mysql-server-syntax (string-append "SELECT DISTINCTROW Coordonnées.Nom, Coordonnées.[N° Fiche], Coordonnées.[N° BD], Coordonnées.[N° ADS]" ", Coordonnées.[Alpha 2000], Coordonnées.[Delta 2000], Coordonnées.mag1, Coordonnées.mag2, Coordonnées.Spectre" ", Coordonnées.[N° HIP], Coordonnées.[Orb]" ", orbite.Auteur, orbite.Année, orbite.référence, orbite.Période, orbite.[moyen mt], orbite.périastre" ", orbite.[mi gd axe], orbite.notes, orbite.excentric, orbite.inclin, orbite.noeud, orbite.[noeud/péri]" " FROM Coordonnées INNER JOIN orbite ON Coordonnées.[N° Fiche] = orbite.[N° Fiche] WHERE"))) (monordreorb " ORDER BY orbite.Année") ;; this SQL is endless on MySQL server: ;; SELECT DISTINCTROW Coordonnées.Nom, Coordonnées.`N° Fiche`, Coordonnées.`N° BD`, Coordonnées.`N° ADS`, Coordonnées.`Alpha 2000`, Coordonnées.`Delta 2000`, Coordonnées.mag1, Coordonnées.mag2, Coordonnées.Spectre, Coordonnées.`N° HIP`, Coordonnées.`Orb`, Mesures.Réf, Références.Revue, Références.Titre FROM Coordonnées INNER JOIN (Mesures INNER JOIN Références ON Mesures.Réf = Références.refer) ON Coordonnées.`N° Fiche` = Mesures.`N° Fiche` GROUP BY Coordonnées.Nom, Coordonnées.`N° Fiche`, Coordonnées.`N° BD`, Coordonnées.`N° ADS`, Coordonnées.`Alpha 2000`, Coordonnées.`Delta 2000`, Coordonnées.mag1, Coordonnées.mag2, Coordonnées.Spectre, Coordonnées.`N° HIP`, Coordonnées.`Orb`, Mesures.Réf, Références.Revue, Références.Titre HAVING Coordonnées.Nom Like 'COU 1027' ORDER BY Références.Revue; ;; ;; must be replaced by: ;; ;; SELECT DISTINCTROW tmp.Nom,tmp.`N° Fiche`,tmp.`N° BD`, tmp.`N° ADS`, tmp.`Alpha 2000`, tmp.`Delta 2000`,tmp.mag1,tmp.mag2,tmp.Spectre,tmp.`N° HIP`,tmp.`Orb`, tmp.Réf,Références.Titre FROM (SELECT DISTINCTROW Coordonnées.Nom, Mesures.Réf FROM Coordonnées INNER JOIN Mesures ON Coordonnées.`N° Fiche` = Mesures.`N° Fiche` WHERE Coordonnées.Nom Like 'a 426') tmp INNER JOIN Références ON tmp.Réf = Références.refer; ;; ;; SELECT DISTINCTROW tmp.Nom,tmp.`N° Fiche`, tmp.`N° BD`, tmp.`N° ADS`, tmp.`Alpha 2000`, tmp.`Delta 2000`,tmp.mag1,tmp.mag2,tmp.Spectre,tmp.`N° HIP`,tmp.`Orb`, tmp.Réf,Références.Revue,Références.Titre FROM (SELECT DISTINCTROW Coordonnées.Nom,Coordonnées.`N° Fiche`,Coordonnées.`N° BD`, Coordonnées.`N° ADS`, Coordonnées.`Alpha 2000`, Coordonnées.`Delta 2000`, Coordonnées.mag1, Coordonnées.mag2, Coordonnées.Spectre, Coordonnées.`N° HIP`, Coordonnées.`Orb`, Mesures.Réf FROM Coordonnées INNER JOIN Mesures ON Coordonnées.`N° Fiche` = Mesures.`N° Fiche` WHERE Coordonnées.Nom Like 'a 426') tmp INNER JOIN Références ON tmp.Réf = Références.refer; ;; ;; SELECT DISTINCTROW tmp.Nom,tmp.Réf,Références.Titre FROM (SELECT DISTINCTROW Coordonnées.Nom, Mesures.Réf FROM Coordonnées INNER JOIN Mesures ON Coordonnées.`N° Fiche` = Mesures.`N° Fiche` WHERE Coordonnées.Nom Like 'a 426') tmp INNER JOIN Références ON tmp.Réf = Références.refer; ;; (sqlrefere ;; (sql-server->mysql-server-syntax ;; (string-append ;; "SELECT DISTINCTROW Coordonnées.Nom, Coordonnées.[N° Fiche], Coordonnées.[N° BD], Coordonnées.[N° ADS]" ;; ", Coordonnées.[Alpha 2000], Coordonnées.[Delta 2000], Coordonnées.mag1, Coordonnées.mag2, Coordonnées.Spectre" ;; ", Coordonnées.[N° HIP], Coordonnées.[Orb]" ;; ", Mesures.Réf, Références.Revue" ;; ", Références.Titre" ;; " FROM Coordonnées INNER JOIN (Mesures INNER JOIN Références ON" ;; " Mesures.Réf = Références.refer) ON Coordonnées.[N° Fiche] = Mesures.[N° Fiche]" ;; " GROUP BY Coordonnées.Nom, Coordonnées.[N° Fiche], Coordonnées.[N° BD], Coordonnées.[N° ADS]" ;; ", Coordonnées.[Alpha 2000], Coordonnées.[Delta 2000], Coordonnées.mag1, Coordonnées.mag2, Coordonnées.Spectre" ;; ", Coordonnées.[N° HIP], Coordonnées.[Orb]" ;; ", Mesures.Réf, Références.Revue" ;; ", Références.Titre HAVING"))) ;; (sqlrefere ;; "SELECT DISTINCTROW tmp.Nom,tmp.`N° Fiche`, tmp.`N° BD`, tmp.`N° ADS`, tmp.`Alpha 2000`, tmp.`Delta 2000`,tmp.mag1,tmp.mag2,tmp.Spectre,tmp.`N° HIP`,tmp.`Orb`, tmp.Réf,Références.Revue,Références.Titre FROM (SELECT DISTINCTROW Coordonnées.Nom,Coordonnées.`N° Fiche`,Coordonnées.`N° BD`, Coordonnées.`N° ADS`, Coordonnées.`Alpha 2000`, Coordonnées.`Delta 2000`, Coordonnées.mag1, Coordonnées.mag2, Coordonnées.Spectre, Coordonnées.`N° HIP`, Coordonnées.`Orb`, Mesures.Réf FROM Coordonnées INNER JOIN Mesures ON Coordonnées.`N° Fiche` = Mesures.`N° Fiche` WHERE Coordonnées.Nom Like 'a 426') tmp INNER JOIN Références ON tmp.Réf = Références.refer") (sqlrefere "") ;; will be construct later (sqlrefere-begin "SELECT DISTINCTROW tmp.Nom,tmp.`N° Fiche`, tmp.`N° BD`, tmp.`N° ADS`, tmp.`Alpha 2000`, tmp.`Delta 2000`,tmp.mag1,tmp.mag2,tmp.Spectre,tmp.`N° HIP`,tmp.`Orb`, tmp.Réf,Références.Revue,Références.Titre FROM (SELECT DISTINCTROW Coordonnées.Nom,Coordonnées.`N° Fiche`,Coordonnées.`N° BD`, Coordonnées.`N° ADS`, Coordonnées.`Alpha 2000`, Coordonnées.`Delta 2000`, Coordonnées.mag1, Coordonnées.mag2, Coordonnées.Spectre, Coordonnées.`N° HIP`, Coordonnées.`Orb`, Mesures.Réf FROM Coordonnées INNER JOIN Mesures ON Coordonnées.`N° Fiche` = Mesures.`N° Fiche` WHERE") (sqlrefere-end " GROUP BY Mesures.Réf) tmp INNER JOIN Références ON tmp.Réf = Références.refer GROUP BY tmp.Nom, tmp.`N° Fiche`, tmp.`N° BD`, tmp.`N° ADS`, tmp.`Alpha 2000`, tmp.`Delta 2000`, tmp.mag1, tmp.mag2, tmp.Spectre, tmp.`N° HIP`, tmp.`Orb`, Références.Revue, Références.Titre ") (monordreref " ORDER BY Références.Revue") (jresult::java.lang.String (java.lang.String-java.lang.String8 "")) (result "") (baratin "") ;;(result-double #;::float 0.0) (result-double '()) (result-double::double 0.0) (result2::real 0.0) (bs-result "") (len-bs-result 0) (str-result "") (rd '()) (iresult 0) (resulth 0) ;; hours (resulth-str "") ;; hours string (resultm 0) ;; minutes (resultm-str "") ;; minutes string (results 0) ;; seconds (results-str "") ;; seconds string (sign "") ;; signe (aresult 0.0) ;; absolute value (resultd 0) (resultd-str "") (resultmi 0) (resultmi-str "") ) ;;(display-msg-symb-nl "BiglooCode.scm :: ResultatMesuresF ::" nombreobjets ) ;; je sais pas pourquoi cette macro fais planter bigloo ici mais pas dans d'autres situations (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: nombreobjets = " nombreobjets ) ;;(eu.oca.bigloofunct.JavaForBigloo-bstringTojstring '()) ;;"hello boy") (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: bstr_identificateur = " bstr_identificateur) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: bstr_objet = " bstr_objet) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: len_identificateur = " len_bstr_identificateur) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: (string? bstr_identificateur) = " (string? bstr_identificateur)) ;;(eu.oca.bigloofunct.JavaForBigloo-bstring->jstring "hello boy") (set! res (string-append "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\"> <html> <head> <meta http-equiv=\"Content-Type\" content=\"text/html; charset=" char-set "\"> <meta name=\"GENERATOR\" content=\"Microsoft FrontPage 5.0\"> <title>SIDONIe-Résultats : identifications et mesures</title> </head> <LINK rel=\"stylesheet\" href=\"../Style.css\" type=\"text/css\"> <body>")) ;;(set! identificateur ($bstring->string bstr_identificateur)) (set! identificateur bstr_identificateur) ;;(set! identificateur (string-append bstr_identificateur)) ;;(display-var-nl "BiglooCode.scm :: ResultatMesuresF :: (string-append \"\" bstr_identificateur) = " (string-append "" bstr_identificateur)) ;;(set! objet ($bstring->string bstr_objet)) ;;(set! choixres ($bstring->string bstr_choixres)) (set! choixres bstr_choixres) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: identificateur = " identificateur) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: (string? identificateur) = " (string? identificateur)) (display (string-append "TEST " identificateur)) (newline) (set! essai (string-append "TEST " identificateur)) (display essai) (newline) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: essai = " essai) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: identificateur = " identificateur) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: (string? essai) = " (string? essai)) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: (string=? identificateur \"\" ) = " (string=? identificateur "")) ;; database driver search (newline) (if dyna (begin (eu.oca.DataBase-searchDriverDynamic db) (eu.oca.DataBase-connectDynamic db) ;;(eu.oca.DataBase-connectDynamic db) ;; testing fool proof overconnections (eu.oca.DataBase-createStatementDynamic db) ;; i put the statement it if it's true it can be reused for multiple SQL queries ) (begin (eu.oca.DataBase-searchDriverStatic) (eu.oca.DataBase-connectStatic) ;;(eu.oca.DataBase-connectStatic) ;; testing fool proof overconnections (eu.oca.DataBase-createStatementStatic) ;; i put the statement here if it's true it can be reused for multiple SQL queries )) (newline) (when (string-null? identificateur) ;;(string=? identificateur "") ;;(when (equal? identificateur "") (set! flagerreur 1) (set! baraterreur (string-append baraterreur " Vous devez choisir un identificateur ! "))) (when (string-null? objet) (set! flagerreur 1) (set! baraterreur (string-append baraterreur " Vous devez spécifier un nom d'objet ! "))) (when (string-null? choixres) (set! flagerreur 1) (set! baraterreur (string-append baraterreur " Vous devez choisir un type d'information ! "))) (cond ((string=? identificateur "Nom") (set! monchoix (string-append " Coordonnées.Nom Like '" objet "'")) (when (= flagerreur 0) (set! flagnom 1) (set! requetexiste (string-append "SELECT DISTINCTROW Coordonnées.Nom FROM Coordonnées WHERE Coordonnées.Nom Like '" objet "'")) (set! jstr (eu.oca.bigloofunct.JavaForBigloo-bstring->jstring requetexiste)) (if dyna (begin (eu.oca.DataBase-executeQueryDynamic db jstr) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-getval db)") (eu.oca.DataBase-getval db) (display-nl "BiglooCode.scm :: ResultatMesuresF :: passed") (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-getresultSet db)") (eu.oca.DataBase-getresultSet db) (display-nl "BiglooCode.scm :: ResultatMesuresF :: passed") ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: (%jresultset-next (eu.oca.DataBase-getresultSet db))") ;; (%jresultset-next (eu.oca.DataBase-getresultSet db)) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (java.sql.ResultSet-next (eu.oca.DataBase-getresultSet db))") (java.sql.ResultSet-next (eu.oca.DataBase-getresultSet db)) (display-nl "BiglooCode.scm :: ResultatMesuresF :: passed") (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-val db)") (eu.oca.DataBase-val db) (display-nl "BiglooCode.scm :: ResultatMesuresF :: passed") (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-resultSet db)") (eu.oca.DataBase-resultSet db) (display-nl "BiglooCode.scm :: ResultatMesuresF :: passed") ;; (%jresultset-next (eu.oca.DataBase-resultSet db)) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: before let") ;; (let ((reset (eu.oca.DataBase-resultSet db))) ;; ;;(%jresultset-next reset) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: (%jresultset-last reset)") ;; (%jresultset-last reset) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: (set! nombreobjets (%jresultset-getRow reset))") ;; (set! nombreobjets (%jresultset-getRow reset)) ;; (display-msg-symb-nl "BiglooCode.scm :: ResultatMesuresF ::" nombreobjets ) ;; ) ;;(%jresultset-next (eu.oca.DataBase-resultSet db)) ) (begin (eu.oca.DataBase-executeQueryStatic jstr) ;; equiv requetexiste (display-nl "BiglooCode.scm :: ResultatMesuresF :: (java.sql.ResultSet-next eu.oca.DataBase-resultSet)") (java.sql.ResultSet-next eu.oca.DataBase-resultSet) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (java.sql.ResultSet-last eu.oca.DataBase-resultSet)") ;; this is for counting (java.sql.ResultSet-last eu.oca.DataBase-resultSet) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (set! objetexiste (java.sql.ResultSet-getRow eu.oca.DataBase-resultSet))") (set! objetexiste (java.sql.ResultSet-getRow eu.oca.DataBase-resultSet)) ;;(display-msg-symb-nl "BiglooCode.scm :: ResultatMesuresF ::" objetexiste ) ;; je sais pas pourquoi cette macro fais planter bigloo ici mais pas dans d'autres situations (symbol->string plante avec le front end java) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: objetexiste = " objetexiste ) ;;(display-nl "BiglooCode.scm :: ResultatMesuresF :: (%jresultset-next eu.oca.DataBase-resultSet)") ;;(%jresultset-next eu.oca.DataBase-resultSet) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: testing (symbol->string 'blabla) :") ;; (symbol->string 'blabla) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: test done") (java.sql.ResultSet-beforeFirst eu.oca.DataBase-resultSet) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: (set! nombreobjets (java.sql.ResultSet-beforeFirst eu.oca.DataBase-resultSet))") (display-nl "BiglooCode.scm :: ResultatMesuresF :: passed") ) ) ;; end if dyna ;;(display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-executeQueryStatic requeteuni)") ;;(eu.oca.DataBase-executeQueryStatic requeteuni) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-executeQueryStatic2args requeteuni2)") (eu.oca.DataBase-executeQueryStatic2args requeteuni 2) ;;(display-nl "BiglooCode.scm :: ResultatMesuresF :: (java.sql.ResultSet-last eu.oca.DataBase-resultSet)") ;;(java.sql.ResultSet-last eu.oca.DataBase-resultSet) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (java.sql.ResultSet-last rsuni)") (java.sql.ResultSet-last rsuni) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: (set! nombreobjets (java.sql.ResultSet-getRow eu.oca.DataBase-resultSet))") ;; (set! nombreobjets (java.sql.ResultSet-getRow eu.oca.DataBase-resultSet)) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (set! nombreobjets (java.sql.ResultSet-getRow rsuni))") (set! nombreobjets (java.sql.ResultSet-getRow rsuni)) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: nombreobjets = " nombreobjets ) ;;(java.sql.ResultSet-beforeFirst eu.oca.DataBase-resultSet) (java.sql.ResultSet-beforeFirst rsuni) (display-nl "BiglooCode.scm :: ResultatMesuresF :: passed-2") (when (> nombreobjets 1) (set! flaguni 1)) (when (and (= objetexiste 0) (= nombreobjets 1)) (set! flagexiste 1)) (when (and (= objetexiste 1) (>= nombreobjets 1)) (set! flagobjet 1)))) ((string=? identificateur "N° ADS") (set! monchoix (sql-server->mysql-server-syntax (string-append " Coordonnées.[N° ADS] Like '" objet "'")))) ((string=? identificateur "N° BD") (set! monchoix (sql-server->mysql-server-syntax (string-append " Coordonnées.[N° BD] Like '" objet "'")))) ((string=? identificateur "N° HIP") (set! monchoix (sql-server->mysql-server-syntax (string-append " Coordonnées.[N° HIP] Like '" objet "'")))) (else (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: UNSUPPORTED CASE with identificateur =" identificateur))) ;;(display-nl "BiglooCode.scm :: ResultatMesuresF :: forcing flagexiste = 1") ;;(set! flagexiste 1) ;;(display-nl "BiglooCode.scm :: ResultatMesuresF :: forcing flaguni = 1") ;;(set! flaguni 1) (if (or (= flagerreur 1) (= flaguni 1) (= flagexiste 1)) (begin (when (= flagerreur 1) (set! res (string-append res "<h1 align=\"center\"> <font color=\"#0000FF\">SIDONIe - Résultats : Identifications et mesures</font> </h1> <div align=\"center\"> <center> <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th width=\"80%\"> <font color=\"#0000FF\">" baraterreur "<br> </font> </th> </tr> </table> </center> </div>"))) (when (= flagexiste 1) (set! res (string-append res "<h1 align=\"center\"> <font color=\"#0000FF\">SIDONIe - Résultats : Identifications et mesures</font> </h1> <div align=\"center\"> <center> <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th width=\"80%\"> <font color=\"#0000FF\">" baratexiste "<br> </font> </th> </tr> </table> </center> </div> <P> <P> <table border=\"1\" cellpadding=\"0\" align=\"center\" cellspacing=\"0\" width=\"20%\" > <tr> <th><font color=\"#000080\" > Objets </font></th> </tr>")) (java.sql.ResultSet-first rsuni) (display-nl "BiglooCode.scm :: ResultatMesuresF :: before loop !") (letrec ((resultat "UN RESULTAT") (loop (lambda () (if (java.sql.ResultSet-isAfterLast rsuni) '() (let ((jresultat::java.lang.String #;(java.lang.String-java.lang.String8 "a result") (java.sql.ResultSet-getString2 rsuni 0)) (bstr_tmp '())) (display-nl "BiglooCode.scm :: ResultatMesuresF :: before (set! bstr_tmp (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresultat))") (set! bstr_tmp (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresultat)) (display-nl "BiglooCode.scm :: ResultatMesuresF :: before (set! resultat jresultat)") (set! resultat bstr_tmp) ;; a revoir quand utilise (convertir avec une procedure java en byte char puis scheme string je pense) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: resultat = " resultat) (when (string-null? resultat) (set! resultat " ")) (set! res (string-append res "<tr> <td>" (string-upcase resultat) " </td> </tr>")) (java.sql.ResultSet-next rsuni) (display-nl "BiglooCode.scm :: ResultatMesuresF :: looping !") (loop)))))) (loop)) ;; (let loop ((l '(1 2 3))) ;; (if (java.sql.ResultSet-isAfterLast rsuni) ;; '() ;; (begin ;; (set! res (string-append ;; res ;; " A ")) ;; (java.sql.ResultSet-next rsuni) ;; (loop)))) (set! res (string-append res "</table>")) ) ;; (when (= flagexiste 1) (when (= flaguni 1) (proc-barat baratuni rsuni)) (display-nl "BiglooCode.scm :: ResultatMesuresF :: before (when (and (= flagerreur 0) (= flagobjet 0) (= flagnom 1))") (when (and (= flagerreur 0) (= flagobjet 0) (= flagnom 1)) (set! rsexiste eu.oca.DataBase-resultSet) (java.sql.ResultSet-close rsexiste) ;;(set! rsexiste (class-nil rsexiste)) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: before (class-nil rsexiste)") ;; (class-nil rsexiste) ;; au cas marche pas utiliser la fonction java setResultSetNull (display-nl "BiglooCode.scm :: ResultatMesuresF :: before (eu.oca.DataBase-setResultSetNull)") (eu.oca.DataBase-setResultSetNull) ;; (java.sql.ResultSet-close rsuni) ;; (class-nil rsuni) (display-nl "BiglooCode.scm :: ResultatMesuresF :: before (eu.oca.DataBase-setResultSet2Null)") (eu.oca.DataBase-setResultSet2Null) ) ) ;; begin ;; else du (if (or (= flagerreur 1) (= flaguni 1) (= flagexiste 1)) (begin (when (= flagobjet 1) (proc-barat baratobjet rsuni)) (when (= flagnom 1) (set! rsexiste eu.oca.DataBase-resultSet) (java.sql.ResultSet-close rsexiste) ;;(display-nl "BiglooCode.scm :: ResultatMesuresF :: before (set! rsexiste (class-nil rsexiste))") ;;(set! rsexiste (class-nil rsexiste)) ;;(display-nl "BiglooCode.scm :: ResultatMesuresF :: before (class-nil rsexiste)") ;;(class-nil rsexiste) ;; au cas marche pas utiliser la fonction java setResultSetNull (display-nl "BiglooCode.scm :: ResultatMesuresF :: before (eu.oca.DataBase-setResultSetNull)") (eu.oca.DataBase-setResultSetNull) ;; (java.sql.ResultSet-close rsuni) ;; (class-nil rsuni) (display-nl "BiglooCode.scm :: ResultatMesuresF :: before (eu.oca.DataBase-setResultSet2Null)") (eu.oca.DataBase-setResultSet2Null)) (display-nl "BiglooCode.scm :: ResultatMesuresF :: choixres =") (display choixres) (newline) ;; un COND assez gros ..... correspond au case du code ASP (cond ((string=? choixres "Ident") (display-nl "BiglooCode.scm :: ResultatMesuresF :: (cond : Ident") (set! marequete (string-append marequete monchoix monordremes)) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-executeQueryStaticStringString ;; (java.lang.String-java.lang.String8 marequete) ;; (java.lang.String-java.lang.String8 \"Requete\")))") ;; (eu.oca.DataBase-executeQueryStaticStringString ;; (java.lang.String-java.lang.String8 marequete) ;; (java.lang.String-java.lang.String8 "Requete")) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-executeQueryStatic (java.lang.String-java.lang.String8 marequete))") (eu.oca.DataBase-executeQueryStatic (java.lang.String-java.lang.String8 marequete)) (java.sql.ResultSet-first rs) (set! res (string-append res "<h1 align=\"center\"><font color=\"#0000FF\"> SIDONIe - Identifications et mesures </font></h1>")) (set! jresult (java.sql.ResultSet-getString2 rs 1)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result = " result)) (display "BiglooCode.scm :: ResultatMesuresF : = (java.sql.ResultSet-wasNull rs) 1 :") (display (java.sql.ResultSet-wasNull rs)) (newline) ;; TODO verifier que en cas de result set null ca plante pas (comportement different en ASP de rs que en java) cd cas orbite qui est ok (when (and (string-null? result) (string=? identificateur "Nom")) (set! baratin "Cet objet n'existe pas dans la base ou est mal orthographié !") (set! flagerreur 1)) (set! bs-result (eu.oca.bigloofunct.JavaForBigloo-jdouble->bstring (eu.oca.bigloofunct.JavaForBigloo-pi2dec))) (display "BiglooCode.scm :: ResultatMesuresF : bs-result = ") (display bs-result) (newline) (set! bs-result (eu.oca.bigloofunct.JavaForBigloo-jdouble->bstring (java.sql.ResultSet-getDouble2 rs 3))) (display "BiglooCode.scm :: ResultatMesuresF : bs-result =") (display bs-result) (display "|") (newline) (display "BiglooCode.scm :: ResultatMesuresF : = (java.sql.ResultSet-wasNull rs) 3 :") (display (java.sql.ResultSet-wasNull rs)) (newline) ;; (set! len-bs-result (byte*-length bs-result)) ;; (display-var-nl "BiglooCode.scm :: ResultatMesuresF : len-bs-result = " len-bs-result) ;; (set! bs-result (make-string len-bs-result)) ;; (set! bs-result (eu.oca.bigloofunct.JavaForBigloo-jdouble->bstring (java.sql.ResultSet-getDouble2 rs 3))) ;; (display "BiglooCode.scm :: ResultatMesuresF : bs-result = ") ;; (display bs-result) ;; (newline) (display-nl "BiglooCode.scm :: ResultatMesuresF : before (set! result-double .....)") ;;(set! result-double (java.sql.ResultSet-getDouble2 rs 3)) (set! result-double (eu.oca.bigloofunct.JavaForBigloo-pi2dec)) ;; (set! result-double (eu.oca.bigloofunct.JavaForBigloo-piFloat)) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF : before (set! result2 .......)") ;; (set! result2 (+fl result-double 0.0)) ;; (display "BiglooCode.scm :: ResultatMesuresF : result2 = ") ;; (display result2) ;; (newline) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF : before display") (display "BiglooCode.scm :: ResultatMesuresF : result-double = ") ;;(display result-double) ;;(printf "~a" result-double) ;;(printf "~s" result-double) (display (double->ieee-string result-double)) (newline) ;;(display (real->string result-double)) ;;(newline) ;;(display-nl "BiglooCode.scm :: ResultatMesuresF : before display-var-nl") ;;(display-var-nl "BiglooCode.scm :: ResultatMesuresF : result-double = " result-double) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: (string? bs-result) = " (string? bs-result)) ;; (display "BiglooCode.scm :: ResultatMesuresF : (display (string->real bs-result)) =") ;; (newline) ;; (display (string->number (string-append " " bs-result))) ;; (newline) (set! result-double (string->real bs-result)) (set! str-result bs-result) (let* ((sp (string-split str-result ".")) (irss (car sp)) (frss (cadr sp)) (irs (string->number irss)) (frs (string->number frss)) (len-frss (string-length frss)) (expo (expt 10 len-frss)) (frc-rs (/ frs expo)) (rsf (+ irs frc-rs)) ) (display-var-nl "BiglooCode.scm :: ResultatMesuresF : irss = " irss) (display-var-nl "BiglooCode.scm :: ResultatMesuresF : frss = " frss) (display-var-nl "BiglooCode.scm :: ResultatMesuresF : irs = " irs) (display-var-nl "BiglooCode.scm :: ResultatMesuresF : frs = " frs) ;;(display-var-nl "BiglooCode.scm :: ResultatMesuresF : rsf = " rsf) (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL rsf) ) (display "BiglooCode.scm :: ResultatMesuresF : (real? result-double) =") (display (real? result-double)) (newline) (set! result2 result-double) ;;(set! str-result (real->string result2)) ;;(+ result-double 1) ;;(display result2) ;;(real->string result2) (when (and (java.sql.ResultSet-wasNull rs) (string=? identificateur "N° BD")) (set! baratin "Cet objet n'existe pas dans la base ou son N° BD est mal orthographié !") (set! flagerreur 1)) (set! jresult (java.sql.ResultSet-getString2 rs 3)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 3 = " result)) (when (and (string-null? result) (string=? identificateur "N° BD")) (set! baratin "Cet objet n'existe pas dans la base ou son N° BD est mal orthographié !") (set! flagerreur 1)) (set! bs-result (eu.oca.bigloofunct.JavaForBigloo-jdouble->bstring (java.sql.ResultSet-getDouble2 rs 4))) (display "BiglooCode.scm :: ResultatMesuresF : bs-result 4 =") (display bs-result) (display "|") (newline) (display "BiglooCode.scm :: ResultatMesuresF : = (java.sql.ResultSet-wasNull rs) 4 :") (display (java.sql.ResultSet-wasNull rs)) (newline) (when (and (java.sql.ResultSet-wasNull rs) (string=? identificateur "N° ADS")) (set! baratin "Cet objet n'existe pas dans la base ou son N° ADS est mal orthographié !") (set! flagerreur 1)) (set! jresult (java.sql.ResultSet-getString2 rs 4)) (when (not (java.sql.ResultSet-wasNull rs)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 4 = " result)) (when (and (string-null? result) (string=? identificateur "N° ADS")) (set! baratin "Cet objet n'existe pas dans la base ou son N° ADS est mal orthographié !") (set! flagerreur 1))) ;; (set! bs-result (eu.oca.bigloofunct.JavaForBigloo-jdouble->bstring (java.sql.ResultSet-getDouble2 rs 9))) ;; (display "BiglooCode.scm :: ResultatMesuresF : bs-result 9 =") ;; (display bs-result) ;; (display "|") ;; (newline) (set! jresult (java.sql.ResultSet-getString2 rs 10)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 10 = " result)) (display "BiglooCode.scm :: ResultatMesuresF : = (java.sql.ResultSet-wasNull rs) 10 :") (display (java.sql.ResultSet-wasNull rs)) (newline) (when (and (java.sql.ResultSet-wasNull rs) (string=? identificateur "N° HIP")) (set! baratin "Cet objet n'existe pas dans la base ou son N° HIP est mal orthographié !") (set! flagerreur 1)) (when (and (string-null? result) (string=? identificateur "N° HIP")) (set! baratin "Cet objet n'existe pas dans la base ou son N° HIP est mal orthographié !") (set! flagerreur 1)) (if (equal? flagerreur 1) (set! res (string-append res "<div align=\"center\"> <center> <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th width=\"82%\"> <font color=\"#0000FF\">" baratin "<br> </font> </th> </tr> </table> </center> </div> <P> <P>")) (begin ;; else du if (set! res (string-append res "<div align=\"center\"> <center> <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th> <font color=\"#0000FF\"> Objet <br></font>" (field-result-set rs 1) "</th>" "<td align=\"center\"><font color=\"#0000FF\"> N° BD<br></font>" (field-result-set-lowercase rs 3) "</td>" "<td align=\"center\"><font color=\"#0000FF\"> N° ADS<br></font>" (field-result-set-lowercase rs 4) "</td>" "<td align=\"center\"><font color=\"#0000FF\"> N° HIP<br></font>" (field-result-set-lowercase-check-star rs 10) "</td>" "<td align=\"center\"><font color=\"#0000FF\"> Type Spectral<br></font>" (field-result-set-lowercase-check-minus rs 9) "</td> </tr> <tr> <td align=\"center\"><font color=\"#0000FF\"> Alpha 2000<br>" (begin (set! result-double (java.sql.ResultSet-getDouble2 rs 5)) ;; (display "BiglooCode.scm :: ResultatMesuresF : result-double =") ;; (display result-double) ;; (newline) (if (java.sql.ResultSet-wasNull rs) (set! result " ") (begin ;; else (set! iresult (floor result-double)) (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL iresult) = ") (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL iresult) ;; (display "BiglooCode.scm :: ResultatMesuresF : iresult =") ;; (display iresult) ;; (newline) (set! resulth (fix (/ iresult 1000))) (display "BiglooCode.scm :: ResultatMesuresF : (integer? resulth) =") (display (integer? resulth)) (newline) (display "BiglooCode.scm :: ResultatMesuresF : (bignum? resulth) =") (display (bignum? resulth)) (newline) ;; (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayInt resulth) =") ;; (newline) ;; (eu.oca.bigloofunct.JavaForBigloo-displayInt resulth) ;; (newline) (display "BiglooCode.scm :: ResultatMesuresF : resulth 1 =") (display resulth) (newline) (display-nl "BiglooCode.scm :: ResultatMesuresF : before change code 1") (set! resulth-str #;"result will be here" #;(number->string resulth) (num->string resulth)) (display-nl "BiglooCode.scm :: ResultatMesuresF : after change code 1") (set! resultm (- iresult (* resulth 1000))) (set! resultm (fix (/ resultm 10))) (display "BiglooCode.scm :: ResultatMesuresF : (integer? resultm) =") (display (integer? resultm)) (newline) (display "BiglooCode.scm :: ResultatMesuresF : (bignum? resultm) =") (display (bignum? resultm)) (newline) (display "BiglooCode.scm :: ResultatMesuresF : resultm =") (display resultm) (newline) (set! resultm-str (num->string resultm)) (display "BiglooCode.scm :: ResultatMesuresF : resultm-str =") (display resultm-str) (newline) (set! results (- iresult (* resulth 1000) (* resultm 10))) (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL results) = ") (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL results) ;; (display "BiglooCode.scm :: ResultatMesuresF : results =") ;; (display results) ;; (newline) (set! results-str (num->string (fix results))) (display "BiglooCode.scm :: ResultatMesuresF : results-str =") (display results-str) (newline) (when (< resulth 1) (set! resulth-str "00")) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (< resulth 1)") (when (and (>= resulth 1) (< resulth 10)) (set! resulth-str (string-append "0" resulth-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (and (>= resulth 1) (< resulth 10)") (when (< resultm 10) (set! resultm-str (string-append "0" resultm-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (< resultm 10)") (set! result (string-append resulth-str " h " resultm-str "." results-str " mn")))) (string-append "</font>" result "</td>")) ;; end begin "<td align=\"center\"><font color=\"#0000FF\"> Delta 2000<br>" (begin (set! result-double (java.sql.ResultSet-getDouble2 rs 6)) ;; (set! result2 result-double) ;; (display "BiglooCode.scm :: ResultatMesuresF : result2 =") ;; (newline) ;; (display (real->string result2)) ;; (newline) (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL result-double) = ") (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL result-double) (if (java.sql.ResultSet-wasNull rs) " " (begin ;; else (if (< result-double 0) (set! sign "-") (set! sign " ")) (set! aresult (abs result-double)) (set! resultd (fix (/ aresult 100))) (set! resultd-str (num->string resultd)) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! resultd-str (num->string resultd))") (set! resultmi (- aresult (* resultd 100))) (set! resultmi-str (num->string (fix resultmi))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! resultmi-str (num->string (fix resultmi)))") (when (< resultd 1) (set! resultd-str "00")) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! resultd-str \"00\")") (when (and (>= resultd 1) (< resultd 10)) (set! resultd-str (string-append "0" resultd-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (when (and (>= resultd 1) (< resultd 10)) ......") (when (< resultmi 10) (set! resultmi-str (string-append "0" resultmi-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (when (< resultmi 10) .....") (set! result (string-append sign resultd-str " ° " resultmi-str " '")) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! result (string-append sign resultd-str ....") (display "BiglooCode.scm :: ResultatMesuresF : result =") (display result) (newline) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed display") ) ;; end begin else ) ;; end if (java.sql.ResultSet-wasNull rs) (string-append "</font>" result "</td>")) ;; end begin "<td align=\"center\"><font color=\"#0000FF\"> mag 1<br>" (begin (set! jresult (java.sql.ResultSet-getString2 rs 7)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 7 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "00.") (set! result " ")) (string-append "</font>" result "</td>")) "<td align=\"center\"><font color=\"#0000FF\"> mag 2<br>" (begin (set! jresult (java.sql.ResultSet-getString2 rs 8)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 8 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "00.") (set! result " ")) (string-append "</font>" result "</td>")) "<td align=\"center\"><font color=\"#0000FF\"> Orbite calculée ?<br>" (begin (set! jresult (java.sql.ResultSet-getString2 rs 11)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 11 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "*") (set! result "NON")) (string-append "</font>" result "</td>")) "</tr> </table> </center> </div>" ) ;; end de string-append , bizarre emacs le voit pas ) ;; end (set! res ... (set! res (string-append res "<P> <P> <table border=\"1\" cellpadding=\"0\" cellspacing=\"0\" width=\"100%\"> <tr> <th><font color=\"#000080\"> Date </font></th> <th><font color=\"#000080\"> Angle </font></th> <th><font color=\"#000080\"> Sépar. </font></th> <th><font color=\"#000080\"> Nuits </font></th> <th><font color=\"#000080\"> Code </font></th> <th><font color=\"#000080\"> Instr. </font></th> <th><font color=\"#000080\"> Dim. </font></th> <th><font color=\"#000080\"> Réf. </font></th> <th><font color=\"#000080\"> Notes </font></th> </tr>")) ;; (let loop ((l '(1 2 3))) ;; (if (java.sql.ResultSet-isAfterLast rsuni) ;; '() ;; (begin ;; (set! res (string-append ;; res ;; " A ")) ;; (java.sql.ResultSet-next rsuni) ;; (loop)))) (java.sql.ResultSet-first rs) ;; rs.movefirst (let loop ((end-flag (java.sql.ResultSet-isAfterLast rs))) (when (not end-flag) ;; not rs.eof (set! res (string-append res "<tr>")) (set! jresult (java.sql.ResultSet-getString2 rs 12)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 12 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 13)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 13 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 14)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 14 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! result (number->string (java.sql.ResultSet-getInt2 rs 15))) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 15 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 16)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 16 = " result)) (if (java.sql.ResultSet-wasNull rs) (set! result " ") (set! result (string-upcase result))) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 18)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 18 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "t") (set! result (string-upcase result))) (when (string=? result "l") (set! result (string-upcase result))) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 17)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 17 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 19)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 19 = " result)) (if (java.sql.ResultSet-wasNull rs) (set! result " ") (set! result (string-upcase result))) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 20)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 20 = " result)) (when (or (java.sql.ResultSet-wasNull rs) (string-null? result)) (set! result " ")) (set! res (string-append res "<td>" result " </td></tr>")) (java.sql.ResultSet-next rs) ;; rs.Movenext (loop (java.sql.ResultSet-isAfterLast rs)))) ;; Loop (set! res (string-append res "</table>")) ) ;; end (begin ... du else du if ) ;; end (if (equal? flagerreur 1) ..... else begin ... ) ;; fin cas dans COND : ((string=? choixres "Ident") ((string=? choixres "Orbite") (display-nl "BiglooCode.scm :: ResultatMesuresF :: (cond : Orbite") (set! sqlorbite (string-append sqlorbite monchoix monordreorb)) ;; (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-executeQueryStaticStringString ;; (java.lang.String-java.lang.String8 sqlorbite) ;; (java.lang.String-java.lang.String8 \"Orbite\")))") ;; (eu.oca.DataBase-executeQueryStaticStringString ;; (java.lang.String-java.lang.String8 sqlorbite) ;; (java.lang.String-java.lang.String8 "Orbite")) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-executeQueryStatic (java.lang.String-java.lang.String8 sqlorbite))") (eu.oca.DataBase-executeQueryStatic (java.lang.String-java.lang.String8 sqlorbite)) (set! res (string-append res "<h1 align=\"center\"><font color=\"#0000FF\"> SIDONIe - Paramètres des orbites</font></h1>")) (display "BiglooCode.scm :: ResultatMesuresF : = (java.sql.ResultSet-wasNull rs):") (display (java.sql.ResultSet-wasNull rs)) (newline) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur = " (number->string flagerreur))) (if (not (java.sql.ResultSet-first rs)) (begin ;; empty result set (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : empty result set")) (set! baratin "Cet objet n'a pas d'orbite calculée !") (set! flagerreur 1)) (begin (set! jresult (java.sql.ResultSet-getString2 rs 1)) (display-wasnull rs) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 1 = " result)) (when (and (string-null? result) (string=? identificateur "Nom")) (set! baratin "Cet objet n'a pas d'orbite calculée !") (set! flagerreur 1)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur 1 = " (number->string flagerreur))) (set! jresult (java.sql.ResultSet-getString2 rs 3)) (display-wasnull rs) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 3 = " result)) (when (and (string-null? result) (string=? identificateur "N° BD")) (set! baratin "Cet objet n'a pas d'orbite calculée !") (set! flagerreur 1)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur 3 = " (number->string flagerreur))) (set! jresult (java.sql.ResultSet-getString2 rs 4)) (display-wasnull rs) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 4 = " result)) (when (and (string-null? result) (string=? identificateur "N° ADS")) (set! baratin "Cet objet n'a pas d'orbite calculée !") (set! flagerreur 1)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur 4 = " (number->string flagerreur))) (set! jresult (java.sql.ResultSet-getString2 rs 10)) (display-wasnull rs) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 10 = " result)) (when (and (string-null? result) (string=? identificateur "N° HIP")) (set! baratin "Cet objet n'a pas d'orbite calculée !") (set! flagerreur 1)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur 10 = " (number->string flagerreur))) (set! jresult (java.sql.ResultSet-getString2 rs 11)) (display-wasnull rs) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 11 Orb = " result)) (when (java.sql.ResultSet-wasNull rs) (set! baratin "Cet objet n'a pas d'orbite calculée !") (set! flagerreur 1)) ) ;; fin begin du else ) ;; fin (if (not (java.sql.ResultSet-first rs)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur 11 = " (number->string flagerreur))) (if (equal? flagerreur 1) (set! res (string-append res "<div align=\"center\"> <center> <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th width=\"82%\"> <font color=\"#0000FF\">" baratin "<br> </font> </th> </tr> </table> </center> </div> <P> <P>")) (begin ;; else du if (set! res (string-append res "<div align=\"center\"> <center> <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th> <font color=\"#0000FF\"> Objet <br></font>" (field-result-set rs 1) "</th>" "<td align=\"center\"><font color=\"#0000FF\"> N° BD<br></font>" (field-result-set-lowercase rs 3) "</td>" "<td align=\"center\"><font color=\"#0000FF\"> N° ADS<br></font>" (field-result-set-lowercase rs 4) "</td>" "<td align=\"center\"><font color=\"#0000FF\"> N° HIP<br></font>" (field-result-set-lowercase-check-star rs 10) "</td>" "<td align=\"center\"><font color=\"#0000FF\"> Type Spectral<br></font>" (field-result-set-lowercase-check-minus rs 9) "</td> </tr> <tr> <td align=\"center\"><font color=\"#0000FF\"> Alpha 2000<br>" (begin (set! result-double (java.sql.ResultSet-getDouble2 rs 5)) ;; (display "BiglooCode.scm :: ResultatMesuresF : result-double =") ;; (display result-double) ;; (newline) (if (java.sql.ResultSet-wasNull rs) (set! result " ") (begin ;; else (set! iresult (floor result-double)) (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL iresult) = ") (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL iresult) ;; (display "BiglooCode.scm :: ResultatMesuresF : iresult =") ;; (display iresult) ;; (newline) (set! resulth (fix (/ iresult 1000))) (display "BiglooCode.scm :: ResultatMesuresF : (integer? resulth) 2 =") (display (integer? resulth)) (newline) (display "BiglooCode.scm :: ResultatMesuresF : (bignum? resulth) 2 =") (display (bignum? resulth)) (newline) ;; (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayInt resulth) =") ;; (newline) ;; (eu.oca.bigloofunct.JavaForBigloo-displayInt resulth) ;; (newline) ;; (let ((bt1 16) ;; (bt2 0)) ;; (display-expr-nl (bignum? bt1)) ;; (display-msg-var-nl "bt1 =" bt1) ;; (newline) ;; (display-expr-nl (bignum? bt2)) ;; (display-msg-var-nl "bt1 =" bt2)) (display "BiglooCode.scm :: ResultatMesuresF : resulth 2 =") (display resulth) (newline) (set! resulth-str #;"result will be here" #;(number->string resulth) (num->string resulth)) (set! resultm (- iresult (* resulth 1000))) (set! resultm (fix (/ resultm 10))) (display "BiglooCode.scm :: ResultatMesuresF : (integer? resultm) =") (display (integer? resultm)) (newline) (display "BiglooCode.scm :: ResultatMesuresF : (bignum? resultm) =") (display (bignum? resultm)) (newline) (display "BiglooCode.scm :: ResultatMesuresF : resultm =") (display resultm) (newline) (set! resultm-str (num->string resultm)) (display "BiglooCode.scm :: ResultatMesuresF : resultm-str =") (display resultm-str) (newline) (set! results (- iresult (* resulth 1000) (* resultm 10))) (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL results) = ") (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL results) ;; (display "BiglooCode.scm :: ResultatMesuresF : results =") ;; (display results) ;; (newline) (set! results-str (num->string (fix results))) (display "BiglooCode.scm :: ResultatMesuresF : results-str =") (display results-str) (newline) (when (< resulth 1) (set! resulth-str "00")) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (< resulth 1)") (when (and (>= resulth 1) (< resulth 10)) (set! resulth-str (string-append "0" resulth-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (and (>= resulth 1) (< resulth 10)") (when (< resultm 10) (set! resultm-str (string-append "0" resultm-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (< resultm 10)") (set! result (string-append resulth-str " h " resultm-str "." results-str " mn")))) (string-append "</font>" result "</td>")) ;; end begin "<td align=\"center\"><font color=\"#0000FF\"> Delta 2000<br>" (begin (set! result-double (java.sql.ResultSet-getDouble2 rs 6)) ;; (set! result2 result-double) ;; (display "BiglooCode.scm :: ResultatMesuresF : result2 =") ;; (newline) ;; (display (real->string result2)) ;; (newline) (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL result-double) = ") (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL result-double) (if (java.sql.ResultSet-wasNull rs) " " (begin ;; else (if (< result-double 0) (set! sign "-") (set! sign " ")) (set! aresult (abs result-double)) (set! resultd (fix (/ aresult 100))) (set! resultd-str (num->string resultd)) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! resultd-str (num->string resultd))") (set! resultmi (- aresult (* resultd 100))) (set! resultmi-str (num->string (fix resultmi))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! resultmi-str (num->string (fix resultmi)))") (when (< resultd 1) (set! resultd-str "00")) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! resultd-str \"00\")") (when (and (>= resultd 1) (< resultd 10)) (set! resultd-str (string-append "0" resultd-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (when (and (>= resultd 1) (< resultd 10)) ......") (when (< resultmi 10) (set! resultmi-str (string-append "0" resultmi-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (when (< resultmi 10) .....") (set! result (string-append sign resultd-str " ° " resultmi-str " '")) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! result (string-append sign resultd-str ....") (display "BiglooCode.scm :: ResultatMesuresF : result =") (display result) (newline) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed display") ) ;; end begin else ) ;; end if (java.sql.ResultSet-wasNull rs) (string-append "</font>" result "</td>")) ;; end begin "<td align=\"center\"><font color=\"#0000FF\"> mag 1<br>" (begin (set! jresult (java.sql.ResultSet-getString2 rs 7)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 7 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "0") (set! result " ")) (string-append "</font>" result "</td>")) "<td align=\"center\"><font color=\"#0000FF\"> mag 2<br>" (begin (set! jresult (java.sql.ResultSet-getString2 rs 8)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 8 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "0") (set! result " ")) (string-append "</font>" result "</td>")) "<td align=\"center\"><font color=\"#0000FF\"> Orbite calculée ?<br>" (begin (set! jresult (java.sql.ResultSet-getString2 rs 11)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 11 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "*") (set! result "NON")) (string-append "</font>" result "</td>")) "</tr> </table> </center> </div>" ;; vaut mieux pas continuer la (syntaxe lourde) ) ;; close string-append ) ;; close set! res ;; continuer ici (set! res (string-append res "<P> <P> <table border=\"1\" cellpadding=\"0\" cellspacing=\"0\" width=\100%\> <tr> <th><font color=\#000080\> Auteur</font></th> <th><font color=\#000080\> Année</font></th> <th><font color=\#000080\> Réf.</font></th> <th><font color=\#000080\> P</font></th> <th><font color=\#000080\> n</font></th> <th><font color=\#000080\> T</font></th> <th><font color=\#000080\> a</font></th> <th><font color=\#000080\> e</font></th> <th><font color=\#000080\> i</font></th> <th><font color=\#000080\> o</font></th> <th><font color=\#000080\> w</font></th> <th><font color=\#000080\> Notes</font></th> </tr>")) (java.sql.ResultSet-first rs) ;; rs.movefirst (while (not (java.sql.ResultSet-isAfterLast rs)) (set! res (string-append res "<tr>")) (set! jresult (java.sql.ResultSet-getString2 rs 12)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 12 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" (string-upcase result) " </td>")) (set! result (number->string (java.sql.ResultSet-getInt2 rs 13))) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 13 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 14)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 14 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 15)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 15 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 16)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 16 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 17)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 17 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 18)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 18 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 20)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 20 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 21)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 21 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 22)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 22 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 23)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 23 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 19)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 19 orbit = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td> </tr>")) (java.sql.ResultSet-next rs) ;; rs.Movenext ) ;; end while (set! res (string-append res "</table>")) ) ;; end begin else du if flagerreur 1 ) ;; close if flagerreur 1 ) ;; fin cas dans COND : ((string=? choixres "Orbite") ((string=? choixres "Ref") (display-nl "BiglooCode.scm :: ResultatMesuresF :: (cond : Ref") (set! sqlrefere (string-append sqlrefere-begin monchoix sqlrefere-end monordreref)) (display-nl "BiglooCode.scm :: ResultatMesuresF :: (eu.oca.DataBase-executeQueryStatic (java.lang.String-java.lang.String8 sqlrefere))") (eu.oca.DataBase-executeQueryStatic (java.lang.String-java.lang.String8 sqlrefere)) (set! res (string-append res "<h1 align=\"center\"><font color=\"#0000FF\"> SIDONIe - Références</font></h1>")) (display "BiglooCode.scm :: ResultatMesuresF : = (java.sql.ResultSet-wasNull rs):") (display (java.sql.ResultSet-wasNull rs)) (newline) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur = " (number->string flagerreur))) (if (not (java.sql.ResultSet-first rs)) (begin ;; empty result set (set! baratin "Il n'existe pas de références pour cet objet !") (set! flagerreur 1)) (begin (set! jresult (java.sql.ResultSet-getString2 rs 1)) (display-wasnull rs) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 1 = " result)) (when (and (string-null? result) (string=? identificateur "Nom")) (set! baratin "Il n'existe pas de références pour cet objet !") (set! flagerreur 1)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur 1 = " (number->string flagerreur))) (set! jresult (java.sql.ResultSet-getString2 rs 3)) (display-wasnull rs) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 3 = " result)) (when (and (string-null? result) (string=? identificateur "N° BD")) (set! baratin "Il n'existe pas de références pour cet objet !") (set! flagerreur 1)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur 3 = " (number->string flagerreur))) (set! jresult (java.sql.ResultSet-getString2 rs 4)) (display-wasnull rs) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 4 = " result)) (when (and (string-null? result) (string=? identificateur "N° ADS")) (set! baratin "Il n'existe pas de références pour cet objet !") (set! flagerreur 1)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur 4 = " (number->string flagerreur))) (set! jresult (java.sql.ResultSet-getString2 rs 10)) (display-wasnull rs) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 10 = " result)) (when (and (string-null? result) (string=? identificateur "N° HIP")) (set! baratin "Il n'existe pas de références pour cet objet !") (set! flagerreur 1)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : flagerreur 10 = " (number->string flagerreur))) ) ;; fin begin du else ) ;; fin (if (not (java.sql.ResultSet-first rs)) (if (equal? flagerreur 1) (set! res (string-append res "<div align=\"center\"> <center> <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th width=\"82%\"> <font color=\"#0000FF\">" baratin "<br> </font> </th> </tr> </table> </center> </div> <P> <P>")) (begin ;; else du if (set! res (string-append res "<div align=\"center\"> <center> <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th> <font color=\"#0000FF\"> Objet <br></font>" (field-result-set rs 1) "</th>" "<td align=\"center\"><font color=\"#0000FF\"> N° BD<br></font>" (field-result-set-lowercase rs 3) "</td>" "<td align=\"center\"><font color=\"#0000FF\"> N° ADS<br></font>" (field-result-set-lowercase rs 4) "</td>" "<td align=\"center\"><font color=\"#0000FF\"> N° HIP<br></font>" (field-result-set-lowercase-check-star rs 10) "</td>" "<td align=\"center\"><font color=\"#0000FF\"> Type Spectral<br></font>" (field-result-set-lowercase-check-minus rs 9) "</td> </tr> <tr> <td align=\"center\"><font color=\"#0000FF\"> Alpha 2000<br>" (begin (set! result-double (java.sql.ResultSet-getDouble2 rs 5)) ;; (display "BiglooCode.scm :: ResultatMesuresF : result-double =") ;; (display result-double) ;; (newline) (if (java.sql.ResultSet-wasNull rs) (set! result " ") (begin ;; else (set! iresult (floor result-double)) (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL iresult) = ") (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL iresult) ;; (display "BiglooCode.scm :: ResultatMesuresF : iresult =") ;; (display iresult) ;; (newline) (set! resulth (fix (/ iresult 1000))) (display "BiglooCode.scm :: ResultatMesuresF : coucou (integer? resulth) =") (display (integer? resulth)) (newline) (display "BiglooCode.scm :: ResultatMesuresF : (bignum? resulth) =") (display (bignum? resulth)) (newline) ;; (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayInt resulth) =") ;; (newline) ;; (eu.oca.bigloofunct.JavaForBigloo-displayInt resulth) ;; (newline) (display-nl "BiglooCode.scm :: ResultatMesuresF : INTRO") (display "BiglooCode.scm :: ResultatMesuresF : resulth 3 =") (display resulth) (newline) (display "BiglooCode.scm :: ResultatMesuresF : before code change") (newline) (set! resulth-str #;"result will be here" #;(number->string resulth) (num->string resulth)) (display-nl "BiglooCode.scm :: ResultatMesuresF : after code change") (set! resultm (- iresult (* resulth 1000))) (set! resultm (fix (/ resultm 10))) (display "BiglooCode.scm :: ResultatMesuresF : (integer? resultm) =") (display (integer? resultm)) (newline) (display "BiglooCode.scm :: ResultatMesuresF : (bignum? resultm) =") (display (bignum? resultm)) (newline) (display "BiglooCode.scm :: ResultatMesuresF : resultm =") (display resultm) (newline) (set! resultm-str (num->string resultm)) (display "BiglooCode.scm :: ResultatMesuresF : resultm-str =") (display resultm-str) (newline) (set! results (- iresult (* resulth 1000) (* resultm 10))) (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL results) = ") (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL results) ;; (display "BiglooCode.scm :: ResultatMesuresF : results =") ;; (display results) ;; (newline) (set! results-str (num->string (fix results))) (display "BiglooCode.scm :: ResultatMesuresF : results-str =") (display results-str) (newline) (when (< resulth 1) (set! resulth-str "00")) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (< resulth 1)") (when (and (>= resulth 1) (< resulth 10)) (set! resulth-str (string-append "0" resulth-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (and (>= resulth 1) (< resulth 10)") (when (< resultm 10) (set! resultm-str (string-append "0" resultm-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (< resultm 10)") (set! result (string-append resulth-str " h " resultm-str "." results-str " mn")))) (string-append "</font>" result "</td>")) ;; end begin "<td align=\"center\"><font color=\"#0000FF\"> Delta 2000<br>" (begin (set! result-double (java.sql.ResultSet-getDouble2 rs 6)) ;; (set! result2 result-double) ;; (display "BiglooCode.scm :: ResultatMesuresF : result2 =") ;; (newline) ;; (display (real->string result2)) ;; (newline) (display "BiglooCode.scm :: ResultatMesuresF : (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL result-double) = ") (eu.oca.bigloofunct.JavaForBigloo-displayDoubleNL result-double) (if (java.sql.ResultSet-wasNull rs) " " (begin ;; else (if (< result-double 0) (set! sign "-") (set! sign " ")) (set! aresult (abs result-double)) (set! resultd (fix (/ aresult 100))) (set! resultd-str (num->string resultd)) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! resultd-str (num->string resultd))") (set! resultmi (- aresult (* resultd 100))) (set! resultmi-str (num->string (fix resultmi))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! resultmi-str (num->string (fix resultmi)))") (when (< resultd 1) (set! resultd-str "00")) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! resultd-str \"00\")") (when (and (>= resultd 1) (< resultd 10)) (set! resultd-str (string-append "0" resultd-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (when (and (>= resultd 1) (< resultd 10)) ......") (when (< resultmi 10) (set! resultmi-str (string-append "0" resultmi-str))) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (when (< resultmi 10) .....") (set! result (string-append sign resultd-str " ° " resultmi-str " '")) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed (set! result (string-append sign resultd-str ....") (display "BiglooCode.scm :: ResultatMesuresF : result =") (display result) (newline) (display-nl "BiglooCode.scm :: ResultatMesuresF : passed display") ) ;; end begin else ) ;; end if (java.sql.ResultSet-wasNull rs) (string-append "</font>" result "</td>")) ;; end begin "<td align=\"center\"><font color=\"#0000FF\"> mag 1<br>" (begin (set! jresult (java.sql.ResultSet-getString2 rs 7)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 7 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "0") (set! result " ")) (string-append "</font>" result "</td>")) "<td align=\"center\"><font color=\"#0000FF\"> mag 2<br>" (begin (set! jresult (java.sql.ResultSet-getString2 rs 8)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 8 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "0") (set! result " ")) (string-append "</font>" result "</td>")) "<td align=\"center\"><font color=\"#0000FF\"> Orbite calculée ?<br>" (begin (set! jresult (java.sql.ResultSet-getString2 rs 11)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 11 = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (when (string=? result "*") (set! result "NON")) (string-append "</font>" result "</td>")) "</tr> </table> </center> </div>" ;; vaut mieux pas continuer la (syntaxe lourde) ) ;; close string-append ) ;; close set! res ;; continuer ici (set! res (string-append res "<P> <P> <table border=\"1\" cellpadding=\"0\" cellspacing=\"0\" width=\100%\> <tr> <th><font color=\#000080\> Réf. </font></th> <th><font color=\#000080\> Revue </font></th> <th><font color=\#000080\> Titre </font></th> </tr>")) (java.sql.ResultSet-first rs) ;; rs.movefirst (while (not (java.sql.ResultSet-isAfterLast rs)) (set! res (string-append res "<tr>")) (set! jresult (java.sql.ResultSet-getString2 rs 12)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 12 Réf = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" (string-upcase result) " </td>")) ;;(set! result (number->string (java.sql.ResultSet-getInt2 rs 13))) (set! jresult (java.sql.ResultSet-getString2 rs 13)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result Revue = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>")) (set! jresult (java.sql.ResultSet-getString2 rs 14)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: ResultatMesuresF : result 14 Titre = " result)) (when (java.sql.ResultSet-wasNull rs) (set! result " ")) (set! res (string-append res "<td>" result " </td>" "</tr>")) (java.sql.ResultSet-next rs) ;; rs.Movenext ) ;; end while (set! res (string-append res "</table>")) ) ;; end begin else du if flagerreur 1 ) ;; end if flagerreur 1 ) ;; fin cas dans COND : ((string=? choixres "Ref") (else ;; du COND (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: UNSUPPORTED CASE with choixres =" choixres))) ;; fin COND ;; en ASP la connection a la BDD est fermée ici ) ;; end begin ) ;; end if (or (= flagerreur 1) (= flaguni 1) (= flagexiste 1)) ;; closing connection to database (if dyna (eu.oca.DataBase-closeDynamic db) (eu.oca.DataBase-closeStatic)) (set! res (string-append res " <table border=\"0\" width=\"95%\"> <tr> <td valign=\"top\">" ;;" " "<a href=\"../SidonieBienvenueF.html\"><img src=\"../retour_blanc.gif\" border=\"0\" width=\"26\" height=\"26\"></a> <font size=\"2\"> <em>Recherche sur un objet</em> </font> </td> <td valign=\"top\"> <a href=\"../ParametresF.html\"> <img src=\"../retour_blanc.gif\" border=\"0\" width=\"26\" height=\"26\"></a> <font size=\"2\"> <em>Recherche statistique</em> </font> </td>" ;; "</h5>" ;; /h5 was here but no h5 upside !!! "</td> </tr> </table>")) ;; (set! res (string-append res "<br>" ;; "<h1> " ;; "identificateur = " bstr_identificateur ;; " , T1 = " bstr_objet ;; " , choixres = " bstr_choixres ;; " , baraterreur = " baraterreur ;; " , flagerreur = " (number->string flagerreur) ;; " , flaguni = " (number->string flaguni) ;; " , flagexiste = " (number->string flagexiste) ;; " , flagobjet = " (number->string flagobjet) ;; "</h1>")) (set! res (string-append res "</body></html>")) (display-var-nl "BiglooCode.scm :: ResultatMesuresF :: res = " res) (set! len (string-length res)) (let ( (bstr (make-byte* len)) ) ;;(set! bstr res) (set! bstr ($string->bstring res)) bstr) ) ) (define (proc-barat baratin rs) (set! res (string-append res "<h1 align=\"center\"> <font color=\"#0000FF\">SIDONIe - Résultats : Identifications et mesures</font> </h1> <div align=\"center\"> <center> <table width=\"85%\" border=\"3\" align=\"center\" cellpadding=\"0\" cellspacing=\"0\"> <tr> <th width=\"80%\"> <font color=\"#0000FF\">" baratin "<br> </font> </th> </tr> </table> </center> </div> <P> <P> <table border=\"1\" cellpadding=\"0\" align=\"center\" cellspacing=\"0\" width=\"20%\" > <tr> <th><font color=\"#000080\" > Objets </font></th> </tr>")) (java.sql.ResultSet-first rs) (display-nl "BiglooCode.scm :: proc-barat :: before loop !") (letrec ((loop (lambda () (if (java.sql.ResultSet-isAfterLast rs) '() (let ((jresultat::java.lang.String #;(java.lang.String-java.lang.String8 "a result") (java.sql.ResultSet-getString2 rs 0)) (resultat "UN RESULTAT")) ;;(bstr_tmp '())) (display-nl "BiglooCode.scm :: proc-barat :: before (set! resultat (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresultat))") (set! resultat (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresultat)) (display-var-nl "BiglooCode.scm :: proc-barat :: resultat = " resultat) (when (string-null? resultat) (set! resultat " ")) (set! res (string-append res "<tr> <td>" (string-upcase resultat) " </td> </tr>")) (java.sql.ResultSet-next rs) (display-nl "BiglooCode.scm :: proc-barat :: looping !") (loop)))))) (loop)) (set! res (string-append res "</table>"))) (define (sql-server->mysql-server-syntax query) ;; replace [ ] by ` (string-replace (string-replace query #\[ #\`) #\] #\`)) ;; extract field n from result set and return an HTML string (define (field-result-set rs n) (let ((jresult::java.lang.String (java.lang.String-java.lang.String8 "")) (result "")) (set! jresult (java.sql.ResultSet-getString2 rs n)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: field-result-set : result = " result)) (display "BiglooCode.scm :: field-result-set : = (java.sql.ResultSet-wasNull rs) :") (display (java.sql.ResultSet-wasNull rs)) (newline) (if (java.sql.ResultSet-wasNull rs) " " (string-upcase result)))) ;; extract field n from result set and renturn an HTML string in lower case (define (field-result-set-lowercase rs n) (let ((jresult::java.lang.String (java.lang.String-java.lang.String8 "")) (result "")) (set! jresult (java.sql.ResultSet-getString2 rs n)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: field-result-set : result = " result)) (display "BiglooCode.scm :: field-result-set : = (java.sql.ResultSet-wasNull rs) :") (display (java.sql.ResultSet-wasNull rs)) (newline) (if (java.sql.ResultSet-wasNull rs) " " result))) ;; extract field n from result set and renturn an HTML string in lower case - check star (define (field-result-set-lowercase-check-star rs n) (let ((jresult::java.lang.String (java.lang.String-java.lang.String8 "")) (result "")) (set! jresult (java.sql.ResultSet-getString2 rs n)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: field-result-set : result = " result)) (display "BiglooCode.scm :: field-result-set : = (java.sql.ResultSet-wasNull rs) :") (display (java.sql.ResultSet-wasNull rs)) (newline) (if (or (java.sql.ResultSet-wasNull rs) (string=? result "*")) " " result))) ;; extract field n from result set and renturn an HTML string in lower case - check minus (define (field-result-set-lowercase-check-minus rs n) (let ((jresult::java.lang.String (java.lang.String-java.lang.String8 "")) (result "")) (set! jresult (java.sql.ResultSet-getString2 rs n)) (set! result (eu.oca.bigloofunct.JavaForBigloo-jstring->bstring jresult)) (display-nl (string-append "BiglooCode.scm :: field-result-set : result = " result)) (display "BiglooCode.scm :: field-result-set : = (java.sql.ResultSet-wasNull rs) :") (display (java.sql.ResultSet-wasNull rs)) (newline) (if (or (java.sql.ResultSet-wasNull rs) (string=? result "-")) " " result))) (define (fix x) (display-nl "BiglooCode.scm :: entering fix") (let ((r (inexact->exact (truncate x)))) (display "BiglooCode.scm :: fix :: r =") (display r) (newline) r)) (define (num->string n) (if (bignum? n) (bignum->string n) (number->string n)))
;; macros or function to display a variable with a message and add a newline (define-syntax display-msg-symb-nl (syntax-rules () ((_ msg symbl) (begin (display msg) (display " ") (display (symbol->string (quote symbl))) (display " = ") (display symbl) (newline))))) (define-syntax display-symb-nl (syntax-rules () ((_ symbl) (begin (display (symbol->string (quote symbl))) (display " = ") (display symbl) (newline))))) (define-syntax display-expr-nl (syntax-rules () ((_ expr) (begin (display (quote expr)) (display " = ") (display expr) (newline))))) (define-syntax display-var-nl (syntax-rules () ((_ msg var) (begin (display msg) (display var) (newline))))) (define-syntax display-msg-var-nl (syntax-rules () ((_ msg var) (begin (display msg) (display var) (newline))))) (define (dvn msg var) (begin (display msg) (display var) (newline))) (define-syntax display-nl (syntax-rules () ((_ msg) (begin (display msg) (newline))))) ;; "if" "then" without "else" ;; (if-t (= 1 1) 'good) -> 'good ;; (if-t (= 1 1) 'good 'bad) -> 'bad ;; (if-t (= 1 1) 'good 'bad 'bof) -> 'bof ;; > (if-t (= 1 1) (display-nl 'good) (display-nl 'bad) (display-nl 'bof)) ;; good ;; bad ;; bof ;; > (if-t (= 1 0) (display-nl 'good) (display-nl 'bad) (display-nl 'bof)) -> '() (define-syntax if-t (syntax-rules () ((_ tst ev) (if tst ev '())) ((_ tst ev ...) (if tst (begin ev ...) '())) )) ;; > (define _quai 34) ;; > (dv _quai) ;; _quai = 34 (define-syntax dv (syntax-rules () ((_ var) (begin (display (symbol->string (quote var))) (display " = ") (display var) (newline))))) (define (fdv var) (begin (display (symbol->string var)) (display " = ") (display (eval var)) (newline)))
 |
 |