File Coverage

blib/lib/Octets/To/Unicode.pm
Criterion Covered Total %
statement 40 64 62.5
branch 8 24 33.3
condition 1 2 50.0
subroutine 8 14 57.1
pod 8 8 100.0
total 65 112 58.0


line stmt bran cond sub pod time code
1             use 5.008001;
2 2     2   1284 use utf8;
  2         6  
3 2     2   9 use strict;
  2         4  
  2         8  
4 2     2   36 use warnings FATAL => 'all';
  2         2  
  2         55  
5 2     2   10  
  2         3  
  2         206  
6             our $VERSION = "0.03";
7              
8             require Exporter;
9             our @ISA = qw(Exporter);
10             our @EXPORT =
11             grep { *{ $Octets::To::Unicode::{$_} }{CODE} } keys %Octets::To::Unicode::;
12              
13             use Encode qw//;
14 2     2   597  
  2         8677  
  2         141  
15             #@category Кодировка
16              
17             # Определяет кодировку.
18             # В koi8-r и в cp1251 большие и малые буквы как бы поменялись местами, поэтому у правильной кодировки вес будет больше
19             my ($s) = @_;
20             my $c = 0;
21 16     16 1 23 while ( $s =~ /[а-яё]+/gi ) {
22 16         18 my $x = $&;
23 2     2   9 if ( $x =~ /^[А-ЯЁа-яё][а-яё]*$/ ) { $c += length $x }
  2         4  
  2         31  
  16         49  
24 52         81 else { $c -= length $x }
25 52 100       120 }
  46         113  
26 6         18 $c;
27             }
28 16         37  
29             # Определить кодировку и декодировать
30             my ( $octets, $encodings ) = @_;
31              
32             return if !length $octets;
33 4     4 1 2886  
34             utf8::encode($octets) if utf8::is_utf8($octets);
35 4 50       11  
36             $encodings //= [qw/utf-8 cp1251 koi8-r/];
37 4 100       12  
38             my @x = grep length $_->[0], map {
39 4   50     21  
40             # В случае ошибки Encode::decode помещает пустую строку в свой второй аргумент. Какой-то баг.
41             my $save = $octets;
42             eval { [ Encode::decode( $_, $save, Encode::FB_CROAK ), $_ ] };
43             } @$encodings;
44 4         6  
  12         486  
45 12         14 my ( $unicode, $mem_encoding );
  12         21  
46             ( $unicode, $mem_encoding ) = @{ $x[0] } if @x == 1;
47              
48 4         100 if ( @x > 1 ) {
49 4 50       8 ( $unicode, $mem_encoding ) =
  0         0  
50             @{ ( sort { bohemy( $b->[0] ) <=> bohemy( $a->[0] ) } @x )[0] };
51 4 50       6 }
52              
53 4         5 wantarray ? ( $unicode, $mem_encoding ) : $unicode;
  4         24  
  8         10  
54             }
55              
56 4 50       26 # Определить кодировку
57             ( decode @_ )[1];
58             }
59              
60             #@category Вспомогательные функции
61 0     0 1    
62             # Ищет файлы в директориях рекурсивно
63             sub file_find($);
64              
65             my ($file) = @_;
66             if ( -d $file ) {
67             $file =~ s!/$!!;
68             map file_find($_), <$file/*>;
69             }
70 0     0 1   else {
71 0 0         $file;
72 0           }
73 0           }
74              
75             # Чтение бинарного файла
76 0           my ($file) = @_;
77             open my $f, "<", $file
78             or die "При открытии для чтения $file произошла ошибка: $!.";
79             read $f, my $buf, -s $f;
80             close $f;
81             $buf;
82 0     0 1   }
83 0 0          
84             # Запись в бинарный файл
85 0           my ( $file, $unicode ) = @_;
86 0            
87 0           utf8::encode($unicode) if utf8::is_utf8($unicode);
88              
89             open my $f, ">", $file
90             or die "При открытии для записи $file произошла ошибка: $!.";
91             print $f $unicode;
92 0     0 1   close $f;
93             return;
94 0 0         }
95              
96 0 0         # Определить кодировку и декодировать файл
97             my ( $file, $encodings ) = @_;
98 0           decode file_read $file, $encodings;
99 0           }
100 0            
101             # Кодировать в указанной кодировке и записать в файл
102             my ( $file, $encoding, $unicode ) = @_;
103            
104             utf8::decode($unicode) if !utf8::is_utf8($unicode);
105 0     0 1    
106 0           $unicode = Encode::encode( $encoding, $unicode ) if defined $encoding;
107              
108             file_write $file, $unicode;
109             }
110              
111 0     0 1   1;
112              
113 0 0         =encoding utf-8
114              
115 0 0         =head1 NAME
116              
117 0           Octets::To::Unicode - модуль утилит для распознавания кодировки текста (в том числе в файлах) и его декодирования
118              
119             =head1 VERSION
120              
121             0.01
122              
123             =head1 SYNOPSIS
124              
125             use Octets::To::Unicode;
126            
127             my $unicode = decode "Стар Трек";
128             my ($unicode, $encoding) = decode "Стар Трек";
129             my $unicode = decode $octets_in_cp1251_or_maybe_in_utf8, [qw/cp1251 utf-8/];
130            
131             my $encoding = detect $octets;
132             my $encoding = detect $octets, [qw/cp1251 utf-8/];
133            
134             my ($file_text_in_unicode, $encoding) = file_decode "path/to/file", ["cp1251", "koi8-r"];
135             file_encode "path/to/file2", "koi8-r", $file_text_in_unicode;
136              
137             Использование утилит:
138            
139             # Отформатировать указанные файлы perltidy:
140             $ ru-perltidy file1 file2
141              
142             # Указать кодировку:
143             $ ru-perltidy file1 file2 -e utf-8,cp1251
144              
145             # Форматирует только изменённые файлы в репозитории git:
146             $ ru-perltidy
147              
148             # Форматирует изменённые файлы в ветке (на случай, если забыл отформатировать перед комитом):
149             $ ru-perltidy --in-branch
150              
151             # Указать расширения файлов:
152             $ ru-perltidy --ext 'pl,pm,'
153              
154             # Перевести файлы во временные в кодировке utf-8 (в /tmp) и после выполнения команды и их изменения переписать обратно в определён
155             ной кодировке:
156             # (тут $1 - первый файл, $2 - второй и т.д., $* - все файлы через пробел. Так же работают подстановки ${1} и т.д.)
157             $ ru-utf8 file1 file2 -c 'perltidy $1 -st > $2'
158              
159             =head1 DESCRIPTION
160              
161             Пакет включает в себя утилиты:
162              
163             =over 4
164              
165             =item B<ru-perltidy> — форматирует файлы через perltidy c определением их кодировки;
166              
167             =item B<ru-utf8> — переводит файлы во временные (в кодировке utf-8), выполняет указанную команду и переписывает обратно в определённой кодировке;
168              
169             =back
170              
171             и модуль perl:
172              
173             =over 4
174              
175             =item B<Octets::To::Unicode> — модуль c функциями определения кодировки текста и его конвертирования между кодировками.
176              
177             =back
178              
179             B<Octets::To::Unicode> предоставляет необходимое множество утилит для определения кодировки текста и его декодирования, а так же — работы с файлами.
180              
181             В 2000-х определилась тенденция переводить проекты в национальных кодировках в utf-8. Однако не везде их перевели одним махом, а решили рубить собаке хвост постепенно. В результате во многих проектах часть файлов c кодом в utf-8, а часть — в национальной кодировке (cp1251, например).
182              
183             Ещё одной проблемой могут служить урлы с эскейп-последоваительностями. Например, https://ru.wikipedia.org/wiki/Молчание#Золото преобразуется в мессенджере, куда эту ссылку можно скопировать, в https://ru.wikipedia.org/wiki/%D0%9C%D0%BE%D0%BB%D1%87%D0%B0%D0%BD%D0%B8%D0%B5#%D0%97%D0%BE%D0%BB%D0%BE%D1%82%D0%BE. Причём один мессенджер переведёт русские символы в utf-8, другой — в cp1251, третий — в koi8-r.
184              
185             Чтобы решить эти две проблемы в приложениях и был написан этот модуль.
186              
187             =head1 SUBROUTINES/METHODS
188              
189             =head2 bohemy
190              
191             $num = bohemy $unicode;
192              
193             Возвращает числовую характеристику похожести текста на русский.
194              
195             Алгоритм основан на наблюдении, что в русском языке слово начинается на прописную или строчную букву, а затем состоит из строчных букв.
196              
197             Таким образом, числовая характеристика, это сумма длин русско-похожих слов с разницей суммы длин русско-непохожих.
198              
199             Принимает параметр:
200              
201             =over 4
202              
203             =item B<$unicode>
204              
205             Текст в юникоде (с взведённым флажком utf8).
206              
207             =back
208              
209             =head2 decode
210              
211             $unicode = decode $octets, $encodings;
212             ($unicode, $encoding) = decode $octets, $encodings;
213              
214             Возвращает декодированный текст в скалярном контексте, а в списочном, ещё и определённую кодировку.
215              
216             Если ни одна из кодировок не подошла, то вместо юникода в первом параметре возвращаются октеты, а вместо кодировки - C<undef>:
217              
218             ($octets, $encoding_is_undef) = decode $octets, [];
219              
220             Принимает параметры:
221              
222             =over 4
223              
224             =item B<$unicode>
225              
226             Текст в юникоде (с взведённым флажком utf8).
227              
228             =item B<$encodings>
229              
230             Cписок кодировок, которыми предлагается попробовать декодировать текст.
231              
232             Необязательный. Значение по умолчанию: C<[qw/utf-8 cp1251 koi8-r/]>.
233              
234             =back
235              
236             =head2 detect
237              
238             $encoding = detect $octets, $encodings;
239              
240             Возвращает определённую кодировку или C<undef>.
241              
242             Параметры такие же как у L</"decode">.
243              
244             =head2 file_find
245              
246             @files = file_find $path_to_directory;
247              
248             Ищет файлы в директориях рекурсивно и возвращает список путей к ним.
249              
250             Принимает параметр:
251              
252             =over 4
253              
254             =item B<$path_to_directory>
255              
256             Путь к файлу или директории. Если путь не ведёт к директории, то он просто возвращается в списке.
257              
258             =back
259              
260             =head2 file_read
261              
262             $octets = file_read $path;
263              
264             Считывает файл.
265              
266             Возвращает текст в октетах.
267              
268             Выбрасывает исключение, если открыть файл не удалось.
269              
270             Принимает параметр:
271              
272             =over 4
273              
274             =item B<$path>
275              
276             Путь к файлу.
277              
278             =back
279              
280             =head2 file_write
281              
282             file_write $path, $octets_or_unicode;
283              
284             Перезаписывает файл строкой.
285              
286             Ничего не возвращает.
287              
288             Выбрасывает исключение, если открыть файл не удалось.
289              
290             Принимает параметры:
291              
292             =over 4
293              
294             =item B<$path>
295              
296             Путь к файлу.
297              
298             =item B<$octets_or_unicode>
299              
300             Новое тело файла в октетах или юникоде.
301              
302             =back
303              
304             =head2 file_decode
305              
306             $unicode = file_decode $path, $encodings;
307             ($unicode, $encoding) = file_decode $path, $encodings;
308              
309             Возвращает декодированный текст из файла в скалярном контексте, а в списочном, ещё и определённую кодировку.
310              
311             Если ни одна из кодировок не подошла, то вместо юникода в первом параметре возвращаются октеты, а вместо кодировки - C<undef>:
312              
313             ($octets, $encoding_is_undef) = file_decode $path, [];
314              
315             Принимает параметры:
316              
317             =over 4
318              
319             =item B<$path>
320              
321             Путь к файлу.
322              
323             =item B<$encodings>
324              
325             Cписок кодировок, которыми предлагается попробовать декодировать текст.
326              
327             Необязательный. Значение по умолчанию: C<[qw/utf-8 cp1251 koi8-r/]>.
328              
329             =back
330              
331             =head2 file_encode
332              
333             file_encode $path, $encoding, $unicode;
334              
335             Переписывает текст в файле в указанной кодировке.
336              
337             Принимает параметры:
338              
339             =over 4
340              
341             =item B<$path>
342              
343             Путь к файлу.
344              
345             =item B<$encoding>
346              
347             Кодировка в которую следует перевести параметр C<unicode> перед записью в файл.
348              
349             =item B<$unicode>
350              
351             Новый текст файла в юникоде (с установленным флажком utf8).
352              
353             =back
354              
355             =head1 INSTALL
356              
357             Установить можно любым менеджером C<perl> со B<CPAN>, например:
358              
359             $ cpm install -g Octets::To::Unicode
360              
361             =head1 DEPENDENCIES
362              
363             Зависит от модулей:
364              
365             =over 4
366              
367             =item * Getopt::Long
368              
369             =item * Encode
370              
371             =item * List::Util
372              
373             =item * Pod::Usage
374              
375             =item * Term::ANSIColor
376              
377             =back
378              
379             и от B<perltidy> опционально:
380              
381             =over 4
382              
383             =item * Perl::Tidy
384              
385             =back
386              
387             =head1 RELEASE
388              
389             Релиз на B<CPAN> осуществляется так:
390              
391             =over 4
392              
393             =item Обновить исходники:
394              
395             $ git pull
396            
397             =item Отредактировать файл __Changes__.
398              
399             В файле __Changes__ нужно написать список изменений, которые вошли в этот релиз.
400              
401             Изменения записываются в виде списка, одно изменение — один элемент списка. Элементы списка обозначаются символами тире `-`.
402              
403             Список с изменениями нужно разместить между строкой `{{$NEXT}}` и строкой с предыдущим релизом.
404              
405             Допустим, предыдущий релиз был 1.71. Тогда описание изменений нового релиза будет выглядеть так:
406              
407             {{$NEXT}}
408            
409             - RU-5 Какой-то тикет, который вошел в релиз.
410             - RU-6 Ещё один тикет, вошедший в релиз.
411            
412             1.71 2021-05-07T08:52:18Z
413            
414             - RU-4 Какой-то предыдущий тикет.
415              
416             Обратите внимание — у нового релиза пока нет версии. Версия будет вычислена Миниллой при выполнении релиза и автоматически вписана в файл CHANGES вместо метки C<{{$NEXT}}>.
417              
418             =item Активировать локальную библиотеку:
419              
420             $ cpanm --local-lib=~/perl5 local::lib && eval $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib)
421              
422             Это нужно, чтобы не выполнять релиз под рутом.
423              
424             =item Выполнить релиз:
425              
426             $ minil release
427            
428             В процессе Минилла задаст несколько вопросов, в частности предложит выбрать номер новой версии.
429              
430             Обычно на все вопросы нужно отвечать кнопкой "enter". Иначе лучше прервать процесс и внести изменения в конфигурационные файлы.
431              
432             =back
433              
434             =head1 AUTHOR
435              
436             Yaroslav O. Kosmina E<lt>darviarush@mail.ruE<gt>
437              
438             =head1 LICENSE
439              
440             ⚖ B<GPLv3>
441              
442             =cut