patrick.sirref.org
1(** GPX Unix I/O operations *)
2
3open Gpx.Types
4
5(** Result binding operators *)
6let (let*) = Result.bind
7
8(** Read GPX from file *)
9let read_file filename =
10 try
11 let ic = open_in filename in
12 let input = Xmlm.make_input (`Channel ic) in
13 let result = Gpx.Parser.parse input in
14 close_in ic;
15 result
16 with
17 | Sys_error msg -> Error (IO_error msg)
18 | exn -> Error (IO_error (Printexc.to_string exn))
19
20(** Write GPX to file *)
21let write_file filename gpx =
22 try
23 let oc = open_out filename in
24 let output = Xmlm.make_output (`Channel oc) in
25 let result = Gpx.Writer.write output gpx in
26 close_out oc;
27 result
28 with
29 | Sys_error msg -> Error (IO_error msg)
30 | exn -> Error (IO_error (Printexc.to_string exn))
31
32(** Read GPX from stdin *)
33let read_stdin () =
34 let input = Xmlm.make_input (`Channel stdin) in
35 Gpx.Parser.parse input
36
37(** Write GPX to stdout *)
38let write_stdout gpx =
39 let output = Xmlm.make_output (`Channel stdout) in
40 Gpx.Writer.write output gpx
41
42(** Read GPX from file with validation *)
43let read_file_validated filename =
44 let* gpx = read_file filename in
45 let validation = Gpx.Validate.validate_gpx gpx in
46 if validation.is_valid then
47 Ok gpx
48 else
49 let errors = List.filter (fun issue -> issue.Gpx.Validate.level = `Error) validation.issues in
50 let error_msgs = List.map Gpx.Validate.format_issue errors in
51 Error (Validation_error (String.concat "; " error_msgs))
52
53(** Write GPX to file with validation *)
54let write_file_validated filename gpx =
55 let validation = Gpx.Validate.validate_gpx gpx in
56 if not validation.is_valid then
57 let errors = List.filter (fun issue -> issue.Gpx.Validate.level = `Error) validation.issues in
58 let error_msgs = List.map Gpx.Validate.format_issue errors in
59 Error (Validation_error (String.concat "; " error_msgs))
60 else
61 write_file filename gpx
62
63(** Check if file exists and is readable *)
64let file_exists filename =
65 try
66 let _ = Unix.stat filename in
67 true
68 with
69 | Unix.Unix_error _ -> false
70
71(** Get file size *)
72let file_size filename =
73 try
74 let stats = Unix.stat filename in
75 Ok stats.st_size
76 with
77 | Unix.Unix_error (errno, _, _) ->
78 Error (IO_error (Unix.error_message errno))
79
80(** Create backup of file before overwriting *)
81let create_backup filename =
82 if file_exists filename then
83 let backup_name = filename ^ ".bak" in
84 try
85 let ic = open_in filename in
86 let oc = open_out backup_name in
87 let rec copy () =
88 match input_char ic with
89 | c -> output_char oc c; copy ()
90 | exception End_of_file -> ()
91 in
92 copy ();
93 close_in ic;
94 close_out oc;
95 Ok backup_name
96 with
97 | Sys_error msg -> Error (IO_error msg)
98 | exn -> Error (IO_error (Printexc.to_string exn))
99 else
100 Ok ""
101
102(** Write GPX to file with backup *)
103let write_file_with_backup filename gpx =
104 let* backup_name = create_backup filename in
105 match write_file filename gpx with
106 | Ok () -> Ok backup_name
107 | Error _ as err ->
108 (* Try to restore backup if write failed *)
109 if backup_name <> "" && file_exists backup_name then (
110 try
111 Sys.rename backup_name filename
112 with _ -> ()
113 );
114 err