PFSCFSNamesImpl.mesa
Carl Hauser, June 7, 1989 11:54:53 am PDT
Chauser, May 24, 1990 10:25 am PDT
DIRECTORY
Ascii USING [NUL, SP, TAB],
Convert USING [CardFromRope, RopeFromCard],
IO USING [BreakProc, GetTokenRope, STREAM],
PFSNames,
PFSBackdoor,
PFSCFSNames,
Rope USING [Cat, 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.Cat[fullFName, UnparseComponent[comp]];
};
sproc: SeparatorProc ~ {
IF serverComponent
THEN {
IF separatorPresent THEN RETURN ELSE serverComponent ← FALSE;
};
SELECT state
FROM
start => {
IF separatorPresent
THEN {
fullFName ← Rope.Cat[fullFName, "["];
state ← insideSquare }
ELSE state ← done;
};
insideSquare => { fullFName ← Rope.Cat[fullFName, "]"]; state ← startingAnglePair };
doingAnglePair =>
{
IF separatorPresent THEN fullFName ← Rope.Cat[fullFName, "<", insideAngleComp, ">"] ELSE fullFName ← Rope.Cat[fullFName, insideAngleComp];
state ← done;
};
done => IF separatorPresent THEN fullFName ← Rope.Cat[fullFName, ">"];
ENDCASE => ERROR;
};
IF unparsed#NIL THEN RETURN [unparsed.cfsUnparsing];
Map[name, cproc, sproc];
};
UnparseComponent:
PUBLIC
PROC [component: Component]
RETURNS [
ROPE] ~ {
RETURN[Rope.Cat[
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.Cat["!", Convert.RopeFromCard[version.version]],
ENDCASE => NIL
];
};
ParseName:
PUBLIC
PROC [name:
ROPE]
RETURNS [parsedName:
PATH] ~ {
Cedar name parsing.
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.Cat[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<limit
THEN {
IF name.Fetch[pos] = '< THEN pos ← pos+1;
};
initialComponent ← FALSE;
}
ELSE {
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 ];
'* => 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.