From a6b5a6bdd138a5ccc6827bcc73580df1e9218820 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 24 Nov 2017 09:22:24 +0100 Subject: Moved all the code to src directory --- odf/odf.ml | 346 ------------------------------------------------------------- 1 file changed, 346 deletions(-) delete mode 100755 odf/odf.ml (limited to 'odf/odf.ml') diff --git a/odf/odf.ml b/odf/odf.ml deleted file mode 100755 index ae120d9..0000000 --- a/odf/odf.ml +++ /dev/null @@ -1,346 +0,0 @@ -module Xml = Ezxmlm -module T = Tools -module NS = Odf_ns - -let u = UTF8.from_utf8string - -type t - -(** 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 - 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 ( - ScTypes.number ( - DataType.Num.of_float (float_of_string content) - )) - | "date" -> Expression.Basic ( - ScTypes.date ( - DataType.Num.of_float (float_of_string content) - )) - | _ -> Expression.Basic ( - ScTypes.string ( - UTF8.from_utf8string content)) -end - -(** Load the content from a cell *) -let load_cell sheet cell_num row_num changed (attrs, cell) = begin - - (* 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 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.Undefined, false - end - end in - - if update then ( - for i = 1 to repetition do - 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_width ) - ); - changed || update -end - -let load_row sheet row_num (attrs, row) = begin - - let repetition = - try int_of_string @@ List.assoc (NS.table, "number-rows-repeated") attrs - with Not_found -> 1 in - - let cells = Xml.members_with_attr "table-cell" row in - - try - for i = 1 to repetition do - incr row_num; - let cell_num = ref 0 in - if not (List.fold_left (load_cell sheet cell_num row_num) false cells) then - (* No changes on the whole row. Do not repeat, and break the loop *) - raise Not_found - done - with Not_found -> row_num := !row_num + repetition - 1 -end - -let load_xml input = begin - - let sheet = ref Sheet.Raw.empty in - let row_num = ref 0 in - - let xml = - Xmlm.make_input ~enc:(Some `UTF_8) (`Channel input) - |> Xml.from_input - |> snd in - let rows = Xml.member "document-content" (xml::[]) - |> Xml.member "body" - |> Xml.member "spreadsheet" - |> Xml.member "table" - |> Xml.members_with_attr "table-row" in - List.iter (fun x -> (load_row sheet row_num) x) rows; - !sheet -end - - -let load file = - let tmp_file = Filename.temp_file "content" ".xml" in - Unix.unlink tmp_file; - - let zip = Zip.open_in file in - let content = Zip.find_entry zip "content.xml" in - 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 - ) - - -let write_type ovalue_type cvalue_type attrs output value = begin - let attrs = - (NS.ovalue_type_attr, ovalue_type):: - (NS.cvalue_type_attr, cvalue_type):: - attrs in - - Xmlm.output output (`El_start (NS.table_cell_node, attrs)); - Xmlm.output output (`El_start (NS.text_node, [])); - Xmlm.output output (`Data value); - Xmlm.output output `El_end; - Xmlm.output output `El_end; -end - -(* Writers for differents types *) -let write_num = write_type "float" "float" -let write_str = write_type "string" "string" -let write_bool = write_type "bool" "bool" -let write_error = write_type "string" "error" -let write_date = write_type "date" "date" - -let write_basic: type a. 'b list -> Xmlm.output -> a ScTypes.types -> unit = fun attrs output types -> begin match types with - | ScTypes.Str s -> write_str attrs output (UTF8.to_utf8string s) - | ScTypes.Bool b -> write_bool attrs output (string_of_bool b) - | ScTypes.Num (data_type, d) -> - begin match ScTypes.get_numeric_type data_type with - | ScTypes.Number -> - let f = DataType.Num.to_float d in - let value = string_of_float f in - write_num ((NS.value_attr, value)::attrs) output value - | ScTypes.Date -> - let value = DataType.Date.to_string d in - write_date ((NS.date_value_attr, value)::attrs) output value - end -end - -let write_formula output attrs f = begin function - | ScTypes.Result x -> write_basic attrs output x - | ScTypes.Error exn -> write_str attrs output "#NAME?" -end - -let print_ref buffer c = - UTF8.Buffer.add_string buffer @@ u"[."; - begin match c with - | ScTypes.Cell c -> UTF8.Buffer.add_string buffer @@ Cell.to_string c; - | ScTypes.Range (c1, c2) -> - UTF8.Buffer.add_string buffer @@ Cell.to_string c1; - UTF8.Buffer.add_string buffer @@ u":."; - UTF8.Buffer.add_string buffer @@ Cell.to_string c2; - end; - UTF8.Buffer.add_string buffer @@ u"]" - -let rec print_expr : UTF8.Buffer.buffer -> ScTypes.expression -> unit = fun buffer -> begin function - | ScTypes.Value (ScTypes.Str s) -> - 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.Num (data_type, d)) -> - begin match ScTypes.get_numeric_type data_type with - | ScTypes.Number -> - let f = DataType.Num.to_float d in - UTF8.Buffer.add_string buffer @@ u(string_of_float f) - | ScTypes.Date -> - DataType.Date.to_string d - |> u - |> UTF8.Buffer.add_string buffer - end - | ScTypes.Ref r -> print_ref buffer r - | ScTypes.Expression x -> - UTF8.Buffer.add_char buffer '('; - print_expr buffer x; - UTF8.Buffer.add_char buffer ')'; - | ScTypes.Call (ident, params) -> - 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 - (UTF8.to_utf8string ident) - print_expr v2 - | _ -> - UTF8.Buffer.add_string buffer ident; - Tools.List.printb ~sep:(u";") print_expr buffer params - end - | _ -> - UTF8.Buffer.add_string buffer ident; - Tools.List.printb ~sep:(u";") print_expr buffer params - end -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 - print_expr buffer f; - let formula = UTF8.Buffer.contents buffer - |> UTF8.to_utf8string in - write_formula output [(NS.formula_attr, ("of:=" ^formula))] f value - | Expression.Formula (Expression.Error (i, s)) -> - write_error [(NS.formula_attr, ("of:" ^ (UTF8.to_utf8string s)))] output (UTF8.to_utf8string s) -end - -(** Jump to the wanted position *) -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; - - if (count > 1) then ( - Xmlm.output output ( - `El_start ( - NS.table_row_node, [(NS.table_row_repeat_attr, string_of_int (count-1))])); - Xmlm.output output (`El_start (NS.table_cell_node, [])); - Xmlm.output output `El_end; - Xmlm.output output `El_end; - ); - Xmlm.output output (`El_start (NS.table_row_node, [])); - 1 - end - - (** Insert as many cells as required *) - and insert_cells count = begin - Xmlm.output output ( - `El_start ( - NS.table_cell_node, [(NS.number_columns_repeat_attr, string_of_int count)])); - Xmlm.output output `El_end; - end in - - (* Insert empty rows or columns until the desired position *) - let jump_row = to_y - from_y in - let from_x' = - if jump_row > 0 then - insert_rows jump_row - else - from_x in - let jump_cell = to_x - from_x' in - 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; - - (* Write the value *) - write_cell output value expr; - - (* Return the update position *) - Tools.Tuple2.map1 ((+) 1) position -end - -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 - let zip = Zip.open_out file in - - let manifest = "\ -\ -\ - -" in - - Tools.try_finally (fun () -> - - let output = Xmlm.make_output (`Channel out_channel) in - Xmlm.output output (`Dtd None); - Xmlm.output output (`El_start (NS.document_content_node, NS.name_spaces())); - Xmlm.output output (`El_start (NS.body_node, [])); - Xmlm.output output (`El_start (NS.spreadsheet_node, [])); - Xmlm.output output (`El_start (NS.table_node, [])); - - Xmlm.output output (`El_start (NS.table_row_node, [])); - ignore (Sheet.Raw.fold (f output) (1,1) sheet); - Xmlm.output output `El_end; - - Xmlm.output output `El_end; - Xmlm.output output `El_end; - Xmlm.output output `El_end; - Xmlm.output output `El_end; - - close_out out_channel; - Zip.copy_file_to_entry tmp_file zip "content.xml"; - Zip.add_entry manifest zip "META-INF/manifest.xml" - ) (fun () -> - Zip.close_out zip; - Unix.unlink tmp_file - ) -end -- cgit v1.2.3