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
|
(***********************************************************************)
(* *)
(* HEVEA *)
(* Luc Maranget, projet MOSCOVA, INRIA Rocquencourt *)
(* *)
(* Copyright 2006 Institut National de Recherche en Informatique et *)
(* en Automatique. Distributed only by permission. *)
(* *)
(* *)
(***********************************************************************)
(* $Id: bibhva.ml,v 1.2 2006-07-19 16:17:13 maranget Exp $ *)
let parse_args () =
let options = ref []
and name = ref "" in
for k = 1 to Array.length Sys.argv-1 do
let a = Sys.argv.(k) in
if String.length a > 0 && a.[0] == '-' then
options := !options @ [a]
else
name := a
done ;
!options, !name
exception Error of string
let rename name1 name2 =
try Sys.rename name1 name2
with Sys_error msg ->
raise (Error (Printf.sprintf "rename %s %s: %s" name1 name2 msg))
let remove name =
try Sys.remove name
with Sys_error msg ->
raise (Error (Printf.sprintf "remove %s: %s" name msg))
let file_exists name =
try Sys.file_exists name
with Sys_error msg ->
raise (Error (Printf.sprintf "file_exists %s: %s" name msg))
let preserved = ref []
let preserve x = preserved := x :: !preserved
(* Not 100% safe, but will do most of the time *)
let rec temp_file name suff =
let temp_name = name ^ suff in
if file_exists temp_name then
temp_file temp_name suff
else
temp_name
let save_to_temp file_name =
if file_exists file_name then begin
let tmp_name = temp_file file_name "~" in
rename file_name tmp_name ;
preserve (file_name, Some tmp_name)
end else begin
preserve (file_name, None)
end
and restore () =
let restore_one x =
try begin match x with
| name,None ->
if file_exists name then remove name
| name,Some tmp_name ->
if file_exists name then remove name ;
rename tmp_name name
end with
Error msg -> Printf.eprintf "Warning: %s\n" msg in
List.iter restore_one !preserved ;
preserved := []
let run_bibtex options name =
try
let base =
if Filename.check_suffix name ".haux" then
Filename.chop_suffix name ".haux"
else
name in
let name_aux = base ^ ".aux"
and name_haux = base ^ ".haux" in
save_to_temp name_aux ;
rename name_haux name_aux ; preserve (name_haux, Some name_aux) ;
let cmd = "bibtex "^String.concat " " (options @ [name_aux]) in
let name_bbl = base ^ ".bbl" in
save_to_temp name_bbl ;
(* bibtex fails too easily to account for its status code *)
ignore (Sys.command cmd) ;
let name_hbbl = base ^ ".hbbl" in
if file_exists name_hbbl then remove name_hbbl ;
rename name_bbl name_hbbl ;
restore ()
with
| Error msg ->
Printf.eprintf "Bibtex run failed: %s\n" msg ;
restore () ;
exit 2
| e ->
restore () ;
raise e
let _ =
let options, name = parse_args () in
run_bibtex options name ;
exit 0
|
