Skip to content
Newer
Older
100644 142 lines (104 sloc) 4.18 KB
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 module U = Unix
19
20 ##register exists : string -> bool
21 let exists n = try ignore (Unix.stat n) ; true with _ -> false
22 (* let exists = File.exists : this one use Sys.file_exists, what do you prefer ?*)
23
24 ##register is_regular : string -> bool
25 let is_regular = File.is_regular
26
27 (**
28 Return true if given path is a file is a directory, false otherwise.
29 If the file/directory doesn't exist, return false too.
30 *)
31 ##register is_directory : string -> bool
32 let is_directory x =
33 try
34 File.is_directory x
35 with Unix.Unix_error (Unix.ENOENT, _, _) -> false
36
37 ##register make_dir : string -> bool
38 let make_dir n =
39 try Unix.mkdir n 0o700; true with _ -> false
40
18cc3e9 [fix] stdlib/file: improve and add bindings
François-Régis Sinot authored Aug 23, 2011
41 ##register basename \ `Filename.basename` : string -> string
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
42
18cc3e9 [fix] stdlib/file: improve and add bindings
François-Régis Sinot authored Aug 23, 2011
43 ##register dirname \ `Filename.dirname` : string -> string
44
45 ##register dir_sep : string
46 let dir_sep = Filename.dir_sep
fccc685 Initial open-source release
MLstate authored Jun 21, 2011
47
48 ##register copy: string, string, bool -> void
49 let copy a b force = ignore (File.copy ~force a b)
50
51 ##register move: string, string, bool -> void
52 let move a b force = ignore (File.mv ~force a b)
53
54
55
56 (**
57 {1 Obsolete API}
58
59 The following functions are blocking. They must be reimplemented in a non-blocking way
60 *)
61
62
63
64
65 ##register fold_dir_rec : ('a, string, string -> 'a), 'a, string -> 'a
66 let fold_dir_rec f = File.fold_dir_rec (fun acc ~name ~path -> f acc name path)
67
68 ##register fold_dir_rec_opt : ('a, string, string -> 'a), 'a, string -> option('a)
69 let fold_dir_rec_opt f acc path =
70 try
71 Some (File.fold_dir_rec (fun acc ~name ~path -> f acc name path) acc path)
72 with Unix.Unix_error (Unix.ENOENT, _, _) -> None
73
74 ##register path_sep : string
75 let path_sep = File.path_sep
76
77
78 ##register mimetype_opt : string -> option(string)
79 let mimetype_opt x =
80 try
81 Some (File.mimetype x)
82 with Failure _ -> None
83
84 ##register explicit_path : string, option(string) -> string
85 let explicit_path = File.explicit_path
86
87 ##register clean_beginning_path : string -> string
88 let clean_beginning_path = File.clean_beginning_path
89
90 ##register last_modification : string -> time_t
91 let last_modification f = Time.in_milliseconds (File.last_modification f)
92
93 (**
94 Dump a value to a file
95
96 @param n The name of the file
97 @param content The content to put in the file
98
99 In case of error, explode.
100 *)
101 ##register of_string : string, string -> void
102 let of_string n content =
103 let och =
104 let path = Filename.dirname n in
105 ignore (File.check_create_path path);
106 open_out n
107 in output_string och content ; close_out och
108
109 ##register create_full_path: string -> void
110 let create_full_path path = ignore (File.check_create_path path)
111
112 ##register content_opt: string -> option(string)
113 let content_opt = File.content_opt
114
115 (**
116 {1 Must reimplement}
117
118 This works on Macintosh, but not Linux, due to limitations of epoll!
119 *)
120
121 ##register [cps-bypass] content_cps: string, continuation(opa[option(string)]) -> void
122 let content_cps filename k =
123 let fd = U.openfile filename [U.O_RDONLY; U.O_NONBLOCK] 0o600 in
124 let size = (U.fstat fd).U.st_size in
125 let sched = BslNet.default_scheduler in
126 let addr = NetAddr.mk_file ~fd in
127 let conn = Scheduler.make_connection sched addr in
128 let finalize result =
129 U.close fd;
130 QmlCpsServerLib.return k result
131 in
132 let on_failure _ = finalize ServerLib.none
133 and on_success (_, buffer) = finalize (ServerLib.some (ServerLib.wrap_string (FBuffer.contents buffer))) in
134 Scheduler.read_all ~read_max:(Some size) sched conn ~err_cont:on_failure on_success
135
136 (**
137 {1 Deprecated}
138 *)
139 (*Deprecated: use [content_cps]*)
140 ##register content : string -> string
141 let content = File.content
Something went wrong with that request. Please try again.