<> <> <> <> <> DIRECTORY BasicTime USING [GMT, nullGMT], DFInternal USING [Client, LocalFileInfo, RemoteFileInfo], DFOperations USING [AbortInteraction, DFInfoInteraction, FileInteraction, InfoClass, InfoInteraction, InteractionProc, YesNoInteraction, YesNoResponse], DFPrivate, DFUtilities USING [Date, DateToRope, RemoveVersionNumber], FS USING [ComponentPositions, Error, ErrorDesc, ExpandName, FileInfo], IO USING [PutF, PutFL, PutFR, PutFR1, rope, STREAM], Process USING [CheckForAbort, Pause, SecondsToTicks, Ticks], Rope USING [Concat, Flatten, Fetch, Length, ROPE]; DFInternalImpl: CEDAR PROGRAM IMPORTS DFUtilities, FS, IO, Process, Rope EXPORTS DFInternal, DFPrivate = BEGIN ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; <> <<>> retryInterval: Process.Ticks ¬ Process.SecondsToTicks[5]; abort: REF DFOperations.AbortInteraction ¬ NIL; <> <<>> <<>> <> FatalError: PUBLIC SIGNAL [message: Rope.ROPE] = CODE; <> AbortDF: PUBLIC ERROR = CODE; SimpleInteraction: PUBLIC PROC [client: DFInternal.Client, interaction: REF] = { abort: BOOL; message: ROPE; IF client = NIL THEN RETURN; DoLogging[interaction, client.log, client.errlog]; [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, NIL, NIL]; }; }; YesOrNo: PUBLIC PROC[client: DFInternal.Client, message: ROPE, default: BOOL, blunder: BOOL ¬ FALSE] RETURNS [choice: BOOL] = { response: REF = 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] RETURNS [response: REF] = { abort: BOOL; message: ROPE; IF client = NIL THEN RETURN [NIL]; DoLogging[interaction, client.log, client.errlog]; [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, NIL, NIL]; }; }; CheckAbort: PUBLIC PROC [client: DFInternal.Client] = { Process.CheckForAbort[]; SimpleInteraction[client, abort]; }; DoAbort: PUBLIC PROC [log: STREAM, message: ROPE, proc: DFOperations.InteractionProc, clientData: REF] = { interaction: REF = NEW[DFOperations.InfoInteraction ¬ [class: $abort, message: message]]; IF proc # NIL AND message # NIL THEN [] ¬ proc[interaction, clientData]; DoLogging[interaction, log, log]; ERROR AbortDF }; DefaultInteractionProc: PUBLIC DFOperations.InteractionProc = { <<[interaction: REF, clientData: REF] RETURNS [abort: BOOL _ FALSE, abortMessageForLog: ROPE _ NIL, response: REF _ NIL]>> WITH interaction SELECT FROM a: REF DFOperations.AbortInteraction => RETURN [abort: a.fromABORTED]; ENDCASE; }; GetFileInfo: PUBLIC PROC [info: REF, notFoundOK: BOOL, remoteCheck: BOOL, client: DFInternal.Client, errorLevel: DFOperations.InfoClass] = { WITH info SELECT FROM local: REF DFInternal.LocalFileInfo => { date: DFUtilities.Date ¬ []; name: ROPE ¬ local.name; IF local.date.format # $explicit THEN name ¬ DFUtilities.RemoveVersionNumber[name]; name ¬ local.name ¬ FS.ExpandName[name: name, wDir: client.workingDir].fullFName; [fullFName: 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 ]; local.name ¬ Rope.Flatten[name]; -- to aid debug 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 []; uName: ROPE ¬ DFUtilities.RemoveVersionNumber[remote.name]; gmt: BasicTime.GMT ¬ BasicTime.nullGMT; <> [fullFName: uName, created: gmt] ¬ FS.FileInfo[name: uName, 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 ]; remote.name ¬ Rope.Flatten[uName]; -- to aid debug IF gmt # BasicTime.nullGMT THEN <> date.format ¬ $explicit; date.gmt ¬ gmt; remote.date ¬ date; }; ENDCASE => ERROR; }; LocalFile: PUBLIC PROC [file: ROPE, client: DFInternal.Client] RETURNS [BOOL] = { < 2 THEN SELECT Rope.Fetch[file, 0] FROM '[, '/ => { SELECT Rope.Fetch[file, 1] FROM '], '/ => RETURN [TRUE]; ENDCASE => RETURN [FALSE]; }; ENDCASE; <> RETURN [FS.ExpandName[name: file, wDir: client.workingDir ! FS.Error => CONTINUE].cp.server.length = 0];>> RETURN [TRUE] }; ShortName: PUBLIC PROC [file: ROPE, keepVersion: BOOL ¬ FALSE] RETURNS [ROPE] = { <> bang: INT ¬ Rope.Length[file]; pos: INT ¬ bang; WHILE pos # 0 DO SELECT Rope.Fetch[file, pos ¬ pos - 1] FROM '! => IF NOT keepVersion THEN bang ¬ pos; '>, '/, '] => {pos ¬ pos + 1; EXIT}; ENDCASE; ENDLOOP; RETURN [Rope.Flatten[file, pos, bang-pos]]; }; 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, client: DFInternal.Client, errorLevel: DFOperations.InfoClass] = { 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", [rope[IF error.group = $user THEN NIL ELSE "Unexpected "]], [rope[error.explanation]]] ]] ]; IF errorLevel = $abort AND client # NIL THEN DoAbort[client.log, NIL, NIL, NIL]; }; <<>> <> DoLogging: PROC [interaction: REF, infolog, errlog: STREAM] = { Log: PROC [infoClass: DFOperations.InfoClass] RETURNS [STREAM] ~ INLINE { RETURN [IF infoClass = $info OR errlog = NIL THEN infolog ELSE errlog]; }; WITH interaction SELECT FROM info: REF DFOperations.InfoInteraction => { log: STREAM ~ Log[info.class]; IF log = NIL THEN RETURN; 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: STREAM ~ Log[$info]; IF log = NIL THEN RETURN; 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.PutFR1[" (%g)", IO.rope[info.message]]] ]; }; file: REF DFOperations.FileInteraction => { log: STREAM ~ Log[$info]; IF log = NIL THEN RETURN; log.PutFL["%g %g %g {%g}%g\N", LIST[ 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.PutFR1[" ('%g')", SELECT file.dateFormat FROM $greaterThan => [character['>]], $notEqual => [rope["#"]], ENDCASE => [null[]] ] ] ]]; }; ENDCASE; }; <> Initialize: PROC = { abort ¬ NEW[DFOperations.AbortInteraction ¬ [FALSE]]; }; Initialize[]; END.