Corrected some issues with odf documents

4 files changed, 83 insertions, 49 deletions

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

diff --git a/odf/odf_ExpressionLexer.mll b/odf/odf_ExpressionLexer.mll
index 28fce22..1db73c3 100755
--- a/odf/odf_ExpressionLexer.mll
+++ b/odf/odf_ExpressionLexer.mll
@@ -13,9 +13,13 @@ let newline = "\r\n" | '\n' | '\r'
 let space = ['\t' ' '] | newline
 
 let letters = ['A'-'Z' 'a'-'z']
-let identifier = letters (letters | digit | ['-' '_' '.'])* (letters | digit)+
 
-let text = letters | digit 
+(* Function identifier.
+   Valid identifiers are : 
+     ORG.OPENOFFICE.DAYSINMONTH
+   it cannot end with a digit.
+ *)
+let identifier = letters (letters | digit | ['-' '_' '.'])* letters+
 
 let cell = letters+ digit+
 
@@ -36,7 +40,7 @@ rule read = parse
   | '+'         { PLUS }
   | '-'         { MINUS }
   | '/'         { DIVIDE }
-  | '"'         { read_string (Buffer.create 17) lexbuf }
+  | '"'         { read_string (Buffer.create 16) lexbuf }
   | ';'         { SEMICOLON }
   | ':'         { COLON }
   | '['         { L_SQ_BRACKET }
@@ -47,6 +51,7 @@ rule read = parse
   | '.'         { DOT }
 
   | letters+ as _1   { LETTERS _1}
+  | identifier as _1 { IDENT _1}
 
   | '\000'      { EOF }
   | eof         { EOF }
diff --git a/odf/odf_ExpressionParser.mly b/odf/odf_ExpressionParser.mly
index 6c34c1d..9731699 100755
--- a/odf/odf_ExpressionParser.mly
+++ b/odf/odf_ExpressionParser.mly
@@ -13,6 +13,7 @@
 %token <string> STR
 
 %token <string> LETTERS
+%token <string> IDENT
 
 %token DOLLAR
 %token DOT
@@ -43,7 +44,8 @@ value:
 
 expr:
   | num                     {Value (Num ((snd $1), Some (u(fst $1))))}
-  | MINUS num               {Value (Num (Num.minus_num (snd $2), Some (u("-" ^(fst $2)) )))}
+  | MINUS expr              {Call (F.sub, [$2])}
+  | PLUS expr               {Call (F.add, [$2])}
 
 
   | L_SQ_BRACKET ref R_SQ_BRACKET {$2}
@@ -85,6 +87,7 @@ num:
   | NUM                     {$1}
 
 ident:
+  | IDENT                   { $1 }
   | text+                   { String.concat "" $1 }
 
 text:
diff --git a/odf/odf_ns.ml b/odf/odf_ns.ml
index c22ae7e..5a501da 100755
--- a/odf/odf_ns.ml
+++ b/odf/odf_ns.ml
@@ -52,7 +52,8 @@ let table_cell_node       = (table, "table-cell")
   let ovalue_type_attr    = (office, "value-type")

   let value_attr          = (office, "value")

   let formula_attr        = (table, "formula")

-  let date_value_attr           = (office, "date-value")

+  let date_value_attr     = (office, "date-value")

+  let number_columns_spanned_attr = (table, "number-columns-spanned")

 

 let text_node             = (text, "p")