fpc-msgbase/tests/test_write_existing.pas

{
  test_write_existing.pas - write into copies of real populated
  bases and verify integrity.

  Never touches the source trees:
    ~/fidonet/msg/jam/10thamd.*       (291 messages on disk)
    ~/fidonet/msg/netmail/            (27 numbered *.msg files)

  Both are copied into /tmp scratch dirs first.  Tests append
  messages, reopen, verify counts and that pre-existing messages
  are still readable.
}

program test_write_existing;

{$mode objfpc}{$H+}

uses
  SysUtils,
  testutil,
  ma.types, ma.events, ma.api,
  ma.fmt.jam,    ma.fmt.jam.uni,
  ma.fmt.msg,    ma.fmt.msg.uni,
  ma.fmt.hudson, ma.fmt.hudson.uni;

const
  JAM_SRC          = '/home/ken/fidonet/msg/jam/10thamd';
  JAM_SCRATCH      = '/tmp/ma_write_jam';
  MSG_SRC          = '/home/ken/fidonet/msg/netmail';
  MSG_SCRATCH      = '/tmp/ma_write_msg';
  HUDSON_SCRATCH   = '/tmp/ma_write_hudson';
  HUDSON_SEED_N    = 50;  { seed from JAM source }

function RunShell(const Cmd: string): integer;
begin
  Result := ExecuteProcess('/bin/sh', ['-c', Cmd]);
end;

function MakeMsg(N: longint): TUniMessage;
begin
  Result.Attributes.Clear;
  Result.Attributes.SetValue('from',    'WriteTester' + IntToStr(N));
  Result.Attributes.SetValue('to',      'Receiver' + IntToStr(N));
  Result.Attributes.SetValue('subject', 'written #' + IntToStr(N));
  Result.Attributes.SetDate('date.written',
    EncodeDate(2026, 4, 15) + EncodeTime(10, N mod 60, 0, 0));
  Result.Attributes.SetBool('attr.local', true);
  Result.Attributes.SetBool('attr.echo',  true);
  Result.Attributes.SetAddr('addr.orig', MakeFTNAddress(1, 100, 200, 0));
  Result.Attributes.SetAddr('addr.dest', MakeFTNAddress(1, 100, 300, 0));
  Result.Attributes.SetValue('area', 'TEST');
  Result.Body := 'Appended message body ' + IntToStr(N) + #13;
end;

procedure TestJamAppend;
const
  APPEND_COUNT = 10;
var
  base:  TMessageBase;
  msg:   TUniMessage;
  i, preCount: longint;
begin
  TestBegin(SysUtils.Format(
    'JAM: append %d messages to real 291-msg base', [APPEND_COUNT]));

  if not FileExists(JAM_SRC + '.jhr') then begin
    WriteLn('SKIP (source missing)');
    exit;
  end;

  { Fresh scratch copy. }
  if DirectoryExists(ExtractFilePath(JAM_SCRATCH + '.')) then
    RunShell(SysUtils.Format('rm -f %s/10thamd.*', [ExtractFilePath(JAM_SCRATCH + '.')]));
  ForceDirectories(ExtractFilePath(JAM_SCRATCH + '.'));
  RunShell(SysUtils.Format('cp %s.jhr %s.jhr', [JAM_SRC, JAM_SCRATCH]));
  RunShell(SysUtils.Format('cp %s.jdt %s.jdt', [JAM_SRC, JAM_SCRATCH]));
  RunShell(SysUtils.Format('cp %s.jdx %s.jdx', [JAM_SRC, JAM_SCRATCH]));
  RunShell(SysUtils.Format('cp %s.jlr %s.jlr', [JAM_SRC, JAM_SCRATCH]));
  RunShell(SysUtils.Format('chmod u+w %s.*', [JAM_SCRATCH]));

  { Record pre-count. }
  base := MessageBaseOpen(mbfJam, JAM_SCRATCH, momReadOnly);
  try
    AssertTrue('Pre-open RO', base.Open);
    preCount := base.MessageCount;
    AssertEquals('Pre-count', 291, preCount);
  finally
    base.Close;
    base.Free;
  end;

  { Append phase. }
  base := MessageBaseOpen(mbfJam, JAM_SCRATCH, momReadWrite);
  try
    AssertTrue('Open RW', base.Open);
    for i := 1 to APPEND_COUNT do begin
      msg := MakeMsg(i);
      AssertTrue('WriteMessage ' + IntToStr(i), base.WriteMessage(msg));
    end;
    AssertEquals('Count after append',
                 preCount + APPEND_COUNT, base.MessageCount);
  finally
    base.Close;
    base.Free;
  end;

  { Reopen + verify. }
  base := MessageBaseOpen(mbfJam, JAM_SCRATCH, momReadOnly);
  try
    AssertTrue('Reopen RO', base.Open);
    AssertEquals('Count after reopen',
                 preCount + APPEND_COUNT, base.MessageCount);

    { First original message should still be Robert Wolfe. }
    AssertTrue('Read original msg 0', base.ReadMessage(0, msg));
    AssertEquals('Msg[0].WhoFrom', 'Robert Wolfe', msg.Attributes.Get('from'));

    { Appended messages should be at indexes preCount..preCount+9. }
    for i := 1 to APPEND_COUNT do begin
      AssertTrue('Read appended ' + IntToStr(i),
                 base.ReadMessage(preCount + i - 1, msg));
      AssertEquals('Appended WhoFrom',
                   'WriteTester' + IntToStr(i), msg.Attributes.Get('from'));
      AssertEquals('Appended Subject',
                   'written #' + IntToStr(i), msg.Attributes.Get('subject'));
      AssertTrue('Appended body contains marker',
                 Pos('Appended message body ' + IntToStr(i),
                     msg.Body) > 0);
    end;
  finally
    base.Close;
    base.Free;
  end;
  TestOK;
end;

procedure TestMsgAppend;
const
  APPEND_COUNT = 5;
var
  base:  TMessageBase;
  msg:   TUniMessage;
  i, preCount: longint;
begin
  TestBegin(SysUtils.Format(
    '*.MSG: append %d messages to 27-msg netmail dir', [APPEND_COUNT]));

  if not DirectoryExists(MSG_SRC) then begin
    WriteLn('SKIP (source missing)');
    exit;
  end;

  { Fresh scratch copy. }
  if DirectoryExists(MSG_SCRATCH) then
    RunShell(SysUtils.Format('rm -rf %s', [MSG_SCRATCH]));
  ForceDirectories(MSG_SCRATCH);
  RunShell(SysUtils.Format('cp -r %s/. %s/', [MSG_SRC, MSG_SCRATCH]));
  RunShell(SysUtils.Format('chmod -R u+w %s', [MSG_SCRATCH]));

  base := MessageBaseOpen(mbfMsg, MSG_SCRATCH, momReadOnly);
  try
    AssertTrue('Pre-open RO', base.Open);
    preCount := base.MessageCount;
    AssertEquals('Pre-count', 27, preCount);
  finally
    base.Close;
    base.Free;
  end;

  base := MessageBaseOpen(mbfMsg, MSG_SCRATCH, momReadWrite);
  try
    AssertTrue('Open RW', base.Open);
    for i := 1 to APPEND_COUNT do begin
      msg := MakeMsg(100 + i);
      AssertTrue('WriteMessage ' + IntToStr(i), base.WriteMessage(msg));
      AssertTrue('New MsgNum > 0', msg.Attributes.GetInt('msg.num') > 0);
    end;
    AssertEquals('Count after append',
                 preCount + APPEND_COUNT, base.MessageCount);
  finally
    base.Close;
    base.Free;
  end;

  base := MessageBaseOpen(mbfMsg, MSG_SCRATCH, momReadOnly);
  try
    AssertTrue('Reopen RO', base.Open);
    AssertEquals('Count after reopen',
                 preCount + APPEND_COUNT, base.MessageCount);
  finally
    base.Close;
    base.Free;
  end;

  TestOK;
end;

{ SeedHudsonFromJam - create a populated Hudson base by copying
  the first N messages from the real JAM sample.  Lets Hudson
  tests run against realistic data without committing binary
  samples to the repo. }
procedure SeedHudsonFromJam(const AHudsonPath: string; N: longint);
var
  src, dst: TMessageBase;
  msg: TUniMessage;
  i, copied: longint;
begin
  if DirectoryExists(AHudsonPath) then
    RunShell(SysUtils.Format('rm -rf %s', [AHudsonPath]));
  ForceDirectories(AHudsonPath);

  dst := MessageBaseOpen(mbfHudson, AHudsonPath, momCreate);
  try
    if not dst.Open then exit;
    src := MessageBaseOpen(mbfJam, JAM_SRC, momReadOnly);
    try
      if not src.Open then exit;
      copied := 0;
      i := 0;
      while (copied < N) and (i < src.MessageCount) do begin
        if src.ReadMessage(i, msg) then begin
          dst.WriteMessage(msg);
          Inc(copied);
        end;
        Inc(i);
      end;
    finally
      src.Close;
      src.Free;
    end;
  finally
    dst.Close;
    dst.Free;
  end;
end;

procedure TestHudsonAppend;
const
  APPEND_COUNT = 10;
var
  base: TMessageBase;
  msg:  TUniMessage;
  i, preCount: longint;
begin
  TestBegin(SysUtils.Format(
    'Hudson: seed %d msgs from JAM, append %d, verify',
    [HUDSON_SEED_N, APPEND_COUNT]));

  if not FileExists(JAM_SRC + '.jhr') then begin
    WriteLn('SKIP (JAM source missing)');
    exit;
  end;

  SeedHudsonFromJam(HUDSON_SCRATCH, HUDSON_SEED_N);

  base := MessageBaseOpen(mbfHudson, HUDSON_SCRATCH, momReadOnly);
  try
    AssertTrue('Pre-open RO', base.Open);
    preCount := base.MessageCount;
    AssertEquals('Pre-count', HUDSON_SEED_N, preCount);
  finally
    base.Close;
    base.Free;
  end;

  base := MessageBaseOpen(mbfHudson, HUDSON_SCRATCH, momReadWrite);
  try
    AssertTrue('Open RW', base.Open);
    for i := 1 to APPEND_COUNT do begin
      msg := MakeMsg(200 + i);
      AssertTrue('WriteMessage ' + IntToStr(i), base.WriteMessage(msg));
    end;
    AssertEquals('Count after append',
                 preCount + APPEND_COUNT, base.MessageCount);
  finally
    base.Close;
    base.Free;
  end;

  base := MessageBaseOpen(mbfHudson, HUDSON_SCRATCH, momReadOnly);
  try
    AssertTrue('Reopen RO', base.Open);
    AssertEquals('Count after reopen',
                 preCount + APPEND_COUNT, base.MessageCount);
    for i := 1 to APPEND_COUNT do begin
      AssertTrue('Read appended ' + IntToStr(i),
                 base.ReadMessage(preCount + i - 1, msg));
      AssertEquals('Appended WhoFrom',
                   'WriteTester' + IntToStr(200 + i), msg.Attributes.Get('from'));
    end;
  finally
    base.Close;
    base.Free;
  end;
  TestOK;
end;

begin
  WriteLn('fpc-msgbase: write-to-existing-base tests');
  WriteLn;
  TestJamAppend;
  TestMsgAppend;
  TestHudsonAppend;
  Halt(TestsSummary);
end.