DIRECTORY Ascii USING [NUL, SP, TAB], Convert USING [CardFromRope, RopeFromCard], IO USING [BreakProc, GetTokenRope, STREAM], PFSNames, PFSBackdoor, PFSCFSNames, Rope USING [Cat, Concat, Substr, Fetch, IsEmpty, Length]; PFSCFSNamesImpl: CEDAR PROGRAM IMPORTS Convert, IO, Rope, PFSBackdoor, PFSNames EXPORTS PFSCFSNames SHARES PFSNames ~ BEGIN OPEN PFSNames; Unparsed: TYPE ~ RECORD [ cfsUnparsing: ROPE ¬ NIL ]; Error: ERROR = CODE; UnparseName: PUBLIC PROC [name: PATH] RETURNS [fullFName: ROPE] ~ { unparsed: REF Unparsed ¬ WITH name.GetUnparsingHint[] SELECT FROM unp: REF Unparsed => unp, ENDCASE => NIL; serverComponent: BOOL ¬ TRUE; state: {start, insideSquare, startingAnglePair, doingAnglePair, done} ¬ start; insideAngleComp: ROPE; cproc: ComponentProc ~ { IF serverComponent THEN {serverComponent ¬ FALSE; RETURN}; SELECT state FROM start => NULL; insideSquare => NULL; startingAnglePair => { insideAngleComp ¬ UnparseComponent[comp]; state ¬ doingAnglePair; RETURN; }; done => NULL; ENDCASE => ERROR; fullFName ¬ Rope.Concat[fullFName, UnparseComponent[comp]]; }; sproc: SeparatorProc ~ { IF serverComponent THEN { IF separatorPresent THEN RETURN ELSE serverComponent ¬ FALSE; }; SELECT state FROM start => { IF separatorPresent THEN { fullFName ¬ Rope.Concat[fullFName, "["]; state ¬ insideSquare } ELSE state ¬ done; }; insideSquare => { fullFName ¬ Rope.Concat[fullFName, "]"]; state ¬ startingAnglePair }; doingAnglePair => { IF separatorPresent THEN fullFName ¬ Rope.Cat[fullFName, "<", insideAngleComp, ">"] ELSE fullFName ¬ Rope.Concat[fullFName, insideAngleComp]; state ¬ done; }; done => IF separatorPresent THEN fullFName ¬ Rope.Concat[fullFName, ">"]; ENDCASE => ERROR; }; IF unparsed#NIL THEN RETURN [unparsed.cfsUnparsing]; 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] ~ { absolute, directory, pattern: 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]='] OR name.Fetch[name.Length[]-1]='>; { ENABLE Error => PFSBackdoor.ProduceError[invalidNameSyntax, Rope.Concat[name, " is syntactically invalid as a Cedar-style file name"]]; pos: NAT ¬ IF absolute THEN 1 ELSE 0; limit: NAT ¬ name.Length[] - (IF directory THEN 1 ELSE 0); initialComponent: BOOL ¬ absolute; -- current component must end with ] or ]<; otherwise must end with > ScanComponent: PROC [] RETURNS [] ~ { nextComp: Component; [nextComp, pos] ¬ ParseComponent[name, pos]; comps ¬ CONS[nextComp, comps]; }; ScanSeparator: PROC [] RETURNS [] ~ { IF initialComponent THEN { IF name.Fetch[pos] # '] THEN ERROR Error[]; pos ¬ pos+1; IF 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 ]; '* => RETURN[ [all], next+1 ]; ENDCASE => NULL; ERROR Error[]; }; ParseNameFromStream: PUBLIC PROC [s: IO.STREAM] RETURNS [name: PATH] ~ { 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. 0 PFSCFSNamesImpl.mesa Copyright Σ 1991 by Xerox Corporation. All rights reserved. Carl Hauser, June 7, 1989 11:54:53 am PDT Chauser, May 24, 1990 10:25 am PDT Michael Plass, September 23, 1991 12:19 pm PDT Cedar name parsing. A convenient way to read a whitespace-delimited name from a stream; ΚΎ•NewlineDelimiter –(cedarcode) style™šœ™Jšœ Οeœ1™