Files
fpc-msgbase/examples/example_read.pas

131 lines
3.2 KiB
ObjectPascal
Raw Normal View History

{
example_read.pas - open a message base via the unified API,
walk every message, dump a one-line summary.
usage: example_read <format> <path>
format : hudson | jam | squish | msg | pcboard | ezycom |
goldbase | auto
path : directory or basename the backend expects
Example:
example_read hudson /home/ken/fidonet/msg/hudson
}
program example_read;
{$mode objfpc}{$H+}
uses
SysUtils,
mb.types, mb.events, mb.api,
mb.fmt.hudson, mb.fmt.hudson.uni,
mb.fmt.jam, mb.fmt.jam.uni,
mb.fmt.squish, mb.fmt.squish.uni,
mb.fmt.msg, mb.fmt.msg.uni,
mb.fmt.pcboard, mb.fmt.pcboard.uni,
mb.fmt.ezycom, mb.fmt.ezycom.uni,
mb.fmt.goldbase, mb.fmt.goldbase.uni;
type
TLogger = class
procedure OnLog(Level: TMsgEventType;
const Source, Msg: AnsiString);
end;
procedure TLogger.OnLog(Level: TMsgEventType;
const Source, Msg: AnsiString);
begin
WriteLn('[', EventTypeToStr(Level), '] ', Source, ': ', Msg);
end;
var
gLogger: TLogger;
function ParseFormat(const S: string; out AFormat: TMsgBaseFormat;
out AAuto: boolean): boolean;
begin
AAuto := False;
Result := True;
case LowerCase(S) of
'hudson': AFormat := mbfHudson;
'jam': AFormat := mbfJam;
'squish': AFormat := mbfSquish;
'msg': AFormat := mbfMsg;
'pcboard': AFormat := mbfPCBoard;
'ezycom': AFormat := mbfEzyCom;
'goldbase': AFormat := mbfGoldBase;
'wildcat': AFormat := mbfWildcat;
'auto': AAuto := True;
else
Result := False;
end;
end;
procedure Usage;
begin
WriteLn('Usage: example_read <format> <path>');
WriteLn(' formats: hudson jam squish msg pcboard ezycom goldbase wildcat auto');
Halt(2);
end;
var
fmtName: string;
path: string;
fmt: TMsgBaseFormat;
auto: boolean;
base: TMessageBase;
msg: TUniMessage;
i, n: longint;
begin
if ParamCount < 2 then Usage;
fmtName := ParamStr(1);
path := ParamStr(2);
if not ParseFormat(fmtName, fmt, auto) then Usage;
try
if auto then
base := MessageBaseOpenAuto(path, momReadOnly)
else
base := MessageBaseOpen(fmt, path, momReadOnly);
except
on E: Exception do begin
WriteLn('error: ', E.Message);
Halt(1);
end;
end;
if base = nil then begin
WriteLn('error: could not detect format at ', path);
Halt(1);
end;
gLogger := TLogger.Create;
base.Events.OnLog := @gLogger.OnLog;
if not base.Open then begin
WriteLn('error: Open returned False (base files missing?)');
base.Free;
Halt(1);
end;
try
n := base.MessageCount;
WriteLn('format: ', MSG_BASE_FORMAT_NAME[base.Format],
' path: ', base.BasePath,
' messages: ', n);
for i := 0 to n - 1 do
if base.ReadMessage(i, msg) then
WriteLn(Format('%5d %-20s -> %-20s %s',
Lossless message model: Body + Attributes (showstopper fix) Replaces TUniMessage's 13-field flat record with a strict two-area model: Body holds only the message text; Attributes holds everything else (from/to/subject/dates/addresses/MSGID/SEEN-BY/PATH/format- specific fields) as namespaced key/value pairs. Why this fix is required NOW: the previous JAM adapter dropped MSGID, ReplyID, PID, Flags, SEEN-BY and PATH on every Read/Write through the unified API. A NetReader parity test surfaced it (17/21 pass with 4 kludge failures). All 9 adapters had the same bug. For tossers and scanners the impact is silent corruption: dropped MSGID → dupe storms, dropped PATH → mail loops, dropped SEEN-BY → broken routing. Three downstream consumers (Fimail's codex-transport branch, NetReader, future Allfix) had halted integration work pending this fix. Without it, anyone vendoring fpc-msgbase 0.1 ships with a known-corrupting adapter. Design choice: per Ken's call, "message is just the message text; everything else is an attribute, including from/to/subject/dates." Same architecture as RFC 822 email (headers + body). Each backend fills attributes it knows on Read; reads attributes it understands on Write; ignores unknown attributes silently (RFC 822 X-header semantics). Forward-compatible -- a new backend (e.g. a planned SQL message store) just adds its own attribute keys; old backends ignore them. Composition is the consumer's job. The library never reassembles Body + Attributes into kludge-laden display text. A BBS that wants inline kludges walks Attributes and prepends ^aMSGID etc. to its own display. A tosser that needs MSGID for dupe detection reads Attributes.Get('msgid') directly -- no body parsing required. src/ma.types.pas: - New TMsgAttribute / TMsgAttributes records with Get/SetValue, typed accessors (GetInt/GetBool/GetDate/GetAddr), Has/Remove, iteration. Linear-search lookup, fine for the ~30-50 keys per message. Switch to hash later if profiling shows need. - Replaced TUniMessage with the minimal Body + Attributes record. - New UniAttrBitsToAttributes / UniAttrBitsFromAttributes helpers to bridge the canonical MSG_ATTR_* cardinal bitset to/from individual `attr.*` boolean keys. - {$modeswitch advancedrecords} added so records have methods. src/ma.api.pas: - New capabilities API: TStringDynArray return type, ClassSupportedAttributes (virtual class fn, default empty), SupportedAttributes (instance sugar), SupportsAttribute (per-key query). Each backend overrides ClassSupportedAttributes with the static list of keys it knows. Callers query before setting so a BBS UI can hide controls the underlying backend has no slot for. src/formats/ma.fmt.*.uni.pas (all 9): - Rewrote each XxxToUni and XxxFromUni for the new model. Read populates Attributes with universal/FTSC/format-specific keys per the attribute registry (to be published in phase 5). Write reads attributes back and writes native form. - JAM walks SubFields[] for SEEN-BY/PATH/TZUTC/TRACE plus passthrough of unknown subfield IDs as `jam.subfield.<id>` for round-trip safety. Squish parses CtrlInfo (NUL-separated ^A lines) into individual attributes, rebuilds on Write. MSG and PKT (which keep kludges inline in body per FTS-1) parse leading ^A lines and trailing SEEN-BY/PATH out of the body so TUniMessage.Body is always plain user text; on Write they reassemble the on-disk form. - Each backend ships ClassSupportedAttributes with its key list. src/ma.batch.pas: PktToUni signature updated to (in,out var) form. tests/* + examples/*: migrated all callers from Msg.WhoFrom (etc.) to Msg.Attributes.Get('from'). MakeMsg helpers now use SetValue/ SetBool/SetAddr. Verified: 24/24 tests pass across all 7 test programs (read, roundtrip, lock, batch, wildcat, write_existing, pack). Wildcat walks all 7 vendored conferences clean. Out of scope (next phases): - docs/attributes-registry.md publishing the full key list with per-format support matrix - cross-format round-trip + capabilities-driven copy test - update architecture.md / PROPOSAL.md to reflect the new model
2026-04-17 14:11:15 -07:00
[msg.Attributes.GetInt('msg.num'),
Copy(msg.Attributes.Get('from'), 1, 20),
Copy(msg.Attributes.Get('to'), 1, 20),
Copy(msg.Attributes.Get('subject'), 1, 40)]));
finally
base.Close;
base.Free;
gLogger.Free;
end;
end.