2a1f111565
Verbatim port of Fastway-Server's TFWScheduler from fw_scheduler.pas
per feedback_copy_dont_reinterpret.md. Library named fpc-cron;
class TCron. Adjustments limited to:
- Type renames per family convention.
- uses clause: drop fw_consts/fw_log/fw_config/fw_database/
fw_plugin_*/dbapi_*; add log.types (fpc-log) + db.dialect/
schema/pool (fpc-db v0.3.0) + cron.types + cron.events.
fpc-cron does NOT depend on fpc-events.
- TDBPool injected on Create where canonical used global DB.
- Logging through optional log.types.TLogProc callback (the
canonical ecosystem-wide logger shape used by every other
fpc-* library). Category='cron'.
- Events: typed observer callbacks (cron.events) instead of
canonical's EventBus.Fire calls. OnTaskStart /
OnTaskComplete / OnTaskRegistered / OnPluginOrphaned /
OnThreadStart / OnThreadStop are assignable properties on
TCron. Same per-library typed-callback pattern as
fpc-binkp's bp.events and fpc-comet's cm.events.
- System-task dispatch: consumer-registered via
RegisterSystemTask (no Fastway-specific log_cleanup / etc.
baked in). Dispatcher shape preserved.
- DoWalCheckpointTruncate lifted out (Fastway-specific).
- No global Scheduler singleton.
- ParseCronField / MatchesCron promoted to class function for
test access; bodies byte-verbatim from canonical (verified
by normalised diff).
Schema: system_scheduler + scheduler_log table names + columns
preserved verbatim from canonical fw_schema.pas, so an existing
Fastway database is reusable as-is.
Behaviours preserved verbatim: cron grammar (5-field, *, */N,
a,b,c, a-b, a-b/N, literal), UTC math via LocalTimeToUniversal,
schedule-miss-on-long-task semantics, TThread + PRTLEvent +
1-second wake loop, suspended-Create + .Start, SyncPluginTasks
orphan cleanup, MatchesCron's DecodeDateFully call (cosmetic but
present in canonical), MatchesCron's pre-try-finally TBits
allocation (known leak inherited verbatim and documented).
Docs: README + docs/API.md + docs/architecture.md +
docs/DEVELOPER_GUIDE.md. fpc.cfg for multi-target builds.
Tests: 73 assertions across 23 scenarios (37 pure-cron + 36
SQLite-backed end-to-end) pass on x86_64-linux. Pre-tag -vh
audit on src/ reports zero hints/warnings on cron.* units.
85 lines
2.1 KiB
ObjectPascal
85 lines
2.1 KiB
ObjectPascal
{ interval_task -- minimal example: schedule a 5-second interval
|
|
task and let it run for ~12 seconds.
|
|
|
|
Build:
|
|
bash build.sh
|
|
/opt/fpcup/fpc/bin/x86_64-linux/fpc -O2 -Sh \
|
|
-Fusrc -Fu../fpc-db/src -Fu../fpc-events/src \
|
|
-FUbuild -FEbuild -obuild/interval_task examples/interval_task.pas
|
|
|
|
Run:
|
|
./build/interval_task }
|
|
|
|
program interval_task;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
uses
|
|
{$IFDEF UNIX}cthreads,{$ENDIF}
|
|
Classes, SysUtils, fpjson, DateUtils,
|
|
db.types, db.pool,
|
|
log.types, cron.types, cron.runner;
|
|
|
|
type
|
|
THost = class
|
|
public
|
|
procedure RunTask(const APluginName, ATaskName: string);
|
|
procedure Log(Level: TLogLevel; const Category, Msg: string);
|
|
end;
|
|
|
|
procedure THost.RunTask(const APluginName, ATaskName: string);
|
|
begin
|
|
Writeln(FormatDateTime('hh:nn:ss', Now), ' -- ',
|
|
APluginName, '/', ATaskName, ' fired');
|
|
end;
|
|
|
|
procedure THost.Log(Level: TLogLevel; const Category, Msg: string);
|
|
begin
|
|
Writeln('[', LogLevelChar(Level), '] ', Category, ': ', Msg);
|
|
end;
|
|
|
|
var
|
|
Pool: TDBPool;
|
|
Sched: TCron;
|
|
Host: THost;
|
|
Params: TJSONObject;
|
|
DBFile: string;
|
|
begin
|
|
DBFile := '/tmp/fpcsched_example_' + IntToStr(GetProcessID) + '.sqlite3';
|
|
if FileExists(DBFile) then DeleteFile(DBFile);
|
|
|
|
Pool := TDBPool.Create;
|
|
Pool.Init(dbSQLite, DBFile);
|
|
Host := THost.Create;
|
|
try
|
|
Sched := TCron.Create(Pool, @Host.RunTask, nil, @Host.Log);
|
|
try
|
|
Params := TJSONObject.Create;
|
|
try
|
|
Params.Add('nr',
|
|
FormatDateTime('yyyy-mm-dd hh:nn:ss',
|
|
LocalTimeToUniversal(Now) - 1));
|
|
Pool.ExecSQL(
|
|
'INSERT INTO system_scheduler ' +
|
|
'(task_name, plugin_name, schedule_type, interval_seconds, ' +
|
|
' enabled, next_run, description) VALUES ' +
|
|
'(''heartbeat'', ''demo'', ''interval'', 5, 1, :nr, ''demo'')',
|
|
Params);
|
|
finally
|
|
Params.Free;
|
|
end;
|
|
Sched.RefreshTasks;
|
|
|
|
Sched.Start;
|
|
Sleep(12000);
|
|
Sched.Terminate;
|
|
finally
|
|
Sched.Free;
|
|
end;
|
|
finally
|
|
Host.Free;
|
|
Pool.Free;
|
|
DeleteFile(DBFile);
|
|
end;
|
|
end.
|