
DIRECTORY BasicTime, Commander, CommanderOps, Convert, IO, PFS, PFSNames, PFSPrefixMap, Rope;
ArchiveDelverImpl: CEDAR PROGRAM
IMPORTS BasicTime, Commander, CommanderOps, Convert, IO, PFS, PFSNames, PFSPrefixMap, Rope
 = BEGIN

Component: TYPE ~ PFSNames.Component;
PATH: TYPE ~ PFSNames.PATH;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Laggards: TYPE ~ RECORD [SEQUENCE size: NAT OF PATH];

ArchiveDelverCommand: Commander.CommandProc ~ {
Yes: PFS.NameConfirmProc ~ { RETURN[TRUE] };
DoPattern: PROC [pattern: ROPE] ~ {
Pad: PROC [r: ROPE] ~ {THROUGH [0..recurseDepth) DO msgStream.PutRope[r]; ENDLOOP};
Inner: PFS.InfoProc ~ {
local: REF Laggards ~ laggards;
path: PATH ~ fullFName;
ncomp: NAT ~ PFSNames.ComponentCount[path];
shortName: ROPE м PFSNames.ComponentRope[PFSNames.ShortName[path]];
IF Rope.Equal[shortName, "."] OR Rope.Equal[shortName, ".."] THEN RETURN[TRUE];
files м files + 1;
SELECT TRUE FROM
ncomp = 0 => {};
NOT includeZeros AND bytes <= 0 => {};
recursive AND fileType = 1 => {
thisPath: ROPE ~ PFS.RopeFromPath[path];
recurseDepth м recurseDepth+1;
IF NOT terse THEN {
Pad["    "];
msgStream.PutF["%l%g%l\n", [rope["b"]], [rope[thisPath]], [rope["B"]] ];
};
DoPattern[Rope.Concat[thisPath, "/*"]];
recurseDepth м recurseDepth-1;
};
ENDCASE => {
lastComp: PFSNames.Component ~ PFSNames.Fetch[path, ncomp-1];
lagPath: PATH ~ local[0];
IF lastComp.version.versionKind # numeric THEN RETURN [TRUE];
IF lagPath # NIL THEN {
lagLastCompCount: NAT ~ PFSNames.ComponentCount[lagPath];
lagLastComp: PFSNames.Component;
IF ncomp # lagLastCompCount THEN GO TO noMatch;
lagLastComp м PFSNames.Fetch[lagPath, lagLastCompCount-1];
IF NOT Rope.EqualSubstrs[
lastComp.name.base, lastComp.name.start, lastComp.name.len,
lagLastComp.name.base, lagLastComp.name.start, lagLastComp.name.len,
FALSE] THEN GO TO noMatch;
FOR i: NAT DECREASING IN [0..ncomp-1) DO
IF PFSNames.CompareComponents[
PFSNames.Fetch[path, i],
PFSNames.Fetch[lagPath, i],
FALSE] # equal THEN GO TO noMatch;
ENDLOOP;
IF lagIdx = keep THEN {
lagRope: ROPE ~ PFS.RopeFromPath[lagPath];
IF countBytes THEN byteCount м byteCount + PFS.FileInfo[lagPath].bytes;

excess м excess + 1;
FOR i: NAT IN [1..lagIdx) DO local[i-1] м local[i]; ENDLOOP;
lagIdx м lagIdx - 1;
{
didArchive: BOOL м TRUE;
dstPath: PFS.PATH м PFSPrefixMap.Translate[lagPath, pfmTable];
Pad["    "];
msgStream.PutF["archive/deleting %g => %g\n", [rope[lagRope]], [rope[PFS.RopeFromPath[dstPath]]]  ];
PFS.Copy[from: lagPath, to: dstPath, confirmProc: Yes
! PFS.Error => {
Pad["    "];
msgStream.PutF1[ "\n  %g\n\n", [rope[PFSErrorMsg[error]]] ];
didArchive м FALSE; CONTINUE}];
IF doDelete AND didArchive THEN PFS.Delete[lagPath
! PFS.Error => {
Pad["    "];
msgStream.PutF1[ "\n  %g\n\n", [rope[PFSErrorMsg[error]]] ];
CONTINUE}];
IF doFlush THEN msgStream.Flush[];
};
};
EXITS
noMatch => clearLaggards[];
};
IF lagIdx = keep THEN ERROR;
local[lagIdx] м path;
lagIdx м lagIdx + 1;
};
RETURN[TRUE];
};
IF laggards = NIL OR laggards.size < keep THEN laggards м NEW[Laggards[keep]];
files м 0;
excess м 0;
lagIdx м 0;
FOR i: NAT IN [0..laggards.size) DO laggards[i] м NIL; ENDLOOP;
PFS.EnumerateForInfo[pattern: PFS.PathFromRope[pattern], proc: Inner
! PFS.Error => IF error.group # bug THEN {
Pad["    "];
msgStream.PutF1["%g\n", [rope[PFSErrorMsg[error]]] ];
IF doFlush THEN msgStream.Flush[];
CONTINUE;
}];
IF ( recurseDepth = 0 ) OR (( recurseDepth > 0 ) AND ( NOT terse )) THEN {
Pad["    "];
msgStream.PutF["files in pattern: %g, excess files: %g\n",
[integer[files]], [integer[excess]] ];
};
IF doFlush THEN msgStream.Flush[];
};

debug: BOOL м FALSE;
countBytes: BOOL м FALSE;
byteCount: INT м 0;
laggards: REF Laggards м NIL;
keep: (0..LAST[NAT]] м 2;
pfmTable: PFSPrefixMap.PrefixTableList м NIL;
recurseDepth: INT м 0;
files: INT м 0;
excess: INT м 0;
lagIdx: NAT м 0; -- current interesting laggard is laggards[lagIdx]
clearLaggards: PROC ~ {
local: REF Laggards м laggards;
FOR i: NAT IN [0..local.size) DO local[i] м NIL; ENDLOOP;
lagIdx м 0;
};
argv: CommanderOps.ArgumentVector м CommanderOps.Parse[cmd
! CommanderOps.Failed => { msg м errorMsg; GO TO bogus } ];
argBase: INT м 1;
didPattern: BOOL м FALSE;
doDelete: BOOL м TRUE;
includeZeros: BOOL м FALSE;
recursive: BOOL м FALSE;
terse: BOOL м FALSE;
append, doFlush: BOOL м FALSE;
outFileName: ROPE м NIL;
msgStream: STREAM;

WHILE (argv # NIL) AND (argBase < argv.argc) DO
arg: ROPE ~ argv[argBase];
IF Rope.Match["-*", arg]
THEN {
sense: BOOL м TRUE;
FOR j: INT IN [1..Rope.Length[arg]) DO
SELECT Rope.Fetch[arg, j] FROM
'~ -- keep -- => {
sense м NOT sense;
LOOP;
};
'a, 'A -- append to outputFileName -- => {
IF NOT ((argBase м argBase+1) < argv.argc) THEN {
msg м "Missing outputFileName in append"; GO TO bogus};
outFileName м argv[argBase];
append м TRUE;
doFlush м TRUE;
};
'b, 'B -- countBytes (default: FALSE) -- => {
countBytes м sense;
};
'd, 'D -- doDelete (default: TRUE) -- => {
doDelete м sense;
};
'k, 'K -- keep -- => {
k: INT;
IF NOT ((argBase м argBase+1) < argv.argc) THEN {
msg м "Missing number of versions to keep"; GO TO bogus};
k м Convert.IntFromRope[argv[argBase] ! Convert.Error => {
msg м IO.PutFR1["Can't parse number of versions to keep (%g)", [rope[argv[argBase]]] ]; GO TO bogus}];
IF NOT (k IN [1..100]) THEN {
msg м "Can't keep less than 1 nor more than 100 versions"; GO TO bogus};
keep м k;
};
'o, 'O -- outputToFile -- => {
IF NOT ((argBase м argBase+1) < argv.argc) THEN {
msg м "Missing outputFileName"; GO TO bogus};
outFileName м argv[argBase];
doFlush м TRUE;
};
'r, 'R -- recursive? -- => {
recursive м sense;
};
't, 'T -- terse reporting when doing recursion? -- => {
terse м sense;
};
'x, 'X -- translation -- => {
prefix, translation: ROPE;
IF NOT ((argBase м argBase+1) < argv.argc) THEN {
msg м "Missing translation prefix"; GO TO bogus};
prefix м argv[argBase];
IF NOT ((argBase м argBase+1) < argv.argc) THEN {
msg м "Missing translation"; GO TO bogus};
translation м argv[argBase];
pfmTable м PFSPrefixMap.InsertIntoNewPTable[
PFS.PathFromRope[prefix],
PFS.PathFromRope[translation] ];
};
'z, 'Z -- keep -- => {
includeZeros м sense;
};
ENDCASE => NULL;
sense м TRUE;
ENDLOOP;
}
ELSE {
msgStream м CheckOutPut[cmd.out, outFileName, append];
IF pfmTable = NIL THEN {
msgStream.PutRope["\n**** No translation given - quitting\n"];
GOTO bogus;
};
IF countBytes THEN msgStream.PutF["\n***Starting Delver %g (at %g)\n", [rope[cmd.commandLine]],  [time[BasicTime.Now[]]] ];
DoPattern[arg];
didPattern м TRUE;
};
argBase м argBase+1;
ENDLOOP;

IF NOT didPattern THEN {
msgStream м CheckOutPut[cmd.out, outFileName, append];
IF pfmTable = NIL THEN {
msgStream.PutRope["\n**** No translation given - quitting\n"];
GOTO bogus;
};
IF countBytes THEN
msgStream.PutF["\n***Starting Delver %g (at %g)\n", [rope[cmd.commandLine]], [time[BasicTime.Now[]]] ];
DoPattern["*"];
};
IF countBytes THEN {
msgStream.PutF[" %g bytes %gdeleted\n", [integer[byteCount]], [rope[IF NOT doDelete THEN "to be " ELSE NIL]]];
msgStream.PutF1["\tFinished at %g\n", [time[BasicTime.Now[]]] ];
};
IF outFileName # NIL THEN msgStream.Close[];
EXITS
bogus => result м $Failure;
};

CheckOutPut: PROC[cmdout: STREAM, outFileName: ROPE, append: BOOL]
RETURNS[outStream: STREAM] = {
outPath: PFS.PATH;
IF outFileName = NIL THEN RETURN[cmdout];
outPath м PFS.PathFromRope[outFileName];
outStream м PFS.StreamOpen[outPath, IF append THEN $append ELSE $create ! PFS.Error => {
cmdout.PutRope[error.explanation]; CONTINUE} ];
IF outStream # NIL THEN {
IF append THEN cmdout.PutF1["Messages will be appended to %g\n", [rope[outFileName]] ]
ELSE cmdout.PutF1["Messages will be written on %g\n", [rope[outFileName]] ]
}
ELSE {
cmdout.PutF1["\n\tCould not open %g - using cmd.out\n", [rope[outFileName]] ];
outStream м cmdout;
};
};

PFSErrorMsg: PROC [error: PFS.ErrorDesc] RETURNS [ROPE] ~ {
RETURN[Rope.Concat["***> PFS.Error: ", error.explanation]];
};

archiveDelverDoc: Rope.ROPE ~ "archive/deletes excess versions of files matching given patterns
  -a fileName	append output to fileName
  -b     report number of bytes to be or actually deleted (default: not to count)
  -f     find excess versions only (default: delete them)
  -k n  # of versions to keep (default: 2, min: 1, max: 100)
  -o fileName	write output to fileName
  -r     perform recursively on sub-directories (default: no recursion)
  -t     terse reporting when doing recursion on sub-directories (default: verbose)
  -x prefix translation  prefixmap translation for where to archive the file
  -z     include zero-length files (default: ignore them)";

Commander.Register[
"ArchiveDelver", ArchiveDelverCommand,
archiveDelverDoc,
$ArchiveDelver];

END.


   ,  
ArchiveDelverImpl.mesa
Copyright ╙ 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) June 7, 1990 2:43 pm PDT
Willie-s, November 12, 1992 2:29 pm PST
Jules Bloomenthal November 22, 1990 5:52 pm PST
Michael Plass, November 27, 1991 12:46 pm PST
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
CommandObject ~ [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]

[fullFName: PATH, ..., bytes: INT, ...] RETURNS [continue: BOOL _ TRUE]
I'm not sure that this can happen, but if so, ignore it
If ignoring zero-length files, then do it now
We don't add files with non-numeric versions!
We have a duplicate file name that differs only in version number
Try to archivedelete this file
Add the new file to the tail
 Э╩Ю  ХNewlineDelimiter
Ц(cedarcode) styleЩ headЩIcodeЪЬ
╧eЬ=ЩHLЩ,LЩ'LЩ/LЩ-ЧШ LЪ╧k	Ь.ЮЬЮЬШ]ЧЪЬЮЬЮШ LЪЮЬ.ЮЬЮЬШZLЪЬЮШLШ LЪЬЮЬШ%LЪЮЬЮЬЮЬШLЪЮЬЮЬЮЬШLЪЮЬЮЬЮЬЮЬШLЪЬ
ЮЬЮЬЮЬЮЬЮЬЮЬШ5ЧLШ Ъ╧nЬШ/LЪЬЮЬ
ЮЬЮЬЮЬЮЬЩ:ЪЬЩLЪЬЮЬЮЬЩ1LЪЬ6Щ6LЩ ЧLХStartOfExpansion* -- [FSBackdoor.Version] RETURNS [BOOLEAN]ЪЯЬЮЬЮЬЮЬШ,ЪЯ	ЬЮЬЮЬШ#LЪЯЬЮЬЮЬЮЬЮЬЮЬШSЪЯЬЮЬШLЪЬЮЬЮЬЮЬЮЬЮЬЩGLЪЬЮЬШLЪЬЮЬШLЪЬЮЬ!Ш+LЪЬЮЬ4ШCLЪ
ЮЬЮЬЮЬЮЬЮЬШOLШЪЮЬЮЬЮШЪЬШLЩ7ЧЪЮЬЮЬШ&LЩ-ЧЪЬ
ЮЬШLЪЬ
ЮЬЮЬШ(LШЪЮЬЮЬЮЬШLЪЬШLЪЬHШHLШЧLЪ╧b	ЬШ'LШLШЧЪЮЬШLЪЬ=Ш=LЪЬ	ЮЬШЪЮЬ(ЮЬЮЬЮЬШ=LЩ-ЧЪЮЬЮЬЮЬШLЪЬЮЬ$Ш9LЪЬ Ш LЪЮЬЮЬЮЬЮЬ	Ш/LШ:LЪЮЬЮЬХЮЬЮЬЮЬЮЬ	Ш╡Ъ	ЮЬЮЬЮ
ЬЮЬЮШ(LЪ
ЮЬRЮЬ
ЮЬЮЬЮЬ	ШvLЪЮЬШЧЪЮЬЮЬШLЩALЪЬ	ЮЬЮЬШ*LЪЮЬЮЬЮЬШGLШ LШLЪ
ЮЬЮЬЮЬЮЬЮЬШ<LШШLЪЬЮЬЮЬШLЪЬ	ЮЬЮЬ-Ш>LШLЩLЪЬEЮЬШdЪЮЬ2Ш5ЪЬЮЬШLЪЬШLШ<LЪЬЮЬЮЬШЧЧЪЮЬ
ЮЬЮЬЮЬШ2ЪЬЮЬШLЪЬШLШ<LЪЮЬШЧЧLЪЮЬ	ЮЬШ"LШЧLШЧЪЮШLЪЬШЧLШЧLЩLЪЮЬЮЬЮЬШLШLШLШЧЧLЪЮЬЮЬШLШЧLЪ
ЮЬЮЬЮЬЮЬЮЬШNLШ
LШLШLЪЮЬЮЬЮЬЮЬЮЬЮЬШ?ЪЮЬЮЬ#ШDЪЬЮЬ
ЮЬЮЬШ*LШLЪЬ5Ш5LЪЮЬ	ЮЬШ"LЪЮЬШ	LЪЬШЧЧЪ
ЮЬЮЬЮЬЮЬ
ЮЬШJLЪЬШLЪЬaШaLШЧLЪЮЬ	ЮЬШ"LШLШ ЧLЪЬЮЬЮЬШLЪЬЮЬЮЬШLЪЬЮЬШLЪЬ
ЮЬЮЬШLЪЬ
ЮЬЮЬШLЪЬ)ЮЬШ-LЪЬЮЬШLЪЬЮЬШLЪЬЮЬШLЪЬЮЬ╧c2ШCЪЬЮЬШLЪЬЮЬШLЪЮЬЮЬЮЬЮЬЮЬЮЬШ9LШLШЧШ:LЪЬ+ЮЬЮЬШ;ЧLЪЬ	ЮЬШLЪЬЮЬЮЬШLЪЬ
ЮЬЮЬШLЪЬЮЬЮЬШLЪЬЮЬЮЬШLЪЬЮЬЮЬШLЪЬЮЬЮЬШLЪЬЮЬЮЬШLЪЬЮЬШLШ ЪЮЬ	ЮЬЮЬЮШ/LЪЬЮЬШЪЮЬШЪЮЬШLЪЬЮЬЮЬШЪЮЬЮЬЮЬЮШ&ЪЮЬЮШЪЬб
ЬШLЪЬЮЬШLЪЮЬШLЪЬШЧЪЬбЬбЬШ*ЪЮЬЮЬ%ЮЬШ1LЪЬ*ЮЬЮЬШ7ЧLШLЪЬ	ЮЬШLЪЬ
ЮЬШLЪЬШЧЪЬб!ЬШ-LШLЪЬШЧЪЬбЬШ*LШLЪЬШЧЪЬб
ЬШLЪЬЮЬШЪЮЬЮЬ%ЮЬШ1LЪЬ,ЮЬЮЬШ9ЧШ:LЪЬЮЬPЮЬЮЬ	ШfЧЪЮЬЮЬЮЬЮЬШLЪЬ;ЮЬЮЬШHЧLШ	LЪЬШЧЪЬбЬШЪЮЬЮЬ%ЮЬШ1LЪЬ ЮЬЮЬШ-ЧLШLЪЬ
ЮЬШLЪЬШЧЪЬбЬШLШLЪЬШЧЪЬб+ЬШ7LШLЪЬШЧЪЬбЬШLЪЬЮЬШЪЮЬЮЬ%ЮЬШ1LЪЬ$ЮЬЮЬШ1ЧLШЪЮЬЮЬ%ЮЬШ1LЪЬЮЬЮЬШ*ЧLШLЪЬ-ЮЬЮЬШgLЪЬШЧЪЬб
ЬШLШLЪЬШЧLЪЮЬЮЬШЧLЪЬЮЬШLЪЮЬШЧLШЧЪЮЬШLШ6ЪЮЬЮЬЮЬШLШ>LЪЮЬШLШЧLЪЮЬЮЬiШ{LЪЬШLЪЬЮЬШLЪЬШЧЧLШLЪЮЬШLШ ЧЪЮЬЮЬЮЬШLШ6ЪЮЬЮЬЮЬШLШ>LЪЮЬШLШЧLЪЮЬЮЬhШzLЪЬШLШЧЪЮЬЮЬШLЪЬDЮЬЮЬ
ЮЬ
ЮЬЮЬШnLЪЬ@Ш@LШЧLЪЮЬЮЬЮЬШ,ЪЮШLШЧLШLШ ЧЪЯЬЮЬ	ЮЬЮЬ
ЮЬЮЬЮЬШaLЪЬ	ЮЬЮЬШLЪЮЬЮЬЮЬЮЬ	Ш)LЪЬ
ЮЬШ(LЪЬЮЬЮЬЮЬ	ЮЬЮЬ/ЮЬШИЪЮЬЮЬЮЬШЪЮЬЮЬHШVLЪЮЬGШKЧLШЪЮЬШLЪЬNШNLШLШЧЧLШLШ ЧЪ
ЯЬЮЬ	ЮЬЮЬЮЬШ;LЪЮЬ5Ш;LЪЬШLШ ЧLЪЬЮЬБШЬLШ ЪЬШLШ&LШLШЧLШ LЪЮЬШLШ LШ Ч ЕЧ    !╩  0Ф  