Lazarus: попытка написать парсер YML [РЕШЕНО]

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Lazarus: попытка написать парсер YML [РЕШЕНО]

Сообщение wofs » 24.12.2017 17:13:44

Доброго дня.
Встала задача импортировать данные из YML в БД (подробнее о формате здесь).
Решил попробовать написать небольшой класс, который поможет мне в чтении данных из YML. Но в процессе решения задачи начали одолевать сомнения в правильности подхода.

Является ли данный подход идеологически верным?

Исходники класса и пробного проекта прилагаю.
Пример прайс-листа можно взять, например, здесь: http://www.alas-nb.ru/yml.xml

Код: Выделить всё
unit wYMLparser;
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  DOM, xmlread
  ;

type
    TCurrencyID = (criEUR, criUSD, criRUB, criKZT, criNONE);

    // Currency
    TCurrency = record
       id: TCurrencyID;
       rate: Double;
    end;

    // Category
    TCategory = record
       id: integer;
       parentId: integer;
       name: string;
    end;

    // Offer
    TOffer = record
       id: integer;
       url: string;
       price: double;
       currencyId: TCurrencyID;
       categoryId: integer;
       name: string;
       vendorCode: string;
       model: string;
       barcode: string;
    end;

    ArrayOfCurrencies =  array of TCurrency;
    ArrayOfCategories = array of TCategory;
    ArrayOfOffers =  array of TOffer;

    { TYML_catalog }

    // Catalog
    TYML_catalog = class
       private
         fDecimalSeparator: Char;
         fYMLFile: string;
         fDate: TDateTime;
         fCompany: string;
         fPhone: string;

         fCurrencies: ArrayOfCurrencies;
         fCategories: ArrayOfCategories;
         fOffers: ArrayOfOffers;

         Document: TXMLDocument;

         function GetCurrencies():ArrayOfCurrencies;
         function GetCategories():ArrayOfCategories;
         function GetCurrencyID(aCurrencyString: string): TCurrencyID;
         function GetOffers():ArrayOfOffers;
       public
         constructor Create(aYMLFile: string);
         destructor Destroy;

         procedure Log(aText: string);

         function Open(): boolean;

         property YMLFile: string read fYMLFile write fYMLFile;
         property Date: TDateTime read fDate write fDate;
         property Company: string read fCompany write fCompany;
         property Phone: string read fPhone write fPhone;

         property Currencies: ArrayOfCurrencies read fCurrencies write fCurrencies;
         property Categories: ArrayOfCategories read fCategories write fCategories;
         property Offers: ArrayOfOffers read fOffers write fOffers;

    end;

implementation

{ TYML_catalog }

constructor TYML_catalog.Create(aYMLFile: string);
begin
  fYMLFile:= aYMLFile;
  fDecimalSeparator:= DefaultFormatSettings.DecimalSeparator;
end;

destructor TYML_catalog.Destroy;
begin
  Document.Free;
  Currencies:= nil;
  Categories:= nil;
  Offers:= nil;
end;

procedure TYML_catalog.Log(aText: string);
begin
  //Here you can write your own output procedure
  //Form1.Log(aText);
end;

function TYML_catalog.Open: boolean;
begin
  try
    result:= true;
    Log('Open ' + YMLFile);

    if  Assigned(Document) then
    begin
      Destroy;
    end;

    ReadXMLFile(Document, YMLFile);
    Log('Open...[OK]');

    Currencies:= GetCurrencies; // Get Currencies
    Categories:= GetCategories; // Get Categories
    Offers:= GetOffers; // Get Offers

  except
    on E: Exception do
    begin
      result:= false;
      Log(E.Message);
    end;
  end;
end;

function TYML_catalog.GetCurrencyID(aCurrencyString: string):TCurrencyID;
begin
  case aCurrencyString of
   'EUR': Result:= criEUR;
   'USD': Result:= criUSD;
   'RUB': Result:= criRUB;
   'KZT': Result:= criKZT
   else
      Result:= criNONE;
  end;
end;

function TYML_catalog.GetCurrencies: ArrayOfCurrencies;
var
  Node: TDOMNode;
  i: Integer;
begin
  try
    try
      Result := nil;
      Node := nil;
      i := 0;

      Node := Document.DocumentElement.FirstChild;
      Node := Node.FindNode('currencies');
      Node := Node.FindNode('currency'); //currency

      while Assigned(Node) do
      begin
        // Used ChildNodes
        Inc(i);
        SetLength(Result, i);

        with Node.ChildNodes do
        begin
          try

            if Assigned(Node.Attributes) then

              Result[i - 1].id:= GetCurrencyID(Node.Attributes[0].NodeValue);
              TryStrToFloat(StringReplace(Node.Attributes[1].NodeValue,'.',fDecimalSeparator,[rfReplaceAll]), Result[i - 1].rate);

          finally
            Free;
          end;

          Node := Node.NextSibling;
        end;

      end; //while Assigned(Node)

    finally
      if Assigned(Node) then
        Node.Free;
    end;

  except
    on E: Exception do
    begin
      Result:= nil;
      Log(E.Message);
    end;
  end;

end;

function TYML_catalog.GetCategories: ArrayOfCategories;
var
  Node: TDOMNode;
  i: Integer;
begin
  try
    try
      Result := nil;
      Node := nil;
      i := 0;

      Node := Document.DocumentElement.FirstChild;
      Node := Node.FindNode('categories');
      Node := Node.FindNode('category'); //category

      while Assigned(Node) do
      begin
        // Used ChildNodes
        Inc(i);
        SetLength(Result, i);

        with Node.ChildNodes do
        begin
          try

            if Assigned(Node.Attributes) then
              if Node.Attributes.Length = 2 then
              begin
                TryStrToInt(Node.Attributes[0].NodeValue, Result[i - 1].id);
                TryStrToInt(Node.Attributes[1].NodeValue, Result[i - 1].parentId);
              end
              else
              begin
                TryStrToInt(Node.Attributes[0].NodeValue, Result[i - 1].id);
                Result[i - 1].parentId:= 0;
              end;

            Result[i - 1].name := StringReplace(Node.TextContent, '&quot', '"', [rfReplaceAll]);

          finally
            Free;
          end;

          Node := Node.NextSibling;
        end;

      end; //while Assigned(Node)

    finally
      if Assigned(Node) then
        Node.Free;
    end;

  except
    on E: Exception do
    begin
      Result:= nil;
      Log(E.Message);
    end;
  end;
end;

function TYML_catalog.GetOffers: ArrayOfOffers;
var
  Node,ChildNode: TDOMNode;
  i: Integer;
begin
  try
    try
      Result := nil;
      Node := nil;
      ChildNode:= nil;
      i:= 0;

      Node := Document.DocumentElement.FirstChild;

      Node := Node.FindNode('offers');
      Node := Node.FindNode('offer'); //offer

      while Assigned(Node) do
      begin
        // Used ChildNodes
        Inc(i);
        SetLength(Result,i);

        with Node.ChildNodes do
        begin
          try

            // id
            if Assigned(Node.Attributes) then
                  TryStrToInt(Node.Attributes[0].NodeValue, Result[i-1].id);

            //url
            ChildNode:=Node.FindNode('url');
            if Assigned(ChildNode) then
                Result[i-1].url:= ChildNode.TextContent else Result[i-1].url:='';

            //price
            ChildNode:=Node.FindNode('price');
             if Assigned(ChildNode) then
                TryStrToFloat(StringReplace(ChildNode.TextContent,'.',fDecimalSeparator,[rfReplaceAll]),Result[i-1].price) else Result[i-1].price:=0;

             //currencyId
             ChildNode:=Node.FindNode('currencyId');
              if Assigned(ChildNode) then
              begin
                  Result[i - 1].currencyId:= GetCurrencyID(Node.TextContent);
              end else
                  Result[i-1].currencyId:=criNONE;

            // categoryId
            ChildNode:=Node.FindNode('categoryId');
            if Assigned(ChildNode) then
            TryStrToInt(ChildNode.TextContent,Result[i-1].categoryId) else Result[i-1].categoryId:=0;

            //name
            ChildNode:=Node.FindNode('name');
            if Assigned(ChildNode) then
                Result[i-1].name:= StringReplace(ChildNode.TextContent, '&quot', '"', [rfReplaceAll]) else Result[i-1].name:='';

            //vendorCode
            ChildNode:=Node.FindNode('vendorCode');
             if Assigned(ChildNode) then
                Result[i-1].vendorCode:= StringReplace(ChildNode.TextContent, '&quot', '"', [rfReplaceAll]) else Result[i-1].vendorCode:='';

            //model
            ChildNode:=Node.FindNode('model');
            if Assigned(ChildNode) then
                Result[i-1].model:= StringReplace(ChildNode.TextContent, '&quot', '"', [rfReplaceAll]) else Result[i-1].model:='';

            //barcode
            ChildNode:=Node.FindNode('barcode');
            if Assigned(ChildNode) then
                Result[i-1].barcode:= ChildNode.TextContent else Result[i-1].barcode:='';

          finally
            Free;
          end;

          Node := Node.NextSibling;
        end;

      end; //while asigned

    finally
      if Assigned(Node) then
        Node.Free;
    end;

  except
    on E: Exception do
    begin
      Result:= nil;
      Log(E.Message);
    end;
  end;
end;

end.


========
Исходники со всеми правками доступны здесь: https://github.com/wofs/wYMLparser.git
Последний раз редактировалось wofs 03.01.2018 11:43:19, всего редактировалось 3 раз(а).
Аватара пользователя
wofs
постоялец
 
Сообщения: 375
Зарегистрирован: 05.10.2009 10:16:55
Откуда: Астрахань

Re: Lazarus: попытка написать парсер YML

Сообщение vitaly_l » 24.12.2017 18:35:04

wofs писал(а):Является ли данный подход идеологически верным?

идеологически верным: признать написание небольшого класса, который поможет Вам в чтении данных из YML - можно .
Однако сам Ваш вопрос: идеологически верным, признать - не представляется возможным.

Кроме того, класс, который Вы привели выше - явно неполноценный, т.к. например вот в этом коде:
Код: Выделить всё
    // Offer
    TOffer = record
       id: integer;
       url: string;
       price: double;
       currencyId: TCurrencyID;
       categoryId: integer;
       name: string;
       vendorCode: string;
       model: string;
       barcode: string;
    end;

недостаёт кучи переменных. В частности, например: description.
Рекомендуется курить описание YML на страничке создателей.

.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Lazarus: попытка написать парсер YML

Сообщение wofs » 24.12.2017 18:37:44

vitaly_l писал(а):недостаёт кучи переменных. В частности, например: description

Там много чего не хватает - это заготовка.
vitaly_l писал(а):идеологически верным: признать написание небольшого класса, который поможет Вам в чтении данных из YML - можно .
Однако сам Ваш вопрос: идеологически верным, признать - не представляется возможным.

Философия не моя сильная сторона, увы...

Я имел ввиду базу для класса - массивы/записи - это норма? Или все же правильнее было бы использовать деревья?
Аватара пользователя
wofs
постоялец
 
Сообщения: 375
Зарегистрирован: 05.10.2009 10:16:55
Откуда: Астрахань

Re: Lazarus: попытка написать парсер YML

Сообщение vitaly_l » 24.12.2017 18:41:21

wofs писал(а):Я имел ввиду базу для класса - массивы/записи - это норма? Или все же правильнее было бы использовать деревья?

Массивы, здесь больше подходят, т.к. в YML 100% нет деревьев.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Lazarus: попытка написать парсер YML

Сообщение wofs » 24.12.2017 18:42:52

vitaly_l писал(а):Массивы, здесь больше подходят, т.к. в YML 100% нет деревьев.

Спасибо, за взгляд со стороны.
Аватара пользователя
wofs
постоялец
 
Сообщения: 375
Зарегистрирован: 05.10.2009 10:16:55
Откуда: Астрахань

Re: Lazarus: попытка написать парсер YML

Сообщение Ichthyander » 27.12.2017 10:31:33

ИМХО, лучшее выделить в отдельную библиотеку и залить на github. Ваш копирайте не постардают, посколько сделаете общим достоянием только библиотеку парсинга YML, но сделаете пользу для фрипаскаль, кому-то может пригодится. И главное для Вас - может кто-то присоединится к разработке
Аватара пользователя
Ichthyander
постоялец
 
Сообщения: 436
Зарегистрирован: 04.04.2007 08:32:43
Откуда: Астрахань

Re: Lazarus: попытка написать парсер YML

Сообщение wofs » 27.12.2017 10:38:45

Ichthyander писал(а):ИМХО, лучшее выделить в отдельную библиотеку и залить на github.

Да там нечего заливать то - так, немного корявого кода :(
Да и библиотеки сам не писал пока никогда.
Аватара пользователя
wofs
постоялец
 
Сообщения: 375
Зарегистрирован: 05.10.2009 10:16:55
Откуда: Астрахань

Re: Lazarus: попытка написать парсер YML

Сообщение Ichthyander » 27.12.2017 10:48:08

Да там несложно, поверьте. Создаете аккаунт на гитхаб https://github.com/, выделяете нужные файлы в отдельную папку. Установите на комп subversion svn или программу от гитхаб и заливаете на гитхаб с помощью него. Файл библиотеки можно не создавать, просто файлы pas залить.

Добавлено спустя 13 минут 53 секунды:
В худшем случае, будете висеть библиотека онлайн, никто за это деньги не берет ;)
Аватара пользователя
Ichthyander
постоялец
 
Сообщения: 436
Зарегистрирован: 04.04.2007 08:32:43
Откуда: Астрахань

Re: Lazarus: попытка написать парсер YML

Сообщение wofs » 27.12.2017 11:27:49

Ichthyander писал(а):Установите на комп subversion svn или программу от гитхаб и заливаете на гитхаб с помощью него.

Я неверно вас понял :) Системами контроля версий пользоваться умею. Конечно выложу.
Аватара пользователя
wofs
постоялец
 
Сообщения: 375
Зарегистрирован: 05.10.2009 10:16:55
Откуда: Астрахань

Re: Lazarus: попытка написать парсер YML

Сообщение LearnMagic » 27.12.2017 13:41:37

wofs, а чем не устраивает TXMLDocument из DOM?
LearnMagic
новенький
 
Сообщения: 57
Зарегистрирован: 10.11.2016 23:13:38

Re: Lazarus: попытка написать парсер YML

Сообщение wofs » 27.12.2017 13:46:05

LearnMagic писал(а):wofs, а чем не устраивает TXMLDocument из DOM?

Не понял вопроса.... Я его использую...
Аватара пользователя
wofs
постоялец
 
Сообщения: 375
Зарегистрирован: 05.10.2009 10:16:55
Откуда: Астрахань

Re: Lazarus: попытка написать парсер YML

Сообщение LearnMagic » 27.12.2017 13:49:50

wofs, извиняюсь за невнимательность :mrgreen:
LearnMagic
новенький
 
Сообщения: 57
Зарегистрирован: 10.11.2016 23:13:38

Re: Lazarus: попытка написать парсер YML

Сообщение vitaly_l » 27.12.2017 16:56:18

wofs писал(а):Конечно выложу

Ну раз Вы собираетесь делать доброе дело, то там на самом деле можно сделать(добавить) дерево из вот этого рекорда:
Код: Выделить всё
    // Category
    TCategory = record
       id: integer;
       parentId: integer;
       name: string;
    end;

И на самых концах веток дерева, тогда будут вот эти хрени, в соответствии с categoryId оно должно равняться ID из TCategory
Код: Выделить всё
    // Offer
    TOffer = record
       id: integer;
       url: string;
       price: double;
       currencyId: TCurrencyID;
       categoryId: integer;
       name: string;
       vendorCode: string;
       model: string;
       barcode: string;
    end;

При перегоне в базу, дерево - это безусловно лишнее, но если потребуется как-то с YML работать БЕЗ ПЕРЕГОНА В БАЗУ, то дерево может быть востребовано. Например для перемещения товаров из категории в категорию или для перемещения/создания категорий.


Добавлено спустя 77 минут 77 секунд:
PS: да и ещё, есть нюанс (а у Вас в приведённом коде - там явная ошибка).
ID в YML - это не интеджер, а стринг длинной 20 символов https://yandex.ru/support/partnermarket ... le.html#id.
Код: Выделить всё
В элементе id указывается идентификатор товарного предложения. Идентификатор может содержать только цифры и латинские буквы. Максимальная длина id — 20 символов.


PS: PS: Помимо гитхаба ещё здесь выложите пожалуйста результат готового модуля, мне тоже может пригодится.

.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Lazarus: попытка написать парсер YML

Сообщение Ichthyander » 27.12.2017 18:00:13

vitaly_l писал(а):PS: PS: Помимо гитхаба ещё здесь выложите пожалуйста результат готового модуля, мне тоже может пригодится.

.

Как раз именно на гитхабе удобный механизм для предложения правок, форков, багрепортов и всего прочего для кодинга, там же сможете и присоединится к разработке классов
Аватара пользователя
Ichthyander
постоялец
 
Сообщения: 436
Зарегистрирован: 04.04.2007 08:32:43
Откуда: Астрахань

Re: Lazarus: попытка написать парсер YML

Сообщение wofs » 27.12.2017 21:56:05

Итак, вот, что получилось:
Код: Выделить всё
unit wYMLparser;
// YML Parser
// v. 0.0.1.3
//
// Degtyarev Alexander(c)2017
// GNU LESSER GENERAL PUBLIC LICENSE v.2.1
//
// Git: https://github.com/wofs/wYMLparser.git
//
// to work with win1251 files use win1251decoder https://github.com/wofs/win1251decoder.git
//

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  DOM, xmlread
  ;

type
    TCurrencyID = (criEUR, criUSD, criKZT, criRUR, criUAH, criBYN, criNONE);

    //Param
    TParam = record
       name: string;
       unit_: string;
       text: string;
    end;

    //Age
    TAge = record
       year: integer;
       month: integer;
    end;

    //Outlets
    TOutlets = record
       id: integer;
       instock: integer;
    end;

    // DeliveryOptions
    TDeliveryOptions = record
       cost: integer;
       days: string;
       order_before: string;
    end;

    // Currency
    TCurrency = record
       id: TCurrencyID;
       rate: Double;
    end;

    // Category
    TCategory = record
       id: integer;
       parentId: integer;
       name: string;
    end;

    // Offer
    ArrayOfOutlets =  array of TOutlets;
    ArrayOfAge = array of TAge;
    ArrayOfParams = array of TParam;
    ArrayOfBarcode = array of string;
    ArrayOfPicture = array of string;
    ArrayOfDeliveryOptions = array of TDeliveryOptions;

    TOffer = record
       id: string;
       url: string;
       oldprice: double;
       price: double;
       currencyId: TCurrencyID;
       categoryId: integer;
       name: string;
       vendorCode: string;
       model: string;
       barcode: ArrayOfBarcode;
       vendor: string;
       picture: ArrayOfPicture;
       delivery: boolean;
       pickup: boolean;
       store: boolean;
       delivery_options: ArrayOfDeliveryOptions;
       outlets: ArrayOfOutlets;
       description: string;
       sales_notes: string;
       min_quantity: integer;
       step_quantity: integer;
       manufacturer_warranty: boolean;
       country_of_origin: string;
       adult: boolean;
       age: ArrayOfAge;
       cpa: integer;
       param: ArrayOfParams;
       expiry: string;
       weight: string;
       dimensions: string;
       downloadable: boolean;
       group_id: integer;
       bid: integer;
       cbid: integer;
       fee: integer;
       available: boolean;
       rec: string;
       type_: string;
       typePrefix: string;

    end;

    ArrayOfCurrencies =  array of TCurrency;
    ArrayOfCategories = array of TCategory;
    ArrayOfOffers =  array of TOffer;

    // Shop
    TShop = record
       name: string;
       company: string;
       url: string;
       phone: string;
       platform: string;
       version: string;
       agency: string;
       email: string;
       cpa: integer;
    end;

    { TYML }

    // Catalog
    TYML = class
       private
         fDecimalSeparator: Char;
         fYMLFile: string;

         Document: TXMLDocument;
         Node: TDOMNode;

         fDate: string;

         fShop: TShop;

         fCurrencies: ArrayOfCurrencies;
         fCategories: ArrayOfCategories;
         fOffers: ArrayOfOffers;

         function GetCurrencies(aNode: TDOMNode): ArrayOfCurrencies;
         function GetCategories(aNode: TDOMNode):ArrayOfCategories;
         function GetCurrencyID(aCurrencyString: string): TCurrencyID;
         function GetOffers(aNode: TDOMNode):ArrayOfOffers;
         procedure GetShop();

       public

         constructor Create(aYMLFile: string);
         destructor Destroy; override;

         function Open(): boolean;

         function SortedCategoriesByParentId(aCategories: ArrayOfCategories): ArrayOfCategories;
         function GetChildrenCategories(aCategory: integer): ArrayOfCategories;
         function GetOffersByCategory(aCategory:integer):ArrayOfOffers;
         function GetOfferByID(aID:string):TOffer;

         property YMLFile: string read fYMLFile write fYMLFile;
         property Date: string read fDate write fDate;
         property Shop: TShop read fShop;

         property Currencies: ArrayOfCurrencies read fCurrencies write fCurrencies;
         property Categories: ArrayOfCategories read fCategories write fCategories;
         property Offers: ArrayOfOffers read fOffers write fOffers;

    end;

implementation

{ TYML }

constructor TYML.Create(aYMLFile: string);
begin
  fYMLFile:= aYMLFile;
  fDecimalSeparator:= DefaultFormatSettings.DecimalSeparator;
end;

destructor TYML.Destroy;
begin
    Currencies:= nil;
    Categories:= nil;
    Offers:= nil;
end;

function TYML.Open: boolean;
begin
  try
    result:= true;

    try
      ReadXMLFile(Document, YMLFile);

      GetShop; // GetShop
    finally
      Document.Free;
    end;

  except
    Result:=false;
    raise;
  end;
end;

function TYML.GetChildrenCategories(aCategory: integer): ArrayOfCategories;
var
  i: Integer;
  k: Integer;
begin
  try
    Result:=nil;
    k:=0;
    for i:=0 to High(Categories) do
    begin
       if Categories[i].parentId = aCategory then
       begin
         inc(k);
         SetLength(Result,k);
         Result[k-1]:=Categories[i];
       end;
    end;
  except
    Result:=nil;
    raise;
  end;

end;

function TYML.GetOffersByCategory(aCategory: integer): ArrayOfOffers;
var
  i: Integer;
  k: Integer;
begin
  try
    Result:=nil;
    if aCategory = 0 then
    begin
      Result:= Offers;
      exit;
    end;

    k:=0;
    for i:=0 to High(Offers) do
    begin
       if Offers[i].categoryId = aCategory then
       begin
         inc(k);
         SetLength(Result,k);
         Result[k-1]:=Offers[i];
       end;
    end;
  except
    Result:=nil;
    raise;
  end;

end;

function TYML.GetOfferByID(aID: string): TOffer;
var
  i: Integer;
  k: Integer;
begin
  try
    if Length(aID) = 0 then exit;

    for i:=0 to High(Offers) do
    begin
       if Offers[i].id = aID then
       begin
         Result:=Offers[i];
         break;
       end;
    end;
  except
    raise;
  end;
end;

function TYML.GetCurrencyID(aCurrencyString: string):TCurrencyID;
begin
  case aCurrencyString of
   'EUR': Result:= criEUR;
   'USD': Result:= criUSD;
   'RUB': Result:= criRUR; // sometimes write so
   'RUR': Result:= criRUR;
   'KZT': Result:= criKZT;
   'UAH': Result:= criUAH;
   'BYN': Result:= criBYN;
   else
      Result:= criNONE;
  end;
end;

function TYML.GetCurrencies(aNode: TDOMNode): ArrayOfCurrencies;
var
  n: Integer;
begin

    try
      Result := nil;
      n := 0;

      if not Assigned(aNode) then exit;

        with aNode.ChildNodes do  //currency
        begin
          try
            for n:=0 to Count-1 do
            begin
               SetLength(Result, n+1);
               if Assigned(Item[n].Attributes) then

                 Result[n].id:= GetCurrencyID(Item[n].Attributes[0].NodeValue);
                 TryStrToFloat(StringReplace(Item[n].Attributes[1].NodeValue,'.',fDecimalSeparator,[rfReplaceAll]), Result[n].rate);
            end;
          finally
            Free;
          end;
        end;  //aNode.ChildNodes

  except
    Result:=nil;
    raise;
  end;

end;

function TYML.GetCategories(aNode: TDOMNode): ArrayOfCategories;
var
n: Integer;
begin
    try
      Result := nil;

     if not Assigned(aNode) then exit;

        with aNode.ChildNodes do //category
        begin
          try

           for n:=0 to Count-1 do
           begin
             SetLength(Result, n+1);

              if Assigned(Item[n].Attributes) then
                if Item[n].Attributes.Length = 2 then
                begin
                  TryStrToInt(Item[n].Attributes[0].NodeValue, Result[n].id);
                  TryStrToInt(Item[n].Attributes[1].NodeValue, Result[n].parentId);
                end
                else
                begin
                  TryStrToInt(Item[n].Attributes[0].NodeValue, Result[n].id);
                  Result[n].parentId:= 0;
                end;

              Result[n].name := Item[n].TextContent;

           end;

          finally
            Free;
          end;

        end;
  except
    Result:=nil;
    raise;
  end;
end;

function TYML.GetOffers(aNode: TDOMNode): ArrayOfOffers;
var
  i, k, j, n: Integer;
  ChildNode: TDOMNode;
        //i - Nodies Count
        //n - NodeCildrens Count
        //k - Attributes.Items Count
        //j - Result.resultArray Count
begin
    try
      Result := nil;
      ChildNode:= nil;
      i:= 0;

      if not Assigned(aNode) then exit;

      aNode := aNode.FirstChild; // offer

      while Assigned(aNode) do
      begin
        // Used ChildNodes
       Inc(i);
       SetLength(Result,i);

        // id
        if (aNode.HasAttributes) and (aNode.Attributes.Length > 0) then
        begin
          for k:=0 to aNode.Attributes.Length-1 do
          begin

            case aNode.Attributes[k].NodeName of
              'id'         : Result[i-1].id:= aNode.Attributes[k].NodeValue;
              'group_id'   : TryStrToInt(aNode.Attributes[k].NodeValue,Result[i-1].group_id);
              'bid'        : TryStrToInt(aNode.Attributes[k].NodeValue,Result[i-1].bid);
              'cbid'       : TryStrToInt(aNode.Attributes[k].NodeValue,Result[i-1].cbid);
              'fee'        : TryStrToInt(aNode.Attributes[k].NodeValue,Result[i-1].fee);
              'available'  :
                begin
                  case LowerCase(aNode.Attributes[k].NodeValue) of
                    'false': Result[i-1].available:= false;
                    'true' : Result[i-1].available:= true
                    else Result[i-1].available:= false;
                  end;
                end;
              'type'      : Result[i-1].type_:= aNode.Attributes[k].NodeValue;
              'typePrefix': Result[i-1].typePrefix:= aNode.Attributes[k].NodeValue;

            end;
          end;
        end;

        with aNode.ChildNodes do   // offer
        begin
          try

            for n:=0 to Count-1 do
            begin

              case Item[n].NodeName of
                'url'            : Result[i-1].url:= Item[n].TextContent;
                'oldprice'       : TryStrToFloat(StringReplace(Item[n].TextContent,'.',fDecimalSeparator,[rfReplaceAll]),Result[i-1].oldprice);
                'price'          : TryStrToFloat(StringReplace(Item[n].TextContent,'.',fDecimalSeparator,[rfReplaceAll]),Result[i-1].price);
                'currencyId'     : Result[i - 1].currencyId:= GetCurrencyID(Item[n].TextContent);
                'categoryId'     : TryStrToInt(Item[n].TextContent,Result[i-1].categoryId);
                'name'           : Result[i-1].name:= Item[n].TextContent;
                'vendorCode'     : Result[i-1].vendorCode:= Item[n].TextContent;
                'model'          : Result[i-1].model:= Item[n].TextContent;
                'barcode'        :
                                  begin
                                   if not Assigned(Result[i-1].barcode) then
                                     j:= 0
                                   else
                                     j:= High(Result[i-1].barcode)+1;

                                   SetLength(Result[i-1].barcode,j+1);
                                   Result[i-1].barcode[j]:= Item[n].TextContent;
                                  end;
                'vendor'          : Result[i-1].vendor:= Item[n].TextContent;
                'picture'         :
                                  begin
                                    if not Assigned(Result[i-1].picture) then
                                      j:= 0
                                    else
                                      j:= High(Result[i-1].picture)+1;

                                    SetLength(Result[i-1].picture,j+1);
                                    Result[i-1].picture[j]:= Item[n].TextContent;
                                  end;
                'delivery'        :
                                  begin
                                   case LowerCase(Item[n].TextContent) of
                                     'false': Result[i-1].delivery:= false;
                                     'true': Result[i-1].delivery:= true
                                     else Result[i-1].delivery:= false;
                                   end;
                                  end;
                'pickup'          :
                                   begin
                                     case LowerCase(Item[n].TextContent) of
                                       'false': Result[i-1].pickup:= false;
                                       'true': Result[i-1].pickup:= true
                                       else Result[i-1].pickup:= false;
                                     end;
                                   end;
                'store'           :
                                   begin
                                     case LowerCase(Item[n].TextContent) of
                                       'false': Result[i-1].store:= false;
                                       'true': Result[i-1].store:= true
                                       else Result[i-1].store:= false;
                                     end;
                                   end;
                'delivery-options':
                                   begin
                                     ChildNode:=nil;
                                     ChildNode:=Item[n];

                                     if Assigned(ChildNode) then
                                     begin
                                       with ChildNode.ChildNodes do
                                       begin
                                        try
                                          for j:=0 to Count-1 do
                                          begin
                                            SetLength(Result[i-1].delivery_options,j+1);
                                              if Assigned(Item[j].Attributes) then
                                              begin
                                                for k:=0 to Item[j].Attributes.Length-1 do
                                                begin
                                                  case Item[j].Attributes[k].NodeName of
                                                    'cost': TryStrToInt(Item[j].Attributes[k].NodeValue,Result[i-1].delivery_options[j].cost);
                                                    'days': Result[i-1].delivery_options[j].days:= Item[j].Attributes[k].NodeValue;
                                                    'order-before': Result[i-1].delivery_options[j].order_before:= Item[j].Attributes[k].NodeValue;
                                                  end;
                                                end;
                                              end;
                                          end;
                                        finally
                                          Free;
                                        end;
                                       end; //with ChildNodes
                                     end;

                                     ChildNode:=nil;
                                   end;
                'description'      : Result[i-1].description:= Item[n].TextContent;
                'sales_notes'      : Result[i-1].sales_notes:= Item[n].TextContent;
                'min-quantity'     : TryStrToInt(ChildNode.TextContent,Result[i-1].min_quantity);
                'step-quantity'    : TryStrToInt(ChildNode.TextContent,Result[i-1].step_quantity);
                'manufacturer_warranty':
                                   begin
                                     case LowerCase(Item[n].TextContent) of
                                       'false': Result[i-1].manufacturer_warranty:= false;
                                       'true': Result[i-1].manufacturer_warranty:= true
                                       else Result[i-1].manufacturer_warranty:= false;
                                     end;
                                   end;
                'country_of_origin': Result[i-1].country_of_origin:= Item[n].TextContent;
                'adult'            :
                                   begin
                                     case LowerCase(Item[n].TextContent) of
                                       'false': Result[i-1].adult:= false;
                                       'true': Result[i-1].adult:= true
                                       else Result[i-1].adult:= false;
                                     end;
                                   end;
                'cpa'              : TryStrToInt(Item[n].TextContent,Result[i-1].cpa);
                'expiry'           : Result[i-1].expiry:= Item[n].TextContent;
                'weight'           : Result[i-1].weight:= Item[n].TextContent;
                'dimensions'       : Result[i-1].dimensions:= Item[n].TextContent;
                'downloadable'     :
                                   begin
                                     case LowerCase(Item[n].TextContent) of
                                       'false': Result[i-1].downloadable:= false;
                                       'true': Result[i-1].downloadable:= true
                                       else Result[i-1].downloadable:= false;
                                     end;
                                   end;
                'rec'              : Result[i-1].rec:= Item[n].TextContent;
                'outlets'          :
                                   begin
                                     ChildNode:=nil;
                                     ChildNode:=Item[n];

                                     if Assigned(ChildNode) then
                                     begin
                                       with ChildNode.ChildNodes do
                                       begin
                                        try
                                          for j:=0 to Count-1 do
                                          begin
                                            SetLength(Result[i-1].outlets,j+1);
                                              if Assigned(Item[j].Attributes) then
                                              begin
                                                for k:=0 to Item[j].Attributes.Length-1 do
                                                begin
                                                  case Item[j].Attributes[k].NodeName of
                                                    'id': TryStrToInt(Item[j].Attributes[k].NodeValue,Result[i-1].outlets[j].id);
                                                    'instock': TryStrToInt(Item[j].Attributes[k].NodeValue,Result[i-1].outlets[j].instock);
                                                  end;
                                                end;
                                              end;
                                          end;
                                        finally
                                          Free;
                                        end;
                                       end; //with ChildNodes
                                     end;
                                     ChildNode:=nil;
                                   end;
                'param'            :
                                   begin

                                     if not Assigned(Result[i-1].param) then
                                       j:= 0
                                     else
                                       j:= High(Result[i-1].param)+1;

                                     SetLength(Result[i-1].param,j+1);

                                     if Assigned(Item[n].Attributes) then
                                     begin
                                       for k:=0 to Item[n].Attributes.Length-1 do
                                       begin
                                         case Item[n].Attributes[k].NodeName of
                                           'name': Result[i-1].param[j].name:= Item[n].Attributes[k].NodeValue;
                                           'unit': Result[i-1].param[j].unit_:= Item[n].Attributes[k].NodeValue;
                                         end;
                                       end;
                                     end;

                                     Result[i-1].param[j].text:= Item[n].TextContent;
                                   end;
                'age'              :
                                   begin
                                     if Assigned(Item[n].Attributes) then
                                     begin
                                       j:=0;
                                       for k:=0 to Item[n].Attributes.Length-1 do
                                       begin
                                         inc(j);
                                         case aNode.Attributes[k].NodeName of
                                           'unit' :
                                             begin
                                               case Item[n].Attributes[k].NodeValue of
                                                'year'  : TryStrToInt(Item[n].TextContent,Result[i-1].age[j-1].year);
                                                'month' : TryStrToInt(Item[n].TextContent,Result[i-1].age[j-1].month);
                                               end;
                                             end;
                                         end;
                                       end;
                                     end;
                                   end;

              end; //case
            end; //for n:=0 to Count-1

          finally
            Free;
          end;
        end;
         aNode := aNode.NextSibling;
      end; //while asigned

  except
    Result:=nil;
    raise;
  end;
end;

procedure TYML.GetShop;
var
  ChildNode: TDOMNode;
  n: Integer;
begin
  try
      try
          Node := Document.DocumentElement;
          ChildNode:= nil;

          if Assigned(Node) then
          begin
            if Node.NodeName = 'yml_catalog' then
            begin
               if Assigned(Node.Attributes) then
                    Date:=Node.Attributes[0].NodeValue;
            end;

           if Node.NodeName<>'shop' then
                 Node := Node.FindNode('shop');
          end;

          if Assigned(Node) then
          begin
            with Node.ChildNodes do
            begin
             try
               for n:=0 to Count-1 do
               begin
                  case Item[n].NodeName of
                    'name'              : fShop.name:= Item[n].TextContent;
                    'company'           : fShop.company:= Item[n].TextContent;
                    'url'               : fShop.url:= Item[n].TextContent;
                    'phone'             : fShop.phone:= Item[n].TextContent;
                    'platform'          : fShop.platform:= Item[n].TextContent;
                    'version'           : fShop.version:= Item[n].TextContent;
                    'agency'            : fShop.agency:= Item[n].TextContent;
                    'email'             : fShop.email:= Item[n].TextContent;
                    'cpa'               : TryStrToInt(Item[n].TextContent,fShop.cpa);
                    'currencies'        : Currencies:= GetCurrencies(Item[n]);
                    'categories'        : Categories:= GetCategories(Item[n]);
                    'offers'            : Offers:= GetOffers(Item[n]);
                  end;
               end;
             finally
               Free;
             end;
            end; //with ChildNodes
          end;

      finally
        Node.Free;
      end;
  except
    raise;
  end;
end;

function TYML.SortedCategoriesByParentId(aCategories: ArrayOfCategories): ArrayOfCategories;
var
  bis, i, j, k : integer;
  temp: TCategory;
begin
if High(aCategories) > 0 then bis := High(aCategories) else exit;
k   := bis shr 1; // div 2
while k > 0 do begin
   for i := 0 to bis -k do begin
     j := i;
     while j >= 0 do begin
       if aCategories[j].parentId <= aCategories[j +k].parentId then break;
       temp := aCategories[j];
       aCategories[j] := aCategories[j+k];
       aCategories[j+k] := temp;
       if j > k then Dec(j, k) else j := 0;
     end;
   end;
   k := k shr 1; // div 2
end;
Result:= aCategories;
end;

end.

ГитХаб: https://github.com/wofs/wYMLparser

Тестовое приложение (Win32):
Бинарник: https://yadi.sk/d/niEpkBaj3R2sQN
Исходник https://github.com/wofs/wYMLparser/tree ... MLexplorer.

Тестовые YML:
Реальный прайс: http://www.alas-nb.ru/yml.xml
Примеры от Яндекс: https://github.com/wofs/wYMLparser/tree ... plorer/yml

А теперь итоги - очень большой расход памяти. При работе с небольшими файлами (2-3Мб) все отлично. А вот если взять файл ~50Мб, то x32 вывалится с Out Off Memory, а x64 откроет, но съест всю доступную память при парсинге (у меня ~ 5Гб). Возможно утечка, но при закрытии Heaptrc рапортует - все норм.
Конвертация псевдонимов спецсимволов пока в процессе.

А теперь знатоки, внимание, вопрос - как уменьшить расход памяти?

Добавлено спустя 32 секунды:
vitaly_l писал(а):PS: да и ещё, есть нюанс (а у Вас в приведённом коде - там явная ошибка).

Это да, я поправил, спасибо.

Добавлено спустя 50 секунд:
vitaly_l писал(а):Ну раз Вы собираетесь делать доброе дело, то там на самом деле можно сделать(добавить) дерево из вот этого рекорда

А как это сделать?
Аватара пользователя
wofs
постоялец
 
Сообщения: 375
Зарегистрирован: 05.10.2009 10:16:55
Откуда: Астрахань

След.

Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2

Рейтинг@Mail.ru