Наследование бизнес-классов (постановка)

Версия 13:01, 18 июня 2014

До текущего момента времени мы могли создавать в платформе только прямых наследников от классов Делфи с помощью т.н. Подтипа (Subtype) бизнес-объекта. Цель настоящей доработки -- реализация наследования бизнес-классов неограниченной вложенности.

Подтип (Subtype)

Формат строки подтипа не будет меняться. Напомним, что сейчас подтип это или произвольная строка, или имя таблицы, или РУИД типа документа.

GetSubTypeList

В вызов функции следует добавить два параметра:

• Subtype -- подтип.
• OnlyDirect -- если True, то возвращаются только непосредственные наследники. В противном случае -- возвращается вся иерархия наследников.

InheritsFromSubtype

Реализовать такую функцию класса. На вход передается анализируемый класс и подтип, а также подтип текущего класса. Возвращает True, если анализируемый класс + подтип являются наследниками от текущего класса и подтипа или соответствуют им. Т.е. аналог InheritsFrom только с учетом подтипов.

ClassParentSubtype

Реализовать такую функцию класса. На вход передается подтип. Возвращает родительский подтип, если он есть, или пустую строку. Т.е. аналог ClassParent, только с учетом подтипов.

Определение иерархии через Хранилище

Сейчас в папке SubTypes глобального Ханилища находятся строковые параметры. Имя параметра задает имя класса из Дельфи, а значение -- перечисленные через запятую подтипы, которые являются прямыми наследниками. Нам не известны случаи из практики, где бы определялось более одного подтипа для класса.

Предлагается оставить как есть, только теперь имя переменной будет имя класса + подтип. Например, для иерархии:

 TgdcCompany
   |
   +--TgdcCompanyA
   |    |
   |    +--TgdcCompanyB
   |         |
   |         +--TgdcCompanyD
   |
   +--TgdcCompanyC

В папке будут прописаны следующие пары (имя параметра = значение):

 TgdcCompany   = A,C
 TgdcCompanyA  = B
 TgdcCompanyB  = D

Определение иерархии для справочников

Сейчас создание таблицы-справочника приводит к созданию нового подтипа для одного из следующих классов: TgdcAttrUserDefined, TgdcAttrUserDefinedTree, TgdcAttrUserDefinedLBRBTree.

Предлагается сделать создание вложенных типов через создание таблиц, связанных 1-к-1 (в дополнение к существующему типу метаданных TgdcTableToTable, который мы не будем трогать). Поясним на примере. Пусть мы "с нуля", не опираясь на существующие справочники, реализуем следующую иерархию:

 ТМЦ
   |
   +--БСО
   |
   +--Продукты питания
   |
   +--Промтовары
      |
      +--Основные средства

Последовательность действий:

1. Создаем таблицу ТМЦ
2. Создаем 1-к-1 таблицу БСО, связанную с ТМЦ
3. Создаем 1-к-1 таблицу Продукт питания, связанную с ТМЦ
4. Создаем 1-к-1 таблицу Промтовары, связанную с ТМЦ
5. Создаем 1-к-1 таблицу ОС, связанную с Промтовары

В запросах объектов БСО, Продукты питания, Промтовары должен быть JOIN с таблицой ТМЦ.

В запросе объекта ОС -- JOIN с таблицами Промтовары и ТМЦ.

Содержимое запроса объекта ТМЦ должно управляться некоторым свойством. В одном случае, нам нужны только записи из ТМЦ без подключения сторонних таблиц. В другом -- записи всех объектов по иерархии наследования, т.е. в запросе должны быть LEFT JOIN на таблицы БСО, Продукты питания, Промтовары, ОС. Аналогично -- для объекта Промтовары.

Для справки: в ПИ Комплексная Автоматизация находится три таблицы типа TgdcTableToTable: USR$INV_ADDINFO, USR$INV_ADDINFOMAT, USR$INVIMP_ADDINFO.

Определение иерархии для типов документов

Иерархию типов документов будем хранить в таблице GD_DOCUMENTTYPE, сняв запрет на вхождение класса в другой класс. В диалоговом окне добавим выпадающий список для выбора родительского класса.

Порядок вызова перекрытых методов

Порядок вызова перекрытых методов в случае множественного наследования рассмотрим на таком примере. Пусть в платформе определен ClassA -- пользовательский справочник. От него наследуется ClassB. Для этих классов перекрыт метод DoBeforeOpen c вызовом Inherited. У нас на руках экземпляр класса ClassB, который мы пытаемся открыть (Open), в процессе чего происходит вызов метода DoBeforeOpen. Тогда последовательность выполнения программного кода будет выглядеть следующим образом:

1 -- ClassA и ClassB -- это исключительно порождения платформы о которых Делфи ничего не известно. Для последнего объект имеет тип TgdcAttrUserDefined.

2 -- Поскольку для TgdcAttrUserDefined нет метода DoBeforeOpen, через VMT попадаем на метод родителя -- TgdcBase.

3 -- Тело метода начинается с кода, который отвечает за вызов перекрытых методов в платформе:

procedure TgdcBase.DoBeforeOpen;
  {@UNFOLD MACRO INH_ORIG_PARAMS(VAR)}
  {M}VAR
  {M}  Params, LResult: Variant;
  {M}  tmpStrings: TStackStrings;
  {END MACRO}
begin
  {@UNFOLD MACRO INH_ORIG_WITHOUTPARAM('TGDCBASE', 'DOBEFOREOPEN', KEYDOBEFOREOPEN)}
  {M}  try
  {M}    if (not FDataTransfer) and Assigned(gdcBaseMethodControl) then
  {M}    begin
  {M}      SetFirstMethodAssoc('TGDCBASE', KEYDOBEFOREOPEN);
  {M}      tmpStrings := TStackStrings(ClassMethodAssoc.IntByKey[KEYDOBEFOREOPEN]);
  {M}      if (tmpStrings = nil) or (tmpStrings.IndexOf('TGDCBASE') = -1) then
  {M}      begin
  {M}        Params := VarArrayOf([GetGdcInterface(Self)]);
  {M}        if gdcBaseMethodControl.ExecuteMethodNew(ClassMethodAssoc, Self, 'TGDCBASE',
  {M}          'DOBEFOREOPEN', KEYDOBEFOREOPEN, Params, LResult) then exit;
  {M}      end else
  {M}        if tmpStrings.LastClass.gdClassName <> 'TGDCBASE' then
  {M}        begin
  {M}          Inherited;
  {M}          Exit;
  {M}        end;
  {M}    end;
  {END MACRO}
 
  if (not CanView) and (not IBLogin.IsUserAdmin) then
  begin
    if SubType > '' then
      raise EgdcUserHaventRights.CreateFmt(strHaventRights,
        [strView, ClassName, SubType, GetDisplayName(SubType)])
    else
      raise EgdcUserHaventRights.CreateFmt(strHaventRightsShort,
        [strView, ClassName])
  end;
 
  if not FSQLInitialized then
    InitSQL;
 
  if HasSubSet('ByID') and (FID > -1) then
    ParamByName(GetKeyField(SubType)).AsInteger := FID
  else if HasSubSet('ByName') and (FObjectName > '') then
    ParamByName(GetListField(SubType)).AsString := FObjectName;
 
  inherited DoBeforeOpen;
 
  {@UNFOLD MACRO INH_ORIG_FINALLY('TGDCBASE', 'DOBEFOREOPEN', KEYDOBEFOREOPEN)}
  {M}  finally
  {M}    if (not FDataTransfer) and Assigned(gdcBaseMethodControl) then
  {M}      ClearMacrosStack2('TGDCBASE', 'DOBEFOREOPEN', KEYDOBEFOREOPEN);
  {M}  end;
  {END MACRO}
end;

Именно здесь вступает в силу Подтип нашего объекта и система начинает понимать, что мы имеем дело с экземпляром TgdcAttrUserDefinedClassB, а не TgdcAttrUserDefined. В базе данных отыскивается скрипт-функция перекрытого метода, загружается в скрипт-контрол и запускается на выполнение.

4 -- По магическому слову Inherited мы снова оказываемся в движке платформы. Для класса TgdcAttrUserDefinedClassB будет определен родитель -- TgdcAttrUserDefinedClassA. Для него найдена скрипт-функция перекрытого метода, загружена и запущена на выполнение.

5 -- Снова вызов Inherited из скрипт-функции. На этот раз родитель -- делфовский класс TgdcAttrUserDefined. Для него нет метода DoBeforeOpen и мы возвращаемся в TgdcBase.DoBeforeOpen. Служебный код, отвечающий за связь Делфи с VBScript, закончился. Начинается логика метода DoBeforeOpen.

6, 7 -- По вызову inherited перейдем на уровень родителя -- TCustomIBDataSet.DoBeforeOpen. По завершении вернемся обратно.

8 -- Собственно, логика метода DoBeforeOpen закончилась. Снова служебный код, который сращивает статичный, однажды откомпилированный код Делфи и динамичный, интерпретируемый код из VBScript. Возращаемся в место вызова -- TgdcAttrUserDefinedClassA.DoBeforeOpen, сразу после слова Inherited.

9 -- Когда выполнение метода закончится, движок платформы вернет нас к прерванному TgdcAttrUserDefinedClassB.DoBeforeOpen.

A, B, C -- Скрипты закончились. Заканчиваем метод TgdcBase.DoBeforeOpen. Затем, минуя несуществующий TgdcAttrUserDefined.DoBeforeOpen, возвращаемся к продолжению программы.

Наследование экранных форм для наследованных бизнес-классов