
<<PFSCanonicalNamesImpl.mesa>>
<<Copyright Ó 1991 by Xerox Corporation.  All rights reserved.>>
    <<Carl Hauser, August 23, 1989 11:40:59 am PDT>>
    <<Chauser, May 24, 1990 10:25 am PDT>>
    <<Michael Plass, September 23, 1991 12:16 pm PDT>>
<<>>
    DIRECTORY
        Ascii USING [NUL, SP, TAB],
        Convert USING [CardFromRope, RopeFromCard],
        IO USING [BreakProc, GetTokenRope, STREAM],
        PFSBackdoor,
        PFSNames,
        PFSCanonicalNames,
        Rope USING [Concat, Substr, Fetch, IsEmpty, Length];


    PFSCanonicalNamesImpl: CEDAR PROGRAM
    IMPORTS Convert, IO, Rope, PFSBackdoor, PFSNames
    EXPORTS PFSCanonicalNames
    SHARES PFSNames
    ~ BEGIN OPEN PFSNames; 

    Error: ERROR ~ CODE;

    Unparsed: TYPE ~ RECORD [
        canonicalUnparsing: ROPE Ź NIL
        ];

    UnparseName: PUBLIC PROC [name: PATH] RETURNS [fullFName: ROPE] ~ {
        unparsed: REF Unparsed;
        serverComponent: BOOL Ź TRUE;
        cproc: ComponentProc ~ {
            fullFName Ź Rope.Concat[fullFName, UnparseComponent[comp]];
            IF serverComponent THEN { 
                IF NOT comp.name.len=0 THEN fullFName Ź Rope.Concat[fullFName, ":"]; 
                serverComponent Ź FALSE; 
                }
            };
        sproc: SeparatorProc ~ {
            IF NOT serverComponent THEN { 
                IF separatorPresent THEN fullFName Ź Rope.Concat[fullFName, "/"];
                }
            ELSE {
                IF NOT separatorPresent THEN serverComponent Ź FALSE;
                };
            };
        name Ź PFSNames.NonNIL[name];
        unparsed Ź WITH name.GetUnparsingHint[] SELECT FROM
            unp: REF Unparsed => unp,
            ENDCASE => NIL;
        IF unparsed#NIL THEN RETURN [unparsed.canonicalUnparsing];
        Map[name, cproc, sproc];
        };

    UnparseComponent: PUBLIC PROC [component: Component] RETURNS [ROPE] ~ {
        RETURN[Rope.Concat[
        component.name.base.Substr[component.name.start, component.name.len], UnparseVersion[component.version]]];
        };

    UnparseVersion: PUBLIC PROC [version: Version] RETURNS [ROPE] ~ {
        RETURN [ SELECT version.versionKind FROM
            none => NIL,
            lowest => "!L",
            highest => "!H",
            all => "!*",
            numeric => Rope.Concat["!", Convert.RopeFromCard[version.version]],
            ENDCASE => NIL
            ];
        };

    ParseName: PUBLIC PROC [name: ROPE] RETURNS [parsedName: PATH] ~ {
        <<Canonical parsing.>>
        absolute, directory: BOOL Ź FALSE;
        comps: LIST OF Component Ź NIL;
        IF name.IsEmpty[] THEN RETURN [NIL];
        absolute Ź name.Fetch[0]='/;
        IF absolute THEN comps Ź CONS[ [name~["", 0, 0]], comps ];
        directory Ź name.Fetch[name.Length[]-1]='/;
        {
            ENABLE Error => PFSBackdoor.ProduceError[invalidNameSyntax, Rope.Concat[name, " is syntactically invalid as a Unix-style file 
            name"]];
            pos: NAT Ź IF absolute THEN 1 ELSE 0;
            limit: NAT Ź name.Length[];
            firstComponent: BOOL Ź TRUE;
            ScanComponent: PROC [] RETURNS [] ~ {
                nextComp: Component;
                [nextComp, pos] Ź ParseComponent[name, pos];
                IF firstComponent AND NOT absolute THEN {
                    len: INT Ź nextComp.name.len;
                    IF len > 0 THEN IF Rope.Fetch[nextComp.name.base, nextComp.name.start+len-1] = ':  THEN {
                        absolute Ź TRUE;
                        nextComp.name.len Ź nextComp.name.len-1;
                        };
                    };
                firstComponent Ź FALSE;
                comps Ź CONS[nextComp, comps];
                };
            ScanSeparator: PROC [] RETURNS [] ~ {
                IF name.Fetch[pos]#'/ THEN ERROR Error[];
                pos Ź pos+1;
                };
            DO
                IF pos >= limit THEN EXIT;
                ScanComponent[];
                IF pos >= limit THEN EXIT;
                ScanSeparator[];
                ENDLOOP;
            };
        RETURN[ConstructName[components: comps, absolute: absolute, directory: directory, reverse: TRUE, unparsed: NEW[Unparsed Ź [name]] 
        ]];
        };

    ParseComponent: PUBLIC PROC [name: ROPE, first: NAT Ź 0] RETURNS [component: Component Ź [], next: NAT] ~ {
        limit: NAT Ź name.Length[];
        next Ź first;
        DO
            IF next >= limit THEN {
                component.name Ź [name, first, next-first];
                EXIT;
                };
            SELECT name.Fetch[next] FROM
                '! => {
                    component.name Ź [name, first, next-first];
                    [component.version, next] Ź ParseVersion[name, next];
                    EXIT;
                    };
                '/ => {
                    component.name Ź [name, first, next-first];
                    EXIT;
                    };
                ENDCASE => next Ź next+1;
            ENDLOOP;
        };

    ParseVersion: PUBLIC PROC [v: ROPE, first: NAT Ź 0] RETURNS [version: Version Ź [none], next: NAT] ~ {
        limit: NAT Ź v.Length[];
        next Ź first;
        IF next>=limit THEN RETURN;
        IF v.Fetch[next]#'! THEN ERROR Error[];
        next Ź next+1;
        IF next>=limit THEN RETURN;
        SELECT v.Fetch[next] FROM 
            IN ['0..'9] => {
                start: NAT Ź next;
                next Ź next+1;
                WHILE next < limit AND v.Fetch[next] IN ['0..'9] DO next Ź next+1 ENDLOOP;
                RETURN [ [numeric, Convert.CardFromRope[v.Substr[start, next-start]]], next ];
                };
            'H, 'h => RETURN[ [highest], next+1 ];
            'L, 'l => RETURN[ [lowest], next+1 ]; 
            'N, 'n => RETURN[ [next], next+1 ]; 
            '* => RETURN[ [all], next+1 ]; 
            ENDCASE => NULL;
        ERROR Error[];
        };

    ParseNameFromStream: PUBLIC PROC [s: IO.STREAM] RETURNS [name: PATH] ~ {
        <<A convenient way to read a whitespace-delimited name from a stream; >>
        FileNameProc: IO.BreakProc ~ {
            OPEN Ascii;
            RETURN [ SELECT char FROM
                NUL, SP, TAB => sepr,
                ENDCASE => other ];
            };
        ropeName: ROPE Ź IO.GetTokenRope[s, FileNameProc].token;
        RETURN[ParseName[ropeName]];
        };

    END.