validate.ml 2.33 KB
Newer Older
1

2 3 4
(*
  XML Schema validator

5
  Usage:   validate <schema_document> [<instance_document> ...]
6 7 8 9 10 11 12

  Exit codes:
    0     validation ok
    1     wrong invocation
    2     error validating schema document
    3     error validating instance document
*)
13

14 15
open Printf
open Pxp_document
16 17

open Schema_common
18
open Schema_types
19

20
exception Usage
21

22 23
let debug = true
let debug_print s = if debug then prerr_endline s
24 25

let main () =
26 27 28 29 30 31 32
  let schema_file =
    try
      (match Sys.argv.(1) with
      | "--help" | "-help" -> raise Usage
      | fname -> fname)
    with Invalid_argument _ -> raise Usage
  in
33
  debug_print "Parsing schema document ...";
34
  let schema = Schema_parser.schema_of_uri schema_file in
35
(*
36 37 38 39 40 41 42 43 44 45 46 47 48 49
  for i = 2 to Array.length Sys.argv - 1 do
    let instance_stream = Schema_xml.pxp_stream_of_file Sys.argv.(i) in
    let first_element_name =
      let rec aux s =
        match Stream.peek s with
        | Some (Pxp_yacc.E_start_tag (name, _, _)) -> name
        | _ -> Stream.junk s; aux s
      in
      aux instance_stream
    in
    (try
      let first_element_decl =
        (try
          List.find (fun (name,_,_) -> name = first_element_name)
50
            schema.elements
51 52 53 54
        with Not_found ->
          raise (XSI_validation_error (sprintf "No declaration found in schema \
            for element '%s'" first_element_name)))
      in
55
      debug_print "Creating validator for root element ...";
56 57 58
      let validator =
        Schema_validator.validator_of_elt_decl first_element_decl
      in
59
      debug_print "Validating ...";
60
      let value = Schema_validator.validate ~validator instance_stream in
61 62 63
      debug_print "Printing CDuce value ...";
      Value.print Format.std_formatter value;
      debug_print "All done!"
64 65 66 67
    with XSI_validation_error msg ->
      print_endline (sprintf "Validation error on '%s': %s" Sys.argv.(i) msg);
      flush stdout)
  done
68
*)
69
  ()
70

71 72 73 74 75 76 77 78 79 80 81
let _ =
  try
    main ()
  with
  | Usage ->
      prerr_endline
        "Usage:   validate <schema_document> [ <instance_document> ...  ]";
      exit 1
  | XSD_validation_error msg ->
      prerr_endline ("Error validating schema document:\n" ^ msg);
      exit 2
82
  | XSI_validation_error msg ->
83 84
      prerr_endline ("Error validating instance document:\n" ^ msg);
      exit 3
85 86 87 88
  | Pxp_types.At _ as exc ->
      prerr_endline ("PXP error: " ^ Pxp_types.string_of_exn exc);
      exit 4