1(* 	$Id: Repositories.Mod,v 1.23 2003/06/05 22:09:32 mva Exp $	 *)
2MODULE OOC:Config:Repositories [OOC_EXTENSIONS];
3(*  Management of a hierarchy of configured repositories.
4    Copyright (C) 2001-2003  Michael van Acken
5
6    This file is part of OOC.
7
8    OOC is free software; you can redistribute it and/or modify it
9    under the terms of the GNU General Public License as published by
10    the Free Software Foundation; either version 2 of the License, or
11    (at your option) any later version.
12
13    OOC is distributed in the hope that it will be useful, but WITHOUT
14    ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
15    or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
16    License for more details.
17
18    You should have received a copy of the GNU General Public License
19    along with OOC. If not, write to the Free Software Foundation, 59
20    Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21*)
22
23IMPORT
24  Msg, Channel, TextRider, LongStrings,
25  Object, URI, URI:Scheme:File,
26  XML:DTD, XML:Locator, Config:Parser, CS := Config:Section,
27  OOC:Repository, OOC:Repository:FileSystem;
28
29
30TYPE
31  Section* = POINTER TO SectionDesc;
32  ModuleList = POINTER TO ARRAY OF Repository.Module;
33  SectionDesc = RECORD
34    (CS.SectionDesc)
35    topLevelRep-: Repository.Repository;
36    cache: ModuleList;
37    lenCache: LONGINT;
38  END;
39
40TYPE
41  RepositoryEntry* = POINTER TO RepositoryEntryDesc;
42  RepositoryEntryDesc* = RECORD [ABSTRACT]
43    next: RepositoryEntry;
44    name: ARRAY 32 OF DTD.Char;
45  END;
46
47CONST
48  invalidContent = 1;
49  invalidAttribute = 2;
50  requireEmpty = 3;
51
52TYPE
53  ErrorContext = POINTER TO ErrorContextDesc;
54  ErrorContextDesc = RECORD  (* stateless *)
55    (CS.ErrorContextDesc)
56  END;
57
58VAR
59  repositoriesContext: ErrorContext;
60  repositoryEntries: RepositoryEntry;
61
62
63PROCEDURE (context: ErrorContext) GetTemplate* (msg: Msg.Msg; VAR templ: Msg.LString);
64  VAR
65    t: ARRAY 128 OF Msg.LChar;
66  BEGIN
67    CASE msg. code OF
68    | invalidContent:
69      t := "Invalid content for element `${name}'"
70    | invalidAttribute:
71      t := "Attribute `${name}' is not defined for this element"
72    | requireEmpty:
73      t := "This element must be empty"
74    END;
75    context. WriteTemplate (msg, t, templ)
76  END GetTemplate;
77
78
79
80PROCEDURE Init (s: Section; id: Parser.String);
81  BEGIN
82    CS.Init (s, id);
83    s. topLevelRep := NIL;
84    NEW (s. cache, 64);
85    s. lenCache := 0;
86  END Init;
87
88PROCEDURE New* (): Section;
89  CONST
90    sectionName = "repositories";
91  VAR
92    s: Section;
93  BEGIN
94    NEW (s);
95    Init (s, sectionName);
96    RETURN s
97  END New;
98
99PROCEDURE InitRepositoryEntry* (re: RepositoryEntry; name: ARRAY OF CHAR);
100  BEGIN
101    re. next := NIL;
102    COPY (name, re. name);
103  END InitRepositoryEntry;
104
105PROCEDURE (re: RepositoryEntry) [ABSTRACT] ProcessElement*
106                       (node: Parser.Element;
107                        errorListener: Locator.ErrorListener;
108                        baseRep: Repository.Repository): Repository.Repository;
109  END ProcessElement;
110
111PROCEDURE AddRepositoryEntry* (re: RepositoryEntry);
112  BEGIN
113    re. next := repositoryEntries;
114    repositoryEntries := re
115  END AddRepositoryEntry;
116
117
118
119PROCEDURE (s: Section) ProcessElements* (sectionRoot: Parser.Element;
120                                         errorListener: Locator.ErrorListener);
121  VAR
122    node: Parser.Node;
123    lastError: Msg.Msg;
124    re: RepositoryEntry;
125    rep: Repository.Repository;
126
127  PROCEDURE Err (code: Msg.Code; xmlNode: Parser.Node);
128    BEGIN
129      lastError := errorListener. Error (repositoriesContext, code, FALSE, xmlNode. pos)
130    END Err;
131
132  BEGIN
133    node := sectionRoot. content;
134    WHILE (node # NIL) DO
135      WITH node: Parser.Element DO
136        re := repositoryEntries;
137        WHILE (re # NIL) & (re. name # node. name^) DO
138          re := re. next
139        END;
140
141        IF (re # NIL) THEN
142          rep := re. ProcessElement (node, errorListener, s. topLevelRep);
143          IF (rep # NIL) THEN
144            s. topLevelRep := rep
145          END
146        ELSE
147          Err (invalidContent, node);
148          lastError. SetLStringAttrib ("name", Msg.GetLStringPtr (s. name^))
149        END
150
151      | node: Parser.CharData DO
152        IF ~node. IsWhitespace() THEN
153          Err (invalidContent, node)
154        END
155      END;
156      node := node. nextNode
157    END
158  END ProcessElements;
159
160PROCEDURE (s: Section) DumpContent* (ch: Channel.Channel);
161  VAR
162    w: TextRider.Writer;
163    str8: ARRAY 2048 OF CHAR;
164
165  PROCEDURE Write (rep: Repository.Repository);
166    BEGIN
167      IF (rep # NIL) THEN
168        Write (rep. baseRep);
169        rep. DumpContent (w)
170      END
171    END Write;
172
173  BEGIN
174    w := TextRider.ConnectWriter (ch);
175    LongStrings.Short (s. name^, "?", str8);
176    w. WriteString ("<");
177    w. WriteString (str8);
178    w. WriteString (">"); w. WriteLn;
179    Write (s. topLevelRep);
180    LongStrings.Short (s. name^, "?", str8);
181    w. WriteString ("</");
182    w. WriteString (str8);
183    w. WriteString (">"); w. WriteLn
184  END DumpContent;
185
186PROCEDURE (s: Section) GetModule* (moduleRef: ARRAY OF CHAR): Repository.Module;
187(**Tries to locate the module corresponding to @oparam{moduleRef} in the
188   configured repositories.  On success, result is a reference to the module;
189   on failure, result is @code{NIL}.
190
191   Depending on the module reference, the module is located by different means.
192   The reference can be one of the following:
193
194   @table @asis
195   @item A Module Name
196   In this case, the top-most repository that contains the sources for this
197   module is used.  This is the preferred way to identify modules.
198
199   @item A File Name in a Repository
200   The referred to repository is used.  Note that this may cause problems, if a
201   repository with a higher priority also defines a module of the same name.
202
203   @item An Arbitrary File Name
204   The module is presumed to belong to the repository with the highest
205   priority.  The module's source code is taken from the file name, but all
206   output files are written into the repository.  This mechanism should only be
207   used in test setups where the input files are not organized into
208   repositories, for example with the Hostess test suite.
209   @end table
210
211   Multiple calls to this function using the same module reference are
212   guaranteed to return the same object.  That is, this function caches all
213   retrieved modules and produces module references from the cache for
214   subsequent queries.  *)
215  VAR
216    m: Repository.Module;
217    topLevelRep: Repository.Repository;
218    i: LONGINT;
219    file: File.URI;
220
221  PROCEDURE AddToCache (m: Repository.Module);
222    VAR
223      new: ModuleList;
224      i: LONGINT;
225    BEGIN
226      (* if we found a module, then add it to the cache *)
227      IF (m # NIL) THEN
228        IF (s. lenCache = LEN (s. cache^)) THEN
229          NEW (new, LEN (s. cache^)*2);
230          FOR i := 0 TO LEN (s. cache^)-1 DO
231            new[i] := s. cache[i]
232          END;
233          s. cache := new
234        END;
235        s. cache[s. lenCache] := m;
236        INC (s. lenCache)
237      END;
238    END AddToCache;
239
240  BEGIN
241    IF Repository.ValidModuleName (moduleRef) OR (moduleRef[0] = "#") THEN
242      (* note: moduleRef[0]="#" selects predefined modules *)
243      (* scan the cache for this module name; linear search isn't exactly fast
244         for huge module sets, so maybe we should improve this later... *)
245      i := 0;
246      WHILE (i # s. lenCache) & (s. cache[i]. name^ # moduleRef) DO
247        INC (i)
248      END;
249      IF (i # s. lenCache) THEN            (* gotcha *)
250        RETURN s. cache[i]
251      END;
252
253      (* module not found in cache: traverse repositories *)
254      topLevelRep := s. topLevelRep;
255      REPEAT
256        m := topLevelRep. GetModule (moduleRef, NIL);
257        topLevelRep := topLevelRep. baseRep
258      UNTIL (m # NIL) OR (topLevelRep = NIL);
259
260      (* if we found a module, then add it to the cache *)
261      AddToCache (m);
262      RETURN m
263
264    ELSE
265      (* scan the cache for this file name; linear search isn't exactly fast
266         for huge module sets, so maybe we should improve this later... *)
267      file := File.ToURI (moduleRef);
268
269      i := 0;
270      WHILE (i # s. lenCache) & (s. cache[i]. MatchesURI (Repository.modModuleSource, file)) DO
271        INC (i)
272      END;
273      IF (i # s. lenCache) THEN            (* gotcha *)
274        RETURN s. cache[i]
275      END;
276
277      (* file name not found in cache: traverse repositories *)
278      topLevelRep := s. topLevelRep;
279      REPEAT
280        m := topLevelRep. GetModuleByURI (file, FALSE);
281        topLevelRep := topLevelRep. baseRep
282      UNTIL (m # NIL) OR (topLevelRep = NIL);
283
284      IF (m = NIL) THEN
285        m := s. topLevelRep. GetModuleByURI (file, TRUE)
286      END;
287
288      AddToCache (m);
289      RETURN m
290    END
291  END GetModule;
292
293PROCEDURE (s: Section) GetResource* (package, path: ARRAY OF CHAR): URI.URI;
294(**Tries to locate the resource file @oparam{path} under the package
295   directory @oparam{package} in the configured repositories.  On success, an
296   URI for the file is returned.  Otherwise, result is @code{NIL}.  *)
297  VAR
298    uri: URI.URI;
299    topLevelRep: Repository.Repository;
300  BEGIN
301    topLevelRep := s. topLevelRep;
302    REPEAT
303      uri := topLevelRep. GetResource (package, path);
304      topLevelRep := topLevelRep. baseRep
305    UNTIL (uri # NIL) OR (topLevelRep = NIL);
306    RETURN uri
307  END GetResource;
308
309PROCEDURE (s: Section) GetIncludePaths*(): Object.StringArrayPtr;
310  VAR
311    rep: Repository.Repository;
312    c: LONGINT;
313    result: Object.StringArrayPtr;
314
315  PROCEDURE Select (rep: Repository.Repository): BOOLEAN;
316    BEGIN
317      RETURN (rep IS FileSystem.Repository)
318    END Select;
319
320  BEGIN
321    c := 0;
322    rep := s. topLevelRep;
323    WHILE (rep # NIL) & Select (rep) DO
324      INC (c);
325      rep := rep. baseRep
326    END;
327
328    NEW (result, c);
329    c := 0;
330    rep := s. topLevelRep;
331    WHILE (rep # NIL) DO
332      IF Select (rep) THEN
333        result[c] :=
334            rep(FileSystem.Repository).relativeBaseURI(File.URI).GetPath()+
335            rep.GetDefaultSubdir(Repository.modHeaderFileC);
336        INC (c);
337      END;
338      rep := rep. baseRep
339    END;
340    RETURN result
341  END GetIncludePaths;
342
343BEGIN
344  URI.RegisterScheme(File.NewPrototype());
345  NEW (repositoriesContext);
346  Msg.InitContext (repositoriesContext, "OOC:Config:Repositories");
347  repositoryEntries := NIL
348END OOC:Config:Repositories.
349