OberonCore

MODULE PrivFilesDb;

   IMPORT Log := StdLog, Files, Stores;

   CONST
      repLocation = 'Priv';
      repName = 'repo.odc';
      minVersion = 0; maxVersion = 1;
      
   TYPE
(*       
      Сохраняем в файл структуру вида
      
      Item1
         Element1-1
         Element1-2
         Element1-3
         ...
      Item2
         Element2-1
         Element2-2
         Element2-3
         ...
      ...
 *)            
      Name = ARRAY 50 OF CHAR;
      
      Element = POINTER TO RECORD (Stores.Store)
         name: Name;
         next: Element
      END;
      
      Item = POINTER TO RECORD (Stores.Store)
         name: Name;
         e: Element;
         next: Item
      END;

   VAR
      repo: Item;
      f: Files.File;


   (* Element *)

   PROCEDURE (s: Element) Externalize- (VAR wr: Stores.Writer);
   BEGIN
      wr.WriteVersion(maxVersion);
      wr.WriteString(s.name);
      wr.WriteStore(s.next)
   END Externalize;

   PROCEDURE (s: Element) Internalize- (VAR rd: Stores.Reader);
      VAR version: INTEGER; store: Stores.Store;
   BEGIN
      rd.ReadVersion(minVersion, maxVersion, version);
      IF ~rd.cancelled THEN
         rd.ReadString(s.name);
         rd.ReadStore(store);
         IF store # NIL THEN s.next := store(Element) ELSE s.next := NIL END;
      END
   END Internalize;


   (* Item *)

   PROCEDURE (s: Item) Externalize- (VAR wr: Stores.Writer);
   BEGIN
      wr.WriteVersion(maxVersion);
      wr.WriteString(s.name);
      wr.WriteStore(s.e);
      wr.WriteStore(s.next)
   END Externalize;

   PROCEDURE (s: Item) Internalize- (VAR rd: Stores.Reader);
      VAR version: INTEGER; store: Stores.Store;
   BEGIN
      rd.ReadVersion(minVersion, maxVersion, version);
      IF ~rd.cancelled THEN
         rd.ReadString(s.name);
         rd.ReadStore(store);
         IF store # NIL THEN s.e := store(Element) ELSE s.e := NIL END;
         rd.ReadStore(store);
         IF store # NIL THEN s.next := store(Item) ELSE s.next := NIL END;
      END
   END Internalize;

   PROCEDURE AddElemTo (name: Name);
      VAR new: Element;
   BEGIN
      NEW(new); new.name := name;
      IF repo.e = NIL THEN repo.e := new ELSE new.next := repo.e; repo.e := new END
   END AddElemTo;

   PROCEDURE NewItem (name: Name);
      VAR new: Item;
   BEGIN
      NEW(new); new.name := name;
      IF repo = NIL THEN repo := new ELSE new.next := repo; repo := new END
   END NewItem;

   PROCEDURE OpenFile;
      VAR loc: Files.Locator; res: INTEGER;
   BEGIN
      loc := Files.dir.This(repLocation);
      IF loc.res = 0 THEN
         (* попытка открыть уже существующий реп *)
         f := Files.dir.Old(loc, repName, Files.exclusive);
         IF (f = NIL) & (loc.res = 2) THEN
            (* репа нет, создаём его *)
            f := Files.dir.New(loc, Files.dontAsk);
            f.Register(repName, '', Files.ask, res);
            IF res = 0 THEN
               Log.String('PrivFilesDb: репозиторий создан.'); Log.Ln;
            ELSE
               Log.String('PrivFilesDb: ошибка создания репозитория:'); Log.Int(res); Log.Ln;
            END;
            (* повторно открываем *)
            f := Files.dir.Old(loc, repName, Files.exclusive);
         ELSIF f # NIL THEN
            Log.String('PrivFilesDb: репозиторий открыт'); Log.Ln;
         END
      ELSE
         Log.String('PrivFilesDb: неверный каталог реп-я.'); Log.Ln;
      END
   END OpenFile;

   PROCEDURE Init*;
   BEGIN
      NewItem('Second Item');
      AddElemTo('Element 2-3'); AddElemTo('Element 2-2'); AddElemTo('Element 2-1');
      NewItem('First Item');
      AddElemTo('Element 1-3'); AddElemTo('Element 1-2'); AddElemTo('Element 1-1');
      OpenFile;
   END Init;

   PROCEDURE Write*;
      VAR wr: Stores.Writer; item: Item;
   BEGIN
      wr.ConnectTo(f);
      item := repo;
      WHILE item # NIL DO
         wr.WriteStore(item);
         item := item.next
      END
   END Write;

   PROCEDURE Read*;
      VAR rd: Stores.Reader; st: Stores.Store;
   BEGIN
      rd.ConnectTo(f); rd.SetPos(0);
      rd.ReadStore(st);
   END Read;

CLOSE
   f.Close
END PrivFilesDb.

1) Создадим и заполним данными наш репозиторий, заодно подключимся к файлу
PrivFilesDb.Init
2) Запишем данные в файл
PrivFilesDb.Write
3) Прочитаем данные из файла
PrivFilesDb.Read

   PROCEDURE Write*;
      VAR wr: Stores.Writer;
   BEGIN
      wr.ConnectTo(f);
      wr.WriteStore(repo)
   END Write;

   PROCEDURE Read*;
      VAR rd: Stores.Reader; st: Stores.Store;
   BEGIN
      repo := NIL;
      rd.ConnectTo(f);
      IF f.Length() > 0 THEN rd.ReadStore(st) END;
      IF st # NIL THEN repo := st(Item) END
   END Read;

   PROCEDURE Read*;
      VAR rd: Stores.Reader; st: Stores.Store;
   BEGIN
      repo := NIL;
      rd.ConnectTo(f);
      IF f.Length() > 0 THEN
         rd.ReadStore(st);
         (* попытка прочитать несуществующий элемент *)
         IF ~rd.rider.eof THEN rd.ReadStore(st) END
      END;
      IF st # NIL THEN repo := st(Item) END
   END Read;

   PROCEDURE Read*;
      VAR rd: Stores.Reader; st: Stores.Store;
   BEGIN
      repo := NIL;
      rd.ConnectTo(f);
      IF f.Length() > 0 THEN
         rd.ReadStore(st);
         (* контроль позиции бегунка *)
         IF rd.Pos() < f.Length() THEN rd.ReadStore(st) END
      END;
      IF st # NIL THEN repo := st(Item) END
   END Read;