Changing default slaves
[hcoop/domtool2.git] / src / slave.sml
CommitLineData
d612d62c
AC
1(* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006, Adam Chlipala
3 *
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
17 *)
18
19(* Code for receiving and executing configuration files *)
20
21structure Slave :> SLAVE = struct
22
23datatype file_action =
24 Add
25 | Delete
26 | Modify
27
28type file_status = {action : file_action,
29 domain : string,
6ae327f8 30 dir : string,
d612d62c 31 file : string}
36e42cb8 32
d612d62c
AC
33val fileHandler = ref (fn _ : file_status => ())
34val preHandler = ref (fn () => ())
35val postHandler = ref (fn () => ())
36
37fun registerFileHandler handler =
38 let
39 val old = !fileHandler
40 in
41 fileHandler := (fn x => (handler x; old x))
42 end
43
44fun registerPreHandler handler =
45 let
46 val old = !preHandler
47 in
48 preHandler := (fn () => (handler (); old ()))
49 end
50
51fun registerPostHandler handler =
52 let
53 val old = !postHandler
54 in
55 postHandler := (fn () => (handler (); old ()))
56 end
57
58fun handleChanges fs = (!preHandler ();
59 app (!fileHandler) fs;
60 !postHandler ())
61
8df2e702
AC
62fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))
63
64fun shellF (ss, msg) =
65 let
66 val s = String.concat ss
67 in
68 if OS.Process.isSuccess (OS.Process.system s) then
69 ()
70 else
71 ErrorMsg.error NONE (msg s)
72 end
73
74fun concatTo p fname =
75 let
76 fun visitDir dname =
77 let
78 val dir = Posix.FileSys.opendir dname
79
80 fun loop () =
81 case Posix.FileSys.readdir dir of
82 NONE => Posix.FileSys.closedir dir
83 | SOME fname' =>
84 let
85 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
86 in
87 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
88 visitDir path
89 else if p fname' then
90 shellF ([Config.cat, " ", path, " >>", fname],
6ae327f8 91 fn cl => "Error concatenating: " ^ cl)
8df2e702
AC
92 else
93 ();
94 loop ()
95 end
96 in
8df2e702
AC
97 loop ()
98 end
99 in
6ae327f8 100 TextIO.closeOut (TextIO.openOut fname);
8df2e702
AC
101 visitDir Config.resultRoot
102 end
103
ed9fda3a
AC
104fun enumerateTo p sep fname =
105 let
106 val outf = TextIO.openOut fname
107
108 val first = ref true
e0b0abd2 109 val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot) + 1
ed9fda3a
AC
110
111 fun visitDir dname =
112 let
113 val dir = Posix.FileSys.opendir dname
114
115 fun loop () =
116 case Posix.FileSys.readdir dir of
117 NONE => Posix.FileSys.closedir dir
118 | SOME fname' =>
119 let
120 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
121 in
122 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
123 visitDir path
124 else if p fname' then
125 let
126 val toks = String.fields (fn ch => ch = #"/") dname
127 val toks = List.drop (toks, baseLen)
128 val dom = String.concatWith "." (rev toks)
129 in
130 if !first then
131 first := false
132 else
133 TextIO.output (outf, sep);
134 TextIO.output (outf, dom)
135 end
136 else
137 ();
138 loop ()
139 end
140 in
141 loop ()
142 end
143 in
144 visitDir Config.resultRoot;
145 TextIO.closeOut outf
146 end
147
d612d62c 148end