open Printf;;
-exception Stylesheet_not_found of string;;
-exception Stylesheet_already_in of string;;
+exception Stylesheet_not_found of string ;;
+exception Stylesheet_already_in of string ;;
+
+type xslt_msg =
+ | LibXsltErrorMsg of string
+ | LibXsltDebugMsg of string
+;;
+type log = xslt_msg list ;;
class styles =
object (self)
(* INVARIANT: 'stylesheets' and 'uris' are in sync *)
- val mutable stylesheets = []
- val mutable uris = []
+ initializer
+ Gdome_xslt.setErrorCallback
+ (Some (fun msg -> self#appendMsg (LibXsltErrorMsg msg)));
+ Gdome_xslt.setDebugCallback
+ (Some (fun msg -> self#appendMsg (LibXsltDebugMsg msg)))
+
+
+ val mutable stylesheets = [] (** association list: key -> Gdome.document *)
+ val mutable uris = [] (** association list: key -> uri *)
+ val mutable libXsltMsgs = [] (** libxslt's error and debugging messages *)
+
val domImpl = Gdome.domImplementation ()
(** process an XSLT stylesheet *)
- method private process uri = domImpl#createDocumentFromURI ~uri ()
+ method private process uri =
+ let dom = domImpl#createDocumentFromURI ~uri () in
+ ignore (Gdome_xslt.processStylesheet dom); (* fills libXsltMsgs in case
+ of errors *)
+ dom
- method get keys =
- let rev_keys = List.rev keys in
- let last_key = List.hd rev_keys in
- let p_stylesheets =
- List.fold_left
- (fun collected_styles key ->
- let (key, stylesheet) =
- try
- List.find (fun (k, _) -> k = key) stylesheets
- with Not_found -> raise (Stylesheet_not_found key)
- in
- (key, Gdome_xslt.processStylesheet stylesheet)::collected_styles)
- []
- rev_keys
- in
- let last_stylesheet =
- snd (List.find (fun (k, _) -> k = last_key) stylesheets)
- in
- (p_stylesheets, last_stylesheet)
+ (* libxslt's error and debugging messages handling *)
+
+ method private appendMsg msg = libXsltMsgs <- msg :: libXsltMsgs
+ method private clearMsgs = libXsltMsgs <- []
+
+ (* stylesheets management *)
method add key uri =
if (List.mem_assoc key uris) then
raise (Stylesheet_already_in key)
else begin
+ self#clearMsgs;
uris <- (key, uri) :: uris;
- stylesheets <- (key, self#process uri) :: stylesheets
+ stylesheets <- (key, self#process uri) :: stylesheets;
+ libXsltMsgs
end
- method remove key =
+ method remove key : log =
if not (List.mem_assoc key uris) then
raise (Stylesheet_not_found key)
else begin
uris <- List.remove_assoc key uris;
- stylesheets <- List.remove_assoc key stylesheets
+ stylesheets <- List.remove_assoc key stylesheets;
+ [] (* no XSLT action -> no logs *)
end
- method removeAll = uris <- []; stylesheets <- []
-
- method list =
- List.map
- (fun (key, uri) ->
- sprintf "key = %s, uri = %s" key (List.assoc key uris))
- uris
+ method removeAll : log =
+ uris <- [];
+ stylesheets <- [];
+ [] (* no XSLT action -> no logs *)
method reload key =
(try
+ self#clearMsgs;
let uri = List.assoc key uris in
stylesheets <-
- (key, self#process uri) :: (List.remove_assoc key stylesheets)
+ (key, self#process uri) :: (List.remove_assoc key stylesheets);
+ libXsltMsgs
with Not_found ->
raise (Stylesheet_not_found key))
method reloadAll =
- stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris
+ self#clearMsgs;
+ stylesheets <- List.map (fun (key, uri) -> (key, self#process uri)) uris;
+ libXsltMsgs
+
+ (* stylesheets usage *)
+
+ method list =
+ List.map
+ (fun (key, uri) ->
+ sprintf "key = %s, uri = %s" key (List.assoc key uris))
+ uris
+
+ method get keys =
+ let rev_keys = List.rev keys in
+ let last_key = List.hd rev_keys in
+ let p_stylesheets =
+ List.fold_left
+ (fun collected_styles key ->
+ let (key, stylesheet) =
+ try
+ List.find (fun (k, _) -> k = key) stylesheets
+ with Not_found -> raise (Stylesheet_not_found key)
+ in
+ (key, Gdome_xslt.processStylesheet stylesheet)::collected_styles)
+ []
+ rev_keys
+ in
+ let last_stylesheet =
+ snd (List.find (fun (k, _) -> k = last_key) stylesheets)
+ in
+ (p_stylesheets, last_stylesheet)
end