From 0d1f9ff76aa6df3f17edd2d73c76ab444fec8528 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 2 Jan 2017 17:56:04 +0100 Subject: Corrected some issues with odf documents --- odf/odf.ml | 113 +++++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 69 insertions(+), 44 deletions(-) (limited to 'odf/odf.ml') diff --git a/odf/odf.ml b/odf/odf.ml index df98adb..da33ba9 100755 --- a/odf/odf.ml +++ b/odf/odf.ml @@ -6,25 +6,27 @@ let u = UTF8.from_utf8string type t -let load_attrs attrs = - - let _load t = function - | (("urn:oasis:names:tc:opendocument:xmlns:table:1.0", "formula"), x) -> - T.Tuple3.replace1 (Some x) t - | (("urn:oasis:names:tc:opendocument:xmlns:office:1.0", "value"), x) -> - T.Tuple3.replace2 (Some x) t - | (("urn:oasis:names:tc:opendocument:xmlns:office:1.0", "date-value"), x) -> - T.Tuple3.replace2 (Some x) t - | (("urn:oasis:names:tc:opendocument:xmlns:table:1.0", "number-columns-repeated"), x) -> - T.Tuple3.replace3 (Some x) t - | _ -> t - in List.fold_left _load (None, None, None) attrs +(** Map for storing all the attributes *) +module AttributesMap = Map.Make (struct + type t = string * string + let compare = Pervasives.compare +end) + +let get_attr map key = begin + try Some (AttributesMap.find key map) with + Not_found -> None +end let load_formula formula = let lineBuffer = Lexing.from_string formula in - Expression.Formula ( - Expression.Expression ( - Odf_ExpressionParser.value Odf_ExpressionLexer.read lineBuffer)) + try + Expression.Formula ( + Expression.Expression ( + Odf_ExpressionParser.value Odf_ExpressionLexer.read lineBuffer)) + with e -> + print_endline formula; + raise e + let load_content content = begin function | "float" -> Expression.Basic ( @@ -38,38 +40,52 @@ let load_content content = begin function UTF8.from_utf8string content)) end +(** Load the content from a cell *) let load_cell sheet cell_num row_num changed (attrs, cell) = begin - let attributes = load_attrs attrs in - let repetition = match T.Tuple3.thd attributes with + (* Load all the attributes from the xml element *) + let add_attr map (key, value) = AttributesMap.add key value map in + let attributes = List.fold_left add_attr AttributesMap.empty attrs in + + (* Check if the content is repeated *) + let repetition = match get_attr attributes NS.number_columns_repeat_attr with + | None -> 1 + | Some x -> int_of_string x + + (* cell width *) + and cell_width = match get_attr attributes NS.number_columns_spanned_attr with | None -> 1 | Some x -> int_of_string x in let vtype = try List.assoc NS.ovalue_type_attr attrs with Not_found -> "" in - let expression, new_change = begin match attributes with - | Some x, _, _ -> load_formula x, true - | _, Some x, _ -> + + let formula = get_attr attributes NS.formula_attr + and value = get_attr attributes NS.value_attr in + + let expression, update = begin match formula, value with + | Some x, _ -> load_formula x, true + | _, Some x -> (load_content x vtype) , true | _ -> begin try Xml.member "p" cell |> Xml.data_to_string |> fun x -> (load_content x vtype, true) - with Xml.Tag_not_found _ -> Expression.Basic ScTypes.Undefined, false + with Xml.Tag_not_found _ -> Expression.Undefined, false end end in - if new_change then ( + if update then ( for i = 1 to repetition do - incr cell_num; + cell_num := !cell_num + cell_width; sheet := snd @@ Sheet.Raw.add (!cell_num, !row_num) (Expression.load_expr expression) !sheet done ) else ( - cell_num := !cell_num + repetition + cell_num := !cell_num + (repetition * cell_width ) ); - changed || new_change + changed || update end let load_row sheet row_num (attrs, row) = begin @@ -119,13 +135,13 @@ let load file = Zip.copy_entry_to_file zip content tmp_file; let input = open_in_bin tmp_file in - Tools.try_finally (fun () -> - load_xml input - )( fun () -> - close_in input; - Unix.unlink tmp_file; - Zip.close_in zip - ) + Tools.try_finally + (fun () -> load_xml input) + (fun () -> + close_in input; + Unix.unlink tmp_file; + Zip.close_in zip + ) let write_type ovalue_type cvalue_type attrs output value = begin @@ -157,7 +173,6 @@ let write_basic attrs output = begin function | ScTypes.Date d -> let value = Tools.Date.to_string d in write_date ((NS.date_value_attr, value)::attrs) output value - | _ -> () end let write_formula output attrs f = begin function @@ -180,11 +195,13 @@ let rec print_expr buffer = begin function | ScTypes.Value (ScTypes.Num (n, _)) -> UTF8.Buffer.add_string buffer @@ u(string_of_float @@ Num.float_of_num n) | ScTypes.Value (ScTypes.Str s) -> - UTF8.Buffer.add_string buffer @@ u"\""; - UTF8.Buffer.add_string buffer s; - UTF8.Buffer.add_string buffer @@ u"\"" - | ScTypes.Value (ScTypes.Bool b) -> UTF8.Buffer.add_string buffer @@ u(string_of_bool b) - | ScTypes.Value x -> () + UTF8.Printf.bprintf buffer "\"%s\"" (UTF8.to_utf8string s) + | ScTypes.Value (ScTypes.Bool b) -> + u(string_of_bool b) + |> UTF8.Buffer.add_string buffer + | ScTypes.Value (ScTypes.Date d) -> + u(Tools.Date.to_string d) + |> UTF8.Buffer.add_string buffer | ScTypes.Ref r -> print_ref buffer r | ScTypes.Expression x -> UTF8.Buffer.add_char buffer '('; @@ -194,6 +211,10 @@ let rec print_expr buffer = begin function begin match (UTF8.to_utf8string ident) with | "+" | "*" | "-" | "/" | "^" | "=" | "<>" | "<=" | ">=" | "<" | ">" -> begin match params with + | v1::[] -> + UTF8.Printf.bprintf buffer "%s%a" + (UTF8.to_utf8string ident) + print_expr v1 | v1::v2::[] -> UTF8.Printf.bprintf buffer "%a%s%a" print_expr v1 @@ -210,6 +231,7 @@ let rec print_expr buffer = begin function end let write_cell output value = begin function + | Expression.Undefined -> () | Expression.Basic b -> write_basic [] output b | Expression.Formula (Expression.Expression f) -> let buffer = UTF8.Buffer.create 10 in @@ -222,8 +244,9 @@ let write_cell output value = begin function end (** Jump to the wanted position *) -let goto output (from_x, from_y) (to_x, to_y) = begin +let goto output (from_x, from_y) (to_x, to_y) :unit = begin + (** Insert as many rows than required *) let insert_rows count = begin (* Close the previous openend rows *) Xmlm.output output `El_end; @@ -240,6 +263,7 @@ let goto output (from_x, from_y) (to_x, to_y) = begin 1 end + (** Insert as many cells as required *) and insert_cells count = begin Xmlm.output output ( `El_start ( @@ -255,11 +279,11 @@ let goto output (from_x, from_y) (to_x, to_y) = begin else from_x in let jump_cell = to_x - from_x' in - if jump_cell > 0 then insert_cells jump_cell; - - + if jump_cell > 0 then + insert_cells jump_cell end +(** Write the cell content and return the updated position *) let f output cursor position (expr, value) = begin goto output cursor position; @@ -271,7 +295,7 @@ let f output cursor position (expr, value) = begin Tools.Tuple2.map1 ((+) 1) position end -let save sheet file = +let save sheet file = begin let tmp_file = Filename.temp_file "content" ".xml" in Unix.unlink tmp_file; let out_channel = open_out_bin tmp_file in @@ -308,3 +332,4 @@ let save sheet file = Zip.close_out zip; Unix.unlink tmp_file ) +end -- cgit v1.2.3