Some cleanup to this horrible piece of code
[lhc/web/wiklou.git] / math / texvc_cgi.ml
1 open Netcgi;;
2 open Netcgi_types;;
3 open Netcgi_env;;
4 open Netchannels;;
5
6 let cgi = new Netcgi.std_activation ()
7 let out = cgi # output # output_string
8 let math = cgi # argument_value ~default:"" "math"
9 let tmppath = "/home/taw/public_html/wiki/tmp/"
10 let finalpath = "/home/taw/public_html/wiki/math/"
11 let finalurl = "http://wroclaw.taw.pl.eu.org/~taw/wiki/math/"
12 ;;
13
14 let h_header = "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0//EN\""^
15 " \"http://www.w3.org/TR/REC-html40/strict.dtd\">\n"^
16 "<html><head><title>texvc</title></head><body>"^
17 "<form method=post action=\"http://wroclaw.taw.pl.eu.org/~taw/cgi-bin/newcodebase/math/texvc_cgi\">"^
18 "<textarea name='math' rows=10 cols=80>"
19 let h_middle = "</textarea><br /><input type=submit value=\"Preview\" name='preview'></form>"
20 let h_footer = "</body></html>\n"
21
22 let render tmppath finalpath tree =
23 let outtex = Texutil.mapjoin Texutil.print tree in
24 let md5 = Digest.to_hex (Digest.string outtex) in
25 begin
26 out "<h3>TeX</h3>";
27 out outtex; (* <, & and > should be protected *)
28 (try out ("<h3>HTML</h3>" ^ (Texutil.html_render tree))
29 with _ -> out "<h3>HTML could not be rendered</h3>");
30 try Render.render tmppath finalpath outtex md5;
31 out ("<h3>Image:</h3><img src=\""^finalurl^md5^".png\">")
32 with Util.FileAlreadyExists -> out ("<h3>Image:</h3><img src=\""^finalurl^md5^".png\">")
33 | Failure s -> out ("<h3>Other failure: " ^ s ^ "</h3>")
34 | Render.ExternalCommandFailure "latex" -> out "<h3>latex failed</h3>"
35 | Render.ExternalCommandFailure "dvips" -> out "<h3>dvips failed</h3>"
36 | _ -> out "<h3>Other failure</h3>"
37 end
38 ;;
39
40 cgi#set_header ();;
41
42 out h_header;;
43 out math;;
44 out h_middle;;
45
46 exception LexerException of string
47 let lexer_token_safe lexbuf =
48 try Lexer.token lexbuf
49 with Failure s -> raise (LexerException s)
50 ;;
51 if math = ""
52 then ()
53 else try
54 render tmppath finalpath (Parser.tex_expr lexer_token_safe (Lexing.from_string math))
55 with Parsing.Parse_error -> out "<h3>Parse error</h3>"
56 | LexerException s -> out "<h3>Lexing failure</h3>"
57 | Texutil.Illegal_tex_function s -> out ("<h3>Illegal TeX function: " ^ s ^ "</h3>")
58 | Failure s -> out ("<h3>Other failure: " ^ s ^ "</h3>")
59 | _ -> out "<h3>Other failure</h3>"
60 ;;
61
62 out h_footer