MODULE---------------------------------------------------------------------------; IMPORT Pathname, Fingerprint, TextRefTbl, TextTextTbl, Text, TextRd, Rd, FileRd, Wr, FileWr, TextSeq, Thread, OSError; IMPORT FileInfo, APN AS APN, FingerprintFmt, TextUtils, TextReadingUtils, PathRepr, FindExpr, FSFindError, EnvUtils, MsgX, MsgIF; Checkpoint
TYPE CacheElem = OBJECT fp : REF Fingerprint.T; attr : AttrSet; env : TextTextTbl.T METHODS init(fp : REF Fingerprint.T; attr : AttrSet) : CacheElem := InitCacheElem; scan(rd : Rd.T) : CacheElem RAISES {Error} := CacheElemScan; toText() : TEXT RAISES {Error} := CacheElemToText; set(a : Attr) := CacheElemSet; isSet(a : Attr) : BOOLEAN := CacheElemIsSet; clear(a : Attr) := CacheElemClear; clearAll() := CacheElemClearAll; scanEnv(rd : Rd.T) : TEXT RAISES {Error} := CacheElemScanEnv; setVal(name, val : TEXT) := CacheElemSetVal; getVal(name : TEXT) : TEXT := CacheElemGetVal; delVal(name : TEXT) := CacheElemDelVal; END;---------------------------------------------------------------------------
PROCEDURE---------------------------------------------------------------------------InitCacheElem (self : CacheElem; fp : REF Fingerprint.T; attr : AttrSet) : CacheElem = BEGIN self.fp := fp; self.attr := attr; self.env := NIL; RETURN self; END InitCacheElem;
PROCEDURE---------------------------------------------------------------------------CacheElemScan (self : CacheElem; rd : Rd.T) : CacheElem RAISES {Error} = VAR fpt, opt : TEXT; BEGIN TRY fpt := TextReadingUtils.GetTokenOrString(rd); opt := TextReadingUtils.GetTokenOrString(rd); self.fp := NEW(REF Fingerprint.T); IF NOT FingerprintFmt.Scan(fpt, self.fp^) THEN RAISE Error("invalid fingerprint: " & fpt); END; AttrFromText(opt, self.attr); EXCEPT Rd.EndOfFile => RAISE Error("unexpected end of file"); | Rd.Failure => RAISE Error("text reader failure"); | Thread.Alerted => RAISE Error("interrupted"); END; RETURN self; END CacheElemScan;
PROCEDURE---------------------------------------------------------------------------CacheElemScanEnv (self : CacheElem; rd : Rd.T) : TEXT RAISES {Error} = VAR tok : TEXT; BEGIN TRY tok := TextReadingUtils.GetTokenOrString(rd); IF Text.Equal(tok, "(@env-start") THEN self.env := EnvUtils.FromRd(rd, skipStart := TRUE); tok := NIL; END; EXCEPT Rd.EndOfFile => tok := NIL; (* skip, may be correct *) | Rd.Failure => RAISE Error("text reader failure"); | Thread.Alerted => RAISE Error("interrupted"); | EnvUtils.Error(e) => RAISE Error(e); END; RETURN tok; END CacheElemScanEnv;
PROCEDURE---------------------------------------------------------------------------CacheElemToText (self : CacheElem) : TEXT RAISES {Error} = VAR env := ""; BEGIN IF self.env # NIL THEN TRY env := B & EnvUtils.ToText(self.env); EXCEPT ELSE RAISE Error("cannot convert checkpoint environment"); END; END; RETURN FingerprintFmt.Hex(self.fp^) & B & AttrToText(self.attr) & env; END CacheElemToText;
PROCEDURE---------------------------------------------------------------------------CacheElemSet (self : CacheElem; a : Attr) = BEGIN self.attr := self.attr + AttrSet{a}; END CacheElemSet;
PROCEDURE---------------------------------------------------------------------------CacheElemIsSet (self : CacheElem; a : Attr) : BOOLEAN = BEGIN RETURN a IN self.attr; END CacheElemIsSet;
PROCEDURE---------------------------------------------------------------------------CacheElemClear (self : CacheElem; a : Attr) = BEGIN self.attr := self.attr - AttrSet{a}; END CacheElemClear;
PROCEDURE---------------------------------------------------------------------------CacheElemClearAll (self : CacheElem) = BEGIN self.attr := AttrSet{}; END CacheElemClearAll;
PROCEDURE---------------------------------------------------------------------------NewCacheElem (fp : REF Fingerprint.T; attr : AttrSet) : CacheElem = BEGIN RETURN NEW(CacheElem).init(fp, attr); END NewCacheElem;
PROCEDURE---------------------------------------------------------------------------CacheElemSetVal (self : CacheElem; name, val : TEXT) = BEGIN IF self.env = NIL THEN self.env := NEW(TextTextTbl.Default).init(); END; EVAL self.env.put(name, val); END CacheElemSetVal;
PROCEDURE---------------------------------------------------------------------------CacheElemGetVal (self : CacheElem; name : TEXT) : TEXT = VAR val : TEXT; BEGIN IF self.env = NIL THEN RETURN NIL; END; IF self.env.get(name, val) THEN RETURN val; ELSE RETURN NIL; END; END CacheElemGetVal;
PROCEDURE---------------------------------------------------------------------------CacheElemDelVal (self : CacheElem; name : TEXT) = VAR val : TEXT; BEGIN IF self.env = NIL THEN RETURN; END; EVAL self.env.delete(name, val); END CacheElemDelVal;
REVEAL T = Public BRANDED " Checkpoint 0.0" OBJECT cache : FileInfo.T; roots : TextRefTbl.T; msgif : MsgIF.T; OVERRIDES init := Init; addDir := AddDir; delDir := DelDir; dirs := Dirs; fingerprint := GetFingerprint; update := Update; diff := Diff; selectByAttr := SelectByAttr; toText := ToText; fromRd := FromRd; fromText := FromText; toFile := ToFile; fromFile := FromFile; getAttr := GetAttr; setAttr := SetAttr; getVal := GetVal; setVal := SetVal; delVal := DelVal; END;---------------------------------------------------------------------------
PROCEDURE---------------------------------------------------------------------------Init (self : T; cache : FileInfo.T; msgif : MsgIF.T := NIL) : T = BEGIN <* ASSERT cache # NIL *> self.msgif := msgif; self.cache := cache; self.roots := NEW(TextRefTbl.Default).init(); RETURN self; END Init;
PROCEDURE---------------------------------------------------------------------------AddDir (self : T; dir : Pathname.T; fp : REF Fingerprint.T := NIL) RAISES {Error} = BEGIN <* ASSERT self.cache # NIL *> dir := PathRepr.Native(dir); IF fp = NIL THEN WITH dirp = APN.New(dir) DO fp := self.cache.fingerprint(dirp, ignoreDirExpr, ignoreFileExpr); IF fp = NIL THEN MsgX.V(self.msgif, "scanning directory " & dir); self.cache.updateRec(dirp, NIL, NIL, skipDirExpr, skipFileExpr); fp := self.cache.fingerprint(dirp, ignoreDirExpr, ignoreFileExpr); IF fp = NIL THEN RAISE Error("cannot compute fingerprint for directory " & dir); END; END; END; END; <* ASSERT fp # NIL *> WITH ce = NewCacheElem(fp, AttrSet{}) DO EVAL self.roots.put(dir, ce); END; END AddDir;
PROCEDURE---------------------------------------------------------------------------DelDir (self : T; dir : Pathname.T) = VAR ce : REFANY; BEGIN <* ASSERT self.roots # NIL *> dir := PathRepr.Native(dir); EVAL self.roots.delete(dir, ce); END DelDir;
PROCEDURE---------------------------------------------------------------------------Dirs (self : T) : TextSeq.T = VAR iter := self.roots.iterate(); fn : TEXT; ref : REFANY; res := NEW(TextSeq.T).init(); BEGIN WHILE iter.next(fn, ref) DO res.addhi(fn); END; RETURN res; END Dirs;
PROCEDURE---------------------------------------------------------------------------GetFingerprint (self : T; dir : Pathname.T) : REF Fingerprint.T = VAR ref : REFANY; BEGIN <* ASSERT self.roots # NIL *> dir := PathRepr.Native(dir); IF self.roots.get(dir, ref) THEN RETURN NARROW(ref, CacheElem).fp; ELSE RETURN NIL; END; END GetFingerprint;
PROCEDURE---------------------------------------------------------------------------Update (self : T; dir : Pathname.T := NIL; missingOnly := FALSE) RAISES {Error} = VAR iter := self.roots.iterate(); fn : TEXT; ref : REFANY; errs := ""; PROCEDURE UpdateOne(dir : Pathname.T; ref : REFANY) = VAR fp : REF Fingerprint.T; BEGIN dir := PathRepr.Native(dir); WITH dirp = APN.New(dir) DO MsgX.V(self.msgif, "scanning directory " & dir); IF missingOnly THEN fp := self.cache.fingerprint(dirp, ignoreDirExpr, ignoreFileExpr); END; IF NOT missingOnly OR fp = NIL THEN self.cache.updateRec(dirp, NIL, NIL, skipDirExpr, skipFileExpr); fp := self.cache.fingerprint(dirp, ignoreDirExpr, ignoreFileExpr); END; IF fp = NIL THEN errs := errs & B & dir; ELSE NARROW(ref, CacheElem).fp := fp; EVAL self.roots.put(dir, ref); END; END; END UpdateOne; BEGIN (* Update *) IF dir = NIL THEN WHILE iter.next(fn, ref) DO UpdateOne(fn, ref); END; ELSE IF self.roots.get(dir, ref) THEN UpdateOne(dir, ref); ELSE AddDir(self, dir); END; END; IF NOT Text.Empty(errs) THEN RAISE Error("cannot compute fingerprint for the following " & "directories: " & errs); END; END Update;
PROCEDURE---------------------------------------------------------------------------Diff (self : T; cp : T) : TextSeq.T = VAR iter := self.roots.iterate(); fn : TEXT; ref : REFANY; fp : REF Fingerprint.T; ce : CacheElem; res := NEW(TextSeq.T).init(); BEGIN WHILE iter.next(fn, ref) DO fp := cp.fingerprint(fn); ce := NARROW(ref, CacheElem); IF fp = NIL OR fp^ # ce.fp^ THEN res.addhi(fn); ce.attr := ce.attr + AttrSet{Attr.Changed}; ELSE ce.attr := ce.attr - AttrSet{Attr.Changed}; END; END; RETURN res; END Diff;
PROCEDURE---------------------------------------------------------------------------SelectByAttr (self : T; attr : AttrSet) : TextSeq.T = VAR iter := self.roots.iterate(); fn : TEXT; ref : REFANY; ce : CacheElem; res := NEW(TextSeq.T).init(); BEGIN WHILE iter.next(fn, ref) DO ce := NARROW(ref, CacheElem); IF ce.attr * attr # AttrSet{} THEN res.addhi(fn); END; END; RETURN res; END SelectByAttr;
PROCEDURE---------------------------------------------------------------------------ToText (self : T; ) : TEXT RAISES {Error} = VAR iter := self.roots.iterate(); fn : TEXT; ref : REFANY; ce : CacheElem; res := ""; BEGIN WHILE iter.next(fn, ref) DO IF ref # NIL THEN ce := NARROW(ref, CacheElem); WITH cetext = ce.toText() DO res := res & Q & fn & Q & B & cetext & "\n"; END; END; END; RETURN res; END ToText;
PROCEDURE---------------------------------------------------------------------------FromRd (self : T; rd : Rd.T) RAISES {Error} = VAR fn : TEXT := NIL; ce : CacheElem; BEGIN <* ASSERT self.cache # NIL *> <* ASSERT self.roots # NIL *> TRY TRY WHILE NOT Rd.EOF(rd) DO IF fn = NIL THEN fn := TextReadingUtils.GetTokenOrString(rd); END; fn := PathRepr.Native(fn); ce := NEW(CacheElem).scan(rd); EVAL self.roots.put(fn, ce); fn := ce.scanEnv(rd); END; EXCEPT Rd.EndOfFile => (* skip *) | Rd.Failure => RAISE Error("text reader failure"); | Thread.Alerted => RAISE Error("interrupted"); END; FINALLY IF rd # NIL THEN TRY Rd.Close(rd) EXCEPT ELSE END; END; END; END FromRd;
PROCEDURE---------------------------------------------------------------------------FromText (self : T; t : TEXT) RAISES {Error} = VAR rd := TextRd.New(t); BEGIN <* ASSERT self.cache # NIL *> <* ASSERT self.roots # NIL *> FromRd(self, rd); END FromText;
PROCEDURE---------------------------------------------------------------------------ToFile (self : T; fn : Pathname.T) RAISES {Error} = VAR iter := self.roots.iterate(); dir : TEXT; ref : REFANY; ce : CacheElem; line := ""; wr : Wr.T := NIL; BEGIN TRY wr := FileWr.Open(fn); EXCEPT OSError.E => RAISE Error("cannot open file " & fn); END; TRY TRY WHILE iter.next(dir, ref) DO IF ref # NIL THEN ce := NARROW(ref, CacheElem); WITH cetext = ce.toText() DO line := Q & dir & Q & B & cetext & "\n"; Wr.PutText(wr, line); END; END; END; EXCEPT Wr.Failure => RAISE Error("write failed on file " & fn); | Thread.Alerted => RAISE Error("interrupted writing file " & fn); END; FINALLY IF wr # NIL THEN TRY Wr.Close(wr) EXCEPT ELSE END; END; END; END ToFile;
PROCEDURE---------------------------------------------------------------------------FromFile (self : T; fn : Pathname.T) RAISES {Error} = VAR rd : Rd.T := NIL; BEGIN <* ASSERT self.cache # NIL *> <* ASSERT self.roots # NIL *> TRY rd := FileRd.Open(fn); EXCEPT OSError.E => RAISE Error("cannot open file " & fn); END; FromRd(self, rd); END FromFile;
PROCEDURE---------------------------------------------------------------------------GetAttr (self : T; dir : Pathname.T) : AttrSet RAISES {Error} = VAR ref : REFANY; ce : CacheElem; BEGIN <* ASSERT self.roots # NIL *> dir := PathRepr.Native(dir); IF self.roots.get(dir, ref) THEN ce := NARROW(ref, CacheElem); RETURN ce.attr; ELSE RAISE Error("cache miss: " & dir); END; END GetAttr;
PROCEDURE---------------------------------------------------------------------------SetAttr (self : T; dir : Pathname.T; attr : AttrSet) RAISES {Error} = VAR ref : REFANY; ce : CacheElem; BEGIN <* ASSERT self.roots # NIL *> dir := PathRepr.Native(dir); IF self.roots.get(dir, ref) THEN ce := NARROW(ref, CacheElem); ce.attr := attr; ELSE RAISE Error("cache miss: " & dir); END; END SetAttr;
PROCEDURE---------------------------------------------------------------------------SetVal (self : T; dir : Pathname.T; name, val : TEXT) RAISES {Error} = VAR ref : REFANY; ce : CacheElem; BEGIN <* ASSERT self.roots # NIL *> dir := PathRepr.Native(dir); IF self.roots.get(dir, ref) THEN ce := NARROW(ref, CacheElem); ce.setVal(name, val); ELSE RAISE Error("cache miss: " & dir); END; END SetVal;
PROCEDURE---------------------------------------------------------------------------GetVal (self : T; dir : Pathname.T; name : TEXT) : TEXT RAISES {Error} = VAR ref : REFANY; ce : CacheElem; BEGIN <* ASSERT self.roots # NIL *> dir := PathRepr.Native(dir); IF self.roots.get(dir, ref) THEN ce := NARROW(ref, CacheElem); RETURN ce.getVal(name); ELSE RAISE Error("cache miss: " & dir); END; END GetVal;
PROCEDURE---------------------------------------------------------------------------DelVal (self : T; dir : Pathname.T; name : TEXT) RAISES {Error} = VAR ref : REFANY; ce : CacheElem; BEGIN <* ASSERT self.roots # NIL *> dir := PathRepr.Native(dir); IF self.roots.get(dir, ref) THEN ce := NARROW(ref, CacheElem); ce.delVal(name); ELSE RAISE Error("cache miss: " & dir); END; END DelVal;
PROCEDURE---------------------------------------------------------------------------AttrToText (attr : AttrSet) : TEXT = VAR res := Q; first := TRUE; BEGIN FOR a := FIRST(Attr) TO LAST(Attr) DO IF a IN attr THEN IF first THEN res := res & AttrRepr[a]; first := FALSE; ELSE res := res & B & AttrRepr[a]; END; END; END; RETURN res & Q; END AttrToText;
PROCEDURE---------------------------------------------------------------------------AttrFromText (t : TEXT; VAR attr : AttrSet) RAISES {Error} = PROCEDURE OneFromText(one : TEXT) : Attr = BEGIN FOR a := FIRST(Attr) TO LAST(Attr) DO IF Text.Equal(one, AttrRepr[a]) THEN RETURN a; END; END; RETURN Attr.None; END OneFromText; VAR seq := TextUtils.Split(t, B); BEGIN attr := AttrSet{}; FOR i := 0 TO seq.size() - 1 DO WITH elem = TextUtils.Compress(seq.get(i)) DO IF NOT Text.Empty(elem) THEN WITH a = OneFromText(elem) DO IF a # Attr.None THEN attr := attr + AttrSet{a}; ELSE RAISE Error("unknown attribute: " & elem); END; END; END; END; END; END AttrFromText;
PROCEDURE---------------------------------------------------------------------------New (c : FileInfo.T; msgif : MsgIF.T := NIL) : T = BEGIN RETURN NEW(T).init(c, msgif); END New;
PROCEDURE---------------------------------------------------------------------------DefineIgnorePatterns ( cacheIgnoreDirs : TEXT := NIL; cacheIgnoreFiles : TEXT := NIL; fingerprintIgnoreDirs : TEXT := NIL; fingerprintIgnoreFiles : TEXT := NIL) RAISES {Error} = BEGIN TRY IF cacheIgnoreDirs # NIL THEN skipDirExpr := FindExpr.New(cacheIgnoreDirs); END; EXCEPT FSFindError.E(e) => RAISE Error("error in directory ignore pattern for file cache: " & e); END; TRY IF cacheIgnoreFiles # NIL THEN skipFileExpr := FindExpr.New(cacheIgnoreFiles); END; EXCEPT FSFindError.E(e) => RAISE Error("error in file ignore pattern for file cache: " & e); END; TRY IF fingerprintIgnoreDirs # NIL THEN ignoreDirExpr := FindExpr.New(fingerprintIgnoreDirs); END; EXCEPT FSFindError.E(e) => RAISE Error("error in directory ignore pattern for fingerprints: " & e); END; TRY IF fingerprintIgnoreFiles # NIL THEN ignoreFileExpr := FindExpr.New(fingerprintIgnoreFiles); END; EXCEPT FSFindError.E(e) => RAISE Error("error in file ignore pattern for fingerprints: " & e); END; END DefineIgnorePatterns;
CONST B = " "; Q = "\""; IgnDir = "tmp or temp"; IgnFile = "\"PkgCDT\" or \"PkgCRT\" or \"PkgCT\" or \"*~\" or " & "\"*.bak\" or \"*.tmp\" or \"*.temp\" or \"PkgErr\""; SkipDir = IgnDir; SkipFile = IgnFile; BEGIN ignoreDirExpr := FindExpr.New(IgnDir); <* NOWARN *> ignoreFileExpr := FindExpr.New(IgnFile); <* NOWARN *> skipDirExpr := FindExpr.New(SkipDir); <* NOWARN *> skipFileExpr := FindExpr.New(SkipFile); <* NOWARN *> END Checkpoint.