<> <> <> <<>> <> <<>> DIRECTORY BasicTime USING [Now, Period], Commander USING [CommandProc, Register], CommandTool USING [ArgumentVector, Failed, Parse], IO USING [int, PutF, PutRope, PutChar, rope, STREAM], Jukebox USING [Handle, DeleteTune, Error, Info, OpenTune, ArchiveCloseTune, Tune], RecordingServiceRegister USING [database, haveJuke, jukebox], Rope USING [Equal, Fetch, Length, ROPE], TuneAccess USING [GetCreateDate, NextTuneNumber], VoiceRopeDB, VoiceCleanup; VoiceCleanupImpl: CEDAR PROGRAM IMPORTS BasicTime, Commander, CommandTool, IO, Jukebox, RecordingServiceRegister, Rope, TuneAccess, VoiceRopeDB EXPORTS VoiceCleanup ~ BEGIN ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; minimumTuneAge: INT _ 300; -- minimum age in seconds minimumVoiceRopeAge: INT _ 300; -- minimum age in seconds testing: BOOLEAN _ FALSE; -- when set, things don't actually get deleted aggressive: BOOLEAN _ TRUE; -- aggressive vertical garbage collection? RegisteredClass: TYPE ~ REF RegisteredClassRecord; RegisteredClassRecord: TYPE ~ RECORD[ class: ROPE, proc: VoiceCleanup.IsGarbageProc ]; classRegistry: LIST OF RegisteredClass _ NIL; <> <> CollectTunes: PUBLIC PROC [reports: STREAM _ NIL] RETURNS [] ~ TRUSTED { <> ENABLE Jukebox.Error => { IF reports#NIL THEN IO.PutF[reports, "Jukebox error: %g\n", IO.rope[rope]]; CONTINUE; }; before, after: INT; db: VoiceRopeDB.Handle _ RecordingServiceRegister.database; openJukebox: Jukebox.Handle _ RecordingServiceRegister.jukebox; tune: INT; IF NOT RecordingServiceRegister.haveJuke THEN { IF reports#NIL THEN IO.PutRope[reports, "Jukebox not available.\n"]; RETURN; }; IF db = NIL THEN { IF reports#NIL THEN IO.PutRope[reports, "Voice rope database not available.\n"]; RETURN; }; before _ Jukebox.Info[openJukebox].nTunes; IF reports # NIL THEN IO.PutRope[reports, "Collecting tunes"]; tune _ TuneAccess.NextTuneNumber[jukebox: openJukebox]; WHILE tune # -1 DO IF reports # NIL THEN IO.PutChar[reports, '.]; [] _ CollectTune[db, tune, reports]; tune _ TuneAccess.NextTuneNumber[jukebox: openJukebox, currentTuneID: tune]; ENDLOOP; after _ Jukebox.Info[openJukebox].nTunes; IF reports # NIL THEN IO.PutF[reports, "%g tunes collected.\n", IO.int[before - after]]; }; CollectTune: PROC [db: VoiceRopeDB.Handle, tune: INT, reports: STREAM] RETURNS [collected: BOOLEAN _ FALSE] ~ TRUSTED { <> ENABLE { VoiceRopeDB.Error => { IF reports # NIL THEN IO.PutF[reports, "Database error: %g\n", IO.rope[explanation]]; CONTINUE; }; Jukebox.Error => { IF reports#NIL THEN IO.PutF[reports, "Jukebox error: %g\n", IO.rope[rope]]; CONTINUE; }; }; openTune: Jukebox.Tune; openJukebox: Jukebox.Handle _ RecordingServiceRegister.jukebox; IF VoiceRopeDB.VoiceRopeContainingTune[db, tune] = NIL THEN { openTune _ Jukebox.OpenTune[openJukebox, tune, FALSE]; IF BasicTime.Period[from: TuneAccess.GetCreateDate[openTune], to: BasicTime.Now[]] < minimumTuneAge THEN { Jukebox.ArchiveCloseTune[openJukebox, openTune]; RETURN;}; Jukebox.ArchiveCloseTune[openJukebox, openTune]; IF NOT testing THEN Jukebox.DeleteTune[openJukebox, tune]; IF reports # NIL THEN IO.PutF[reports, "\nTune garbage: %g\n", IO.int[tune]]; collected _ TRUE; }; }; <> CollectVoiceRopes: PUBLIC PROC [reports: STREAM _ NIL] RETURNS [] ~ { <> ENABLE VoiceRopeDB.Error => { IF reports # NIL THEN IO.PutF[reports, "Database error: %g\n", IO.rope[explanation]]; CONTINUE; }; Internal: VoiceRopeDB.EnumProc ~ { IF CollectVoiceRope[db, info, reports] THEN count _ count + 1; IF reports # NIL THEN IO.PutChar[reports, '.]; }; count: INT _ 0; db: VoiceRopeDB.Handle _ RecordingServiceRegister.database; IF db = NIL THEN { IF reports#NIL THEN IO.PutRope[reports, "Voice rope database not available.\n"]; RETURN; }; IF reports # NIL THEN IO.PutRope[reports, "Collecting voice ropes"]; VoiceRopeDB.EnumerateVoiceRopes[handle: db, proc: Internal]; IF reports # NIL THEN IO.PutF[reports, "%g voice ropes collected.\n", IO.int[count]]; }; CollectVoiceRope: PROC [db: VoiceRopeDB.Handle, info: VoiceRopeDB.VoiceRopeInfo, reports: STREAM] RETURNS [collected: BOOLEAN _ FALSE] ~ { <> ENABLE VoiceRopeDB.Error => { IF reports # NIL THEN IO.PutF[reports, "Database error: %g\n", IO.rope[explanation]]; CONTINUE; }; IF VoiceRopeDB.InterestInVoiceRope[db, info.vrID] = NIL AND BasicTime.Period[from: info.timestamp, to: BasicTime.Now[]] > minimumVoiceRopeAge THEN { IF NOT testing THEN VoiceRopeDB.DeleteVoiceRope[db, info.vrID]; IF reports # NIL THEN IO.PutF[reports, "\nVoice rope garbage: %g", IO.rope[info.vrID]]; IF aggressive THEN { tune: INT; struct: VoiceRopeDB.TuneList _ info.struct; UNTIL struct=NIL DO [tune: tune, rest: struct] _ VoiceRopeDB.NextTuneOnList[struct]; [] _ CollectTune[db, tune, reports]; ENDLOOP; }; IF reports # NIL THEN IO.PutChar[reports, '\n]; collected _ TRUE; } }; <> CollectInterests: PUBLIC PROC [class: ROPE _ NIL, reports: STREAM _ NIL] RETURNS [] ~ { <> ENABLE VoiceRopeDB.Error => { IF reports # NIL THEN IO.PutF[reports, "Database error: %g\n", IO.rope[explanation]]; CONTINUE; }; Internal: VoiceRopeDB.InterestProc ~ { IF CollectInterest[db, info, classProc, reports] THEN count _ count + 1; IF reports # NIL THEN IO.PutChar[reports, '.]; }; count: INT _ 0; classProc: VoiceCleanup.IsGarbageProc _ NIL; db: VoiceRopeDB.Handle _ RecordingServiceRegister.database; IF db = NIL THEN { IF reports#NIL THEN IO.PutRope[reports, "Voice rope database not available.\n"]; RETURN; }; IF class # NIL THEN { -- collecting a single class so lookup garbage proc once classProc _ LookupClass[class]; IF classProc = NIL THEN { IF reports # NIL THEN IO.PutF[reports, "No registered garbage procedure for class %g.\n", IO.rope[class]]; RETURN; }; }; IF reports # NIL THEN IO.PutRope[reports, "Collecting interests"]; VoiceRopeDB.EnumerateInterestClass[handle: db, class: class, proc: Internal]; IF reports # NIL THEN IO.PutF[reports, "%g interests collected.\n", IO.int[count]]; }; CollectInterest: PROC [db: VoiceRopeDB.Handle, info: VoiceCleanup.InterestInfo, proc: VoiceCleanup.IsGarbageProc _ NIL, reports: STREAM] RETURNS [collected: BOOLEAN _ FALSE] ~ { ENABLE VoiceRopeDB.Error => { IF reports # NIL THEN IO.PutF[reports, "Database error: %g\n", IO.rope[explanation]]; CONTINUE; }; classProc: VoiceCleanup.IsGarbageProc _ proc; IF proc = NIL THEN { -- lookup garbage proc for the particular class classProc _ LookupClass[info.class]; IF classProc = NIL THEN { IF reports # NIL THEN IO.PutF[reports, "No registered garbage procedure for class %g.\n", IO.rope[info.class]]; RETURN; }; }; IF classProc[info] THEN { -- returns TRUE if info is garbage IF NOT testing THEN VoiceRopeDB.DropInterest[db, info]; IF reports # NIL THEN IO.PutF[reports, "\nInterest garbage: vr=%g, ref=%g", IO.rope[info.vrID], IO.rope[info.refID]]; IF aggressive THEN { vrEntry: VoiceRopeDB.Header; vrInfo: VoiceRopeDB.VoiceRopeInfo; vrEntry _ VoiceRopeDB.ReadVoiceRope[handle: db, ropeID: info.vrID].header; IF vrEntry # NIL THEN { vrInfo _ VoiceRopeDB.UnpackHeader[vrEntry]; [] _ CollectVoiceRope[db, vrInfo, reports]; }; }; IF reports # NIL THEN IO.PutChar[reports, '\n]; collected _ TRUE; }; }; RegisterClass: PUBLIC PROC [class: ROPE, proc: VoiceCleanup.IsGarbageProc] RETURNS [] ~ { <> data: RegisteredClass; FOR l: LIST OF RegisteredClass _ classRegistry, l.rest WHILE l # NIL DO IF l.first.class = class THEN { -- new proc for a previously registered class l.first.proc _ proc; RETURN; } ENDLOOP; data _ NEW[RegisteredClassRecord _ [class, proc]]; classRegistry _ CONS[data, classRegistry]; }; LookupClass: PROC [class: ROPE] RETURNS [proc: VoiceCleanup.IsGarbageProc _ NIL] ~ { <> FOR l: LIST OF RegisteredClass _ classRegistry, l.rest WHILE l # NIL DO IF Rope.Equal[s1: l.first.class, s2: class, case: FALSE] THEN RETURN[l.first.proc]; ENDLOOP; }; <> silent: BOOLEAN _ FALSE; -- turns off reporting ParseSwitches: PROC [argv: CommandTool.ArgumentVector] RETURNS [] ~ { arg: ROPE; FOR i: NAT IN [1..argv.argc) DO arg _ argv[i]; IF Rope.Length[arg] = 0 THEN LOOP; IF Rope.Fetch[arg, 0] = '- THEN { FOR index: INT IN [1..Rope.Length[arg]) DO SELECT Rope.Fetch[arg, index] FROM 't, 'T => testing _ TRUE; -- testing mode 'g, 'G => testing _ FALSE; -- really collect bad entries 'r, 'R => silent _ FALSE; -- turn on reporting 's, 'S => silent _ TRUE; -- turn off reporting ENDCASE; ENDLOOP; }; ENDLOOP; }; NextNonSwitch: PROC [argv: CommandTool.ArgumentVector, start: NAT] RETURNS [arg: ROPE, p: NAT] ~ { FOR i: NAT IN [start..argv.argc) DO arg _ argv[i]; IF Rope.Length[arg] = 0 THEN LOOP; IF Rope.Fetch[arg, 0] # '- THEN RETURN[arg, i]; ENDLOOP; RETURN[NIL, argv.argc]; }; TuneProc: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd: cmd ! CommandTool.Failed => {msg _ errorMsg; GO TO failed}]; ParseSwitches[argv]; IF testing THEN IO.PutRope[cmd.out, "Test mode:\n"]; CollectTunes[reports: IF silent THEN NIL ELSE cmd.out]; IF testing THEN IO.PutRope[cmd.out, "No garbage actually collected.\n"]; EXITS failed => {result _ $Failure}; }; VoiceRopeProc: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd: cmd ! CommandTool.Failed => {msg _ errorMsg; GO TO failed}]; ParseSwitches[argv]; IF testing THEN IO.PutRope[cmd.out, "Test mode:\n"]; CollectVoiceRopes[reports: IF silent THEN NIL ELSE cmd.out]; IF testing THEN IO.PutRope[cmd.out, "No garbage actually collected.\n"]; EXITS failed => {result _ $Failure}; }; InterestProc: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> class: ROPE; i: NAT; argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd: cmd ! CommandTool.Failed => {msg _ errorMsg; GO TO failed}]; ParseSwitches[argv]; [class, i] _ NextNonSwitch[argv, 1]; IF testing THEN IO.PutRope[cmd.out, "Test mode:\n"]; CollectInterests[class: class, reports: IF silent THEN NIL ELSE cmd.out]; IF testing THEN IO.PutRope[cmd.out, "No garbage actually collected.\n"]; EXITS failed => {result _ $Failure}; }; <> Commander.Register[key: "CollectVoiceInterests", proc: InterestProc, doc: "Garbage collects interests in voice ropes.\n CollectVoiceInterests {-t | -g} "]; Commander.Register[key: "CollectVoiceRopes", proc: VoiceRopeProc, doc: "Garbage collects voice ropes that are no longer of interest.\n CollectVoiceRopes {-t | -g}"]; Commander.Register[key: "CollectTunes", proc: TuneProc, doc: "Garbage collects unused bluejay tunes.\n CollectTunes {-t | -g}"]; END. <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>> <<>>