Транслитерация

Интересные алгоритмы, олимпиадные задачи, эффектные и эффективные решения. freepascal, delphi, c, c++, c#, java, javascript, perl, ruby, python, php, bash, wsh и т.д. Компиляторы, интерпретаторы, линкеры, отладчики, системы контроля версий и многое другое.

Модератор: xdsl

Транслитерация

Сообщение xdsl 23 дек 2008, 09:47

Неоднокартно приходится сталкиваться с "проблемой русских имен файлов". Суть проблемы заключается в использовании различных кодировок в файловых системах на различных ОС, отсутствие у многих архиваторов поддержки кодировок или поддержки перевода имен файлов из одной кодировки в другую при архивации или разархивации (в выгодную сторону отличается 7zip), отсутствие понятия "кодировка" у ftp-серверов, проблемы с некорректным перекодированием имен файлов при доступе к контенту веб-серверов и т.д. и т.п. В результате невообразимое искажение имен файлов - гарантировано.

К счастью, существует универсальное (хотя и не для всех случаев подходящее) решение - перевод имен файлов, предназначенных для использования в одной из указанных ситуаций, в транслит. Желательно - с рекурсивным обходом каталога и поиском файлов по маске.

Скрипты для решения данной проблемы в Линуксе у меня давно есть, причем в двух вариантах - на php и bash. Однако буквально вчера пришлось из-заугольными методами копировать на линуксовый веб-сервер огромный каталог с рускоязычными файлами и каталогами. При наличии аналогичных утилит под виндовс проблемы не случилось-бы вообще. Самое интересное, что совершенно бесплатные утилиты для решения данной задачи в интернете без проблем находятся. Однако! Одним нужна java, другие делают кучу дополнительной работы, третьи написаны на visual basic и требуют установки дополнительных библиотек и т.д. В то время как нужна
    1. консольная утилита
    2. функционирующая на чистой, только-что установленной win32-системе.
    3. принимающая два параметра: каталог_для_поиска маска_транслитируемых_файлов
    4. НИЧЕГО, КРОМЕ УКАЗАННОГО - НЕ ДЕЛАЮЩАЯ
Погуглив достаточное время, такую утилиту, скорее всего найдем. Однако за это время можно две таких утилиты написать.
Один из моих сотрудников (студент пятого курса) пообещался по быстрому склепать такую утилиту сегодня вечером.
Если у него вдруг не случится праздник, не придут гости, не прорвет отопление (тук-тук по дереву чтоб не сглазить на таком морозе), не выключат свет и т.д. (господа студенты - дальше придумайте сами, вы в этом деле специалисты, знаю - сам таким был), то к утру получим рабочую вещь. Код выложим сюда, вычистим от возможным багов, ускорим, если понадобится.
Если-же один из форсмажоров (не)ожиданно случится, то сделаю завтра с утра ее сам на freepascal и тоже выложу.
В любом случае - получится полезная вещь.
xdsl
 
Сообщения: 1228
Зарегистрирован: 09 дек 2008, 05:16
Откуда: ВЦ ШГПИ
Полное имя: Слинкин Д.А.

Re: Транслитерация

Сообщение Kido.fm 23 дек 2008, 20:49

xdsl писал(а):Если у него вдруг не случится праздник, не придут гости, не прорвет отопление (тук-тук по дереву чтоб не сглазить на таком морозе), не выключат свет и т.д.

Ну вот, накаркали опять. И конечно же случилось ЧП. Ставил елку - обрезал пол пальца. но утилу сделал все равно. Истекая кровью, так сказать. Звезду бы надо, или орден...
Kido.fm
Elite
 
Сообщения: 12
Зарегистрирован: 18 дек 2008, 13:47
Полное имя: ftm

Re: Транслитерация

Сообщение Vladislav_133 23 дек 2008, 22:11

Для программирования нужна голова и всего один палец. Так что можете резать и резать.
Аватара пользователя
Vladislav_133
Elite
 
Сообщения: 1254
Зарегистрирован: 13 дек 2008, 18:08
Полное имя: П.В.Ю.

Re: Транслитерация

Сообщение xdsl 24 дек 2008, 10:30

Уже 10:30. Неужели истек кровью ....
xdsl
 
Сообщения: 1228
Зарегистрирован: 09 дек 2008, 05:16
Откуда: ВЦ ШГПИ
Полное имя: Слинкин Д.А.

Re: Транслитерация

Сообщение Kido.fm 24 дек 2008, 10:46

Vladislav_133 писал(а):Для программирования нужна голова и всего один палец.

для того чтобы кушать тоже зубы не нужны, только вот без зубов одну лишь кашку получится
Вложения
translit.7z
а вот, собственно, утилка
(23.83 Кб) Скачиваний: 260
Kido.fm
Elite
 
Сообщения: 12
Зарегистрирован: 18 дек 2008, 13:47
Полное имя: ftm

Re: Транслитерация

Сообщение xdsl 24 дек 2008, 14:25

Мы вскорости поюзаем
Политый кровью код
Ускорим, прокачаем,
Все баги заремарим,
Функционал поправим,
И встретим НОВЫЙ ГОД!
(c) xdsl
xdsl
 
Сообщения: 1228
Зарегистрирован: 09 дек 2008, 05:16
Откуда: ВЦ ШГПИ
Полное имя: Слинкин Д.А.

Re: Транслитерация

Сообщение xdsl 25 дек 2008, 05:15

Итак, имеем:
1. Заказчик xdsl, исполнитель fatum
2. Техническое задание, сформулированное в первом посте темы
3. Результирующий код на object pascal (в принципе, для перевода на freepascal достаточно заменить {$APPTYPE CONSOLE} на {$mode objfpc}):
Код: Выделить всё
{$APPTYPE CONSOLE}

uses
  SysUtils;
  var mask:string;

function perevod(iname:string):string;
var i:integer;
c:char;
begin
   result:='';
   for i:=1 to length(iname) do
          begin
            c:=iname[i];
            case c of
            'А': result:=result+'A';          'а': result:=result+'a';            'Б': result:=result+'B';
            'б': result:=result+'b';            'В': result:=result+'V';            'в': result:=result+'v';
            'Г': result:=result+'G';            'г': result:=result+'g';            'Д': result:=result+'D';
            'д': result:=result+'d';            'Е': result:=result+'E';            'е': result:=result+'e';
            'Ё': result:=result+'Yo';            'ё': result:=result+'yo';            'Ж': result:=result+'Zh';
            'ж': result:=result+'zh';            'З': result:=result+'Z';            'з': result:=result+'z';
            'И': result:=result+'I';            'и': result:=result+'i';            'Й': result:=result+'I';
            'й': result:=result+'i';            'К': result:=result+'K';            'к': result:=result+'k';
            'Л': result:=result+'L';            'л': result:=result+'l';            'М': result:=result+'M';
              'м': result:=result+'m';            'Н': result:=result+'N';            'н': result:=result+'n';
            'О': result:=result+'O';            'о': result:=result+'o';            'П': result:=result+'P';
            'п': result:=result+'p';            'Р': result:=result+'R';            'р': result:=result+'r';
            'С': result:=result+'S';            'с': result:=result+'s';            'Т': result:=result+'T';
            'т': result:=result+'t';            'У': result:=result+'U';            'у': result:=result+'u';
            'Ф': result:=result+'F';            'ф': result:=result+'f';            'Х': result:=result+'H';
            'х': result:=result+'h';            'Ц': result:=result+'Ts';            'ц': result:=result+'ts';
            'Ч': result:=result+'4';            'ч': result:=result+'4';            'Ш': result:=result+'Sh';
            'ш': result:=result+'sh';            'Щ': result:=result+'Chsh';            'щ': result:=result+'chsh';
            'Ъ': result:=result+'''' + '''';            'ъ': result:=result+'''' + '''';            'Ы': result:=result+'Y';
            'ы': result:=result+'y';            'Ь': result:=result+'''';            'ь': result:=result+'''';
            'Э': result:=result+'E';            'э': result:=result+'e';            'Ю': result:=result+'Yu';
            'ю': result:=result+'yu';            'Я': result:=result+'Ya';            'я': result:=result+'ya'
            else
             result:=result+c
            end
          end;
end;

procedure _rename(path:string);
var sr:TSearchRec;
iname,oname,ext:string;
begin
   if FindFirst(path+'*.*',faDirectory,sr)=0 then
    begin
      repeat
        if (sr.Attr and faAnyFile and not faDirectory)=sr.Attr then
        begin
          iname:=sr.Name;
          ext:=SysUtils.ExtractFileExt(iname);
          if (ext<>mask) and (mask<>'') then continue;
          oname:=perevod(iname);
          if (FileExists(path+oname))then
          oname:='';
          RenameFile(path+iname,path+oname);
        end
        else
        if (sr.Attr and faDirectory)=sr.Attr then
        begin
        if (sr.Name<>'..') and  (sr.Name<>'.') then
        _rename(path+sr.Name+'\');
        end;
      until FindNext(sr)<>0;

      FindClose(sr);
    end;
end;

var path:string;

begin
  if paramstr(1)='--help' then
  begin
  writeln('renfile - utilite for translate');
  writeln('russian file names to latin');
  writeln('Call with 2 parametres:');
  writeln('path - path to dir');
  writeln('ext - file extension. if exists, all files will be translated');
  exit;
  end;
  if paramstr(1)='' then
  begin
  writeln('Usage:');
  writeln('renfile <path> [mask]');
  writeln('for help use "renfile --help"');
  exit;
  end;

  path:=trim(paramstr(1));
  if  paramstr(2)='' then mask:='' else
  mask:=trim(paramstr(2));
  if not DirectoryExists(path) then begin
  writeln('Error! Directory not exists. Please check your parameter "path"');
  exit;
  end;
  if path[length(path)]<>'\' then path:=path+'\';
  _rename(path);
  writeln('press Enter...');
  readln;

end.
Взял на себя смелость и сделал пару косметических модификаций - исправил пару описок в сообщениях и ужал для лучшей представительности функцию perevod.

Исходное ТЗ:
    0. Транслитератор имён файлов с рекурсивным обходом каталогов
    1. консольная утилита
    2. функционирующая на чистой, только-что установленной win32-системе.
    3. принимающая два параметра: каталог_для_поиска маска_транслитируемых_файлов
    4. НИЧЕГО, КРОМЕ УКАЗАННОГО - НЕ ДЕЛАЮЩАЯ
С первого взгляда - все соответствует. Файлы транслитерируются. Консольно. Без дополнительных библиотек. Утилита с двумя параметрами. Никаких дополнительных действий (сообщения об ошибках в наборе параметров и help-страницу будем считать неизбежной рюшечкой).

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

1. В ТЗ ничего не сказано о переименовании каталогов. Заказчика понять можно - он работает в линуксе, где всё является файлом - и регулярный файл, и каталог, и сокет, и пайп, и раздел жесткого диска и т.п. Исполнителя то-же понять можно - он пишет программу для виндовс, где файл и каталог - разные категории. Результат вполне очевиден - программа переименовывает ТОЛЬКО ФАЙЛЫ, оставляя рускоязычные каталоги без модификаций. К счастью, исправление данного недочёта решается добавлением одной строки

2. Вдогонку первому пункту. Вполне логичным явилось-бы добавление третьего параметра - маска_транслитерируемых_каталогов

3. В ТЗ нераскрыто понятие "маска_транслитируемых_файлов". В результате под маской исполнитель понимает расширение файла, а заказчик - классическое понимание маски (globbing). Примеры: рисунок*.*, *.*, *.avi, *.jp* и т.д. Исправление - нетривиально и, возможно, потребует полного переписывания функции _rename (лично я аналога юниксового glob в свежеустановленном виндовсе не знаю, разве что в дотнете, но желания нет жертвовать 3-4 кратным замедлением работы программы после переписывания ее на С#, а также требовать наличия дотнет на любой виндовс системе)

4. В ТЗ не сказано, что делать в ситуации, когда имя транслитерируемого файла уже занято. Другим файлом или каталогом. В результате исполнитель только фиксирует данный факт и ничего не предпринимает.

Суммарно эти недостатки приводят к тому, что для задач, решаемых заказчиком, данная утилита не подходит. В реальной жизни с этой точки начинаются препирательства между заказчиком и исполнителем, иногда решаемые миром, а иногда доходящие до судебных разбирательств. Мы выбираем мирный вариант ;). Поле для деятельности расчищенно, готовлю свои варианты кода и жду код от всех желающих принять участие в обсуждении.

P.S. Думаю, разговор об оптимизации кода утилиты следует отложить до момента, когда она будет полностью удовлетворять нуждам заказчика. Однако уже сейчас можно увидеть низкую эффективность функции perevod, связанную с активными строковыми манипуляциями, скорость которых в паскале невысока. Дополнительно, данную функцию в ее исходном виде будет сложно модифицировать в транслитерацию имен файлов из неоднобайтной кодировки (например - из UTF-8). Для текущей задачи это несущественно, но с точки зрения возможного дальнейшего кроссплатформенного применения становится актульным.
xdsl
 
Сообщения: 1228
Зарегистрирован: 09 дек 2008, 05:16
Откуда: ВЦ ШГПИ
Полное имя: Слинкин Д.А.

Re: Транслитерация

Сообщение xdsl 25 дек 2008, 12:29

xdsl писал(а):2. Вдогонку первому пункту. Вполне логичным явилось-бы добавление третьего параметра - маска_транслитерируемых_каталогов

Этот пункт стоит уточнить. Рекурсивный обход должен быть полным. А вот переименование каталогов - подчиняться маске. Отсутствие маски = *.*. Как для каталогов, так и для файлов.
xdsl
 
Сообщения: 1228
Зарегистрирован: 09 дек 2008, 05:16
Откуда: ВЦ ШГПИ
Полное имя: Слинкин Д.А.

Re: Транслитерация

Сообщение xdsl 25 дек 2008, 21:02

Сделал вариант с двумя проходами по содержимому каталога, с учетом масок транслитерируемых каталогов и файлов. Все работает, но два прохода ... Крайне неэффективно. Вообщем - сделаю на досуге однопроходник с аналогом юниксового glob(), оценю скорость работы и выложу лучший вариант.
xdsl
 
Сообщения: 1228
Зарегистрирован: 09 дек 2008, 05:16
Откуда: ВЦ ШГПИ
Полное имя: Слинкин Д.А.

Re: Транслитерация

Сообщение xdsl 26 дек 2008, 00:39

Ну вот, что получилось.
Код: Выделить всё
{$define info}
{$mode objfpc}
{$H+}

uses
  Windows,SysUtils,strutils;

const iUsage='Usage:'#10
  +' translit <path> [filemask] [dirmask]'#10
  +'  path - path to directory'#10
  +'  filemask - mask of files. if not exists, all files will be translated'#10
  +'  dirmask - mask of dirs. if not exists, all dirs will be translated';
const iDescription='"translit" - convert russian filenames to translit';
const eDirNotExists='Error! Directory not exists. Please check your first parameter';
const defaultExt='._';

type tMask=(fmask,dmask);
const Masks:array[tMask] of string = ('*','*');

var path:string;

function perevod(iname:string):string;
var i:integer;
c:char;
begin
   result:='';
   for i:=1 to length(iname) do
          begin
            c:=iname[i];
            case c of
            'А': result:=result+'A'; 'а': result:=result+'a'; 'Б': result:=result+'B'; 'б': result:=result+'b';
            'В': result:=result+'V'; 'в': result:=result+'v'; 'Г': result:=result+'G'; 'г': result:=result+'g';
            'Д': result:=result+'D'; 'д': result:=result+'d'; 'Е': result:=result+'E'; 'е': result:=result+'e';
            'Ё': result:=result+'Yo'; 'ё': result:=result+'yo'; 'Ж': result:=result+'Zh'; 'ж': result:=result+'zh';
            'З': result:=result+'Z';  'з': result:=result+'z'; 'И': result:=result+'I';  'и': result:=result+'i';
            'Й': result:=result+'I';  'й': result:=result+'i'; 'К': result:=result+'K';  'к': result:=result+'k';
            'Л': result:=result+'L';  'л': result:=result+'l'; 'М': result:=result+'M';  'м': result:=result+'m';
            'Н': result:=result+'N';  'н': result:=result+'n'; 'О': result:=result+'O';  'о': result:=result+'o';
            'П': result:=result+'P';  'п': result:=result+'p'; 'Р': result:=result+'R';  'р': result:=result+'r';
            'С': result:=result+'S';  'с': result:=result+'s'; 'Т': result:=result+'T';  'т': result:=result+'t';
            'У': result:=result+'U';  'у': result:=result+'u'; 'Ф': result:=result+'F';  'ф': result:=result+'f';
            'Х': result:=result+'H';  'х': result:=result+'h'; 'Ц': result:=result+'Ts'; 'ц': result:=result+'ts';
            'Ч': result:=result+'4';  'ч': result:=result+'4'; 'Ш': result:=result+'Sh'; 'ш': result:=result+'sh';
            'Щ': result:=result+'Chsh'; 'щ': result:=result+'chsh';
            'Ъ': result:=result+'''' + ''''; 'ъ': result:=result+'''' + '''';
            'Ы': result:=result+'Y'; 'ы': result:=result+'y'; 'Ь': result:=result+''''; 'ь': result:=result+'''';
            'Э': result:=result+'E';  'э': result:=result+'e'; 'Ю': result:=result+'Yu'; 'ю': result:=result+'yu';
            'Я': result:=result+'Ya'; 'я': result:=result+'ya'; ' ': result:=result+'_'
            else
            result:=result+c
            end
          end;
end;


procedure translit(path:string);
var sr:TSearchRec;
    iname,oname,ext:string;
    mask:string;
    dir:boolean;
begin
   if FindFirst(path+'*.*',faAnyFile,sr)=0 then
    repeat   
     if (sr.name='.') or (sr.name='..') then continue;
     iname:=sr.name;
     dir:=boolean(sr.attr and faDirectory);
     if dir then begin   
      translit(path+iname+'\');
      mask:=Masks[dmask];
     end
     else
      mask:=Masks[fmask];
     if not isWild(iname,mask,true) then continue;
     oname:=perevod(iname);
     if iname=oname then continue;
     ext:=ExtractFileExt(oname); if ext='' then ext:=defaultExt;
     iname:=path+iname; oname:=path+oname;
     while GetFileAttributes(PChar(oname))<>$ffffffff do oname:=oname+ext;
     RenameFile(iname,oname);
{$ifdef info}
     ansitooem(pchar(iname),pchar(iname));
     ansitooem(pchar(oname),pchar(oname));
     if not dir then write('File: ') else write('Dir: ');
     writeln(iname,' -> ',oname);
{$endif}
    until FindNext(sr)<>0;
    FindClose(sr);
end;

begin
  if paramcount=0 then begin
   writeln(iDescription); writeln(iUsage);
   exit;
  end;
  path:=paramstr(1); 
  writeln(path);
  if not DirectoryExists(path) then begin
   writeln(eDirNotExists); writeln(iUsage);
   exit;
  end;
  if paramcount>1 then Masks[fmask]:=paramstr(2);
  if paramcount>2 then Masks[dmask]:=paramstr(3);
  if path[length(path)]<>'\' then path:=path+'\';
  translit(path);
end.

Повезло, что не пришлось самому делать глоббинг. Вовремя глянул в исходники и нашел функцию isWild в модуле strutils. Ее код, судя по исходникам, не особо эффективен, но работоспособен.
Теперь работает как маска файлов, так и маска каталогов.
Осталось оптимизировать код функции perevod и будет вполне приличная утилита. А если тюнинг isWild провести - вообще конфетка получится. Правда эксперимент показал, что 10 тысяч файлов с именами по 10 символов длиной переименовывает за 15 секунд. И это - в виртуальной машине. Так что особого смысла в тюнинге пока не вижу.
xdsl
 
Сообщения: 1228
Зарегистрирован: 09 дек 2008, 05:16
Откуда: ВЦ ШГПИ
Полное имя: Слинкин Д.А.

Re: Транслитерация

Сообщение xdsl 27 дек 2008, 20:36

Кстати, стандарт ГОСТ 7.79-2000 (ИСО 9-95) определяет правила транслитерации для любых кириллических алфавитов. Самое главное - обеспечивает восстановимое преобразование. Т.е. транслитерированный текст однозначным образом переводится из латиницы обратно в кириллицу. Соответственно, при любых модификациях функции perevod() логично было-бы брать правила перевода из этого стандарта.
Вложения
gost7_79.htm.gz
Сам стандарт
(10.13 Кб) Скачиваний: 243
xdsl
 
Сообщения: 1228
Зарегистрирован: 09 дек 2008, 05:16
Откуда: ВЦ ШГПИ
Полное имя: Слинкин Д.А.

Re: Транслитерация

Сообщение alekam 24 мар 2009, 00:51

предлагаю улучшение для ваших алгоритмов. вместо блока кэйсов использовать ассоциированный массив, где ключи - буквы русского языка, значания - символы транслита.
alekam
 
Сообщения: 46
Зарегистрирован: 23 дек 2008, 14:36
Полное имя: A.K.

Re: Транслитерация

Сообщение xdsl 24 мар 2009, 08:22

Эх, где-ж его в Паскале взять, ассоциативный массив... На php эквивалент давно уже так и сделал, но у php - своя ниша применения, с паскалем пересекается редко.
Код: Выделить всё
function translit($str)
{
$rf=array
("й"=>"j","ц"=>"c","у"=>"u","к"=>"k","е"=>"e","н"=>"n","г"=>"g","ш"=>"sh","щ"=>"shj","з"=>"z","х"=>"h","ъ"=>"j",
"ф"=>"f","ы"=>"ji","в"=>"w","а"=>"a","п"=>"p","р"=>"r","о"=>"o","л"=>"l","д"=>"d","ж"=>"j","э"=>"je","я"=>"ja",
"ч"=>"ch","с"=>"s","м"=>"m","и"=>"i","т"=>"t","ь"=>"j","б"=>"b","ю"=>"ju","ё"=>"jo"," "=>"_"
);
foreach ($rf as $k=>$v) $str=mb_ereg_replace($k,$v,$str);
return $str;
}
xdsl
 
Сообщения: 1228
Зарегистрирован: 09 дек 2008, 05:16
Откуда: ВЦ ШГПИ
Полное имя: Слинкин Д.А.


Вернуться в Алгоритмизация и программирование

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

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

cron