PFSCommandsImpl.mesa
Copyright Ó 1989, 1990, 1991 by Xerox Corporation. All rights reserved.
Carl Hauser, August 24, 1989 4:43:16 pm PDT
Michael Plass, November 25, 1991 1:19 pm PST
Doug Wyatt, April 15, 1992 12:28 pm PDT
Last tweaked by Mike Spreitzer on February 7, 1990 12:12:30 pm PST
Chauser, September 28, 1990 11:16 am PDT
Willie-s, August 14, 1992 3:10 pm PDT
DIRECTORY
BasicTime USING [GMT, minutesPerHour, MonthOfYear, nullGMT, OutOfRange, Period, TimeParametersNotKnown, Unpack, Unpacked, unspecifiedZone, Zone],
Commander USING [CommandProc, CommandProcHandle, Register],
Convert USING [Base, CardFromRope],
IO,
List USING [AList, PutAssoc],
PFS USING [AbsoluteName, Attach, Copy, Delete, EnumerateForInfo, EnumerateForNames, Error, ErrorDesc, ErrorGroup, FileInfo, FileType, GetWDir, InfoProc, NameProc, NameConfirmProc, nullUniqueID, PathFromRope, Rename, Retrieve, RetrieveConfirmProc, RopeFromPath, StreamOpen, tDirectory, tText, tUnspecified, UniqueID],
PFSNames USING [Cat, Compare, ComponentCount, ComponentProc, ComponentRope, Equal, IsADirectory, Map, NarrowPath, Parent, PATH, SeparatorProc, SetVersionNumber, ShortName, StripVersionNumber, SubName, VersionKind],
PFSPrefixMap USING [Delete, Entry, EntryList, GetMap, Insert, Lookup, Translate],
PriorityQueue USING [Create, Insert, Item, Ref, Remove, Size, SortPred],
Process USING [CheckForAbort],
ProcessProps USING [AddPropList, GetProp],
Rope USING [Cat, Concat, Equal, Fetch, Find, Length, Match, ROPE, Substr],
RuntimeError USING [UNCAUGHT];
PFSCommandsImpl: CEDAR MONITOR
IMPORTS BasicTime, Commander, Convert, IO, List, PFS, PFSNames, PFSPrefixMap, PriorityQueue, Process, ProcessProps, Rope, RuntimeError
= BEGIN
GMT: TYPE = BasicTime.GMT;
LORA: TYPE = LIST OF REF ANY;
ROPE: TYPE = Rope.ROPE;
PATH: TYPE = PFSNames.PATH;
STREAM: TYPE = IO.STREAM;
QuotedStringError: ERROR = CODE;
CmdTokenBreak: PROC [char: CHAR] RETURNS [IO.CharClass] = {
IF char = '" THEN RETURN [break];
IF char = ' OR char = '\t OR char = ', OR char = '\l OR char = '\r THEN RETURN [sepr];
RETURN [other];
};
Token: TYPE = RECORD [value, literal: ROPE];
GetCmdToken: PROC [stream: IO.STREAM] RETURNS [token: Token ¬ [NIL, NIL]] = {
token.value ¬ token.literal ¬ IO.GetTokenRope[stream, CmdTokenBreak ! IO.EndOfStream => CONTINUE].token;
IF Rope.Equal[token.literal, "\""] THEN {
ref: REF;
IO.Backup[self: stream, char: '"];
ref ¬ IO.GetRefAny[stream ! IO.Error, IO.EndOfStream => ERROR QuotedStringError];
WITH ref SELECT FROM
rope: ROPE => token.value ¬ rope;
ENDCASE => ERROR QuotedStringError;
};
};
GetPath: PROC [stream: IO.STREAM] RETURNS [PATH] = {
RETURN [PFS.PathFromRope[GetCmdToken[stream].value]]
};
PrefixMapAdd: Commander.CommandProc ~ TRUSTED {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [in, out, err: STREAM, commandLine, command: ROPE, ...]
ENABLE QuotedStringError => {msg ← "Mismatched quotes"; GO TO failed};
translateFirst, checkPrev: BOOL ¬ FALSE;
argStream: IO.STREAM ~ IO.RIS[cmd.commandLine];
prefix, translation: PATH;
first: ROPE ¬ GetCmdToken[argStream].value;
DO
IF first = NIL THEN EXIT;
IF Rope.Fetch[first, 0] # '- THEN { prefix ¬ PFS.PathFromRope[first]; EXIT };
FOR i: INT IN [1..Rope.Length[first]-1] DO
SELECT Rope.Fetch[first, i] FROM
'c, 'C => checkPrev ¬ TRUE;
't, 'T => translateFirst ¬ TRUE;
ENDCASE => {
cmd.out.PutF1["Unknown switch %g; quitting\n", [character[Rope.Fetch[first, i]]] ];
RETURN;
};
ENDLOOP;
first ¬ GetCmdToken[argStream].value;
ENDLOOP;
translation ← GetPath[argStream];
SELECT TRUE FROM
prefix=NIL => {
cmd.out.PutF1["%g \n", [rope[prefixMapAddDoc]]];
RETURN;
};
translation=NIL => {
[] ← PFSPrefixMap.Delete[prefix];
};
ENDCASE => {
IF translateFirst THEN translation ¬ PFSPrefixMap.Translate[translation];
IF checkPrev THEN {
prev: PATH ¬ PFSPrefixMap.Lookup[prefix];
IF prev # NIL AND NOT PFSNames.Equal[prev, translation] THEN
cmd.out.PutF1["Redefining previous translation (%g)\n", [rope[PFS.RopeFromPath[prev]]] ];
};
[] ¬ PFSPrefixMap.Insert[prefix, translation];
};
EXITS
failed=> result ← $Failure;
};
PrefixMapPrint: Commander.CommandProc ~ TRUSTED {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [in, out, err: STREAM, commandLine, command: ROPE, ...]
ENABLE QuotedStringError => {msg ¬ "Mismatched quotes"; GO TO failed};
argStream: IO.STREAM ~ IO.RIS[cmd.commandLine];
prefix: PATH ¬ GetPath[argStream];
SELECT TRUE FROM
prefix=NIL => {
list: PFSPrefixMap.EntryList ~ PFSPrefixMap.GetMap[];
FOR l: PFSPrefixMap.EntryList ¬ list, l.rest UNTIL l=NIL DO
cmd.out.PutF[ "\t%g\t\t%g\n", [rope[PFS.RopeFromPath[l.first.prefix]]], [rope[PFS.RopeFromPath[l.first.translation]]] ];
ENDLOOP;
};
ENDCASE => {
translation: PATH ~ PFSPrefixMap.Lookup[prefix];
cmd.out.PutF[ "\t%g\t\t%g\n", [rope[PFS.RopeFromPath[prefix]]], [rope[PFS.RopeFromPath[translation]]] ];
};
EXITS
failed=> result ¬ $Failure;
};
PrefixMapTranslate: Commander.CommandProc ~ TRUSTED {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [in, out, err: STREAM, commandLine, command: ROPE, ...]
ENABLE QuotedStringError => {msg ¬ "Mismatched quotes"; GO TO failed};
argStream: IO.STREAM ~ IO.RIS[cmd.commandLine];
path: PATH ¬ GetPath[argStream];
SELECT TRUE FROM
path=NIL => {
cmd.out.PutF1[ "%g\n", [rope[prefixMapTranslateDoc]] ];
};
ENDCASE => {
translation: PATH ~ PFSPrefixMap.Translate[path];
cmd.out.PutF[ "\t%g\t\t%g\n", [rope[PFS.RopeFromPath[path]]], [rope[PFS.RopeFromPath[translation]]] ];
};
EXITS
failed=> result ¬ $Failure;
};
NameCommandProc: Commander.CommandProc ~ TRUSTED {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [in, out, err: STREAM, commandLine, command: ROPE, ...]
ENABLE QuotedStringError => {msg ¬ "Mismatched quotes"; GO TO failed};
argStream: IO.STREAM ~ IO.RIS[cmd.commandLine];
val: REF ANY ¬ LOOPHOLE[ Convert.CardFromRope[GetCmdToken[argStream].value !
RuntimeError.UNCAUGHT => {msg ¬ "conversion error"; GO TO failed}] ];
name: PATH ¬ PFSNames.NarrowPath[val !
RuntimeError.UNCAUGHT => { msg ¬ "narrow failed"; GO TO failed}];
nameRope: ROPE ¬ PFS.RopeFromPath[name];
cmd.out.PutF[ " %g: %g\n", [cardinal[LOOPHOLE[val]]], [rope[nameRope]] ];
EXITS
failed=> result ¬ $Failure;
};
Delete Files
DeleteCommandProc: Commander.CommandProc = {
argStream: IO.STREAM ~ IO.RIS[cmd.commandLine];
out: STREAM = cmd.out;
exactLevelMatch: BOOL ¬ FALSE;
componentsRequired: INT ¬ 0;
deleteIt: PFS.NameProc = {
ok: PFS.NameConfirmProc ~ {
IO.PutRope[out, " deleting "];
IO.PutRope[out, PFS.RopeFromPath[fullName]];
RETURN[TRUE];
};
Process.CheckForAbort[];
continue ¬ TRUE;
IF exactLevelMatch AND componentsRequired # name.ComponentCount[] THEN RETURN;
PFS.Delete[name~name, confirmProc~ok ! PFS.Error =>
IF error.group # bug THEN { IO.PutRope[cmd.err, PFSErrorMsg1[error]]; CONTINUE } ];
IO.PutRope[out, "\n"];
};
DO
pattern: ROPE ¬ GetCmdToken[argStream ! QuotedStringError => {msg ¬ "Mismatched quotes"; GO TO Die}].value;
IF pattern = NIL THEN EXIT;
IF Rope.Match["-*", pattern] THEN {
This is a switch, not a file name
sense: BOOL ¬ TRUE;
FOR i: INT IN [1..Rope.Length[pattern]) DO
c: CHAR = Rope.Fetch[pattern, i];
SELECT c FROM
'~ => {sense ¬ NOT sense; LOOP};
'x, 'X => exactLevelMatch ¬ sense;
ENDCASE;
sense ¬ TRUE;
ENDLOOP;
LOOP;
};
{ENABLE PFS.Error => IF error.group # $bug
THEN {msg ¬ PFSErrorMsg[error]; GO TO Die};
path: PATH ¬ PFS.PathFromRope[pattern];
path ¬ PFS.AbsoluteName[path];
IF path.ComponentCount[] = 0 THEN LOOP;
IF exactLevelMatch THEN componentsRequired ¬ path.ComponentCount[];
IF path.ShortName[].version = [none] THEN path ¬ path.SetVersionNumber[[lowest]];
IF Rope.Find[pattern, "*"] = -1
THEN [] ¬ deleteIt[path]
ELSE PFS.EnumerateForNames[path, deleteIt];
};
Process.CheckForAbort[];
ENDLOOP;
EXITS
Die => result ¬ $Failure;
};
PFSErrorMsg: PROC [error: PFS.ErrorDesc] RETURNS [ROPE] = {
IF error.code = $unknownFile
THEN RETURN [" -- not found!\n"]
ELSE RETURN[Rope.Cat[" -- PFS.Error: ", error.explanation, "\n"]];
};
PFSErrorMsg1: PROC [error: PFS.ErrorDesc] RETURNS [ROPE] = {
IF error.code = $unknownFile
THEN RETURN [" -- not found!"]
ELSE RETURN[Rope.Concat["\n -- PFS.Error: ", error.explanation]];
};
Copying and Renaming
CopyAndRename: Commander.CommandProc = {
destinationDirectory: PATH ¬ NIL;
leftArrowExists: BOOL ¬ FALSE;
useRetrieve: BOOL ¬ cmd.procData.clientData = $Retrieve;
doACopy: BOOL ¬ cmd.procData.clientData = $Copy;
doStore: BOOL ¬ cmd.procData.clientData = $Store;
compsBeforeStar: INT ¬ 0;
forceCopy: BOOL ¬ TRUE;
retainStructure: BOOL ¬ FALSE;
updateOnly: BOOL ¬ FALSE;
exactLevelMatch: BOOL ¬ FALSE;
componentsRequired: INT ¬ 0;
HandleAFile: PROC [to, from: PATH] = {
Process.CheckForAbort[];
cmd.out.PutF[" %g ← %g", [rope[PFS.RopeFromPath[to]]], [rope[PFS.RopeFromPath[from]]]];
{ENABLE
PFS.Error =>
IF error.group # bug THEN {msg ¬ PFSErrorMsg1[error]; GO TO skipIt};
IF updateOnly THEN {
sourceID: PFS.UniqueID ¬ PFS.nullUniqueID;
destID: PFS.UniqueID ¬ PFS.nullUniqueID;
sourceID ¬ PFS.FileInfo[from].uniqueID;
destID ¬ PFS.FileInfo[to ! PFS.Error => IF error.group # bug THEN CONTINUE].uniqueID;
IF sourceID = destID AND sourceID # PFS.nullUniqueID THEN {
This file does not need a copy, since it has the same ID as the destination file. We have been instructed to trust the ID.
cmd.out.PutRope["\n -- not copied, create dates match"];
GO TO skipIt;
};
};
SELECT TRUE FROM
doACopy => {
IF forceCopy
THEN PFS.Copy[from: from, to: to, confirmProc: NIL]
ELSE [] ¬ PFS.Attach[attachedFile: from, attachment: to];
};
useRetrieve => {
toStrm: STREAM ¬ PFS.StreamOpen[to, $create, PFS.FileInfo[from].uniqueID];
Rcp: PFS.RetrieveConfirmProc ~ { RETURN[toStrm] };
PFS.Retrieve[name: from, proc: Rcp];
toStrm.Close[];
};
ENDCASE => PFS.Rename[from: from, to: to];
EXITS
skipIt => {};
};
cmd.out.PutRope["\n"];
};
argStream: IO.STREAM ~ IO.RIS[cmd.commandLine];
head: LIST OF ROPE ~ LIST[NIL];
last: LIST OF ROPE ¬ head;
nArgs: NAT ¬ 0;
args: LIST OF ROPE ¬ NIL;
sources: LIST OF ROPE ¬ NIL;
DO
arg: Token ~ GetCmdToken[argStream];
length: INT ~ Rope.Length[arg.value];
SELECT TRUE FROM
(arg.value = NIL) => EXIT;
(length = 0) => NULL;
(Rope.Fetch[arg.literal, 0] = '-) => {
sense: BOOL ¬ TRUE;
FOR j: INT IN [1..length) DO
SELECT arg.literal.Fetch[j] FROM
'~ => {sense ¬ NOT sense; LOOP };
'c, 'C => forceCopy ¬ sense;
'r, 'R => retainStructure ¬ sense;
'u, 'U => updateOnly ¬ sense;
'x, 'X => exactLevelMatch ¬ sense;
ENDCASE => {
msg ¬ Rope.Cat["Unknown switch: ", arg.literal.Substr[0, j], " ", arg.literal.Substr[j]];
GOTO Die;
};
sense ¬ TRUE;
ENDLOOP;
};
(nArgs = 1 AND (Rope.Equal[arg.literal, "←"] OR Rope.Equal[arg.literal, "¬"])) => {
leftArrowExists ¬ TRUE;
};
ENDCASE => { nArgs ¬ nArgs + 1; last ¬ last.rest ¬ LIST[arg.value] };
ENDLOOP;
args ¬ head.rest;
IF leftArrowExists
THEN {
target: PATH ¬ PFS.PathFromRope[args.first];
sources ¬ args.rest;
IF target.IsADirectory[]
THEN destinationDirectory ¬ target
ELSE {
IF nArgs # 2 OR Rope.Find[args.first, "*"] >= 0 OR Rope.Find[args.rest.first, "*"] >= 0
THEN RETURN[$Failure, "Bad syntax for copying a file"];
HandleAFile[from: PFS.PathFromRope[args.rest.first], to: target];
RETURN[IF msg # NIL THEN $Failure ELSE NIL, msg];
};
}
ELSE {
destinationDirectory ¬ PFS.GetWDir[];
sources ¬ args;
};
If we get here, then for each of the filenames and patterns, copy the file to the destination directory.
FOR tail: LIST OF ROPE ¬ sources, tail.rest UNTIL tail = NIL DO
source: PATH ¬ PFS.PathFromRope[tail.first];
IF source.IsADirectory[] THEN {
msg ¬ Rope.Concat["Cannot copy a directory: ", tail.first];
GO TO Die;
};
IF Rope.Find[tail.first, "*"] >= 0
THEN {
pattern: PATH ¬ source;
handleIt: PFS.NameProc = {
[name: PATH] RETURNS [continue: BOOL]
to: PATH;
short: ROPE ¬ NIL;
continue ¬ TRUE;
IF exactLevelMatch AND componentsRequired # name.ComponentCount[] THEN RETURN [TRUE];
IF retainStructure
THEN to ¬ name.SubName[compsBeforeStar]
ELSE to ¬ name.SubName[start~name.ComponentCount[]-1, count~1];
to ¬ to.StripVersionNumber[];
to ¬ PFSNames.Cat[destinationDirectory, to];
HandleAFile[from: name, to: to];
RETURN[msg = NIL];
};
IF pattern.ShortName[].version = [none] THEN pattern ¬ pattern.SetVersionNumber[[highest]];
pattern ¬ PFS.AbsoluteName[pattern];
IF exactLevelMatch THEN componentsRequired ¬ PFSNames.ComponentCount[pattern];
IF retainStructure THEN {
goOn: BOOL ¬ TRUE;
findStar: PFSNames.ComponentProc ~ {
IF goOn AND Rope.Find[comp.ComponentRope[], "*"] >= 0 THEN goOn ¬ FALSE ELSE compsBeforeStar ¬ compsBeforeStar+1;
};
dummySeparatorProc: PFSNames.SeparatorProc ~ {};
PFSNames.Map[pattern, findStar, dummySeparatorProc, NIL];
};
PFS.EnumerateForNames[pattern, handleIt
! PFS.Error => IF error.group # $bug THEN {msg ¬ PFSErrorMsg[error]; GO TO Die}];
}
ELSE {
from: PATH ¬ source;
to: PATH ¬ PFSNames.StripVersionNumber[from.SubName[from.ComponentCount[]-1]];
to ¬ PFSNames.Cat[destinationDirectory, to];
HandleAFile[from: from, to: to];
IF msg # NIL THEN GO TO Die;
};
Process.CheckForAbort[];
ENDLOOP;
EXITS
Die => result ¬ $Failure;
};
List Command
ListCommandProc: Commander.CommandProc = {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [in, out, err: STREAM, commandLine, command: ROPE, ...]
EachFileName: PFS.NameProc = {
[name: PATH] RETURNS [continue: BOOL]
attachedTo: PATH ¬ NIL;
created: BasicTime.GMT ¬ BasicTime.nullGMT;
bytes: INT ¬ -1;
fileType: PFS.FileType ¬ PFS.tUnspecified;
uniqueID: PFS.UniqueID;
item: FileItem ¬ NIL;
continue ¬ TRUE;
Process.CheckForAbort[];
IF xactLevelMatch AND componentsRequired # PFSNames.ComponentCount[name] THEN RETURN;
IF NOT prefixOnly THEN {
We may need the info
[attachedTo: attachedTo, bytes: bytes, uniqueID: uniqueID, fileType: fileType] ¬ PFS.FileInfo[name: name];
};
IF bytes > 0 AND lostFilesOnly THEN RETURN;
IF attachedTo#NIL AND unattachedOnly THEN RETURN;
item ¬ NEW[FileItemRep ¬ [name, attachedTo, uniqueID.egmt.gmt, bytes, PFS.tUnspecified]];
filesSeen ¬ filesSeen + 1;
IF bytes > 0 THEN bytesTotal ¬ bytesTotal + bytes;
SELECT TRUE FROM
prefixOnly => {
oldLag: PATH ¬ lagPrefix;
SetLagPrefix[name];
IF oldLag # lagPrefix THEN {
item.fullUName ¬ lagPrefix;
PriorityQueue.Insert[pq, item];
};
};
complexSorting => PriorityQueue.Insert[pq, item];
ENDCASE => PrintOneFile[item];
};
EachFileInfo: PFS.InfoProc = {
item: FileItem ¬ NIL;
continue ¬ TRUE;
Process.CheckForAbort[];
IF xactLevelMatch AND componentsRequired # PFSNames.ComponentCount[fullFName] THEN RETURN;
IF bytes > 0 AND lostFilesOnly THEN RETURN;
IF attachedTo#NIL AND unattachedOnly THEN RETURN;
item ¬ NEW[FileItemRep ¬ [fullFName, attachedTo, uniqueID.egmt.gmt, bytes, fileType]];
filesSeen ¬ filesSeen + 1;
IF bytes > 0 THEN bytesTotal ¬ bytesTotal + bytes;
SELECT TRUE FROM
prefixOnly => {
oldLag: PATH ¬ lagPrefix;
SetLagPrefix[fullFName];
IF oldLag # lagPrefix THEN {
item.fullUName ¬ lagPrefix;
PriorityQueue.Insert[pq, item];
};
};
complexSorting => PriorityQueue.Insert[pq, item];
ENDCASE => PrintOneFile[item];
};
PrintOneFile: PROC [item: FileItem] = {
item: REF [fullUName, attachedTo: PATH, created: GMT, bytes: INT, keep: CARDINAL, PFS.FileType]
oldLag: PATH ¬ lagPrefix;
printName: ROPE ¬ PFS.RopeFromPath[item.fullUName];
Process.CheckForAbort[];
IF NOT fullPrint AND NOT prefixOnly THEN {
Factor out the directories
SetLagPrefix[item.fullUName];
IF oldLag # lagPrefix THEN {
IO.PutRope[out, PFS.RopeFromPath[lagPrefix]];
IO.PutChar[out, IF oneLine THEN ' ELSE '\n];
};
printName ¬ PFS.RopeFromPath[PFSNames.SubName[item.fullUName, lagPrefixLen]];
IF NOT oneLine THEN IO.PutRope[out, " "];
};
SELECT TRUE FROM
prefixOnly => IO.PutRope[out, printName];
briefPrint => {
IO.PutRope[out, printName];
};
ENDCASE => {
form: ROPE = IF narrowPrint THEN "%g\n%12g " ELSE "%-24g %6g ";
IO.PutF[out, form, [rope[printName]], [integer[item.bytes]] ];
IF item.created = BasicTime.nullGMT
THEN IO.PutRope[out, "??"]
ELSE DateToStream[out, [explicit, item.created] ];
IF typePrint THEN {
r: ROPE ~ SELECT item.fileType FROM
PFS.tUnspecified => " tUnspec",
PFS.tDirectory => " tDir",
PFS.tText => " tText",
ENDCASE => IO.PutFR1[" t%g", [integer[item.fileType]]];
IO.PutRope[out, r];
};
IF attachPrint AND item.attachedTo#NIL THEN IO.PutF[out, "%g=> %g", [rope[IF oneLine THEN " " ELSE "\n "]], [rope[PFS.RopeFromPath[item.attachedTo]]]];
};
IO.PutChar[out, IF oneLine THEN ' ELSE '\n];
};
TryPattern: PROC [pattern: PATH, allVersions: BOOL¬FALSE] = {
Do: PROC [] ~ {
ENABLE PFS.Error => IF error.group # $bug THEN {
IO.PutRope[cmd.err, " -- "];
IO.PutRope[cmd.err, error.explanation];
IO.PutRope[cmd.err, "\n"];
GO TO err};
patternsTried ¬ patternsTried + 1;
IF allVersions THEN {
pattern ¬ PFSNames.SetVersionNumber[pattern, [all]];
highestPrint ¬ FALSE;
};
IF highestPrint THEN
pattern ¬ PFSNames.SetVersionNumber[pattern, [highest]];
IF xactLevelMatch THEN {
pattern ¬ PFS.AbsoluteName[pattern];
componentsRequired ¬ PFSNames.ComponentCount[pattern];
};
complexSorting ¬ sortData # NIL;
SELECT TRUE FROM
prefixOnly => pq ¬ PriorityQueue.Create[SortPred, NIL];
complexSorting => pq ¬ PriorityQueue.Create[SortPred, sortData];
ENDCASE => pq ¬ NIL;
SetLagPrefix[NIL];
IF prefixOnly OR xactLevelMatch
THEN PFS.EnumerateForNames[pattern, EachFileName]
In these cases it is better to enumerate the names, then get the info
ELSE PFS.EnumerateForInfo[pattern, EachFileInfo];
In these cases it is better to enumerate for info, to reduce server traffic
SetLagPrefix[NIL];
IF pq # NIL THEN {
lagName: PATH ¬ NIL;
THROUGH [0..PriorityQueue.Size[pq]) DO
item: FileItem = NARROW[PriorityQueue.Remove[pq]];
IF prefixOnly THEN {
IF PFSNames.Equal[item.fullUName, lagName] THEN LOOP;
lagName ¬ item.fullUName;
};
PrintOneFile[item];
ENDLOOP;
};
EXITS
err => {IO.PutRope[cmd.err, "\n"]; RETURN};
};
wDir: ROPE ~ NARROW[ProcessProps.GetProp[$WorkingDirectory]];
newProp: List.AList ~ List.PutAssoc[$WDir, PFS.PathFromRope[wDir], NIL];
ProcessProps.AddPropList[newProp, Do];
};
SetLagPrefix: PROC [fileName: PATH] = {
... sets the lagging prefix from the given file name, which is presumed to be syntactically correct, although it need not be complete. A file name without a prefix will set the lagPrefix to NIL. We also enforce lagPrefixLen = Rope.Length[lagPrefix] at exit, assuming that no other routine sets lagPrefix.
newPrefix: PATH ¬ IF fileName# NIL THEN PFSNames.Parent[fileName] ELSE NIL;
IF lagPrefix # NIL THEN {
do we have a new prefix?
IF PFSNames.Equal[lagPrefix, newPrefix] THEN RETURN;
};
We have a new lagging prefix, so scan backwards for the LAST directory
lagPrefix ¬ newPrefix;
lagPrefixLen ¬ PFSNames.ComponentCount[newPrefix];
};
AddSortOption: PROC [option: ATOM] = {
new: LORA ¬ LIST[option];
IF sortDataTail = NIL THEN sortData ¬ new ELSE sortDataTail.rest ¬ new;
sortDataTail ¬ new;
};
RemSortOption: PROC [option: ATOM] = {
lag: LORA ¬ sortData;
IF lag = NIL THEN RETURN;
IF lag.first = option THEN {
sortData ¬ sortData.rest;
RETURN};
FOR each: LORA ¬ lag.rest, each.rest WHILE each # NIL DO
IF each.first = option THEN {lag.rest ¬ each.rest; EXIT};
lag ¬ each;
ENDLOOP;
};
gHost, gDir: ROPE ¬ NIL;
out: STREAM = cmd.out;
lagPrefix: PATH ¬ NIL;
lagPrefixLen: INT ¬ 0;
patternsTried, filesSeen, bytesTotal: INT ¬ 0;
briefPrint, complexSorting, fullPrint, attachPrint, keepPrint, lostFilesOnly, narrowPrint, oneLine, prefixOnly, typePrint, unattachedOnly, xactLevelMatch: BOOL ¬ FALSE;
highestPrint: BOOL ¬ cmd.procData.clientData = $Highest;
componentsRequired: INT ¬ 0;
sortData: LORA ¬ NIL;
sortDataTail: LORA ¬ NIL;
pq: PriorityQueue.Ref ¬ NIL;
argStream: IO.STREAM ~ IO.RIS[cmd.commandLine];
ProcessSwitches: PROC [arg: ROPE] = {
sense: BOOL ¬ TRUE;
direction: {up, down} ¬ down;
FOR index: INT IN [1..Rope.Length[arg]) DO
SELECT Rope.Fetch[arg, index] FROM
'~ => {sense ¬ NOT sense; LOOP};
'> => direction ¬ down;
'< => direction ¬ up;
'a, 'A => attachPrint ¬ sense;
'b, 'B => briefPrint ¬ sense;
'd, 'D => {
RemSortOption[$MoreRecent];
RemSortOption[$LessRecent];
IF sense THEN
AddSortOption[IF direction = up THEN $LessRecent ELSE $MoreRecent];
};
'f, 'F => fullPrint ¬ sense;
'h, 'H => highestPrint ¬ sense;
'k, 'K => keepPrint ¬ sense;
'n, 'N => narrowPrint ¬ sense;
'o, 'O => oneLine ¬ sense;
'p, 'P => prefixOnly ¬ sense;
'r, 'R => {
-- remoteCheck ← sense;
};
's, 'S => {
RemSortOption[$Larger];
RemSortOption[$Smaller];
IF sense THEN
AddSortOption[IF direction = up THEN $Smaller ELSE $Larger];
};
't, 'T => typePrint ¬ sense;
'u, 'U => unattachedOnly ¬ sense;
'x, 'X => xactLevelMatch ¬ sense;
'z, 'Z => lostFilesOnly ¬ sense;
ENDCASE => {
result ¬ $Failure;
msg ¬ Rope.Cat["Unknown switch: ", arg.Substr[0, index], " ", arg.Substr[index]];
RETURN;
};
sense ¬ TRUE;
ENDLOOP;
};
DO
arg: Token = GetCmdToken[argStream ! QuotedStringError => {msg ¬ "Mismatched quotes"; GO TO failed}];
IF arg.value = NIL THEN EXIT;
IF Rope.Length[arg.value] = 0 THEN LOOP;
IF Rope.Fetch[arg.literal, 0] = '- THEN {
This argument sets switches for the remaining patterns
ProcessSwitches[arg.literal];
IF result = $Failure THEN RETURN;
LOOP;
};
Now the argument is assumed to be a file pattern.
TryPattern[PFS.PathFromRope[arg.value ! PFS.Error => IF error.group # $bug THEN {
IO.PutRope[cmd.err, " -- "];
IO.PutRope[cmd.err, error.explanation];
IO.PutRope[cmd.err, "\n"];
GO TO failed}]];
ENDLOOP;
IF patternsTried = 0 THEN TryPattern[PFS.PathFromRope["*" ! PFS.Error => IF error.group # $bug THEN {
IO.PutRope[cmd.err, " -- "];
IO.PutRope[cmd.err, error.explanation];
IO.PutRope[cmd.err, "\n"];
GO TO failed}]];
IF oneLine THEN IO.PutChar[out, '\n];
IF filesSeen > 0 THEN {
out: IO.STREAM ~ IO.ROS[];
IO.PutF1[out, "-- %g files", [integer[filesSeen]] ];
IF bytesTotal > 0 THEN IO.PutF1[out, ", %g total bytes", [integer[bytesTotal]] ];
IO.PutChar[out, '\n];
msg ¬ IO.RopeFromROS[out];
};
EXITS
failed => {result ¬ $Failure};
};
FileItem: TYPE = REF FileItemRep;
FileItemRep: TYPE = RECORD [fullUName, attachedTo: PATH, created: GMT, bytes: INT, fileType: PFS.FileType];
SortPred: PriorityQueue.SortPred = {
[x: Item, y: Item, data: REF] RETURNS [BOOL]
xx: FileItem = NARROW[x];
yy: FileItem = NARROW[y];
options: LORA = NARROW[data];
FOR each: LORA ¬ options, each.rest WHILE each # NIL DO
SELECT each.first FROM
$MoreRecent => {
IF xx.created = yy.created THEN LOOP;
RETURN [BasicTime.Period[xx.created, yy.created] < 0];
};
$LessRecent => {
IF xx.created = yy.created THEN LOOP;
RETURN [BasicTime.Period[xx.created, yy.created] > 0];
};
$Larger => {
IF xx.bytes = yy.bytes THEN LOOP;
RETURN [xx.bytes > yy.bytes];
};
$Smaller => {
IF xx.bytes = yy.bytes THEN LOOP;
RETURN [xx.bytes < yy.bytes];
};
ENDCASE;
ENDLOOP;
RETURN [PFSNames.Compare[xx.fullUName, yy.fullUName, FALSE] = less];
};
Utilities
-- Stolen from DFUtilitiesImpl
DateFormat: TYPE = {explicit, omitted, greaterThan, notEqual};
Date: TYPE = RECORD [
format: DateFormat ¬ $omitted,
gmt: GMT ¬ BasicTime.nullGMT
'gmt' is valid only if dateFormat = $explicit. (We don't use a variant record because it complicates the client's life too much (i.e., the compiler is unnecessarily picky about assignments involving variant records that aren't REF-containing).)
];
Note: Dates returned by ParseFromStream are guaranteed to have `gmt' = nullGMT if `format' ~= $explicit. The other procedures of this interface ignore the 'gmt' field if 'format' ~= $explicit.
DateToStream: PROC [s: STREAM, date: Date] = {
SELECT date.format FROM
$explicit => {
months: ROPE = "JanFebMarAprMayJunJulAugSepOctNovDec";
up: BasicTime.Unpacked = BasicTime.Unpack[date.gmt
! BasicTime.OutOfRange, BasicTime.TimeParametersNotKnown => GO TO noDate];
ConvertZone: PROC = {
dst: BOOL = up.dst = yes;
SELECT up.zone FROM
0 => IF ~dst THEN s.PutRope["GMT"];
NAT[5*BasicTime.minutesPerHour] => s.PutRope[IF dst THEN "EDT" ELSE "EST"];
NAT[6*BasicTime.minutesPerHour] => s.PutRope[IF dst THEN "CDT" ELSE "CST"];
NAT[7*BasicTime.minutesPerHour] => s.PutRope[IF dst THEN "MDT" ELSE "MST"];
NAT[8*BasicTime.minutesPerHour] => s.PutRope[IF dst THEN "PDT" ELSE "PST"];
ENDCASE =>
s.PutF["%g%02d%02d",
[character[IF up.zone < 0 THEN '- ELSE '+]],
[cardinal[up.zone.ABS/BasicTime.minutesPerHour]],
[cardinal[up.zone.ABS MOD BasicTime.minutesPerHour]]
]
};
s.PutF["%02d-%g-%02d ",
[cardinal[up.day]],
[rope[months.Substr[start: up.month.ORD*3, len: 3]]],
[cardinal[up.year MOD 100]]
];
s.PutF["%02d:%02d:%02d ",
[cardinal[up.hour]], [cardinal[up.minute]], [cardinal[up.second]]];
ConvertZone[];
};
$notEqual => s.PutRope["~="];
$greaterThan => s.PutChar['>];
ENDCASE;
EXITS
noDate => NULL;
};
Initialization
deleteDoc: ROPE = "{switch | pattern}*
Deletes files matching pattern.
-x exact level match";
listDoc: ROPE = "{switch | pattern}*
Lists files matching pattern.
-a print attachments
-b brief format
-d date sort
-f full name print
-h highest version
-k keep print
-n narrow print
-o one line
-p prefixes only
-s size sort
-t file type print
-x exact level match
-u unattached files only
-z 0-length files only
-> sort decreasing
-< sort increasing";
nameDoc: ROPE = "PFSName <positive decimal address> -- ";
prefixMapAddDoc: ROPE = "{-c|t} <prefix> <translation>
Adds a prefix map translation; omit <translation> to remove; -c means check if redefining and print out prev; -t means translate translation first.";
prefixMapPrintDoc: ROPE = "<prefix>
Prints a prefix map translation; omit <prefix> to print them all.";
prefixMapTranslateDoc: ROPE = "<path>
Translates <path> through the prefix map and prints the result.";
copyDoc: ROPE = "newFile ← oldFile | directory ← {pattern}*
Copies a file or files.
-c force copy
-r retain structure
-u update only
-x exact level match";
retrieveDoc: ROPE = "newFile ← oldFile | directory ← {pattern}*
Uses retrieve to copy a file or files (necessary for large xns files).
-r retain structure
-u update only
-x exact level match";
renameDoc: ROPE = "newFile ← oldFile | directory ← {pattern}*
Renames a file or files.
-r retain structure
-u update only
-x exact level match";
Init: PROC = {
Commander.Register["Delete", DeleteCommandProc, deleteDoc];
Commander.Register["Del", DeleteCommandProc, deleteDoc];
Commander.Register["LS", ListCommandProc, listDoc];
Commander.Register["LSH", ListCommandProc, listDoc, $Highest];
Commander.Register["List", ListCommandProc, listDoc];
Commander.Register["ListH", ListCommandProc, listDoc, $Highest];
Commander.Register["PFSPATH", NameCommandProc, nameDoc];
Commander.Register["PrefixMapAdd", PrefixMapAdd, prefixMapAddDoc];
Commander.Register["PMA", PrefixMapAdd, prefixMapAddDoc];
Commander.Register["PrefixMapPrint", PrefixMapPrint, prefixMapPrintDoc];
Commander.Register["PMP", PrefixMapPrint, prefixMapPrintDoc];
Commander.Register["PrefixMapTranslate", PrefixMapTranslate, prefixMapTranslateDoc];
Commander.Register["PMT", PrefixMapTranslate, prefixMapTranslateDoc];
Commander.Register["Copy", CopyAndRename, copyDoc, $Copy];
Commander.Register["Rename", CopyAndRename, renameDoc];
Commander.Register["Retrieve", CopyAndRename, retrieveDoc, $Retrieve];
};
Init[];
END.