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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
module T = Tools
module NS = Odf_ns
let u = UTF8.from_utf8string
type t
let load_xml input = begin
let source = Xmlm.make_input ~enc:(Some `UTF_8) (`Channel input) in
let sheet = OdfLoader.load source in
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
|
