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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
(***************************************************************************)
(* HLins: insert http-links into HTML documents. *)
(* See http://www.lri.fr/~treinen/hlins *)
(* *)
(* Copyright (C) 1999-2024 Ralf Treinen <treinen@irif.fr> *)
(* *)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation; either version 2 of the License, or (at *)
(* your option) any later version. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU General Public License *)
(* along with this program; if not, write to the Free Software *)
(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
(* USA *)
(* *)
(***************************************************************************)
(*
HLins: insert http-links into HTML documents.
See http://www.lri.fr/~treinen/hlins
Copyright (C) 1999 Ralf Treinen <treinen@lri.fr>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
open Unix;;
open Str;;
open String;;
open Errors;;
let samefile s1 s2 =
s1 <> "" &&
s2 <> "" &&
try
let stat1 = stat s1
and stat2 = stat s2
in stat1.st_dev = stat2.st_dev && stat1.st_ino = stat2.st_ino
with
Unix_error _ -> false
;;
exception Error_tmpfile of string;;
let newtmpfile tmpdir =
let tmp = tmpdir ^ "/hlins" ^ (string_of_int (getpid ()))
in try
let _ = stat tmp
in raise (Error_tmpfile tmp)
(* file tmp exists already *)
with
Unix_error _ -> tmp
(* file tmp does not exist *)
;;
exception Error_move of string;;
(* copy file f_in on f_out *)
let copy f_in f_out =
let rec copy_canal c_in c_out =
try
begin
output_string c_out ( (input_line c_in)^"\n");
copy_canal c_in c_out
end
with
End_of_file -> ()
in
if f_in = f_out
then raise (Error_move "move: file names must be different")
else
try let c_in = open_in f_in
and c_out = open_out f_out
in begin
copy_canal c_in c_out;
close_in c_in;
close_out c_out
end
with
Sys_error s -> raise (Error_move "cannot open files")
;;
let move s1 s2 =
if (stat s1).st_dev = (stat s2).st_dev
then rename s1 s2
else begin
copy s1 s2;
unlink s1
end
;;
(* reads a dirhandle into a list and closes it *)
let rec dirhandle_to_list dirhandle =
try
let entry = readdir dirhandle
in entry::(dirhandle_to_list dirhandle)
with
End_of_file -> begin
closedir dirhandle;
[]
end
;;
(* check wether file f is a regular file and ends on .html *)
let ishtmlfile f =
try
(stat f).st_kind = S_REG && length f >= 5 && last_chars f 5 = ".html"
with
Unix_error _ ->
stopwitherror ("cannot get status of file "^f)
;;
(* check wether file f is a directory *)
let isdirectory f =
try
(stat f).st_kind = S_DIR
with
Unix_error _ ->
stopwitherror ("cannot get status of file "^f)
;;
(* (select l), where l is a list of filenames, returns the pair (hl,dl)
where hl is the list of html files and sl is the list of directories
in l
*)
let rec select path = function
[] -> ([],[])
| h::r ->
let (hl,dl) = select path r
and pathh = path^"/"^h
in if ishtmlfile pathh
then (h::hl,dl)
else if isdirectory pathh && h <> "." && h <> ".."
then (hl,h::dl)
else (hl,dl)
;;
let scandir path dir =
try
let pathdir = path^"/"^dir
in let dirhandle = opendir pathdir
in select pathdir (dirhandle_to_list dirhandle)
with
Unix_error (_,_,d) -> stopwitherror ("cannot read directory "^d)
;;
let rec expanddot = function
[] -> []
| h::r ->
if h = "."
then (dirhandle_to_list (opendir "."))@r
else h::(expanddot r)
|
