1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
(*
This file is part of licht.
licht is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
licht is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with licht. If not, see <http://www.gnu.org/licenses/>.
*)
module NS = Odf_ns
type tree =
| Data of string
| Cell of {repetition: int; cell_width: int; expression: Expression.t}
| Unit
let memoization cache key f = begin
try
Hashtbl.find cache key
with Not_found ->
let value = f key in
Hashtbl.add cache key value;
value
end
let load_content cache content = begin function
| "float" -> Expression.Basic (
ScTypes.Type.number (
DataType.Num.of_float (float_of_string content)
))
| "date" -> Expression.Basic (
ScTypes.Type.date (
DataType.Num.of_float (float_of_string content)
))
| _ ->
(* If the same text is present many times, use the same string instead of creating a new one *)
memoization cache content (fun content ->
Expression.Basic (
ScTypes.Type.string (
UTF8.from_utf8string content)))
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 build_cell cache (attributes:Xmlm.attribute list) (childs:tree list) = begin
(* Check if the content is repeated *)
let repetition =
try int_of_string @@ List.assoc NS.number_columns_repeat_attr attributes
with Not_found -> 1
(* cell width *)
and cell_width =
try int_of_string @@ List.assoc NS.number_columns_spanned_attr attributes
with Not_found -> 1
and expression =
try
load_formula @@ List.assoc NS.formula_attr attributes
with Not_found -> (
let vtype =
try List.assoc NS.ovalue_type_attr attributes
with Not_found -> "" in
try
load_content cache (List.assoc NS.value_attr attributes) vtype
with Not_found -> (
(* This is not a formula, neither a value ? *)
try
let value = Tools.List.find_map (function | Data x -> Some x | _ -> None) childs in
load_content cache value vtype
with Not_found -> Expression.Undefined
)
) in
Cell {repetition; cell_width; expression}
end
let build_p (attributes:Xmlm.attribute list) = begin function
| Data x::_ -> Data x
| _ -> Data ""
end
let build_row (sheet:Sheet.t) (row_num:int ref) (attributes:Xmlm.attribute list) (childs:tree list) = begin
let repetition =
try int_of_string @@ List.assoc (NS.table, "number-rows-repeated") attributes
with Not_found -> 1 in
for i = 1 to repetition do
let cell_num = ref 1 in
List.iter (function
| Cell cell ->
for i = 1 to cell.repetition do
ignore @@ Sheet.add ~history:false cell.expression (!cell_num, !row_num) sheet;
cell_num := !cell_num + cell.cell_width
done;
| _ -> ()
) childs;
incr row_num
done;
Unit
end
let data str = Data str
let load catalog source = begin
(* Mutable datas *)
let sheet = Sheet.create catalog in
let cache = Hashtbl.create 10 in
let table = String_dict.of_alist_exn [
((NS.text ^ "p"), build_p);
((NS.table ^ "table-cell"), build_cell cache);
((NS.table ^ "table-row"), build_row sheet (ref 1))
] in
let el (((ns, name), attributes):Xmlm.tag) childs = begin
match String_dict.find table (ns ^ name) with
| Some f -> f attributes childs
| None -> Unit
end in
match Xmlm.input_doc_tree ~el ~data source with
| _, Unit -> sheet
| _ -> raise Not_found
end
|
