Предложение по модулю LConvEncoding

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

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

Ответить

Предложение по модулю LConvEncoding

Сообщение v-t-l » 31.01.2012 10:21:10

Имеющаяся в модуле функция ConvertEncoding не очень эффективна при частых многократных вызовах.
Поэтому предлагаю добавить в модуль LConvEncoding подобные функции:
Код: Выделить всё
function DontConvert(const s:string):string;
begin
  Result := s;
end;

function GetToUTF8Function(const FromEncoding:string): TConvertEncodingFunction;
var
  AEnc, SysEnc : String;
begin
  Result := @DontConvert;
  AEnc:=NormalizeEncoding(FromEncoding);
  SysEnc:=NormalizeEncoding(GetDefaultTextEncoding);
  if AEnc=EncodingAnsi then AEnc:=SysEnc;
  if (AEnc='') or (AEnc=EncodingUTF8) then
  begin
    Exit;
  end;
  if AEnc=EncodingUTF8BOM then begin Result:=@UTF8BOMToUTF8; exit; end;
  if AEnc='iso88591' then begin Result:=@ISO_8859_1ToUTF8; exit; end;
  if AEnc='iso88592' then begin Result:=@ISO_8859_2ToUTF8; exit; end;
  if AEnc='cp1250' then begin Result:=@CP1250ToUTF8; exit; end;
  if AEnc='cp1251' then begin Result:=@CP1251ToUTF8; exit; end;
  if AEnc='cp1252' then begin Result:=@CP1252ToUTF8; exit; end;
  if AEnc='cp1253' then begin Result:=@CP1253ToUTF8; exit; end;
  if AEnc='cp1254' then begin Result:=@CP1254ToUTF8; exit; end;
  if AEnc='cp1255' then begin Result:=@CP1255ToUTF8; exit; end;
  if AEnc='cp1256' then begin Result:=@CP1256ToUTF8; exit; end;
  if AEnc='cp1257' then begin Result:=@CP1257ToUTF8; exit; end;
  if AEnc='cp1258' then begin Result:=@CP1258ToUTF8; exit; end;
  if AEnc='cp437' then begin  Result:=@CP437ToUTF8;  exit; end;
  if AEnc='cp850' then begin  Result:=@CP850ToUTF8;  exit; end;
  if AEnc='cp852' then begin  Result:=@CP852ToUTF8;  exit; end;
  if AEnc='cp866' then begin  Result:=@CP866ToUTF8;  exit; end;
  if AEnc='cp874' then begin  Result:=@CP874ToUTF8;  exit; end;
  if AEnc='cp936' then begin  Result:=@CP936ToUTF8;  exit; end;
  if AEnc='cp950' then begin  Result:=@CP950ToUTF8;  exit; end;
  if AEnc='cp949' then begin  Result:=@CP949ToUTF8;  exit; end;
  if AEnc='cp932' then begin  Result:=@CP932ToUTF8;  exit; end;
  if AEnc='koi8'  then begin  Result:=@KOI8ToUTF8;   exit; end;
  if AEnc=EncodingUCS2LE then begin Result:=@UCS2LEToUTF8; exit; end;
  if AEnc=EncodingUCS2BE then begin Result:=@UCS2BEToUTF8; exit; end;
  if (AEnc=SysEnc) and Assigned(ConvertAnsiToUTF8) then begin
    Result:=ConvertAnsiToUTF8;
    exit;
  end;
  {$ifdef EnableIconvEnc}
  Result:=nil;
  {$endif}
end;

function GetFromUTF8Function(const ToEncoding:string): TConvertEncodingFunction;
var
  AEnc, SysEnc : String;
begin
  Result := @DontConvert;
  AEnc:=NormalizeEncoding(ToEncoding);
  SysEnc:=NormalizeEncoding(GetDefaultTextEncoding);
  if AEnc=EncodingAnsi then AEnc:=SysEnc;
  if (AEnc='') or (AEnc=EncodingUTF8) then
  begin
    Exit;
  end;
  if AEnc=EncodingUTF8BOM then begin Result:=@UTF8ToUTF8BOM; exit; end;
  if AEnc='iso88591' then begin Result:=@UTF8ToISO_8859_1; exit; end;
  if AEnc='iso88592' then begin Result:=@UTF8ToISO_8859_2; exit; end;
  if AEnc='cp1250' then begin Result:=@UTF8ToCP1250; exit; end;
  if AEnc='cp1251' then begin Result:=@UTF8ToCP1251; exit; end;
  if AEnc='cp1252' then begin Result:=@UTF8ToCP1252; exit; end;
  if AEnc='cp1253' then begin Result:=@UTF8ToCP1253; exit; end;
  if AEnc='cp1254' then begin Result:=@UTF8ToCP1254; exit; end;
  if AEnc='cp1255' then begin Result:=@UTF8ToCP1255; exit; end;
  if AEnc='cp1256' then begin Result:=@UTF8ToCP1256; exit; end;
  if AEnc='cp1257' then begin Result:=@UTF8ToCP1257; exit; end;
  if AEnc='cp1258' then begin Result:=@UTF8ToCP1258; exit; end;
  if AEnc='cp437' then begin  Result:=@UTF8ToCP437;  exit; end;
  if AEnc='cp850' then begin  Result:=@UTF8ToCP850;  exit; end;
  if AEnc='cp852' then begin  Result:=@UTF8ToCP852;  exit; end;
  if AEnc='cp866' then begin  Result:=@UTF8ToCP866;  exit; end;
  if AEnc='cp874' then begin  Result:=@UTF8ToCP874;  exit; end;
  if AEnc='cp936' then begin  Result:=@UTF8ToCP936;  exit; end;
  if AEnc='cp950' then begin  Result:=@UTF8ToCP950;  exit; end;
  if AEnc='cp949' then begin  Result:=@UTF8ToCP949;  exit; end;
  if AEnc='cp932' then begin  Result:=@UTF8ToCP932;  exit; end;
  if AEnc='koi8'  then begin  Result:=@UTF8ToKOI8;   exit; end;
  if AEnc=EncodingUCS2LE then begin Result:=@UTF8ToUCS2LE; exit; end;
  if AEnc=EncodingUCS2BE then begin Result:=@UTF8ToUCS2BE; exit; end;
  if (AEnc=SysEnc) and Assigned(ConvertUTF8ToAnsi) then begin
    Result:=ConvertUTF8ToAnsi;
    exit;
  end;
  {$ifdef EnableIconvEnc}
  Result:=nil;
  {$endif}
end;

тогда функцию ConvertEncoding можно было бы упростить
Код: Выделить всё
function ConvertEncoding(const s, FromEncoding, ToEncoding: string): string;
var
  aToUTF8, aFromUTF8: TConvertEncodingFunction;
  {$ifdef EnableIconvEnc}
  Dummy: String;
  {$endif}
begin
  aToUTF8 := GetToUTF8Function(FromEncoding);
  aFromUTF8 := GetFromUTF8Function(ToEncoding);
  {$ifdef EnableIconvEnc}
  if (aToUTF8=nil) or (aFromUTF8=nil) then
  try
    if not IconvLibFound and not InitIconv(Dummy) then
    begin
      {$IFNDEF DisableChecks}
      DebugLn(['Can not init iconv: ',Dummy]);
      {$ENDIF}
      Exit;
    end;
    if Iconvert(s, Result, FromEncoding, ToEncoding)<>0 then
    begin
      Result:=s;
      Exit;
    end;
  except
  end
  else
    Result := aFromUTF8(aToUTF8(s));
  {$else}
  Result := aFromUTF8(aToUTF8(s));
  {$endif}
end;
v-t-l
энтузиаст
 
Сообщения: 728
Зарегистрирован: 13.05.2007 16:27:22
Откуда: Belarus
Вернуться к началу

Re: Предложение по модулю LConvEncoding

Сообщение Odyssey » 31.01.2012 13:57:26

В целом выглядит толково, хотя есть замечания:
1) Если внутренних функций для перекодирования не было найдено, iconv разрешён (EnableIconvEnc defined), но его не удалось найти или загрузить ('Can not init iconv: '), то результат функции останется неопределённым, а должен быть равен входной строке.
2) Можно ещё немного ускорить, если заставить GetToUTF8Function и GetFromUTF8Function возвращать Boolean, а найденную функцию возвращать через out-параметр. Тогда можно будет вызывать функции прямо из проверки условия и за счёт short-circuit evaluation если одна функция не найдена, вторая даже не будет искаться:
Код: Выделить всё
if not ((GetToUTF8Function(aToUTF8)) and (GetToUTF8Function(aFromUTF8))) then
Это также позволит убрать ifdef и возврат nil из функций поиска.

Только чтобы изменения попали в Lazarus нужно
1) Сделать патч и отправить его в багтрекер (http://bugs.freepascal.org/);
2) Желательно приложить к патчу тестовый пример, который показывает, что ничего не ломается, и что эффективность повышается.
Odyssey
энтузиаст
 
Сообщения: 580
Зарегистрирован: 29.11.2007 17:32:24
Вернуться к началу

Re: Предложение по модулю LConvEncoding

Сообщение Ask » 31.01.2012 18:24:34

Можно к тому же заменить кучу if-ов на case.
Ask
постоялец
 
Сообщения: 163
Зарегистрирован: 25.12.2008 03:51:37
Вернуться к началу

Re: Предложение по модулю LConvEncoding

Сообщение v-t-l » 01.02.2012 11:22:51

Сейчас нет времени (и сил - начало года - министерства не дремлют, новые указивы, отчетность и т.п.), если у кого найдется - welcome. Только номер в багтрекере отпишите здесь, пожалуйста.
v-t-l
энтузиаст
 
Сообщения: 728
Зарегистрирован: 13.05.2007 16:27:22
Откуда: Belarus
Вернуться к началу

Re: Предложение по модулю LConvEncoding

Сообщение mrkaban » 31.05.2016 18:21:58

v-t-l писал(а):Имеющаяся в модуле функция ConvertEncoding не очень эффективна при частых многократных вызовах.
Поэтому предлагаю добавить в модуль LConvEncoding подобные функции:
Код: Выделить всё
function DontConvert(const s:string):string;
begin
  Result := s;
end;

function GetToUTF8Function(const FromEncoding:string): TConvertEncodingFunction;
var
  AEnc, SysEnc : String;
begin
  Result := @DontConvert;
  AEnc:=NormalizeEncoding(FromEncoding);
  SysEnc:=NormalizeEncoding(GetDefaultTextEncoding);
  if AEnc=EncodingAnsi then AEnc:=SysEnc;
  if (AEnc='') or (AEnc=EncodingUTF8) then
  begin
    Exit;
  end;
  if AEnc=EncodingUTF8BOM then begin Result:=@UTF8BOMToUTF8; exit; end;
  if AEnc='iso88591' then begin Result:=@ISO_8859_1ToUTF8; exit; end;
  if AEnc='iso88592' then begin Result:=@ISO_8859_2ToUTF8; exit; end;
  if AEnc='cp1250' then begin Result:=@CP1250ToUTF8; exit; end;
  if AEnc='cp1251' then begin Result:=@CP1251ToUTF8; exit; end;
  if AEnc='cp1252' then begin Result:=@CP1252ToUTF8; exit; end;
  if AEnc='cp1253' then begin Result:=@CP1253ToUTF8; exit; end;
  if AEnc='cp1254' then begin Result:=@CP1254ToUTF8; exit; end;
  if AEnc='cp1255' then begin Result:=@CP1255ToUTF8; exit; end;
  if AEnc='cp1256' then begin Result:=@CP1256ToUTF8; exit; end;
  if AEnc='cp1257' then begin Result:=@CP1257ToUTF8; exit; end;
  if AEnc='cp1258' then begin Result:=@CP1258ToUTF8; exit; end;
  if AEnc='cp437' then begin  Result:=@CP437ToUTF8;  exit; end;
  if AEnc='cp850' then begin  Result:=@CP850ToUTF8;  exit; end;
  if AEnc='cp852' then begin  Result:=@CP852ToUTF8;  exit; end;
  if AEnc='cp866' then begin  Result:=@CP866ToUTF8;  exit; end;
  if AEnc='cp874' then begin  Result:=@CP874ToUTF8;  exit; end;
  if AEnc='cp936' then begin  Result:=@CP936ToUTF8;  exit; end;
  if AEnc='cp950' then begin  Result:=@CP950ToUTF8;  exit; end;
  if AEnc='cp949' then begin  Result:=@CP949ToUTF8;  exit; end;
  if AEnc='cp932' then begin  Result:=@CP932ToUTF8;  exit; end;
  if AEnc='koi8'  then begin  Result:=@KOI8ToUTF8;   exit; end;
  if AEnc=EncodingUCS2LE then begin Result:=@UCS2LEToUTF8; exit; end;
  if AEnc=EncodingUCS2BE then begin Result:=@UCS2BEToUTF8; exit; end;
  if (AEnc=SysEnc) and Assigned(ConvertAnsiToUTF8) then begin
    Result:=ConvertAnsiToUTF8;
    exit;
  end;
  {$ifdef EnableIconvEnc}
  Result:=nil;
  {$endif}
end;

function GetFromUTF8Function(const ToEncoding:string): TConvertEncodingFunction;
var
  AEnc, SysEnc : String;
begin
  Result := @DontConvert;
  AEnc:=NormalizeEncoding(ToEncoding);
  SysEnc:=NormalizeEncoding(GetDefaultTextEncoding);
  if AEnc=EncodingAnsi then AEnc:=SysEnc;
  if (AEnc='') or (AEnc=EncodingUTF8) then
  begin
    Exit;
  end;
  if AEnc=EncodingUTF8BOM then begin Result:=@UTF8ToUTF8BOM; exit; end;
  if AEnc='iso88591' then begin Result:=@UTF8ToISO_8859_1; exit; end;
  if AEnc='iso88592' then begin Result:=@UTF8ToISO_8859_2; exit; end;
  if AEnc='cp1250' then begin Result:=@UTF8ToCP1250; exit; end;
  if AEnc='cp1251' then begin Result:=@UTF8ToCP1251; exit; end;
  if AEnc='cp1252' then begin Result:=@UTF8ToCP1252; exit; end;
  if AEnc='cp1253' then begin Result:=@UTF8ToCP1253; exit; end;
  if AEnc='cp1254' then begin Result:=@UTF8ToCP1254; exit; end;
  if AEnc='cp1255' then begin Result:=@UTF8ToCP1255; exit; end;
  if AEnc='cp1256' then begin Result:=@UTF8ToCP1256; exit; end;
  if AEnc='cp1257' then begin Result:=@UTF8ToCP1257; exit; end;
  if AEnc='cp1258' then begin Result:=@UTF8ToCP1258; exit; end;
  if AEnc='cp437' then begin  Result:=@UTF8ToCP437;  exit; end;
  if AEnc='cp850' then begin  Result:=@UTF8ToCP850;  exit; end;
  if AEnc='cp852' then begin  Result:=@UTF8ToCP852;  exit; end;
  if AEnc='cp866' then begin  Result:=@UTF8ToCP866;  exit; end;
  if AEnc='cp874' then begin  Result:=@UTF8ToCP874;  exit; end;
  if AEnc='cp936' then begin  Result:=@UTF8ToCP936;  exit; end;
  if AEnc='cp950' then begin  Result:=@UTF8ToCP950;  exit; end;
  if AEnc='cp949' then begin  Result:=@UTF8ToCP949;  exit; end;
  if AEnc='cp932' then begin  Result:=@UTF8ToCP932;  exit; end;
  if AEnc='koi8'  then begin  Result:=@UTF8ToKOI8;   exit; end;
  if AEnc=EncodingUCS2LE then begin Result:=@UTF8ToUCS2LE; exit; end;
  if AEnc=EncodingUCS2BE then begin Result:=@UTF8ToUCS2BE; exit; end;
  if (AEnc=SysEnc) and Assigned(ConvertUTF8ToAnsi) then begin
    Result:=ConvertUTF8ToAnsi;
    exit;
  end;
  {$ifdef EnableIconvEnc}
  Result:=nil;
  {$endif}
end;

тогда функцию ConvertEncoding можно было бы упростить
Код: Выделить всё
function ConvertEncoding(const s, FromEncoding, ToEncoding: string): string;
var
  aToUTF8, aFromUTF8: TConvertEncodingFunction;
  {$ifdef EnableIconvEnc}
  Dummy: String;
  {$endif}
begin
  aToUTF8 := GetToUTF8Function(FromEncoding);
  aFromUTF8 := GetFromUTF8Function(ToEncoding);
  {$ifdef EnableIconvEnc}
  if (aToUTF8=nil) or (aFromUTF8=nil) then
  try
    if not IconvLibFound and not InitIconv(Dummy) then
    begin
      {$IFNDEF DisableChecks}
      DebugLn(['Can not init iconv: ',Dummy]);
      {$ENDIF}
      Exit;
    end;
    if Iconvert(s, Result, FromEncoding, ToEncoding)<>0 then
    begin
      Result:=s;
      Exit;
    end;
  except
  end
  else
    Result := aFromUTF8(aToUTF8(s));
  {$else}
  Result := aFromUTF8(aToUTF8(s));
  {$endif}
end;

Спасибо, пашет!
mrkaban
новенький
 
Сообщения: 55
Зарегистрирован: 28.05.2016 09:48:18
Вернуться к началу
Ответить

Вернуться в Lazarus

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

Сейчас этот форум просматривают: Google [Bot] и гости: 88

Powered by phpBB® Forum Software © phpBB Group
Русская поддержка phpBB
Рейтинг@Mail.ru