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

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

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

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

Сообщение vitaly_l » 27.12.2017 22:30:51

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

Забейте ненужно там дерево, как факт. Кому надо тот сам его сделает.

wofs писал(а):А вот если взять файл ~50Мб, то x32 вывалится с Out Off Memory, а x64 откроет, но съест всю доступную память при парсинге (у меня ~ 5Гб).

50Mb превратились в 5Гб??? Похоже на свежие "ресурсы" мамонта.

Однако, YML - файлы, легко, могут быть и изначально = гигабайт и два и три (правда, ВОЗМОЖНО у яндекса есть ограничение по размеру), тогда ваш код явно свалится.

wofs писал(а):как уменьшить расход памяти?

Технически можете начать с замены, record на paced record. Кроме того, можно задать все значения с максимально их возможным кол-вом байт, это тоже сократит выделяемую под массивы память.

Например вот это явное излишество мамонта:
Код: Выделить всё
    TAge = record
       year: integer;
       month: integer;
    end;

т.к. month - это максимум byte, а не integer. year - тоже явно не integer. Ну и везде подобное хулиганство мамонта - нужно по-сокращать.
Остальной код мамонта пусть опытные программисты изучают и подсказывают.


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

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

Сообщение Mirage » 28.12.2017 13:34:59

wofs писал(а):как уменьшить расход памяти?


Раз это XML, то следует использовать SAX-парсер. Сейчас, видимо, используется DOM, который очень редко когда следует использовать.
Mirage
энтузиаст
 
Сообщения: 817
Зарегистрирован: 06.05.2005 20:29:07
Откуда: Russia

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

Сообщение LearnMagic » 28.12.2017 14:10:42

wofs писал(а):как уменьшить расход памяти?

Проблема скорее всего в фрагментации. Для её решения
SetLength(Result, n+1); (строка 354) заменить на SetLength(Result, Count); и перенести в строку перед циклом. Аналогичным образом поступить с SetLength(Result[i-1].delivery_options,j+1) - строка 507, SetLength(Result[i-1].outlets,j+1) - строка 574.
В функциях GetChildrenCategories, GetOffersByCategory, GetCurrencies добавить цикл для определения размера массива с последующим вызовом SetLength.
LearnMagic
новенький
 
Сообщения: 57
Зарегистрирован: 10.11.2016 23:13:38

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

Сообщение wofs » 28.12.2017 21:33:47

Mirage писал(а):Раз это XML, то следует использовать SAX-парсер. Сейчас, видимо, используется DOM, который очень редко когда следует использовать.

Здесь наткнулся на TXMLReader (точнее на возможность "Streamed reading"), если с DOM будет большой расход памяти, то буду использовать его (скорее всего буду).
vitaly_l писал(а):Например вот это явное излишество мамонта:

Виталий, такое ощущение, что в вас живет две противоположных личности :) Я видел ваш пост после публикации и теперь - эти посты писали разные люди :D
За замечания спасибо - поправлю.
LearnMagic писал(а):Проблема скорее всего в фрагментации. Для её решения

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

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

Сообщение wofs » 31.12.2017 02:17:21

LearnMagic
Да вы просто кудесник! Только поправив указанные строки (+ GetOffers) время импорта файла 52Мб сократилось с 4 минут до 3 секунд и потребление памяти с полностью занятой 5Гб до 324Мб (для справки - процедура открытия файла (без парсинга) занимает ~220Мб)!
Львиную долю памяти занимали фрагментированные массивы Categories и Offers.

vitaly_l
packed record тоже дал свой эффект минус ~ 25Мб.
Поменял Integer местами на byte. А вот попытка кроить строки привело к увеличению расхода памяти - оставил просто string.
Итог:
Код: Выделить всё
unit wYMLparser;
// YML Parser
// v. 0.0.1.7
//
// 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 = packed record
       name: string;
       unit_: string;
       text: string;
    end;

    //Age
    TAge = packed record
       year: byte;
       month: byte;
    end;

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

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

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

    // Category
    TCategory = packed 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 = packed record
       id: string;
       url: string;
       oldprice: double;
       price: double;
       price_from: boolean;
       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: byte;
       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 = packed record
       name: string;
       company: string;
       url: string;
       phone: string;
       platform: string;
       version: string;
       agency: string;
       email: string;
       cpa: byte;
       delivery_options: ArrayOfDeliveryOptions;
    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();
         function TryStrToByte(const s: string; out i: Byte): boolean;

       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.TryStrToByte(const s: string; out i : Byte) : boolean;
var Error : word;
begin
  Val(s, i, Error);
  if (Error = 0) and (i>=0) and (i<=255) then
      Result:= true else
    begin
      Result:= false;
      i:=0;
    end;
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);
       end;
    end;

    SetLength(Result,k);

    k:=0;

    for i:=0 to High(Categories) do
    begin
       if Categories[i].parentId = aCategory then
       begin
         inc(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);
       end;
    end;
    SetLength(Result,k);

    k:=0;
    for i:=0 to High(Offers) do
    begin
       if Offers[i].categoryId = aCategory then
       begin
         inc(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
            SetLength(Result, Count);

            for n:=0 to Count-1 do
            begin
               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
           SetLength(Result, Count);

           for n:=0 to Count-1 do
           begin
              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;
  _Node: TDomNode;
        //i - Nodies Count
        //n - NodeCildrens Count
        //k - Attributes.Items Count
        //j - Result.resultArray Count
begin
    try
      Result := nil;
      ChildNode:= nil;
      _Node:= nil;
      i:= 0;

      if not Assigned(aNode) then exit;

      aNode := aNode.FirstChild; // offer

      _Node:= aNode;
      while Assigned(_Node) do
      begin
         Inc(i);
         _Node := _Node.NextSibling;
      end;

      _Node:=nil;

      SetLength(Result,i);

      i:=0;
      while Assigned(aNode) do
      begin
        // Used ChildNodes
       Inc(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;
            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'          :
                                 begin
                                  TryStrToFloat(StringReplace(Item[n].TextContent,'.',fDecimalSeparator,[rfReplaceAll]),Result[i-1].price);
                                   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
                                         'from':
                                               begin
                                                  case LowerCase(Item[n].Attributes[k].NodeValue) of
                                                    'false': Result[i-1].price_from:= false;
                                                    'true': Result[i-1].price_from:= true
                                                    else Result[i-1].price_from:= false;
                                                  end;
                                               end;
                                       end;
                                     end;
                                   end else Result[i-1].price_from:= false;
                                 end;
                '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;
                '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;
                'typePrefix'      : Result[i-1].typePrefix:= Item[n].TextContent;
                'vendor'          : Result[i-1].vendor:= Item[n].TextContent;
                'model'           : Result[i-1].model:= 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
                                          SetLength(Result[i-1].delivery_options,Count);
                                          for j:=0 to Count-1 do
                                          begin
                                              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': TryStrToByte(Item[j].Attributes[k].NodeValue,Result[i-1].delivery_options[j].order_before);
                                                  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'              : TryStrToByte(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
                                          SetLength(Result[i-1].outlets,Count);
                                          for j:=0 to Count-1 do
                                          begin
                                              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'  : TryStrToByte(Item[n].TextContent,Result[i-1].age[j-1].year);
                                                'month' : TryStrToByte(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, j, k: 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'               : TryStrToByte(Item[n].TextContent,fShop.cpa);
                    'currencies'        : Currencies:= GetCurrencies(Item[n]);
                    'categories'        : Categories:= GetCategories(Item[n]);
                    'delivery-options'  :
                                         begin
                                           ChildNode:=nil;
                                           ChildNode:=Item[n];

                                           if Assigned(ChildNode) then
                                           begin
                                             with ChildNode.ChildNodes do
                                             begin
                                              try
                                                SetLength(fShop.delivery_options,Count);
                                                for j:=0 to Count-1 do
                                                begin
                                                    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,fShop.delivery_options[j].cost);
                                                          'days': fShop.delivery_options[j].days:= Item[j].Attributes[k].NodeValue;
                                                          'order-before': TryStrToByte(Item[j].Attributes[k].NodeValue,fShop.delivery_options[j].order_before);
                                                        end;
                                                      end;
                                                    end;
                                                end;
                                              finally
                                                Free;
                                              end;
                                             end; //with ChildNodes
                                           end;

                                           ChildNode:=nil;
                                         end;
                    '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
Тестовое приложение (Win64):
Бинарник: https://yadi.sk/d/niEpkBaj3R2sQN
После праздников попробую отказаться от DOM - посмотрим что это даст.

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

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

Сообщение zub » 31.12.2017 07:34:31

Конструкции типа
Код: Выделить всё
s:=s+' ';
Setlength(arr,length(arr)+1);

Это изнасилование производительности противоестественным способом в особо жёсткой форме.
По топику: попробуй обертки над массивом, например tvector. Если ты зарание знаешь нужную длину массива лучше не станет, если незнаешь- самое оно.
zub
долгожитель
 
Сообщения: 2458
Зарегистрирован: 14.11.2005 23:51:26

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

Сообщение vitaly_l » 31.12.2017 08:14:19

wofs писал(а):    //Age
    TAge = packed record
       year: byte;
       month: byte;
    end;

Поищите и прочтите ЛЮБУЮ книжку по программированию, т.к. Вы не знаете или не понимаете даже примитивных азов,

потому что: year - явно не byte!!! .

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

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

Сообщение LearnMagic » 31.12.2017 11:08:50

vitaly_l писал(а):...Поищите и прочтите ЛЮБУЮ книжку по программированию, т.к. Вы не знаете или не понимаете даже примитивных азов,
потому что: year - явно не byte!!! .

Ну зачем же так. Если за базу взять 1900, то 1900+255 = 2155. На мой взгляд вполне предостаточно. А если пойти в сторону оптимизации хранения, то можно взять word, первые четрые бита отвести под месяц, а оставшиеся 12 под год - получится диапазон 0..4095. :D
LearnMagic
новенький
 
Сообщения: 57
Зарегистрирован: 10.11.2016 23:13:38

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

Сообщение wofs » 31.12.2017 13:07:00

vitaly_l писал(а):
wofs писал(а):    //Age
    TAge = packed record
       year: byte;
       month: byte;
    end;

Поищите и прочтите ЛЮБУЮ книжку по программированию, т.к. Вы не знаете или не понимаете даже примитивных азов,

потому что: year - явно не byte!!! .

.

С чего это?
age
Возрастная категория товара.
В формате YML:

Годы задаются с помощью атрибута unit со значением year. Допустимые значения параметра age при unit="year": 0, 6, 12, 16, 18.

Месяцы задаются с помощью атрибута unit со значением month. Допустимые значения параметра age при unit="month": 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12.
https://yandex.ru/support/partnermarket/export/yml.html

Код: Выделить всё
Byte    0 .. 255
http://wiki.freepascal.org/Variables_and_Data_Types


Добавлено спустя 8 минут 16 секунд:
zub писал(а):Конструкции типа
Код: Выделить всё
s:=s+' ';
Setlength(arr,length(arr)+1);

Это изнасилование производительности противоестественным способом в особо жёсткой форме.

Я так понял это об этой строчке в Unit 1?
Код: Выделить всё
SetLength(_arr,High(_arr)+2);

А как лучше сделать в данном случае?

zub писал(а):По топику: попробуй обертки над массивом, например tvector. Если ты зарание знаешь нужную длину массива лучше не станет, если не знаешь- самое оно.

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

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

Сообщение vitaly_l » 31.12.2017 13:58:42

LearnMagic писал(а):Ну зачем же так. Если за базу взять 1900, то 1900+255 = 2155. На мой взгляд вполне предостаточно.

ужас! Ну ведь, абсолютно ясно, что недостаточно 255, если речь идёт например о возрасте художников или поделиях мамонтов!
wofs писал(а):С чего это?

Ну что опять за неуважение к художникам?
А если продаётся картина Рембрандта или поделие мамонта?
Вы об этом подумали?
Рембрандт издох в 1669. Сейчас 2017-8. 2018 - 1669 = 349 лет назад!!!
Разве: 349 - можно уместить в байт?

Дикари! Никакого уважения к Великим художникам!
А если в YML продаётся украшение или вино или картина возрастом 333 года, как быть?
А если там продаётся поделие мамонта?

И ещё раз напоминаю, ID - это не интеджер, а стринг не более 20 символов
(соблюдайте это правило YML, раз уж Вы выложили КОД на гитхаб, а тем более на этот форум).

wofs писал(а):в вас живет две противоположных личности

В нас живёт много художников и один программист.

Всех с наступающим!
.
Последний раз редактировалось vitaly_l 31.12.2017 14:14:33, всего редактировалось 1 раз.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

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

Сообщение wofs » 31.12.2017 14:11:06

vitaly_l писал(а):И ещё раз напоминаю, ID - это не интеджер, а стринг не более 20 символов
(соблюдайте это правило YML, раз уж Вы выложили КОД на гитхаб, а тем более на этот форум).

string ТОЛЬКО в
id — идентификатор предложения
https://yandex.ru/support/partnermarket ... le.html#id

И у меня там string
Код: Выделить всё
    TOffer = packed record
       id: string;


А к остальным идентификаторам требование такое (пример для категорий):
Требования к идентификаторам

Идентификаторы категорий и подкатегорий должны быть уникальными.

Все идентификаторы должны быть положительными целыми числами.

Идентификатор не может быть равен 0.
Максимальная длина идентификатора — 32 символа.
https://yandex.ru/support/partnermarket/categories.html

===============
vitaly_l писал(а):Дикари! Никакого уважения к Великим художникам!
А если в YML продаётся картина возрастом 333 года, как быть?

Виталию больше не наливать...
age
Возрастная категория товара.
В формате YML:

Годы задаются с помощью атрибута unit со значением year. Допустимые значения параметра age при unit="year": 0, 6, 12, 16, 18.

Месяцы задаются с помощью атрибута unit со значением month. Допустимые значения параметра age при unit="month": 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12.
https://yandex.ru/support/partnermarket/export/yml.html

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

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

Сообщение vitaly_l » 31.12.2017 14:27:07

wofs писал(а):То есть с 6 меяцев, с 16 лет...

Ну ладно тогда с меня вот такой предновогодний "подарок":
Вот такие и подобные громоздкие коды мамонта:
Код: Выделить всё
    Result:=nil;
    k:=0;
   
    for i:=0 to High(Categories) do
    begin
       if Categories[i].parentId = aCategory then
       begin
         inc(k);
       end;
    end;

    SetLength(Result,k);

    k:=0;

    for i:=0 to High(Categories) do
    begin
       if Categories[i].parentId = aCategory then
       begin
         inc(k);
         Result[k-1]:=Categories[i];
       end;
    end;

Замените примерно на вот такой художественный код:
Код: Выделить всё
    k:=0;
    SetLength(Result,High(Categories));

    for i:=0 to High(Categories) do
       if Categories[i].parentId = aCategory then begin         
         Result[k]:=Categories[i];
         inc(k);
       end;
   
    SetLength(Result,k);


И длинна модуля заметно сократится, скорость обработки увеличится, а в некоторых местах исчезнут неправильные SetLength.

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

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

Сообщение wofs » 31.12.2017 15:58:48

vitaly_l писал(а):Ну ладно тогда с меня вот такой предновогодний "подарок":

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

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

Сообщение vitaly_l » 31.12.2017 16:02:39

wofs писал(а):Тогда я выделю память под массив Result с 100500 элементами и помещу в него 4 нужных - где экономия?

Код функции/блока надо весь читать и понимать, а не только первую строчку.
Вот этот код: SetLength(Result,k); - для чего в конце моего примера?

А экономия в удалении кучи вычислений (в том числе и неправильных) и + в избавлении от сотен лишних циклов с априори ненужными вычислениями Count. А в ряде случаев, ещё и в удалении кучи ненужных переменных и операций с ними. После внесения изменений, размер вашего мамонт-модуля - сократится чуть ли не в два раза. Модуль станет, без ошибок, выполнять задачу за долю секунды, а не за три. И он ещё спрашивает: где экономия? ...

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

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

Сообщение wofs » 31.12.2017 16:40:35

vitaly_l писал(а):А экономия в удалении кучи вычислений (в том числе и неправильных) и + в избавлении от сотен лишних циклов с априори ненужными вычислениями Count.

То есть выделить кучу памяти под массив, а потом обрезать под фактическое количество элементов это норма?
vitaly_l писал(а): Модуль станет, без ошибок, выполнять задачу за долю секунды, а не за три.

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

Пред.След.

Вернуться в Lazarus

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

Сейчас этот форум просматривают: alps и гости: 7

Рейтинг@Mail.ru