DFInternalImpl.mesa
last edited by Levin on November 23, 1983 12:53 am
DIRECTORY
BasicTime USING [nullGMT],
DFInternal USING [Client, LocalFileInfo, RemoteFileInfo],
DFOperations
USING [
AbortInteraction, DFInfoInteraction, FileInteraction, InfoClass, InfoInteraction, InteractionProc, YesNoInteraction, YesNoResponse],
DFUtilities USING [Date, DateToRope, RemoveVersionNumber],
FS USING [ComponentPositions, Error, ErrorDesc, ExpandName, FileInfo],
IO USING [PutF, PutFR, rope, STREAM],
Process USING [Pause, SecondsToTicks, Ticks],
Rope USING [Concat, Length, ROPE, Substr];
DFInternalImpl:
CEDAR
PROGRAM
IMPORTS DFUtilities, FS, IO, Process, Rope
EXPORTS DFInternal =
BEGIN
OPEN Int: DFInternal, Ops: DFOperations, Utils: DFUtilities;
ROPE: TYPE = Rope.ROPE;
retryInterval: Process.Ticks = Process.SecondsToTicks[5];
Global "variables"
abort:
REF Ops.AbortInteraction;
logically, this is constant; it is set by initialization and never changed
Exported to DFInternal
AbortDF: PUBLIC ERROR = CODE;
SimpleInteraction:
PUBLIC
PROC [client: Int.Client, interaction:
REF
ANY] = {
abort: BOOL;
message: ROPE;
DoLogging[interaction, client.log];
[abort: abort, abortMessageForLog: message] ← client.proc[interaction, client.data];
IF abort
THEN {
[] ← client.proc[NEW[Ops.InfoInteraction ← [class: $abort, message: message]], client.data];
DoAbort[client.log, message];
};
};
YesOrNo:
PUBLIC
PROC [client: Int.Client, message:
ROPE, default:
BOOL]
RETURNS [choice: BOOL] = {
response:
REF
ANY = DoInteraction[
client,
NEW[Ops.YesNoInteraction ← [
message: message,
default: default
]]
];
choice ← default;
WITH response
SELECT
FROM
r: REF Ops.YesNoResponse => choice ← r^;
ENDCASE;
};
DoInteraction:
PUBLIC
PROC [client: Int.Client, interaction:
REF
ANY]
RETURNS [response: REF ANY] = {
abort: BOOL;
message: ROPE;
DoLogging[interaction, client.log];
[abort, message, response] ← client.proc[interaction, client.data];
IF abort
THEN {
[] ← client.proc[NEW[Ops.InfoInteraction ← [class: $abort, message: message]], client.data];
DoAbort[client.log, message];
};
};
CheckAbort:
PUBLIC
PROC [client: Int.Client] = {
SimpleInteraction[client, abort];
};
DoAbort:
PUBLIC PROC [
log: IO.STREAM,
message: ROPE ← NIL, proc: Ops.InteractionProc ← NIL, clientData: REF ANY ← NIL] = {
interaction: REF ANY = NEW[Ops.InfoInteraction ← [class: $abort, message: message]];
IF proc ~= NIL AND message ~= NIL THEN [] ← proc[interaction, clientData];
DoLogging[interaction, log];
ERROR AbortDF
};
DefaultInteractionProc:
PUBLIC Ops.InteractionProc
-- [interaction: REF ANY] RETURNS [abort: BOOL ← FALSE, abortMessageForLog: ROPE ← NIL, response: REF ANY ← NIL] -- = {
WITH interaction
SELECT
FROM
a: REF Ops.AbortInteraction => RETURN[abort: a.fromABORTED];
ENDCASE;
};
GetFileInfo:
PUBLIC
PROC [
info: REF ANY, notFoundOK: BOOL ← FALSE,
client: Int.Client ← NIL, errorLevel: Ops.InfoClass ← $error] = {
WITH info
SELECT
FROM
local:
REF Int.LocalFileInfo => {
date: Utils.Date ← [];
name: ROPE ← FS.ExpandName[local.name].fullFName;
local.name ← name;
IF local.date.format ~= $explicit THEN name ← Utils.RemoveVersionNumber[name];
[fullFName: local.name, attachedTo: local.attachedTo, created: date.gmt, keep: local.keep] ←
FS.FileInfo[name: name, remoteCheck:
FALSE
!
FS.Error =>
SELECT
TRUE
FROM
error.group = $user AND notFoundOK => CONTINUE;
RetryFSOperation[error, client] => RETRY;
client ~= NIL => ReportFSError[error, info, client, errorLevel];
ENDCASE
];
IF date.gmt ~= BasicTime.nullGMT THEN date.format ← $explicit;
local.date ← date;
};
remote:
REF Int.RemoteFileInfo => {
date: Utils.Date ← IF remote.date.format = $explicit THEN remote.date ELSE [];
name: ROPE ← remote.name;
IF remote.date.format ~= $explicit THEN name ← Utils.RemoveVersionNumber[name];
[fullFName: remote.name, created: date.gmt] ←
FS.FileInfo[name: name, wantedCreatedTime: date.gmt, remoteCheck:
TRUE
!
FS.Error =>
SELECT
TRUE
FROM
error.group = $user AND notFoundOK => CONTINUE;
RetryFSOperation[error, client] => RETRY;
client ~= NIL => ReportFSError[error, info, client, errorLevel];
ENDCASE
];
IF date.gmt ~= BasicTime.nullGMT THEN date.format ← $explicit;
remote.date ← date;
};
ENDCASE => ERROR;
};
LocalFile:
PUBLIC
PROC [file:
ROPE]
RETURNS [
BOOL ←
FALSE] = {
RETURN[FS.ExpandName[file ! FS.Error => CONTINUE].cp.server.length = 0]
};
ShortName:
PUBLIC
PROC [file:
ROPE, keepVersion:
BOOL ←
FALSE]
RETURNS [
ROPE] = {
cp: FS.ComponentPositions;
l: INT;
[fullFName: file, cp: cp] ← FS.ExpandName[file];
l ← (IF keepVersion THEN cp.ver.start + cp.ver.length ELSE cp.ext.start + cp.ext.length) - cp.base.start;
RETURN[file.Substr[start: cp.base.start, len: l]]
};
RetryFSOperation:
PUBLIC
PROC [error:
FS.ErrorDesc, client: Int.Client]
RETURNS [retry: BOOL ← FALSE] = {
IF error.group ~= $environment THEN RETURN[FALSE];
retry ← YesOrNo[client: client, message: error.explanation.Concat[". Retry?"], default: TRUE];
SELECT error.code
FROM
$serverInaccessible, $connectionRejected, $connectionTimedOut =>
Process.Pause[retryInterval];
ENDCASE;
};
ReportFSError:
PUBLIC
PROC [
error: FS.ErrorDesc, info: REF ANY, client: Int.Client, errorLevel: Ops.InfoClass ← $error] = {
name: ROPE;
date: Utils.Date;
WITH info
SELECT
FROM
remote: REF Int.RemoteFileInfo => {name ← remote.name; date ← remote.date};
local:
REF Int.LocalFileInfo => {
name ← FS.ExpandName[name ← local.name ! FS.Error => CONTINUE].fullFName;
date ← local.date;
};
ENDCASE => ERROR;
SimpleInteraction[
client,
NEW[Ops.InfoInteraction ← [
class: errorLevel,
message:
IF error.group = $user
THEN
IO.PutFR[
"%g {%g} can't be found.", IO.rope[name], IO.rope[Utils.DateToRope[date]]]
ELSE
IO.PutFR["Unexpected FS.Error%g: %g",
IO.rope[
IF error.explanation.Length[] = 0 THEN Rope.Concat[" manipulating ", name]
ELSE NIL
],
IO.rope[
IF error.explanation.Length[] ~= 0 THEN error.explanation
ELSE "(no explanation)"
]
]
]]
];
IF errorLevel = $abort THEN DoAbort[client.log];
};
Internal Procedures
DoLogging:
PROC [interaction:
REF
ANY, log:
IO.
STREAM] = {
IF log = NIL THEN RETURN;
WITH interaction
SELECT
FROM
info:
REF Ops.InfoInteraction =>
log.PutF["%g%g\N",
IO.rope[
SELECT info.class
FROM
warning => "Warning: ", error => "Error: ", abort => "Abort: ", ENDCASE => NIL
],
IO.rope[info.message]
];
info:
REF Ops.DFInfoInteraction =>
log.PutF["%g: %g%g\N",
IO.rope[
SELECT info.action
FROM
$start => "Start", $end => "End", $abort => "Abort", ENDCASE => NIL
],
IO.rope[info.dfFile],
IO.rope[IF info.message = NIL THEN NIL ELSE IO.PutFR[" (%g)", IO.rope[info.message]]]
];
file:
REF Ops.FileInteraction => {
log.PutF["%g %g %g {%g}%g\N",
IO.rope[file.localFile],
IO.rope[
SELECT file.action
FROM
$fetch => "<--", $store => "-->", $check => "<-->", ENDCASE => NIL],
IO.rope[file.remoteFile],
IO.rope[Utils.DateToRope[[$explicit, file.date]]],
IO.rope[
IF file.dateFormat = $explicit THEN NIL
ELSE
IO.PutFR[" ('%g')",
SELECT file.dateFormat
FROM
$greaterThan => [character['>]],
$notEqual => [rope["~="]],
ENDCASE => [null[]]
]
]
];
};
ENDCASE;
};
Initialization
Initialize:
PROC = {
abort ← NEW[Ops.AbortInteraction ← [FALSE]];
};
Initialize[];
END.