------------------------------------------------------------------------------ -- -- -- DEMO EMBEDDED WEB INTERFACE TO THE R LANGUAGE -- -- -- -- WEBD -- -- (http://ecardio.uhosp.ro) -- -- -- -- Copyright (C) 2001-2003 Alexandru Dan Corlan MD PhD -- -- -- -- WEBD is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. It is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- ------------------------------------------------------------------------------ with Ada.Interrupts; use Ada.Interrupts; with Ada.Interrupts.Names; use Ada.Interrupts.Names; package Unisig is protected Termination_Flag is procedure Termi; pragma Interrupt_Handler(Termi); pragma Attach_Handler(Termi,SIGQUIT); function Istermi return Boolean; private Stopit: Boolean:= False; end Termination_Flag; end Unisig; package body Unisig is protected body Termination_Flag is procedure Termi is begin Stopit := True; end Termi; function Istermi return Boolean is begin return Stopit; end Istermi; end Termination_Flag; end Unisig; with Ada.Text_IO; use Ada.Text_Io; with Gnat.Os_Lib; use Gnat.Os_Lib; with AWS.Response; with AWS.Server; with AWS.Status; with AWS.Default; with Aws.Parameters; with Aws.Mime; with Unisig; use Unisig; with Ada.Strings.Fixed; use Ada.Strings.Fixed; with Interfaces.C; use Interfaces.C; with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; procedure Webd is WS : AWS.Server.HTTP; Root_Dir: String:= "/home/dcorlan/.www"; function Log_Frag(Request: Aws.Status.Data) return String is begin return Aws.Status.Http_Version(Request) & " FROM=" & Aws.Status.Peername(Request) & " URI=" & Aws.Status.Uri(Request) & " AGENT=" & Aws.Status.User_Agent(Request); end Log_Frag; protected Logfile is procedure Log(S: String); private Fi: File_Type; end Logfile; protected body Logfile is procedure Log(S: String) is begin Open(Fi,Append_File,Root_Dir & "/log/webd"); Put_Line(Fi,S); Close(Fi); end Log; end Logfile; type struct_sched_param is record sched_priority : Integer; -- scheduling priority end record; pragma Convention (C, struct_sched_param); -- the following are useful to control the scheduling method -- of the processes (scripts) which might be run from this task function Getpri(What: Integer; Who: Process_Id) return Integer; pragma Import(C, Getpri, "getpriority"); function Setpri(What: Integer; Who: Process_Id; Prio: Integer) return Integer; pragma Import(C, Setpri, "setpriority"); function Getsched(Pid: Process_Id) return Integer; pragma Import(C, Getsched, "sched_getscheduler"); function J_Getsched(Pid: Integer) return Integer; pragma Import(C, J_Getsched, "sched_getscheduler"); function Setsched (Pid: Process_Id; policy : Integer; param : access struct_sched_param) return Integer; pragma Import (C, Setsched, "sched_setscheduler"); protected Rjob is procedure Rrun(S: String; P:Aws.Parameters.List; Op: out Unbounded_String); private Crtj: Integer; Ng: Integer:= 0; Arg_List_Buff: Argument_List(1..10) := (others => null); Sccs: Boolean; Pid: Process_Id; X: Integer; Ssp: aliased Struct_Sched_Param; end Rjob; protected body Rjob is procedure Rrun(S: String; P: Aws.Parameters.List; Op: out Unbounded_String) is Job_Dir: String := Root_Dir & "/bin"; R_Filename: String:= Job_Dir & "/x.R"; Out_Filename: String:= Root_Dir & "/www/x.out"; Fi: File_Type; Ss: String(1..4096); Lst: Integer; function Par(Vname: String) return String is begin return Aws.Parameters.Get(P,Vname); end Par; begin Create(Fi,Out_File,R_Filename); Put_Line(Fi,"sink(""" & Out_Filename & """)"); if S="/RSCRIPT/chisq" then Put_Line(Fi,"cat(""Testul chi patrat

\n"")");
            Put_Line(Fi,"cht <- chisq.test(matrix(c(" & Par("V1") &
                     ", " & Par("V2") & ", " & Par("V3") & ", " & Par("V4") &
                     "),nrow=2))");
            Put_Line(Fi, "cat(""
Testul chi patrat
"")");
            Put_Line(Fi, "cat(""Valori observate
"")");
            Put_Line(Fi, "cat(""
\n"")");
            Put_Line(Fi, "print.default(cht$observed)");
            Put_Line(Fi, "cat(""\n
\n"")");
            Put_Line(Fi, "cat(""
Valori calculate
\n"")");
            Put_Line(Fi, "print.default(cht$expected)");
            Put_Line(Fi, "cat(""
p ="", cht$p.value, ""
\n"")");
            Put_Line(Fi,"cat(""\n
\n"")"); elsif S="/RSCRIPT/binom.conf" then Put_Line(Fi,"cat(""" & "Interval de confidenta pentru o proportie

\n"")"); Put_Line(Fi,"bt <- binom.test(" & Par("PL") & ", " & Par("NN") & ")"); Put_Line(Fi, "cat(""Date
\n"")"); Put_Line(Fi, "cat(""Esantionul are " & par("NN") & " cazuri din care " & Par("PL") & " sunt pozitive.
\n"")"); Put_Line(Fi, "cat(""

Rezultate
\n"")"); Put_Line(Fi, "cat(""Cu probabilitate de 95% proportia pozitivilor " & "in populatie este cuprinsa intre "", bt$conf.int[1] , "" si """ & ", bt$conf.int[2], ""
\n"")"); Put_Line(Fi,"cat(""\n\n"")"); elsif S="/RSCRIPT/specif" then Put_Line(Fi,"cat(""" & "Sensitivitatea si specificitatea unui test

\n"")"); Put_Line(Fi,"realp <- " & Par("REALP")); Put_Line(Fi,"realn <- " & Par("REALN")); Put_Line(Fi,"falsp <- " & Par("FALSP")); Put_Line(Fi,"falsn <- " & Par("FALSN")); Put_Line(Fi,"tp <- " & Par("REALP") & "+" & Par("FALSN") ); Put_Line(Fi,"tn <- " & Par("REALN") & "+" & Par("FALSP")); Put_Line(Fi,"sens <- " & Par("REALP") & "/ tp"); Put_Line(Fi,"spec <- " & Par("REALN") & "/ tn"); Put_Line(Fi,"ppv <- " & Par("REALP") & "/(" & Par("FALSP") & "+" & Par("REALP") & ")"); Put_Line(Fi,"npv <- " & Par("REALN") & "/(" & Par("FALSN") & "+" & Par("REALN") & ")"); Put_Line(Fi, "cat(""Date
\n"")"); Put_Line(Fi, "cat(""Real pozitivi="", realp, ""
\n"")"); Put_Line(Fi, "cat(""Real negativi="", realn, ""
\n"")"); Put_Line(Fi, "cat(""Fals pozitivi="", falsp, ""
\n"")"); Put_Line(Fi, "cat(""Fals negativi="", falsn, ""
\n"")"); Put_Line(Fi, "cat(""

Rezultate
\n"")"); Put_Line(Fi, "cat(""Sensibilitate = "", sens, ""
\n"")"); Put_Line(Fi, "cat(""Specificitate = "", spec, ""
\n"")"); Put_Line(Fi, "cat(""Valoare predictiva pozitiva = "", ppv, ""
\n"")"); Put_Line(Fi, "cat(""Valoare predictiva negativa = "", npv, ""
\n"")"); Put_Line(Fi,"cat(""\n\n"")"); end if; Put_Line(Fi,"sink()"); Close(Fi); Arg_List_Buff(1) := new String'("BATCH"); Arg_List_Buff(2) := new String'("--slave"); Arg_List_Buff(3) := new String'("--no-save"); Arg_List_Buff(4) := new String'("--no-restore"); Arg_List_Buff(5) := new String'(R_Filename); -- Spawn("/usr/bin/R",Arg_List_Buff(1..5), Sccs); -- Arg_List_Buff(1) := new String'("bajo"); Pid := Non_Blocking_Spawn("/usr/bin/R", Arg_List_Buff(1..5)); Ssp.Sched_Priority:=0; X := Setsched(Pid,0,Ssp'Access); -- make the script have normal scheduling Wait_Process(Pid,Sccs); Open(Fi,In_File,Out_Filename); loop Get_Line(Fi,Ss,Lst); Append(Op,Ss(1..Lst) & Ascii.Lf); if End_Of_File(Fi) then exit; end if; end loop; Close(Fi); end Rrun; end Rjob; function Page_Server (Request : in AWS.Status.Data) return AWS.Response.Data is P: Aws.Parameters.List:= Aws.Status.Parameters(Request); In_Dir: String:= Root_Dir & "/www"; Uri: String:= Aws.Status.Uri(Request); Urr: Unbounded_String:= To_Unbounded_String(""); begin Logfile.Log(Log_Frag(Request)); if Uri="/" or else Index(Uri,"..")>0 then return AWS.Response.File (Content_Type => "text/html", Filename => In_Dir & "/index.html"); elsif Uri(1..9)="/RSCRIPT/" then Rjob.Rrun(Uri,P,Urr); return Aws.Response.Build ("text/html", Urr); elsif Is_Regular_File(Root_Dir & Uri) then return AWS.Response.File (Content_Type => AWS.MIME.Content_Type (Root_Dir & Uri), Filename => Root_Dir & Aws.Status.Uri(Request)); else return Aws.Response.Build ("text/html", "

Sorry, """ & Uri & """ could not be found." & Ascii.Lf); end if; end Page_Server; begin AWS.Server.Start (WS, "webd", Max_Connection => 10, Port => 80, Callback => Page_Server'Unrestricted_Access); loop delay 1.0; if Termination_Flag.Istermi then exit; end if; end loop; Put_Line("OK, webd leaving gracefully."); AWS.Server.Shutdown (WS); end Webd;