save_corpus_cgi.ml 4.24 KB
Newer Older
Idir Lankri's avatar
Idir Lankri committed
1
(**************************************************************************)
2
(*                                                                        *)
Idir Lankri's avatar
Idir Lankri committed
3 4 5 6 7 8 9
(*                     The Sanskrit Heritage Platform                     *)
(*                                                                        *)
(*                              Idir Lankri                               *)
(*                                                                        *)
(* ©2017 Institut National de Recherche en Informatique et en Automatique *)
(**************************************************************************)

10 11
(* CGI script [save_corpus] for saving a sentence into the corpus.  *)

12 13 14
open Html;
open Web;

15
value confirmation_page query =
16
  let title_str = "Sanskrit Corpus" in
17
  let env = Cgi.create_env query in
18
  let corpdir = Cgi.decoded_get Params.corpus_dir "" env in
19
  let corppermission = Cgi.decoded_get Params.corpus_permission "" env in
20
  let sentno = Cgi.decoded_get Params.sentence_no "" env in
21 22 23
  let confirmation_msg =
    Printf.sprintf "Confirm changes for sentence no. %s of %s ?" sentno corpdir
  in
24
  let specific_url path = Cgi.url path ~fragment:sentno in
25
  do
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
  { maybe_http_header ()
  ; page_begin (title title_str)
  ; body_begin Chamois_back |> pl
  ; open_page_with_margin 15
  ; h1_title title_str |> print_title (Some default_language)
  ; center_begin |> pl
  ; div Latin16 confirmation_msg |> pl
  ; html_break |> pl
  ; cgi_begin (specific_url save_corpus_cgi) "" |> pl
  ; hidden_input Save_corpus_params.state (escape query) |> pl
  ; hidden_input Save_corpus_params.force (string_of_bool True) |> pl
  ; submit_input "Yes" |> pl
  ; cgi_end |> pl
  ; html_break |> pl
  ; cgi_begin (specific_url corpus_manager_cgi) "" |> pl
  ; hidden_input Params.corpus_dir corpdir |> pl
42
  ; hidden_input Params.corpus_permission corppermission |> pl
43 44 45 46 47
  ; submit_input "No" |> pl
  ; cgi_end |> pl
  ; center_end |> pl
  ; close_page_with_margin ()
  ; page_end default_language True
48
  }
49

50 51 52 53 54 55 56 57 58 59
;
value analysis_of_env env =
  let lang =
    env
    |> Cgi.decoded_get "lex" Paths.default_lexicon
    |> Html.language_of
  in
  let cpts =
    env
    |> Cgi.decoded_get "cpts" ""
Gérard Huet's avatar
Gérard Huet committed
60
    (* [|> Checkpoints.parse_cpts] *)
61 62 63
  in
  let nb_sols =
    env
Idir Lankri's avatar
Idir Lankri committed
64
    |> Cgi.decoded_get Save_corpus_params.nb_sols "0"
65 66 67 68 69
    |> Num.num_of_string
  in
  Corpus.Analysis.make Corpus.Analyzer.Graph lang cpts nb_sols
;
value error_page = error_page "Corpus Manager"
70
;
71 72 73
(***************)
(* Entry point *)
(***************)
74 75 76
value main =
  let query = Cgi.query_string () in
  let env = Cgi.create_env query in
77
  let query = Cgi.decoded_get Save_corpus_params.state "" env in
78
  try
79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
    let force =
      env
      |> Cgi.decoded_get Save_corpus_params.force (string_of_bool False)
      |> bool_of_string
    in
    let env = Cgi.create_env query in
    let corpdir = Cgi.decoded_get Params.corpus_dir "" env in
    let sentno =
      env
      |> Cgi.decoded_get Params.sentence_no ""
      |> float_of_string
      |> int_of_float
    in
    let text = Cgi.decoded_get "text" "" env in
    let unsandhied = Cgi.decoded_get "us" "f" env = "t" in
94 95
    let permission =
      Web_corpus.permission_of_string (Cgi.decoded_get Params.corpus_permission "" env)
96
    in
97
    match permission with
98
    [ Web_corpus.Annotator ->
99 100 101 102 103 104 105 106 107
      let read_skt =
        if unsandhied then Sanskrit.read_raw_sanskrit else
          Sanskrit.read_sanskrit
      in
      let encode =
        Cgi.decoded_get "t" Paths.default_transliteration env
        |> Corpus.Encoding.of_string
        |> Corpus.Encoding.encode
      in
108 109
      do
      { Web_corpus.save_sentence force corpdir sentno
110
          (read_skt encode text) unsandhied (analysis_of_env env)
111
      ; Corpus_manager.mk_page corpdir permission
112 113
      }
    | Web_corpus.Reader | Web_corpus.Manager ->
114
      let expected_permission = Web_corpus.(string_of_permission Annotator) in
115 116
      let current_permission = Web_corpus.string_of_permission permission in
      invalid_corpus_permission_page expected_permission current_permission
117
    ]
118 119
  with
  [ Web_corpus.Sentence_already_exists -> confirmation_page query
120 121
  | Sys_error msg -> error_page Control.sys_err_mess msg
  | Failure msg -> error_page Control.fatal_err_mess msg
122
  | _ -> abort default_language Control.fatal_err_mess "Unexpected anomaly"
123
  ]
124
;