Commit a4c9b503 authored by Idir Lankri's avatar Idir Lankri

Handle exceptions correctly in corpus CGIs

parent c1eb6db6
......@@ -297,22 +297,22 @@ web_corpus.cmx : web.cmx corpus.cmx web_corpus.cmi
corpus_manager.cmi :
corpus_manager.cmo : web_corpus.cmi web.cmo paths.cmo params.cmi \
multilingual.cmo mkdir_corpus_params.cmi html.cmo dir.cmi corpus.cmi \
canon.cmo corpus_manager.cmi
control.cmo canon.cmo corpus_manager.cmi
corpus_manager.cmx : web_corpus.cmx web.cmx paths.cmx params.cmx \
multilingual.cmx mkdir_corpus_params.cmx html.cmx dir.cmx corpus.cmx \
canon.cmx corpus_manager.cmi
control.cmx canon.cmx corpus_manager.cmi
corpus_manager_cgi.cmo : params.cmi corpus_manager.cmi cgi.cmo
corpus_manager_cgi.cmx : params.cmx corpus_manager.cmx cgi.cmx
save_corpus_cgi.cmo : web_corpus.cmi web.cmo params.cmi html.cmo \
corpus_manager.cmi cgi.cmo
corpus_manager.cmi control.cmo cgi.cmo
save_corpus_cgi.cmx : web_corpus.cmx web.cmx params.cmx html.cmx \
corpus_manager.cmx cgi.cmx
corpus_manager.cmx control.cmx cgi.cmx
mkdir_corpus_params.cmi :
mkdir_corpus_params.cmo : params.cmi mkdir_corpus_params.cmi
mkdir_corpus_params.cmx : params.cmx mkdir_corpus_params.cmi
mkdir_corpus_cgi.cmo : web_corpus.cmi mkdir_corpus_params.cmi \
corpus_manager.cmi cgi.cmo
mkdir_corpus_cgi.cmx : web_corpus.cmx mkdir_corpus_params.cmx \
corpus_manager.cmx cgi.cmx
mkdir_corpus_cgi.cmo : web_corpus.cmi web.cmo mkdir_corpus_params.cmi \
corpus_manager.cmi control.cmo cgi.cmo
mkdir_corpus_cgi.cmx : web_corpus.cmx web.cmx mkdir_corpus_params.cmx \
corpus_manager.cmx control.cmx cgi.cmx
mk_corpus.cmo : paths.cmo params.cmi corpus.cmi cgi.cmo
mk_corpus.cmx : paths.cmx params.cmx corpus.cmx cgi.cmx
......@@ -85,6 +85,8 @@ module type S = sig
;
value save_sentence : bool -> string -> unit
;
exception Heading_abbrev_already_exists of string
;
value mkdir : string -> unit
;
value gobble_metadata : string -> Sentence.t -> Sentence.metadata
......@@ -159,7 +161,13 @@ module Make (Loc : Location) : S = struct
; Gen.dump sentence file
}
;
value mkdir dirname = Unix.mkdir (Loc.dir ^ dirname) 0o755
exception Heading_abbrev_already_exists of string
;
value mkdir dirname =
try Unix.mkdir (Loc.dir ^ dirname) 0o755 with
[ Unix.Unix_error (Unix.EEXIST, _, _) ->
raise (Heading_abbrev_already_exists (Filename.basename dirname))
]
;
end
;
......@@ -35,13 +35,21 @@ module type S = sig
;
(* List the contents of the given corpus subdirectory. Note that the
returned elements are sorted according to [Heading.compare] or
[Sentence.compare] depending on the case. *)
[Sentence.compare] depending on the case. Raise [Sys_error] when
an operating system error occurs. *)
value contents : string -> contents
;
exception Sentence_already_exists
;
(* Raise [Sentence_already_exists] if the sentence to be saved already
exists and [Sys_error] when an operating system error occurs. *)
value save_sentence : bool -> string -> unit
;
exception Heading_abbrev_already_exists of string
;
(* Raise [Heading_abbrev_already_exists] if the given corpus directory
already exists and [Unix.Unix_error] when an operating system error
occurs. *)
value mkdir : string -> unit
;
value gobble_metadata : string -> Sentence.t -> Sentence.metadata
......
......@@ -233,14 +233,18 @@ value body dir =
;
value make dir =
let title = "Sanskrit Corpus" in
do
{ Web.maybe_http_header ()
; Web.page_begin (Html.title title)
; Html.body_begin Html.Chamois_back |> Web.pl
; Web.open_page_with_margin 15
; Html.h1_title title |> Web.print_title (Some Html.default_language)
; body dir
; Web.close_page_with_margin ()
; Web.page_end Html.default_language True
}
try
do
{ Web.maybe_http_header ()
; Web.page_begin (Html.title title)
; Html.body_begin Html.Chamois_back |> Web.pl
; Web.open_page_with_margin 15
; Html.h1_title title |> Web.print_title (Some Html.default_language)
; body dir
; Web.close_page_with_margin ()
; Web.page_end Html.default_language True
}
with
[ Sys_error msg -> Web.abort Html.default_language Control.sys_err_mess msg
]
;
(* Directory operations *)
(* [subdirs dir] returns the list of subdirectories of [dir]. The order
of the returned list is unspecified. *)
of the returned list is unspecified. Raise [Sys_error] when an
operating system error occurs. *)
value subdirs : string -> list string
;
(* [files_with_ext ext dir] returns the list of files in [dir] with the
extension [ext] (e.g. ["txt"]). The order of the returned list is
unspecified.*)
unspecified. Raise [Sys_error] when an operating system error
occurs. *)
value files_with_ext : string -> string -> list string
;
(* [split path] splits [path] into substrings corresponding to the
......
......@@ -5,8 +5,19 @@ value main =
let env = Cgi.create_env query in
let dirname = Cgi.decoded_get Mkdir_corpus_params.dirname "" env in
let parent_dir = Cgi.decoded_get Mkdir_corpus_params.parent_dir "" env in
do
{ Web_corpus.mkdir (parent_dir ^ dirname)
; Corpus_manager.make parent_dir
}
let error_page = Web.error_page "Corpus Manager" in
try
do
{ Web_corpus.mkdir (parent_dir ^ dirname)
; Corpus_manager.make parent_dir
}
with
[ Web_corpus.Heading_abbrev_already_exists abbrev ->
error_page "Already used heading abbreviation " abbrev
| Unix.Unix_error (err, func, arg) ->
let submsg =
Printf.sprintf "'%s' failed on '%s': %s" func arg (Unix.error_message err)
in
error_page Control.sys_err_mess submsg
]
;
......@@ -29,6 +29,9 @@ value confirmation_page query =
}
;
(***************)
(* Entry point *)
(***************)
value main =
let query = Cgi.query_string () in
let env = Cgi.create_env query in
......@@ -44,5 +47,9 @@ value main =
{ Web_corpus.save_sentence force query
; Corpus_manager.make corpdir
}
with [ Web_corpus.Sentence_already_exists -> confirmation_page query ]
with
[ Web_corpus.Sentence_already_exists -> confirmation_page query
| Sys_error msg ->
Web.error_page "Corpus Manager" Control.sys_err_mess msg
]
;
......@@ -701,5 +701,15 @@ value abort lang s1 s2 = do
; page_end lang True
}
;
(* Build an HTML page to report error. *)
value error_page title msg submsg =
do
{ maybe_http_header ()
; page_begin (Html.title title)
; Html.body_begin Html.Chamois_back |> pl
; open_page_with_margin 15
; Html.h1_title title |> print_title (Some Html.default_language)
; abort Html.default_language msg submsg
}
;
(*i end; i*)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment