src/tatoo.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                               TAToo                                 *)
   4 (*                                                                     *)
   5 (*                     Kim Nguyen, LRI UMR8623                         *)
   6 (*                   Université Paris-Sud & CNRS                       *)
   7 (*                                                                     *)
   8 (*  Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
   9 (*  Recherche Scientifique. All rights reserved.  This file is         *)
  10 (*  distributed under the terms of the GNU Lesser General Public       *)
  11 (*  License, with the special exception on linking described in file   *)
  12 (*  ../LICENSE.                                                        *)
  13 (*                                                                     *)
  14 (***********************************************************************)
  15
  16 (*
  17   Time-stamp: <Last modified on 2013-04-22 17:26:34 CEST by Kim Nguyen>
  18 *)
  19
  20 open Format
  21
  22 let main () =
  23   let () = Options.parse () in
  24   let doc =
  25     let fd = open_in !Options.input_file in
  26     let d = Naive_tree.load_xml_file fd in
  27     close_in fd; d
  28   in
  29   let query =
  30     Xpath.Parser.parse (Ulexing.from_latin1_string !Options.query)
  31   in
  32   let auto =
  33     Xpath.Compile.path query
  34   in
  35   let output =
  36     match !Options.output_file with
  37     | None | Some "-" | Some "/dev/stdout" -> stdout
  38     | Some f -> open_out f
  39   in
  40   if !Options.stats then begin
  41     fprintf err_formatter "@[STATS: Query: %a @]@." Xpath.Ast.print_path query;
  42     fprintf err_formatter "@[STATS: @[Automaton: @\n";
  43     Ata.print err_formatter auto;
  44     fprintf err_formatter "@]@]@.";
  45   end;
  46   let module Naive = Eval.Make(Naive_tree) in
  47   let t1 = Unix.gettimeofday() in
  48   let results = Naive.eval auto doc (Naive_tree.root doc) in
  49   let teval = (Unix.gettimeofday () -. t1) *. 1000. in
  50   let t1 = Unix.gettimeofday () in
  51   output_string output "<xml_result>\n";
  52   if !Options.count then begin
  53     output_string output (string_of_int (List.length results));
  54     output_char output '\n';
  55   end else
  56     List.iter (fun n ->
  57       Naive_tree.print_xml output doc n;
  58       output_char output '\n'
  59     ) results;
  60   output_string output "</xml_result>\n";
  61   let tprint = (Unix.gettimeofday () -. t1) *. 1000. in
  62   flush output;
  63   if output != stdout then close_out output;
  64   if !Options.stats then begin
  65     fprintf err_formatter "@[STATS: evaluation time: %fms@]@." teval;
  66     fprintf err_formatter "@[STATS: serialization time: %fms@]@." tprint
  67   end
  68
  69
  70 let () =
  71   try
  72     main ()
  73   with
  74     Arg.Bad msg -> eprintf "Error: %s\n%!" msg; Options.usage (); exit 1
  75   | Sys_error msg -> eprintf "Error: %s\n%!" msg; exit 2
  76   | Tree.Parse_error msg -> eprintf "Error: file %s, %s\n%!" !Options.input_file msg; exit 3
  77   | Xpath.Ulexer.Error (s, e, msg) -> eprintf "Error: character %i-%i: %s\n%!" s e msg; exit 4
  78   | e -> eprintf "FATAL ERROR: %s\n%!" (Printexc.to_string e); exit 128