
<<DFInternalImpl.mesa>>
<<Copyright © 1984 by Xerox Corporation.  All rights reserved.>>
<<Levin on December 16, 1983 2:05 pm>>
<<Russ Atkinson, September 10, 1984 12:36:26 pm PDT>>

DIRECTORY
BasicTime USING [GMT, 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

ROPE: TYPE = Rope.ROPE;

<<Global "variables">>
<<>>
retryInterval: Process.Ticks _ Process.SecondsToTicks[5];
abort: REF DFOperations.AbortInteraction _ NIL;
<<logically, this is constant; it is set by initialization and never changed>>
<<>>
<<>>
<<Exported to DFInternal>>

AbortDF: PUBLIC ERROR = CODE;

SimpleInteraction: PUBLIC PROC [client: DFInternal.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[DFOperations.InfoInteraction _ [class: $abort, message: message]], client.data];
DoAbort[client.log, message];
};
};

YesOrNo: PUBLIC PROC [client: DFInternal.Client, message: ROPE, default: BOOL, blunder: BOOL _ FALSE]
RETURNS [choice: BOOL] = {
response: REF ANY = DoInteraction[
client,
NEW[DFOperations.YesNoInteraction _ [
message: message,
blunder: blunder,
default: default
]]
];
choice _ default;
WITH response SELECT FROM
r: REF DFOperations.YesNoResponse => choice _ r^;
ENDCASE;
};

DoInteraction: PUBLIC PROC [client: DFInternal.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[DFOperations.InfoInteraction _ [class: $abort, message: message]], client.data];
DoAbort[client.log, message];
};
};

CheckAbort: PUBLIC PROC [client: DFInternal.Client] = {
SimpleInteraction[client, abort];
};

DoAbort: PUBLIC PROC [
log: IO.STREAM,
message: ROPE _ NIL, proc: DFOperations.InteractionProc _ NIL, clientData: REF ANY _ NIL] = {
interaction: REF ANY = NEW[DFOperations.InfoInteraction _ [class: $abort, message: message]];
IF proc # NIL AND message # NIL THEN [] _ proc[interaction, clientData];
DoLogging[interaction, log];
ERROR AbortDF
};

DefaultInteractionProc: PUBLIC DFOperations.InteractionProc -- [interaction: REF ANY] RETURNS [abort: BOOL _ FALSE, 
abortMessageForLog: ROPE _ NIL, response: REF ANY _ NIL] --  = {
WITH interaction SELECT FROM
a: REF DFOperations.AbortInteraction => RETURN[abort: a.fromABORTED];
ENDCASE;
};

GetFileInfo: PUBLIC PROC [
info: REF ANY, notFoundOK: BOOL _ FALSE, remoteCheck: BOOL _ FALSE, 
client: DFInternal.Client _ NIL, errorLevel: DFOperations.InfoClass _ $error] = {
WITH info SELECT FROM
local: REF DFInternal.LocalFileInfo => {
date: DFUtilities.Date _ [];
name: ROPE _ FS.ExpandName[local.name].fullFName;
local.name _ name;
IF local.date.format # $explicit THEN name _ DFUtilities.RemoveVersionNumber[name];
[fullFName: local.name, attachedTo: local.attachedTo, created: date.gmt, keep: local.keep] _
FS.FileInfo[name: name, remoteCheck: remoteCheck
! 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 DFInternal.RemoteFileInfo => {
date: DFUtilities.Date _ IF remote.date.format = $explicit THEN remote.date ELSE [];
name: ROPE _ remote.name;
uName: ROPE _ DFUtilities.RemoveVersionNumber[name];
rName: ROPE _ NIL;
gmt: BasicTime.GMT _ BasicTime.nullGMT;

<<RRA: The preferred version, regardless of the one hinted at, is the highest version number.  This crock helps avoid problems with 
deleting elderly (but still correct) versions using Chat.  Ideally our tools would play together such that this did not happen.>>
[fullFName: rName, created: 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 gmt # BasicTime.nullGMT AND remote.date.format = $explicit THEN {
<<There is a hinted version, which we should give another try at.>>
[fullFName: remote.name, created: 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 gmt # BasicTime.nullGMT THEN
<<We have found an explcit date.>>
date.format _ $explicit;

date.gmt _ gmt;
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: DFInternal.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: DFInternal.Client, errorLevel: DFOperations.InfoClass _ $error] = {
name: ROPE;
WITH info SELECT FROM
remote: REF DFInternal.RemoteFileInfo => name _ remote.name;
local: REF DFInternal.LocalFileInfo =>
name _ FS.ExpandName[name _ local.name ! FS.Error => CONTINUE].fullFName;
ENDCASE => ERROR;
SimpleInteraction[
client,
NEW[DFOperations.InfoInteraction _ [
class: errorLevel,
message: 
IO.PutFR["%gFS.Error%g: %g",
IO.rope[IF error.group = $user THEN NIL ELSE "Unexpected "],
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 DFOperations.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 DFOperations.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 DFOperations.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[DFUtilities.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[DFOperations.AbortInteraction _ [FALSE]];
};

Initialize[];

END.