diff options
Diffstat (limited to 'src/odf/odf.ml')
| -rwxr-xr-x | src/odf/odf.ml | 346 |
1 files changed, 346 insertions, 0 deletions
diff --git a/src/odf/odf.ml b/src/odf/odf.ml new file mode 100755 index 0000000..ae120d9 --- /dev/null +++ b/src/odf/odf.ml @@ -0,0 +1,346 @@ +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 = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\
+<manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\
+<manifest:file-entry manifest:full-path=\"/\" manifest:version=\"1.2\" manifest:media-type=\"application/vnd.oasis.opendocument.spreadsheet\"/>\
+<manifest:file-entry manifest:full-path=\"content.xml\" manifest:media-type=\"text/xml\"/>
+</manifest: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
|