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
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* only by permission. *)
(* *)
(***********************************************************************)
let string_of_ic ic =
let l = in_channel_length ic in
let buf = String.create 1024 in
let res = Buffer.create l in
try
while true do
let n = input ic buf 0 1024 in
if n = 0 then raise Exit else
Buffer.add_substring res buf 0 n
done;
Buffer.contents res
with Exit -> Buffer.contents res;;
let string_of_file fname =
let ic = open_in fname in
let r = string_of_ic ic in
close_in ic;
r;;
let copy_channel ic oc =
let buf = String.create 1024 in
try
while true do
let n = input ic buf 0 1024 in
if n = 0 then raise Exit else
output oc buf 0 n
done
with Exit -> ();;
let copy_file s copy =
let ic = open_in s in
let oc = open_out copy in
copy_channel ic oc;
close_out oc;
close_in ic;;
let bannerize_channel banner ic oc =
output_string oc banner;
copy_channel ic oc;;
let ckpname fname = fname ^ "~";;
let ckp_file fname =
let copy = ckpname fname in
copy_file fname copy;
copy;;
let bannerize_file banner s =
let copy = ckp_file s in
let ic = open_in copy in
let oc = open_out s in
bannerize_channel banner ic oc;
close_out oc;
close_in ic;;
let with_in_channel fname f =
let ic = open_in fname in
try
let r = f ic in
close_in ic;
r
with x -> close_in ic; raise x;;
let with_out_channel fname f =
let oc = open_out fname in
try
let r = f oc in
close_out oc;
r
with x -> close_out oc; raise x;;
let string_of_file fname = with_in_channel fname string_of_ic;;
let copy_file s copy =
with_in_channel s (fun ic -> with_out_channel copy (copy_channel ic));;
let bannerize_file banner fname =
let copy = ckp_file fname in
with_in_channel copy
(fun ic -> with_out_channel fname (bannerize_channel banner ic));;
let skip_banner_channel banner_marker ic =
let l = try input_line ic with End_of_file -> "" in
if l = banner_marker then
try
while input_line ic <> banner_marker do () done
with End_of_file ->
invalid_arg "replace_banner: end of banner not found"
else seek_in ic 0;;
(* The main function to rewrite files with banners. *)
let replace_banner banner_marker banner fname =
let copy = ckp_file fname in
with_in_channel copy
(fun ic ->
skip_banner_channel banner_marker ic;
with_out_channel fname (bannerize_channel banner ic));;
(* To get the banner's marker. *)
let get_first_line fname = with_in_channel fname input_line;;
let main () =
let files = ref [] in
let banner_file = ref "banner" in
let set_banner_file fname = banner_file := fname in
let record_file_name s = files := s :: !files in
let b_opt = Arg.String set_banner_file
and b_message =
" <banner file>: set the contents of file <banner file> as the banner \n\
(default name for the banner file is \"banner\")." in
Arg.parse
["-b", b_opt, b_message;
"--banner", b_opt, b_message]
record_file_name
"Usage: banner [-b | --banner <banner file>] <files>\n\n\
This command adds a banner to the top of each file given in the list of\n\
argument files.\n\
The text of the banner is the contents of a <banner file> that can\n\
be fixed with the [-b] option (default banner file name is \"banner\").\n\
The text of a banner must be comprised between two identical lines,\n\
the ``banner markers'' (hence the first and the last lines of the\n\
banner file must be identical).\n\
Two banners are considered similar if they have the same banner markers.\n\
If a file already had a similar banner, this banner is removed \
before adding\n\
the contents of the <banner file>. This way, slight modifications of the\n\
banner are easily handled.\n\n\
Prior to add a banner to the file \"f\", a checkpoint of \"f\" is\n\
written in the file named [f~].";
let banner_marker = get_first_line !banner_file in
let banner = string_of_file !banner_file in
List.iter (replace_banner banner_marker banner) !files;;
try main () with Sys_error s -> prerr_endline ("Fatal error: " ^ s); exit 1;;
|
