<<>>
<<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.