src/solve.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 (** use: [./test xml_file -f XPath_queries_file]
  18     one query per line [XPath_querie_file]
  19 *)
  20
  21 open Format
  22
  23 let doc () =
  24   let fd = open_in Sys.argv.(1) in
  25   let d = Tree.load_xml_file fd in
  26   close_in fd;
  27   fprintf err_formatter "Parse Tree OK ! ";
  28   d
  29
  30
  31 let query () =
  32   let arg2 = Sys.argv.(2) in
  33   if arg2 = "-f"
  34   then  let fq = open_in Sys.argv.(3) in
  35         let rec list_qu fq list =
  36           try
  37             (match XPath.parse_file fq with
  38               | q -> list_qu fq (q::list)
  39               | _ -> list)
  40           with _ -> list in
  41         let list = list_qu fq [] in
  42         close_in fq;
  43         fprintf err_formatter "Parse query OK ! ";
  44         list
  45   else failwith "Use -f"
  46
  47 let build_asta query =
  48   let asta = Compil.trans query in
  49   fprintf err_formatter "Compil OK ! ";
  50   asta
  51
  52 let compute_run doc query =
  53   let run = Run.compute doc query in
  54   fprintf err_formatter "Run OK ! \n";
  55   run
  56
  57 let () =
  58   Format.pp_set_margin err_formatter 80;
  59   let doc = doc () in
  60   output_string stderr "##### Doc with positions #####\n";
  61   Tree.print_xml_preorder stderr doc (Tree.root doc);
  62   let queries = query () in
  63   let rec solve_queries = function
  64     | [] -> ()
  65     | query :: tl ->
  66       let asta = build_asta query in
  67       let selected_nodes = Run.selected_nodes doc asta in
  68       fprintf err_formatter "Query: %a\n"
  69         XPath.Ast.print query;
  70       let rec print_selec fmt l = match l with
  71         | [x] -> fprintf fmt "%s" (string_of_int x)
  72         | x :: tl -> fprintf fmt "%s" ((string_of_int x)^"; ");print_selec fmt tl
  73         | [] -> fprintf fmt "%s" "ø" in
  74       fprintf err_formatter "@.@.  # Selected nodes: {%a}@."
  75         print_selec selected_nodes in
  76   solve_queries queries;
  77   exit 0