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
(** GPX Unix I/O operations *)
(** Result binding operators *)
let (let*) = Result.bind
(** Read GPX from file *)
let read_file ?(validate=false) filename =
try
let ic = open_in filename in
let input = Xmlm.make_input (`Channel ic) in
let result = Gpx.parse ~validate input in
close_in ic;
result
with
| Sys_error msg -> Error (Gpx.Error.io_error msg)
| exn -> Error (Gpx.Error.io_error (Printexc.to_string exn))
(** Write GPX to file *)
let write_file ?(validate=false) filename gpx =
try
let oc = open_out filename in
let dest = `Channel oc in
let result = Gpx.write ~validate dest gpx in
close_out oc;
result
with
| Sys_error msg -> Error (Gpx.Error.io_error msg)
| exn -> Error (Gpx.Error.io_error (Printexc.to_string exn))
(** Read GPX from stdin *)
let read_stdin ?(validate=false) () =
let input = Xmlm.make_input (`Channel stdin) in
Gpx.parse ~validate input
(** Write GPX to stdout *)
let write_stdout ?(validate=false) gpx =
Gpx.write ~validate (`Channel stdout) gpx
(** Check if file exists and is readable *)
let file_exists filename =
try
let _ = Unix.stat filename in
true
with
| Unix.Unix_error _ -> false
(** Get file size *)
let file_size filename =
try
let stats = Unix.stat filename in
Ok stats.st_size
with
| Unix.Unix_error (errno, _, _) ->
Error (Gpx.Error.io_error (Unix.error_message errno))
(** Create backup of file before overwriting *)
let create_backup filename =
if file_exists filename then
let backup_name = filename ^ ".bak" in
try
let ic = open_in filename in
let oc = open_out backup_name in
let rec copy () =
match input_char ic with
| c -> output_char oc c; copy ()
| exception End_of_file -> ()
in
copy ();
close_in ic;
close_out oc;
Ok backup_name
with
| Sys_error msg -> Error (Gpx.Error.io_error msg)
| exn -> Error (Gpx.Error.io_error (Printexc.to_string exn))
else
Ok ""
(** Write GPX to file with backup *)
let write_file_with_backup ?(validate=false) filename gpx =
let* backup_name = create_backup filename in
match write_file ~validate filename gpx with
| Ok () -> Ok backup_name
| Error _ as err ->
if backup_name <> "" && file_exists backup_name then (
try
Sys.rename backup_name filename
with _ -> ()
);
err