
<<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.