
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] ~ {
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] ~ {
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.
  6  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

Canonical parsing.
A convenient way to read a whitespace-delimited name from a stream; 
Э╩∙  ХNewlineDelimiter
Ц(cedarcode) styleШ ЪЬЩJЪЬ
╧eЬ1Щ<IcodeЩ,KЩ"KЩ.JЩ ЧЪ╧k	Ш	KЪ	ЬЮЬЮЬЮЬЮЬШKЪЬЮЬШ+KЪЮЬЮЬЮЬШ+KЪЬШKЪЬ	Ш	KШKЪЬЮЬ*Ш4KШ ЧKШ KЪ╧nЬЮЬЮШ$KЪЮЬ)Ш0KЪЮЬШKЪЮЬ	ШKЪЬЮЬЮЬШKШ ЪЯЬЮЬЮЬШKШ ЧЪЬ
ЮЬЮЬШKЪЬЮЬЮШKЪЬШKШ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШCKЪЬ
ЮЬ
ШKЪЬЮЬЮЬШЪЬШKЪЬ;Ш;ЪЮЬЮЬШKЪЮЬЮЬЮЬ*ШEKЪЬЮЬШKЪЬШЧKЪЬШЧЪЬШЪЮЬЮЬЮЬШKЪЮЬЮЬ)ШAKШЧЪЮЬШKЪЮЬЮЬЮЬЮЬШ5KЪЬШЧKЪЬШЧKЪЬШЪЬЮЬЮЬЮШ3KЪЬЮЬШKЪЮЬЮЬШЧKЪЮЬ
ЮЬЮЬЮЬШ:KШKШKШ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШGKЪЮЬxШ~KШKШ ЧЪ
ЯЬЮЬЮЬЮЬЮЬШAЪЮЬЮЬЮШ(KЪЬЮЬШKШKШKШKЪЬCШCKЪЮЬЮШKШЧKШKШ ЧЪЯ	ЬЮЬЮЬЮЬЮЬЮЬШBKЩKЪЬЮЬЮЬШ"KЪЬЮЬЮЬЮЬШKЪЮЬЮЬЮЬЮЬШ$KШKЪЮЬ
ЮЬ	ЮЬШ:KШ+ШKЪЮЬАШЖKЪ	ЬЮЬЮЬ
ЮЬЮЬШ%KЪЬЮЬШKЪЬЮЬЮЬШЪЯЬЮЬЮЬШ%KШKЪЬ,Ш,ЪЮЬЮЬЮЬ
ЮЬШ)KЪЬЮЬШЪЮЬ	ЮЬЮЬAЮЬШYKЪЬЮЬШKЪЬ(Ш(KШЧKЪЬШЧKЪЬЮЬШKЪЬЮЬШKШЧЪЯЬЮЬЮЬШ%KЪЮЬЮЬЮЬ	Ш)KШKЪЬШЧЪЮШKЪЮЬЮЬЮЬШKЪЬШKЪЮЬЮЬЮЬШKШKЪЮЬШЧKШЧKЪЮЬUЮЬЮЬШЕKЪЬШKШ ЧЪЯЬЮЬЮЬЮЬ	ЮЬЮЬ#ЮЬШkKЪЬЮЬШKЪЬШЪЮШЪЮЬЮЬЮШKЪЬ+Ш+KЪЮЬШKШЧЪЮЬЮШЪЬШKЪЬ+Ш+KЪЬ5Ш5KЪЮЬШKЪЬШЧЪЬШKЪЬ+Ш+KЪЮЬШKЪЬШЧKЪЮЬШЧKЪЮЬШЧKШKШ ЧЪЯЬЮЬЮЬЮЬ	ЮЬЮЬ#ЮЬШfKЪЬЮЬШKЪЬШKЪЮЬЮЬЮЬШKЪЮЬЮЬЮЬ	Ш'KЪЬШKЪЮЬЮЬЮЬШЪЮЬЮЬШЪЮЬШKЪЬЮЬШKШKЪ
ЮЬЮЬЮЬ
ЮЬЮЬШJKЪЮЬHШNKЪЬШЧKЪЬ
ЮЬШ&KЪЬ
ЮЬШ&KЪЬ
ЮЬШ$KЪЬЮЬШKЪЮЬЮЬШЧKЪЮЬ	ШKШKШ ЧЪ
ЯЬЮЬЮ	ЬЮЬЮЬШHKЩDЪЯЬЮЬШKЪЮЬШЪЮЬЮЬЮШKЪЮЬЮЬЮЬ	ШKЪЮЬШЧKШЧKЪЬ
ЮЬЮЬ%Ш8KЪЮЬШKЪЬШЧKШ KЪЮЬШЧ ЕЧ    °  '  