GiveAndTakeImpl.mesa
Copyright Ó 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Last changed by Pavel on April 24, 1990 9:35 pm PDT
Michael Plass, April 2, 1993 12:00 pm PST
Willie-s, April 1, 1993 2:06 pm PST
DIRECTORY
Ascii USING [Upper],
BasicTime USING [GMT, nullGMT, Now],
Commander USING [CommandProc, Register],
CommanderOps USING [ParseToList],
Convert USING [Error, RopeFromTime, TimeFromRope],
GiveAndTake,
IO,
PFS USING [Delete, EnumerateForNames, Error, FileLookup, GetName, OpenFileFromStream, NameProc, PATH, PathFromRope, StreamOpen],
PFSNames USING [ComponentRope, SetVersionNumber, ShortName],
Rope USING [Equal, Fetch, FromChar, IsEmpty, Length, Match, ROPE, Replace, Substr],
RuntimeError USING [NarrowRefFault],
SystemNames USING [UserName],
SystemVersion USING [release];
GiveAndTakeImpl: CEDAR PROGRAM
IMPORTS Ascii, BasicTime, Commander, CommanderOps, Convert, IO, PFS, PFSNames, Rope, RuntimeError, SystemNames, SystemVersion
EXPORTS GiveAndTake
~ BEGIN
GMT: TYPE ~ BasicTime.GMT;
PATH: TYPE ~ PFS.PATH;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
defaultWorldName: PUBLIC ROPE ¬ IO.PutFR["Cedar%g.%g", [cardinal[SystemVersion.release.major]], [cardinal[SystemVersion.release.minor]] ];
Programmer's interface
NoSuchPackage: PUBLIC ERROR [packageName: ROPE, worldName: ROPE] ~ CODE;
MalformedTorch: PUBLIC SIGNAL [packageName: ROPE, worldName: ROPE] ~ CODE;
TakePackage: PUBLIC PROC [packageName: ROPE, worldName: ROPE ¬ defaultWorldName, forcibly: BOOL ¬ FALSE] RETURNS [ok: BOOL, owner: ROPE, takenDate: GMT] ~ {
torchName: PATH ~ PFS.PathFromRope[IO.PutFR["/%g/Torches/%g.torch", [rope[worldName]], [rope[packageName]]]];
newOwner: ROPE ~ GetNiceUserName[];
[taken: ok, owner: owner, takenDate: takenDate] ¬ PackageTaken[packageName, worldName];
IF ok AND (NOT forcibly) THEN {ok ¬ NOT ok; RETURN};
DO -- loop for forcible taking
torchStream: STREAM ¬ PFS.StreamOpen[torchName, $create];
fullTorchName: PATH ~ PFS.GetName[PFS.OpenFileFromStream[torchStream]].fullFName;
IF PFSNames.ShortName[fullTorchName].version.version = 1 THEN { -- We're a winner!
now: GMT ~ BasicTime.Now[];
nowRope: ROPE ~ Convert.RopeFromTime[now];
IO.PutF[torchStream, "( \"%q\" \"%q\" )\n", [rope[newOwner]], [rope[nowRope]]];
IO.Close[torchStream];
RETURN [TRUE, newOwner, now];
}
ELSE { -- We're a loser ...
versionOne: PATH ~ PFSNames.SetVersionNumber[torchName, [numeric, 1]];
lora: LIST OF REF ANY;
IO.Close[torchStream];
PFS.Delete[fullTorchName];
IF forcibly THEN -- Remove the old torch file and try again
PFS.Delete[versionOne]
ELSE {
torchStream ¬ PFS.StreamOpen[versionOne];
[owner, takenDate] ¬ GetTorchData[torchStream, packageName, worldName];
IO.Close[torchStream];
RETURN[FALSE, owner, takenDate];
};
};
ENDLOOP;
};
GivePackage: PUBLIC PROC [packageName: ROPE, worldName: ROPE ¬ defaultWorldName] RETURNS [yoursToGive: BOOL] ~ {
torchName: PATH ~ PFS.PathFromRope[IO.PutFR["/%g/Torches/%g.torch!1", [rope[worldName]], [rope[packageName]]]];
torchStream: STREAM;
owner: ROPE;
--CheckPackageExists[packageName, worldName];--
torchStream ¬ PFS.StreamOpen[torchName ! PFS.Error => IF error.code = $unknownFile THEN GO TO notOwner ELSE REJECT];
[owner,] ¬ GetTorchData[torchStream, packageName, worldName];
IO.Close[torchStream];
IF Rope.Equal[owner, GetNiceUserName[], FALSE] THEN {
PFS.Delete[torchName];
RETURN [TRUE];
}
ELSE GO TO notOwner;
EXITS
notOwner => { CheckPackageExists[packageName, worldName]; RETURN [FALSE]};
};
PackageTaken: PUBLIC PROC [packageName: ROPE, worldName: ROPE ¬ defaultWorldName] RETURNS [taken: BOOL, owner: ROPE, takenDate: GMT] ~ {
torchName: PATH ~ PFS.PathFromRope[IO.PutFR["/%g/Torches/%g.torch!1", [rope[worldName]], [rope[packageName]]]];
torchStream: STREAM;
torchStream ¬ PFS.StreamOpen[torchName ! PFS.Error => IF error.code = $unknownFile THEN GO TO notTaken ELSE REJECT];
[owner, takenDate] ¬ GetTorchData[torchStream, packageName, worldName];
IO.Close[torchStream];
RETURN [TRUE, owner, takenDate];
EXITS
notTaken => {CheckPackageExists[packageName, worldName]; RETURN [FALSE, NIL, BasicTime.nullGMT]};
};
PackageMine: PUBLIC PROC [packageName: ROPE, worldName: ROPE ¬ defaultWorldName] RETURNS [BOOL] ~ {
torchName: PATH ~ PFS.PathFromRope[IO.PutFR["/%g/Torches/%g.torch!1", [rope[worldName]], [rope[packageName]]]];
torchStream: STREAM;
owner: ROPE;
CheckPackageExists[packageName, worldName];
torchStream ¬ PFS.StreamOpen[torchName ! PFS.Error => IF error.code = $unknownFile THEN GO TO notTaken ELSE REJECT];
[owner,] ¬ GetTorchData[torchStream, packageName, worldName];
IO.Close[torchStream];
IF Rope.Equal[owner, GetNiceUserName[], FALSE] THEN {
RETURN [TRUE];
}
ELSE
RETURN [FALSE];
EXITS
notTaken => RETURN [FALSE];
};
EnumerateTakenPackages: PUBLIC PROC [worldName: ROPE ¬ defaultWorldName, proc: PROC [packageName: ROPE, owner: ROPE, takenDate: GMT] RETURNS [quit: BOOL ¬ FALSE]] ~ {
EachTorchFile: PFS.NameProc ~ {
[name: PATH] RETURNS [continue: BOOL ← TRUE]
shortName: ROPE ~ PFSNames.ComponentRope[PFSNames.ShortName[name]];
packageName: ROPE ~ shortName.Substr[0, shortName.Length[] - 6]; -- strip off ".torch"
torchStream: STREAM ~ PFS.StreamOpen[name];
owner: ROPE;
takenDate: GMT;
[owner, takenDate] ¬ GetTorchData[torchStream, packageName, worldName
! MalformedTorch => {
Convert the error to a resumable one.
SIGNAL MalformedTorch[packageName, worldName];
IO.Close[torchStream];
GO TO malformed;
}];
IO.Close[torchStream];
continue ¬ NOT proc[packageName, owner, takenDate];
EXITS
malformed =>
RETURN [TRUE];
};
pattern: PATH ~ PFS.PathFromRope[IO.PutFR1["/%g/Torches/*.torch!1", [rope[worldName]]]];
PFS.EnumerateForNames[pattern, EachTorchFile];
};
Utilities
GetTorchData: PROC [torchStream: STREAM, packageName, worldName: ROPE] RETURNS [owner: ROPE, takenDate: GMT] ~ {
ENABLE
RuntimeError.NarrowRefFault =>
GO TO malformed;
lora: LIST OF REF ANY ~ NARROW[IO.GetRefAny[torchStream
! IO.Error => IF ec = SyntaxError THEN GO TO malformed ELSE REJECT;
IO.EndOfStream => GO TO malformed]];
owner ¬ NARROW[lora.first];
takenDate ¬ Convert.TimeFromRope[NARROW[lora.rest.first]
! Convert.Error => GO TO malformed];
EXITS
malformed =>
ERROR MalformedTorch[packageName, worldName];
};
CheckPackageExists: PROC [packageName: ROPE, worldName: ROPE] ~ {
suiteDFName: PATH ~ PFS.PathFromRope[IO.PutFR["/%g/Top/%g-Suite.df", [rope[worldName]], [rope[packageName]]]];
plainDFName: PATH ~ PFS.PathFromRope[IO.PutFR["/%g/Top/%g.df", [rope[worldName]], [rope[packageName]]]];
IF PFS.FileLookup[plainDFName, NIL] = NIL AND PFS.FileLookup[suiteDFName, NIL] = NIL THEN
ERROR NoSuchPackage[packageName, worldName];
};
GetNiceUserName: PROC RETURNS [ROPE] = {
user: ROPE ¬ SystemNames.UserName[];
IF Rope.IsEmpty[user] THEN RETURN [user];
user ¬ Rope.Replace[user, 0, 1, Rope.FromChar[Ascii.Upper[Rope.Fetch[user, 0]]]];
RETURN [user];
};
Command interface
Command: Commander.CommandProc ~ {
ENABLE
PFS.Error => {
cmd.err.PutF1["*** Unexpected PFS.Error: %g\n*** Aborting torch operations ...\n", [rope[error.explanation]]];
GO TO pfsError;
};
worldName: ROPE ¬ defaultWorldName;
packageNames: LIST OF ROPE ¬ CommanderOps.ParseToList[cmd].list;
BadPackageName: PROC [name: ROPE] ~ {
cmd.err.PutF["*** \"%g\" is not the name of a %g package and so cannot be given or taken.\n", [rope[name]], [rope[worldName]]];
result ¬ $Failure;
};
ReportMalformedTorch: PROC [name: ROPE] ~ {
cmd.err.PutF["*** The %g torch for %g is malformed; please consult a wizard.\n", [rope[worldName]], [rope[name]]];
result ¬ $Failure;
};
IF packageNames # NIL THEN {
IF packageNames.first.Equal["-w"] THEN {
IF packageNames.rest = NIL THEN {
RETURN [result: $Failure, msg: IO.PutFR["Usage: %g [-w world] %gpackage ...", [rope[cmd.command]], [rope[IF cmd.procData.clientData=$Taken THEN "[-o owner] " ELSE NIL]] ]];
};
worldName ¬ packageNames.rest.first;
packageNames ¬ packageNames.rest.rest;
};
};
SELECT cmd.procData.clientData FROM
$Take, $Steal => {
ok: BOOL;
owner: ROPE;
takenDate: GMT;
FOR names: LIST OF ROPE ¬ packageNames, names.rest WHILE names # NIL DO
[ok, owner, takenDate] ¬ TakePackage[names.first, worldName
! NoSuchPackage => {
BadPackageName[names.first];
LOOP;
};
MalformedTorch => {
ReportMalformedTorch[names.first];
LOOP;
}];
IF ok THEN
cmd.out.PutF["You now have the %g torch for %g.\n", [rope[worldName]], [rope[names.first]]]
ELSE IF owner.Equal[GetNiceUserName[]] THEN
cmd.out.PutF["*** You've had the %g torch for %g since %g.\n", [rope[worldName]], [rope[names.first]], [time[takenDate]]]
ELSE IF cmd.procData.clientData = $Steal THEN {
[] ¬ TakePackage[names.first, worldName, TRUE];
cmd.out.PutF["You have stolen the %g torch for %g. Please let %g know you did so.\n", [rope[worldName]], [rope[names.first]], [rope[owner]]];
}
ELSE {
cmd.out.PutFL["*** Sorry, but %g has had the %g torch for %g since %g.\n", LIST[[rope[owner]], [rope[worldName]], [rope[names.first]], [time[takenDate]]]];
result ¬ $Failure;
};
ENDLOOP;
};
$Give => {
Give: PROC [name: ROPE] ~ {
IF GivePackage[name, worldName] THEN
cmd.out.PutF["You have released the %g torch for %g.\n", [rope[worldName]], [rope[name]]]
ELSE
cmd.out.PutF["*** Sorry, but the %g torch for %g is not yours to give.\n", [rope[worldName]], [rope[name]]];
};
IF packageNames = NIL THEN {
myName: ROPE ~ GetNiceUserName[];
EachTorch: PROC [packageName: ROPE, owner: ROPE, takenDate: GMT] RETURNS [quit: BOOL ¬ FALSE] ~ {
IF myName.Equal[owner] THEN {
answer: ROPE;
cmd.out.PutF["Release %g torch for %g (y or n)? ", [rope[worldName]], [rope[packageName]]];
answer ¬ cmd.in.GetLineRope[];
IF NOT answer.IsEmpty[] AND answer.Fetch[0] = 'y THEN
Give[packageName];
};
};
EnumerateTakenPackages[worldName, EachTorch
! MalformedTorch => {
ReportMalformedTorch[packageName];
RESUME;
}];
}
ELSE
FOR names: LIST OF ROPE ¬ packageNames, names.rest WHILE names # NIL DO
Give[names.first
! NoSuchPackage => {
BadPackageName[names.first];
LOOP;
};
MalformedTorch => {
ReportMalformedTorch[names.first];
LOOP;
}];
ENDLOOP;
};
$Taken => {
ownerPat: ROPE ¬ NIL;
IF packageNames # NIL THEN {
IF packageNames.first.Equal["-o"] THEN {
IF packageNames.rest = NIL THEN {
RETURN [result: $Failure, msg: IO.PutFR1["Usage: %g [-w world] [-o owner] package ...", [rope[cmd.command]]]];
};
ownerPat ¬ packageNames.rest.first;
packageNames ¬ packageNames.rest.rest;
};
};
IF packageNames = NIL THEN {
Torch: TYPE ~ RECORD [
owner: ROPE,
packageName: ROPE,
takenDate: GMT
];
head, tail: LIST OF Torch ¬ NIL;
whoWidth, whatWidth: NAT ¬ 0;
whenWidth: NAT ~ Rope.Length[Convert.RopeFromTime[BasicTime.Now[]]];
heading: ROPE ~ IO.PutFR1["%g Torches", [rope[worldName]]];
EachTorch: PROC [packageName: ROPE, owner: ROPE, takenDate: GMT] RETURNS [quit: BOOL ¬ FALSE] ~ {
IF ownerPat#NIL AND NOT Rope.Match[ownerPat, owner, FALSE] THEN RETURN;
{new: LIST OF Torch ~
CONS[[owner: owner, packageName: packageName, takenDate: takenDate], NIL];
whoWidth ¬ MAX[whoWidth, owner.Length[] + 3];
whatWidth ¬ MAX[whatWidth, packageName.Length[] + 3];
IF head = NIL THEN
head ¬ tail ¬ new
ELSE
tail ¬ tail.rest ¬ new;
}};
Spaces: PROC [k: INT] ~ {
FOR i: INT IN [0..MAX[k, 1]) DO
cmd.out.PutChar[' ];
ENDLOOP;
};
EnumerateTakenPackages[worldName, EachTorch
! MalformedTorch => {
ReportMalformedTorch[packageName];
RESUME;
}];
cmd.out.PutF1["%l", [rope["f"]]];
Spaces[(whoWidth + whatWidth + whenWidth - heading.Length[]) / 2];
cmd.out.PutF["%l%g%l\n\n", [rope["Fb"]], [rope[heading]], [rope["Bf"]]];
cmd.out.PutF["%lWho%l", [rope["z"]], [rope["Z"]]];
Spaces[whoWidth - 3];
cmd.out.PutF["%lWhat%l", [rope["z"]], [rope["Z"]]];
Spaces[whatWidth - 4];
cmd.out.PutF["%lWhen%l\n", [rope["z"]], [rope["Z"]]];
FOR list: LIST OF Torch ¬ head, list.rest WHILE list # NIL DO
cmd.out.PutF["%g %l", [rope[list.first.owner]], [rope["y"]]];
Spaces[whoWidth - list.first.owner.Length[] - 2];
cmd.out.PutF["%l %g %l", [rope["Y"]], [rope[list.first.packageName]], [rope["y"]]];
Spaces[whatWidth - list.first.packageName.Length[] - 2];
cmd.out.PutF["%l %g\n", [rope["Y"]], [time[list.first.takenDate]]];
ENDLOOP;
cmd.out.PutF1["%l\n", [rope["F"]]];
}
ELSE {
taken: BOOL;
owner: ROPE;
takenDate: GMT;
FOR names: LIST OF ROPE ¬ packageNames, names.rest WHILE names # NIL DO
[taken, owner, takenDate] ¬ PackageTaken[names.first, worldName
! NoSuchPackage => {
BadPackageName[names.first];
LOOP;
};
MalformedTorch => {
ReportMalformedTorch[names.first];
LOOP;
}];
IF taken THEN {IF ownerPat=NIL OR Rope.Match[ownerPat, owner, FALSE] THEN
cmd.out.PutFL["%g has had the %g torch for %g since %g.\n", LIST[[rope[owner]], [rope[worldName]], [rope[names.first]], [time[takenDate]]]]}
ELSE IF ownerPat=NIL THEN
cmd.out.PutF["*** The %g torch for %g has not been taken by anyone.\n", [rope[worldName]], [rope[names.first]]];
ENDLOOP;
};
};
ENDCASE => ERROR;
EXITS
pfsError => result ¬ $Failure;
};
Doc: PROC [rope: ROPE] RETURNS [ROPE] ~ {
RETURN [IO.PutFR1[rope, [rope[defaultWorldName]]]]
};
Commander.Register["TakeTorch", Command, Doc["[-w world] package ...\n\tGrab the torches for the named packages in the named world (default: %g)."], $Take];
Commander.Register["GiveTorch", Command, Doc["[-w world] package ...\n\tRelease the torches for the named packages in the named world (default: %g). If no packages are listed, GiveTorch asks you about giving each torch you have in that world."], $Give];
Commander.Register["StealTorch", Command, Doc["[-w world] package ...\n\tForcibly grab the torches for the named packages in the named world (default: %g), even if someone else already has them."], $Steal];
Commander.Register["TorchTaken?", Command, Doc["[-w world] [-o owner] package ...\n\tTell who owns the torch for the named packages in the named world (default: %g). If no packages are listed, tell about all torches surrently taken in that world. If an owner pattern is given, tell only about torches taken by matching owners."], $Taken];
END.