File: tmpfile.ml

package info (click to toggle)
camlimages 2.20-8%2Betch3
  • links: PTS
  • area: main
  • in suites: etch
  • size: 4,024 kB
  • ctags: 2,436
  • sloc: ml: 12,244; ansic: 2,402; makefile: 1,148; sh: 358
file content (38 lines) | stat: -rw-r--r-- 1,684 bytes parent folder | download | duplicates (8)
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
(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Franois Pessaux, projet Cristal, INRIA Rocquencourt     *)
(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
(*            Jun Furuse, projet Cristal, INRIA Rocquencourt           *)
(*                                                                     *)
(*  Copyright 1999 - 2003                                              *)
(*  Institut National de Recherche en Informatique et en Automatique.  *)
(*  Distributed only by permission.                                    *)
(*                                                                     *)
(***********************************************************************)

(* temporary directory *)
let tmp_dir = ref (try Sys.getenv "CAMLIMAGESTMPDIR" with Not_found -> "/tmp");;

let cnter = ref 0;;

let rec new_tmp_name prefx =
  incr cnter;
  let name =
    Filename.concat !tmp_dir
      (Printf.sprintf "camlimages-%s-%d" prefx !cnter) in
  if not (Sys.file_exists name) then name else begin
    prerr_endline ("Warning: tmp file " ^ name ^ " already exists");
    new_tmp_name prefx
  end;;

let remove_tmp_file tmpfile = try Sys.remove tmpfile with _ -> ();;

let new_tmp_file_name prefx =
  if not (Sys.file_exists !tmp_dir) then 
    failwith ("Temporary directory " ^ !tmp_dir ^ " does not exist") else
  let f = new_tmp_name prefx in
  at_exit (fun () -> remove_tmp_file f);
  f;;