added ocaml version of draw_graph and uri_set_queue

[helm.git] / helm / graphs / tools / drawGraph.ml

diff --git a/helm/graphs/tools/drawGraph.ml b/helm/graphs/tools/drawGraph.ml
new file mode 100644 (file)
index 0000000..5c539c1
--- /dev/null
+++ b/helm/graphs/tools/drawGraph.ml
@@ -0,0 +1,80 @@
+
+(* Copyright (C) 2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT 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
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+open Printf;;
+
+let daemon_name = "Draw Graph";;
+let default_port = 48083;;
+let port_env_var = "DRAW_GRAPH_PORT";;
+
+let wget url fname =
+  let data = Http_client.Convenience.http_get url in
+  let oc = open_out fname in
+  output_string oc data;
+  close_out oc
+;;
+
+let port =
+  try
+    int_of_string (Sys.getenv port_env_var)
+  with
+  | Not_found -> default_port
+  | Failure "int_of_string" ->
+      prerr_endline "Warning: invalid port, reverting to default";
+      default_port
+in
+let callback req outchan =
+  try
+    (match req#path with
+    | "/draw" ->
+        let url = req#param "url" in
+        let pid = Unix.getpid () in
+        wget (sprintf "%s&param.PID=%d" url pid) (sprintf "prova0.%d.dot" pid);
+        (match Unix.system (sprintf "make PID=%d > log.%d" pid pid) with
+        | Unix.WEXITED 0 ->
+            Http_daemon.respond_file (sprintf "") outchan
+        | _ ->
+            Http_daemon.respond_error
+              ~status:(`Server_error `Internal_server_error) outchan)
+    | "/get_gif" ->
+        let pid = req#param "pid" in
+        Http_daemon.respond_file (sprintf "prova.%s.gif" pid) outchan;
+        ignore (Unix.system (
+          sprintf "make PID=%s clean; rm -f prova0.%s.dot" pid pid))
+    | invalid_request ->
+        Http_daemon.respond_error ~status:(`Client_error `Bad_request) outchan)
+  with
+  | Http_request.Param_not_found attr_name ->
+      Http_daemon.respond_error
+        ~status:(`Client_error `Bad_request)
+        ~body:(sprintf "Parameter '%s' is missing" attr_name)
+        outchan
+in
+printf "%s started and listening on port %d\n" daemon_name port;
+flush stdout;
+Http_daemon.start' ~port callback;
+printf "%s is terminating, bye!\n" daemon_name
+