(*********************************************************************************) |
(* Cameleon *)
(* *)
(* Copyright (C) 2005,2006 Institut National de Recherche en Informatique *)
(* et en Automatique. All rights reserved. *)
(* *)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU Library General Public License as *)
(* published by the Free Software Foundation; either version 2 of the *)
(* License, or any later version. *)
(* *)
(* This program is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Library General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Library General Public *)
(* License along with this program; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA *)
(* 02111-1307 USA *)
(* *)
(* Contact: Maxence.Guesdon@inria.fr *)
(* *)
(*********************************************************************************) |
open Rep_desc
open Xml
let xml_of_tag_att (name, value) =
Element ("att", ["name", name ; "value", value], [])
let rec xml_of_report_ele = function
Leaf leaf ->
Element ("leaf", [], [PCData leaf.leaf])
| Tag t ->
Element ("tag", ["tag", t.tag],
(List.map xml_of_tag_att t.atts) @
(List.map xml_of_report_ele t.tag_subs))
| List l ->
Element ("list", ["var", l.var; "f", l.f],
List.map xml_of_report_ele l.list_subs)
| Cond c ->
Element ("cond", ["cond", c.cond],
[
Element ("then", [], List.map xml_of_report_ele c.subs_then) ;
Element ("else", [], List.map xml_of_report_ele c.subs_else) ;
]
)
| Sub s ->
Element ("sub", [], [PCData s.sub_code])
| Mark m ->
Element ("mark", ["id", m.mark_id ; "name", m.mark_name], [])
| _ ->
assert false
let xml_of_param p = Element ("param", [], [PCData p])
let xml_of_report r =
Element ("report", [],
(Element ("header", [], [PCData r.rep_header])) ::
(List.map xml_of_param r.rep_params) @
(List.map xml_of_report_ele r.rep_eles)
)
let store_report f r =
let oc = open_out f in
output_string oc (Xml.to_string (xml_of_report r));
close_out oc
exception Bad_format of xml
let rec report_ele_of_xml xml =
match xml with
| PCData _ -> None
| Element ("leaf", atts, [PCData s]) ->
Some (Leaf { leaf = s })
| Element ("tag", atts, subs) ->
(
try
let tag = Xml.attrib xml "tag" in
let atts = List.fold_left
(fun acc xml ->
match xml with
Element ("att", l, _) ->
(
try
let a = (Xml.attrib xml "name", Xml.attrib xml "value") in
a :: acc
with
Xml.No_attribute _ -> acc
)
| _ -> acc
)
[]
subs
in
let subs = report_ele_list_of_xmls subs in
Some
(Tag { tag = tag ;
atts = atts ;
tag_subs = subs ;
}
)
with
_ -> None
)
| Element ("list", atts, subs) ->
(
try
Some (List
{
var = Xml.attrib xml "var" ;
f = Xml.attrib xml "f" ;
list_subs = report_ele_list_of_xmls subs ;
}
)
with
_ -> None
)
| Element ("cond", atts,
[ Element ("then", _, subs_then) ;
Element ("else", _, subs_else) ]
) ->
(
try
Some (Cond
{
cond = Xml.attrib xml "cond";
subs_then = report_ele_list_of_xmls subs_then ;
subs_else = report_ele_list_of_xmls subs_else ;
}
)
with
_ -> None
)
| Element ("sub", _, [PCData s]) ->
Some (Sub { sub_code = s})
| Element ("mark", atts, _) ->
(
try Some (Mark { mark_id = Xml.attrib xml "id" ;
mark_name = Xml.attrib xml "name" ;
}
)
with _ -> None
)
| _ -> None
and report_ele_list_of_xmls l =
List.rev
(List.fold_left
(fun acc xml ->
match report_ele_of_xml xml with
None -> acc
| Some e -> e :: acc
)
[]
l
)
let report_of_xml xml =
match xml with
Element ("report", _, subs) ->
(
match subs with
(Element ("header",_,subs) as xml2) :: l ->
let header =
match subs with
[] -> ""
| [PCData s] -> s
| _ -> raise (Bad_format xml2)
in
let params = List.fold_left
(fun acc xml ->
match xml with
Element ("param", _, [PCData s]) -> s :: acc
| _ -> acc
)
[]
l
in
let eles = report_ele_list_of_xmls l in
{ rep_header = header ;
rep_params = List.rev params ;
rep_eles = eles ;
}
| [] -> raise (Bad_format xml)
| xml :: _ -> raise (Bad_format xml)
)
| _ ->
raise (Bad_format xml)
let read_xml_file f file =
let t_parser = XmlParser.make () in
let _ = XmlParser.prove t_parser false in
f (XmlParser.parse t_parser (XmlParser.SFile file))
let load_report f =
try read_xml_file report_of_xml f
with
Xml.File_not_found _ ->
{ rep_header = "" ;
rep_params = [] ;
rep_eles = [] ;
}
| Bad_format xml ->
let s = Rep_misc.chop_n_char 120 (Xml.to_string xml) in
failwith (Rep_messages.bad_format s)
(*
{ rep_header = "header" ;
rep_params = ["x" ; "y"] ;
rep_eles =
[
Tag { tag = "h1" ;
atts = ["class", "toto" ; "color", "#FFF000"] ;
tag_subs =
[
Leaf { leaf = "Titre 1" } ;
] ;
} ;
Tag { tag = "h2" ;
atts = ["class", "toto" ; "color", "#FFF000"] ;
tag_subs =
[
Leaf { leaf = "Titre 2" } ;
Tag { tag = "h3" ;
atts = ["class", "toto" ; "color", "#FFF000"] ;
tag_subs =
[
Leaf { leaf = "Titre 3" } ;
] ;
}
] ;
}
]
}
*)