MODULE; IMPORT ClientClass, CVProto, CVTree, ErrMsg, FileAttr, FileID, FileInfo, FileInfoMerger, FileRd, FileStatus, GlobTree, GzipRd, GzipWr, IO, LinkTbl, Logger, OSError, PathComp, Pathname, Rd, Reaper, StreamRd, StreamWr, SupFileRec, SupFileRecSeq, SupMisc, Text, Thread, Time, TokScan, Wr; EXCEPTION Error(TEXT); REVEAL T = Public BRANDED OBJECT proto: CVProto.T; wireRd: StreamRd.T; (* Raw reader. *) rd: StreamRd.T; (* Currently active reader. *) wireWr: StreamWr.T; (* Raw writer. *) wr: StreamWr.T; (* Currently active writer. *) collections: SupFileRecSeq.T; clientClass: ClientClass.T; compLevel: [0..9]; reaper: Reaper.T; logger: Logger.T; OVERRIDES apply := Apply; init := Init; END; PROCEDURE TreeComp Apply (self: T): REFANY = VAR ts: TokScan.T; collection, release: TEXT; initialBytesIn, initialBytesOut: LONGREAL; BEGIN TRY TRY FOR i := 0 TO self.collections.size()-1 DO WITH sfr = self.collections.get(i) DO IF NOT SupFileRec.Option.Skip IN sfr.options THEN ts := self.proto.getCmd(self.rd); ts.getFolded("COLL"); collection := ts.getToken("collection"); release := ts.getToken("release"); SupFileRec.Check(sfr, collection, release); initialBytesIn := StreamRd.ByteCount(self.rd); initialBytesOut := StreamWr.ByteCount(self.wr); TRY CompCollection(self, sfr); FINALLY LOCK sfr DO sfr.bytesIn := sfr.bytesIn + StreamRd.ByteCount(self.rd) - initialBytesIn; sfr.bytesOut := sfr.bytesOut + StreamWr.ByteCount(self.wr) - initialBytesOut; END; END; END; END; END; ts := self.proto.getCmd(self.rd); ts.getLiteral("."); self.proto.putCmd(self.wr, "."); Wr.Flush(self.wr); FINALLY IF self.reaper # NIL THEN Reaper.Dying(self.reaper); END; END; EXCEPT | CVTree.Error(msg) => RETURN msg; | Error(msg) => RETURN msg; | Rd.EndOfFile => RETURN "Premature EOF from client"; | Rd.Failure(list) => RETURN "Network read failure: " & ErrMsg.StrError(list); | Thread.Alerted => RETURN "Interrupted"; | TokScan.Error(msg) => RETURN "TreeComp protocol error: " & msg; | Wr.Failure(list) => RETURN "Network write failure: " & ErrMsg.StrError(list); END; RETURN NIL; END Apply; PROCEDURECompCollection (self: T; sfr: SupFileRec.T) RAISES {CVTree.Error, Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted, TokScan.Error, Wr.Failure} = VAR compress: BOOLEAN; merger: Merger; BEGIN sfr.scanTime := Time.Now(); self.proto.putCmd(self.wr, "COLL", sfr.collection, sfr.release, TokScan.EncodeTime(sfr.scanTime)); Wr.Flush(self.wr); compress := SupFileRec.Option.Compress IN sfr.options; IF compress THEN TRY self.rd := NEW(GzipRd.T).init(self.wireRd, closeChild := FALSE); EXCEPT OSError.E(list) => RAISE Error("Cannot create Gzip reader: " & ErrMsg.StrError(list)); END; END; TRY IF compress THEN TRY self.wr := NEW(GzipWr.T).init(self.wireWr, level := self.compLevel, closeChild := FALSE); EXCEPT OSError.E(list) => RAISE Error("Cannot create Gzip writer: " & ErrMsg.StrError(list)); END; END; TRY merger := NEW(Merger).init(self, sfr); TRY IF SupFileRec.Option.CheckoutMode IN sfr.options THEN CompCheckoutMode(self, sfr, merger); ELSE CompCVSMode(self, sfr, merger); END; FINALLY merger.close(); END; self.proto.putCmd(self.wr, "."); Wr.Flush(self.wr); IF compress THEN Wr.Close(self.wr); IF NOT Rd.EOF(self.rd) THEN RAISE TokScan.Error( "Expected EOF from compressed stream, didn't get it"); END; Rd.Close(self.rd); END; FINALLY IF compress THEN GzipWr.Cleanup(self.wr); self.wr := self.wireWr; END; END; FINALLY IF compress THEN GzipRd.Cleanup(self.rd); self.rd := self.wireRd; END; END; END CompCollection; PROCEDURECompCVSMode (self: T; sfr: SupFileRec.T; merger: Merger) RAISES {Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted, TokScan.Error, Wr.Failure} = CONST myName = "CompCVSMode: "; VAR linkTbl: LinkTbl.T := NIL; clientFile, serverFile: FileInfo.T; BEGIN Trace(self, myName, " ", sfr.collection); IF self.proto.v.hasHardLinks THEN linkTbl := NEW(LinkTbl.Default).init(); END; WHILE GetNext(merger, clientFile, serverFile) DO IF clientFile = NIL THEN (* Add file on client. *) IF NOT SupFileRec.Option.DoDeletesOnly IN sfr.options THEN CASE serverFile.type OF | FileInfo.Type.DirDown => (* Create directory. *) Trace(self, myName, " Create directory ", serverFile.name); self.proto.putCmd(self.wr, "I", serverFile.name); | FileInfo.Type.DirUp => (* Set directory attributes. *) Trace(self, myName, " Set directory attributes ", serverFile.name); self.proto.putCmd(self.wr, "J", serverFile.name, EncodeAttr(self, sfr, serverFile.attr)); | FileInfo.Type.Live, FileInfo.Type.Dead => (* Create the file if it doesn't already exist with the proper attributes. *) VAR cmd := "T"; sendAttr := serverFile.attr; BEGIN Trace(self, myName, " Create file with proper attributes ", serverFile.name); IF serverFile.type = FileInfo.Type.Dead THEN cmd := "t" END; (* If it is an RCS file, and we are using "loose" equality for RCS files, then the sizes may disagree because of harmless differences in white space. *) IF SupMisc.IsRCS(serverFile.name) AND NOT SupFileRec.Option.NoRCS IN sfr.options AND NOT SupFileRec.Option.StrictCheckRCS IN sfr.options AND self.proto.v.hasLooseRCSCheck THEN sendAttr := FileAttr.MaskOut(sendAttr, FileAttr.AttrTypes{ FileAttr.AttrType.Size }); END; IF NOT HardLink(self, linkTbl, serverFile) THEN self.proto.putCmd(self.wr, cmd, serverFile.name, EncodeAttr(self, sfr, sendAttr)); END; END; END; END; ELSIF serverFile = NIL THEN (* Delete file on client. *) CASE clientFile.type OF | FileInfo.Type.DirDown => (* Remove listfile entry for directory. *) Trace(self, myName, " Remove listfile entry for directory ", clientFile.name); self.proto.putCmd(self.wr, "i", clientFile.name); | FileInfo.Type.DirUp => (* Remove directory. *) Trace(self, myName, " Remove directory ", clientFile.name); self.proto.putCmd(self.wr, "j", clientFile.name); | FileInfo.Type.Live, FileInfo.Type.Dead => (* Delete file. *) Trace(self, myName, " Delete file ", clientFile.name); self.proto.putCmd(self.wr, "D", clientFile.name); END; ELSE (* File exists on both the server and the client. *) IF NOT SupFileRec.Option.DoDeletesOnly IN sfr.options THEN CASE serverFile.type OF | FileInfo.Type.DirDown => IF clientFile.type # FileInfo.Type.DirDown THEN <* ASSERT clientFile.type # FileInfo.Type.DirUp *> ReplaceFileWithDirectory(self, clientFile := clientFile, serverDir := serverFile); END; (* Otherwise, do nothing at this point. The work will be done when we reach the DirUp. *) | FileInfo.Type.DirUp => <* ASSERT clientFile.type = FileInfo.Type.DirUp *> IF NOT FileAttr.Equal(clientFile.attr, FileAttr.Umask(serverFile.attr, sfr.umask)) THEN (* Set directory attributes. *) Trace(self, myName, " Set directory attributes ", serverFile.name); self.proto.putCmd(self.wr, "J", serverFile.name, EncodeAttr(self, sfr, serverFile.attr)); END; | FileInfo.Type.Live, FileInfo.Type.Dead => IF clientFile.type = FileInfo.Type.DirDown THEN ReplaceDirectoryWithFile(self, merger, clientDir := clientFile, serverFile := serverFile); ELSE <* ASSERT clientFile.type # FileInfo.Type.DirUp *> IF NOT HardLink(self, linkTbl, serverFile) THEN IF NOT FileAttr.Equal(clientFile.attr, FileAttr.Umask(serverFile.attr, sfr.umask)) OR clientFile.type # serverFile.type OR SupFileRec.Option.DetailAllRCSFiles IN sfr.options AND SupMisc.IsRCS(serverFile.name) THEN (* FIXME - check for BogusModTime? *) IF self.clientClass.collectionIsPartiallyHidden( sfr.collection) THEN Trace(self, myName, " Update partially hidden file (fix) ", serverFile.name); ELSE Trace(self, myName, " Update file (fix) ", serverFile.name); END; self.proto.putCmd(self.wr, "U", serverFile.name); END; END; END; END; END; END; Wr.Flush(self.wr); END; END CompCVSMode; PROCEDUREReplaceDirectoryWithFile (self: T; merger: Merger; clientDir: FileInfo.T; serverFile: FileInfo.T) RAISES {Error, Rd.EndOfFile, Rd.Failure, Thread.Alerted, TokScan.Error, Wr.Failure} = CONST myName = "ReplaceDirectoryWithFile: "; VAR cf, sf: FileInfo.T; depth: CARDINAL; BEGIN Trace(self, myName, " ", clientDir.name, " ", serverFile.name); (* Remove the entire directory tree on the client. *) (* FIXME - Make the client remove empty Attic directories automatically. *) cf := clientDir; sf := NIL; depth := 0; REPEAT (* We should get only client files from the merger until we have consumed the entire directory tree. *) <* ASSERT sf = NIL *> CASE cf.type OF | FileInfo.Type.DirDown => (* Remove listfile entry. *) Trace(self, myName, " Remove listfile entry ", cf.name); self.proto.putCmd(self.wr, "i", cf.name); INC(depth); | FileInfo.Type.DirUp => (* Remove directory. *) Trace(self, myName, " Remove directory ", cf.name); self.proto.putCmd(self.wr, "j", cf.name); DEC(depth); | FileInfo.Type.Live, FileInfo.Type.Dead => (* Delete file. *) Trace(self, myName, " Delete file ", cf.name); self.proto.putCmd(self.wr, "D", cf.name); END; UNTIL depth = 0 OR NOT GetNext(merger, cf, sf); IF depth # 0 THEN RAISE Error("Unmatched DirDown from client"); END; (* Add the file. *) Trace(self, myName, " Update file ", serverFile.name); self.proto.putCmd(self.wr, "U", serverFile.name); END ReplaceDirectoryWithFile; PROCEDUREReplaceFileWithDirectory (self: T; clientFile: FileInfo.T; serverDir: FileInfo.T) RAISES {Thread.Alerted, Wr.Failure} = CONST myName = "ReplaceFileWithDirectory: "; BEGIN Trace(self, myName, " ", clientFile.name, " ", serverDir.name); (* Delete the file, then create the directory. *) self.proto.putCmd(self.wr, "D", clientFile.name); self.proto.putCmd(self.wr, "I", serverDir.name); END ReplaceFileWithDirectory; PROCEDURECompCheckoutMode (self: T; sfr: SupFileRec.T; merger: Merger) RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted, TokScan.Error, Wr.Failure} = CONST myName = "CompCheckoutMode: "; VAR clientFile, serverFile: FileInfo.T; BEGIN Trace(self, myName, sfr.collection); <* ASSERT self.clientClass.inAllowedCollections(sfr.collection) *> <* ASSERT NOT self.clientClass.collectionIsPartiallyHidden(sfr.collection) *> WHILE GetNext(merger, clientFile, serverFile) DO IF clientFile = NIL THEN (* Add file on client. *) IF NOT FileInfo.IsDir(serverFile) THEN Trace(self, myName, " Update file (add) ", serverFile.name); self.proto.putCmd(self.wr, "U", serverFile.name); END; ELSIF serverFile = NIL THEN (* Delete file on client. *) IF NOT FileInfo.IsDir(clientFile) THEN Trace(self, myName, " Delete file ", clientFile.name); self.proto.putCmd(self.wr, "D", clientFile.name); END; ELSE (* File exists on both the server and the client. *) (* Note, the client records the exact attributes of the server's RCS file in checkout mode, unmodified by the client's umask. So we need not do anything with the umask on this end. *) IF NOT FileInfo.IsDir(serverFile) AND NOT FileAttr.Equal(clientFile.attr, serverFile.attr) THEN (* FIXME - check for BogusModTime? *) Trace(self, myName, " Update file (fix)"); self.proto.putCmd(self.wr, "U", serverFile.name); END; END; Wr.Flush(self.wr); END; END CompCheckoutMode; PROCEDUREHardLink (self: T; linkTbl: LinkTbl.T; fi: FileInfo.T): BOOLEAN RAISES {Thread.Alerted, Wr.Failure} =
If there is a known hard link to the given file, emits a link command and returnsTRUE
. Otherwise, returnsFALSE
.
VAR linkTo: Pathname.T; cmd: TEXT; BEGIN IF linkTbl # NIL AND NOT FileInfo.IsDir(fi) AND FileAttr.AttrType.LinkCount IN FileAttr.GetMask(fi.attr) AND FileAttr.GetLinkCount(fi.attr) > 1 THEN WITH id = FileID.FromAttr(fi.attr) DO IF id # NIL THEN IF linkTbl.get(id, linkTo) THEN IF fi.type = FileInfo.Type.Live THEN cmd := "H" ELSE cmd := "h" END; self.proto.putCmd(self.wr, cmd, fi.name, linkTo); RETURN TRUE; END; EVAL linkTbl.put(id, fi.name); END; END; END; RETURN FALSE; END HardLink; PROCEDUREDecodeAttr (<*UNUSED*> self: T; t: TEXT): FileAttr.T RAISES {TokScan.Error} = BEGIN LOOP TRY RETURN FileAttr.Decode(t); EXCEPT FileAttr.UnknownGroup, FileAttr.UnknownOwner => (* Ignore unknown attributes from the client. *) END; END; END DecodeAttr; PROCEDUREEncodeAttr (self: T; sfr: SupFileRec.T; attr: FileAttr.T): TEXT = BEGIN IF self.proto.v.hasFileAttrs THEN RETURN FileAttr.Encode(attr, support := self.proto.v.attrSupport, ignore := sfr.attrIgnore); ELSE RETURN TokScan.EncodeTime(FileAttr.GetModTime(attr)); END; END EncodeAttr; PROCEDUREGetNext (m: Merger; VAR clientFile, serverFile: FileInfo.T): BOOLEAN RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted, TokScan.Error} =
This is a wrapper aroundMerger.next()
, to correct itsRAISES
clause. This procedure should raise the union of the exceptions raised byGetFromClient
andGetFromServer
.
<* FATAL ANY *> BEGIN RETURN m.next(clientFile, serverFile); END GetNext; PROCEDURE***************************************************************************Init (self: T; proto: CVProto.T; rd: StreamRd.T; wr: StreamWr.T; collections: SupFileRecSeq.T; clientClass: ClientClass.T; compLevel: [-1..9] := -1; reaper: Reaper.T := NIL; logger: Logger.T := NIL): T = BEGIN self.proto := proto; self.wireRd := rd; self.rd := rd; (* Start out uncompressed. *) self.wireWr := wr; self.wr := wr; (* Start out uncompressed. *) self.collections := collections; self.clientClass := clientClass; IF compLevel = -1 THEN compLevel := SupMisc.DefaultCompression END; self.compLevel := compLevel; self.reaper := reaper; self.logger := logger; RETURN self; END Init;
TYPE Merger = FileInfoMerger.T OBJECT treeComp: T; rd: Rd.T; sfr: SupFileRec.T; iter: CVTree.Iterator; serverPruning: BOOLEAN; clientDecomp: PathComp.Decompressor; METHODS init(self: T; sfr: SupFileRec.T): Merger RAISES {CVTree.Error, Thread.Alerted} := MergerInit; close() RAISES {CVTree.Error, Thread.Alerted} := MergerClose; OVERRIDES getA := GetFromClient; getB := GetFromServer; END; PROCEDUREMergerInit (m: Merger; self: T; sfr: SupFileRec.T): Merger RAISES {CVTree.Error, Thread.Alerted} = BEGIN m.treeComp := self; m.rd := self.rd; m.sfr := sfr; m.iter := NIL; IF sfr.serverScanFile # NIL THEN (* Use the scan file. *) TRY m.iter := NEW(FSIter).init(sfr.serverScanFile); EXCEPT CVTree.Error => (* Ignore. *) END; END; IF m.iter = NIL THEN (* Do a full tree walk. *) m.iter := CVTree.Iterate( root := sfr.serverPrefix, follow := GlobTree.Not(sfr.symlink)); END; m.serverPruning := FALSE; m.clientDecomp := NEW(PathComp.Decompressor).init(); RETURN m; END MergerInit; PROCEDUREMergerClose (m: Merger) RAISES {CVTree.Error, Thread.Alerted} = BEGIN m.iter.close(); END MergerClose; PROCEDUREGetFromClient (m: Merger): FileInfo.T RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted, TokScan.Error} =
If you add any exceptions, add them to GetNext
also.
VAR ts: TokScan.T; cmd: TEXT; name: TEXT; attr: FileAttr.T; cmdCh: CHAR; type: FileInfo.Type; BEGIN LOOP ts := m.treeComp.proto.getCmd(m.rd); cmdCh := ts.getChar("command"); cmd := Text.FromChar(cmdCh); CASE cmdCh OF | '.' => EXIT; | 'D' => (* Down into directory. *) name := ts.getToken("directory name"); ts.getEnd("end of \"" & cmd & "\" command"); WITH path = m.clientDecomp.put(PathComp.Type.DirDown, name) DO IF m.treeComp.proto.v.dirsAreExplicit AND NOT SupFileRec.Option.CheckoutMode IN m.sfr.options THEN RETURN NEW(FileInfo.T, name := path, attr := NIL, type := FileInfo.Type.DirDown); END; END; | 'F', 'f' => (* Live file, dead file. *) IF cmdCh = 'F' THEN type := FileInfo.Type.Live; ELSE type := FileInfo.Type.Dead; END; name := ts.getToken("file name"); IF m.treeComp.proto.v.hasFileAttrs THEN attr := DecodeAttr(m.treeComp, ts.getToken("attributes")); ELSE attr := NEW(FileAttr.T).init(FileAttr.FileType.File, modTime := ts.getTime("modTime")); END; ts.getEnd("end of \"" & cmd & "\" command"); WITH path = m.clientDecomp.put(PathComp.Type.File, name) DO RETURN NEW(FileInfo.T, name := path, attr := attr, type := type); END; | 'U' => (* Up out of directory. *) IF m.treeComp.proto.v.dirsAreExplicit THEN attr := DecodeAttr(m.treeComp, ts.getToken("attributes")); END; ts.getEnd("end of \"" & cmd & "\" command"); WITH path = m.clientDecomp.put(PathComp.Type.DirUp, NIL) DO IF m.treeComp.proto.v.dirsAreExplicit AND NOT SupFileRec.Option.CheckoutMode IN m.sfr.options THEN RETURN NEW(FileInfo.T, name := path, attr := attr, type := FileInfo.Type.DirUp); END; END; ELSE RAISE TokScan.Error("Invalid command \"" & cmd & "\""); END; END; RETURN NIL; END GetFromClient; PROCEDUREGetFromServer (m: Merger): FileInfo.T RAISES {Thread.Alerted} =
If you add any exceptions, add them to GetNext
also.
VAR type: CVTree.FileType; path: Pathname.T; attr: FileAttr.T; listIt: BOOLEAN; BEGIN LOOP TRY IF NOT m.iter.next(type, path, attr) THEN EXIT END; CASE type OF | CVTree.FileType.DirDown => IF m.sfr.dirFilter.test(path) THEN IF m.treeComp.proto.v.dirsAreExplicit AND NOT SupFileRec.Option.CheckoutMode IN m.sfr.options THEN RETURN NEW(FileInfo.T, name := path, attr := attr, type := FileInfo.Type.DirDown); END; ELSE m.iter.prune(); m.serverPruning := TRUE; END; | CVTree.FileType.File => IF SupFileRec.Option.CheckoutMode IN m.sfr.options THEN (* List RCS files only. *) listIt := attr.fileType = FileAttr.FileType.File AND SupMisc.IsRCS(path); ELSE (* List everything that is supported by the protocol. Ignore the unsupported file types. *) listIt := FileAttr.AttrType.FileType IN m.treeComp.proto.v.attrSupport[attr.fileType]; END; IF listIt AND m.sfr.fileFilter.test(path) THEN RETURN NEW(FileInfo.T, name := path, attr := attr, type := FileInfo.Type.Live); END; | CVTree.FileType.AtticFile => WITH atticPath = SupMisc.AtticName(path) DO IF attr.fileType = FileAttr.FileType.File AND SupMisc.IsRCS(path) THEN IF m.sfr.fileFilter.test(atticPath) THEN RETURN NEW(FileInfo.T, name := path, attr := attr, type := FileInfo.Type.Dead); END; ELSE (* Non-RCS file in the Attic?! *) WITH fullPath = SupMisc.CatPath(m.sfr.serverPrefix, atticPath) DO Warning(m.treeComp, "Non-RCS file \"" & fullPath & "\" in Attic"); END; END; END; | CVTree.FileType.DirUp => IF NOT m.serverPruning THEN IF m.treeComp.proto.v.dirsAreExplicit AND NOT SupFileRec.Option.CheckoutMode IN m.sfr.options THEN RETURN NEW(FileInfo.T, name := path, attr := attr, type := FileInfo.Type.DirUp); END; ELSE m.serverPruning := FALSE; END; END; EXCEPT CVTree.Error(msg) => Warning(m.treeComp, msg); END; END; RETURN NIL; END GetFromServer;***************************************************************************
TYPE FSIter = CVTree.Iterator OBJECT path: Pathname.T; fsrd: FileStatus.Reader; pruning := FALSE; METHODS init(path: Pathname.T): FSIter RAISES {CVTree.Error, Thread.Alerted} := FSIterInit; OVERRIDES next := FSIterNext; prune := FSIterPrune; close := FSIterClose; END; PROCEDURE***************************************************************************FSIterClose (self: FSIter) RAISES {CVTree.Error, Thread.Alerted} = BEGIN TRY self.fsrd.close(); EXCEPT Rd.Failure(l) => RAISE CVTree.Error("Read failure on \"" & self.path & "\": " & ErrMsg.StrError(l)); END; END FSIterClose; PROCEDUREFSIterInit (self: FSIter; path: Pathname.T): FSIter RAISES {CVTree.Error, Thread.Alerted} = VAR rd: Rd.T; BEGIN TRY self.path := path; rd := FileRd.Open(self.path); self.fsrd := NIL; TRY TRY self.fsrd := FileStatus.FromRd(rd); IF self.fsrd.version() < 5 THEN (* Too old. *) self.fsrd.close(); RAISE CVTree.Error("Scan file \"" & self.path & "\" format is too old"); END; RETURN self; EXCEPT | FileStatus.Error(msg) => RAISE CVTree.Error("Error in \"" & self.path & "\": " & msg); | Rd.Failure(l) => RAISE CVTree.Error("Read failure on \"" & self.path & "\": " & ErrMsg.StrError(l)); END; FINALLY IF self.fsrd = NIL THEN TRY Rd.Close(rd) EXCEPT ELSE END; END; END; EXCEPT | OSError.E(l) => RAISE CVTree.Error("Cannot open \"" & self.path & "\": " & ErrMsg.StrError(l)); END; END FSIterInit; PROCEDUREFSIterNext (self: FSIter; VAR type: CVTree.FileType; VAR name: Pathname.T; VAR attr: FileAttr.T): BOOLEAN RAISES {CVTree.Error, Thread.Alerted} = VAR fs: FileStatus.T; BEGIN TRY IF self.pruning THEN self.pruning := FALSE; fs := self.fsrd.prune(); ELSE fs := self.fsrd.get(); END; name := fs.name; attr := fs.clientAttr; CASE fs.type OF | FileStatus.Type.DirDown => type := CVTree.FileType.DirDown; | FileStatus.Type.DirUp => type := CVTree.FileType.DirUp; | FileStatus.Type.FileLive => type := CVTree.FileType.File; | FileStatus.Type.FileDead => type := CVTree.FileType.AtticFile; | FileStatus.Type.CheckoutLive, FileStatus.Type.CheckoutDead => RAISE CVTree.Error("Invalid checkout-mode scan file \"" & self.path & "\""); END; RETURN TRUE; EXCEPT | FileStatus.Error(msg) => RAISE CVTree.Error("Error in \"" & self.path & "\": " & msg); | Rd.EndOfFile => RETURN FALSE; | Rd.Failure(l) => RAISE CVTree.Error("Read error on \"" & self.path & "\": " & ErrMsg.StrError(l)); END; END FSIterNext; PROCEDUREFSIterPrune (self: FSIter) = BEGIN self.pruning := TRUE; END FSIterPrune;
PROCEDUREWarning (self: T; msg: TEXT) =
Logs a warning message.
BEGIN IF self.logger # NIL THEN Logger.Put(self.logger, Logger.Priority.Warning, msg); END; END Warning; PROCEDURETrace (self: T; m1, m2, m3, m4, m5, m6, m7, m8: TEXT := NIL; level := 1) =
Logs a trace message.
BEGIN IF traceLevel >= level THEN VAR msg := ""; BEGIN IF m1 # NIL THEN msg := msg & m1 END; IF m2 # NIL THEN msg := msg & m2 END; IF m3 # NIL THEN msg := msg & m3 END; IF m4 # NIL THEN msg := msg & m4 END; IF m5 # NIL THEN msg := msg & m5 END; IF m6 # NIL THEN msg := msg & m6 END; IF m7 # NIL THEN msg := msg & m7 END; IF m8 # NIL THEN msg := msg & m8 END; IF self.logger # NIL THEN Logger.Debug(self.logger, msg); ELSE IO.Put("logger = NIL: " & msg & "\n"); END; END; END; END Trace; BEGIN END TreeComp.