File Coverage

blib/lib/MARC/Convert/Wikidata/Utils.pm
Criterion Covered Total %
statement 219 238 92.0
branch 32 52 61.5
condition 6 6 100.0
subroutine 22 22 100.0
pod 0 12 0.0
total 279 330 84.5


line stmt bran cond sub pod time code
1             package MARC::Convert::Wikidata::Utils;
2              
3 21     21   117742 use base qw(Exporter);
  21         236  
  21         2761  
4 21     21   148 use strict;
  21         54  
  21         505  
5 21     21   162 use warnings;
  21         58  
  21         818  
6              
7 21     21   152 use List::Util qw(none);
  21         39  
  21         2704  
8 21     21   7723 use Readonly;
  21         56779  
  21         1083  
9 21     21   9356 use Roman;
  21         16739  
  21         1414  
10 21     21   6161 use Unicode::UTF8 qw(decode_utf8);
  21         6336  
  21         70223  
11              
12             Readonly::Array our @EXPORT_OK => qw(clean_cover clean_date clean_edition_number
13             clean_number_of_pages clean_oclc clean_publication_date clean_publisher_name
14             clean_publisher_place clean_series_name clean_series_ordinal clean_subtitle
15             clean_title);
16             Readonly::Array our @COVERS => qw(hardback paperback);
17              
18             our $VERSION = 0.01;
19             our $DEBUG = 0;
20              
21             sub clean_cover {
22 13     13 0 6045 my $cover = shift;
23              
24 13 50       39 if (! defined $cover) {
25 0         0 return;
26             }
27              
28 13         23 my $ret_cover = $cover;
29 13         81 $ret_cover =~ s/\s*:\s*$//ms;
30 13         58 $ret_cover =~ s/^\s*//ms;
31 13         43 $ret_cover =~ s/^\(\s*//ms;
32 13         76 $ret_cover =~ s/\s*\)$//ms;
33 13         42 my $c = decode_utf8('(v|V)áz');
34 13         132 $ret_cover =~ s/^$c\.?$/hardback/ms;
35 13         37 $c = decode_utf8('(v|V)ázáno');
36 13         84 $ret_cover =~ s/^$c$/hardback/ms;
37 13         49 $c = decode_utf8('(b|B)rož');
38 13         86 $ret_cover =~ s/^$c\.?$/paperback/ms;
39 13         34 $c = decode_utf8('(b|B)rožováno');
40 13         74 $ret_cover =~ s/^$c$/paperback/ms;
41              
42 13 50   18   97 if (none { $ret_cover eq $_ } @COVERS) {
  18         254  
43 0 0       0 if ($DEBUG) {
44 0         0 warn "Book cover '$ret_cover' couldn't clean.";
45             }
46 0         0 $ret_cover = undef;
47             }
48              
49 13         72 return $ret_cover;
50             }
51              
52             sub clean_date {
53 17     17 0 3053 my $date = shift;
54              
55 17 100       51 if (! defined $date) {
56 1         3 return;
57             }
58 16 100       43 if (! $date) {
59 1         4 return;
60             }
61              
62 15         294 my $months_hr = {
63             'leden' => '01',
64             decode_utf8('únor') => '02',
65             decode_utf8('březen') => '03',
66             'duben' => '04',
67             decode_utf8('květen') => '05',
68             decode_utf8('červen') => '06',
69             decode_utf8('červenec') => '07',
70             'srpen' => '08',
71             decode_utf8('září') => '09',
72             decode_utf8('říjen') => '10',
73             'listopad' => '11',
74             'prosinec' => '12',
75             };
76              
77 15         48 my $ret_date = $date;
78 15         31 foreach my $month (keys %{$months_hr}) {
  15         73  
79 180         2906 $ret_date =~ s/^(\d{4})\s*$month\s*(\d+)\.$/$1-$months_hr->{$month}-$2/ms;
80             }
81 15         107 my $bk = decode_utf8('př. Kr.');
82 15         108 $ret_date =~ s/^(\d+)\s*$bk/-$1/ms;
83 15         51 $ret_date =~ s/\s*\.$//ms;
84              
85 15 50       131 if ($ret_date !~ m/^\-?\d+(\-\d+)?(\-\d+)?$/ms) {
86 0 0       0 if ($DEBUG) {
87 0         0 warn "Date '$date' couldn't clean.";
88             }
89 0         0 $ret_date = undef;
90             }
91              
92 15         114 return $ret_date;
93             }
94              
95             sub clean_edition_number {
96 52     52 0 28886 my $edition_number = shift;
97              
98 52 100       139 if (! defined $edition_number) {
99 1         2 return;
100             }
101              
102 51         89 my $ret_edition_number = $edition_number;
103              
104             # Remove [] on begin and end.
105 51         115 $ret_edition_number = _remove_square_brackets($ret_edition_number);
106              
107             # Remove trailing whitespace
108 51         118 $ret_edition_number = _remove_trailing_whitespace($ret_edition_number);
109              
110             # Remove special meanings.
111 51         140 $ret_edition_number =~ s/,//msg;
112 51         146 $ret_edition_number =~ s/\s+a\s+//ms;
113              
114             # Edition.
115 51         148 my $v1 = decode_utf8('Vydání');
116 51         111 my $v2 = decode_utf8('vydání');
117 51         681 $ret_edition_number =~ s/\s*(Vyd\.|vyd\.|$v1|$v2|Vydanie|vyd)//gx;
118              
119 51         187 $ret_edition_number =~ s/\s*rozmn\.//ms;
120 51         140 my $re = decode_utf8('souborné');
121 51         204 $ret_edition_number =~ s/\s*$re//ms;
122              
123             # Authorized.
124 51         109 $ret_edition_number =~ s/\s*aut\.//ms;
125 51         87 $ret_edition_number =~ s/\s*autoris\.//ms;
126 51         81 $ret_edition_number =~ s/\s*autoriz\.//ms;
127 51         126 $re = decode_utf8('autorisované');
128 51         181 $ret_edition_number =~ s/\s*$re//ms;
129              
130             # Extended.
131 51         126 $re = decode_utf8('přeprac');
132 51         186 $ret_edition_number =~ s/\s*$re\.//ms;
133 51         146 $re = decode_utf8('přepracované');
134 51         163 $ret_edition_number =~ s/\s*$re//ms;
135 51         96 $ret_edition_number =~ s/\s*aktualiz\.//ms;
136 51         115 $re = decode_utf8('aktualizované');
137 51         178 $ret_edition_number =~ s/\s*$re//ms;
138 51         104 $ret_edition_number =~ s/\s*nezm\.//ms;
139 51         128 $re = decode_utf8('rozšířené');
140 51         162 $ret_edition_number =~ s/\s*$re//ms;
141 51         131 $re = decode_utf8('rozš');
142 51         233 $ret_edition_number =~ s/\s*$re\.?//ms;
143 51         107 $ret_edition_number =~ s/\s*dopl\.//ms;
144 51         100 $ret_edition_number =~ s/\s*dopln\.//ms;
145 51         113 $re = decode_utf8('doplněné');
146 51         165 $ret_edition_number =~ s/\s*$re//ms;
147 51         112 $re = decode_utf8('upravené');
148 51         183 $ret_edition_number =~ s/\s*$re//ms;
149 51         103 $ret_edition_number =~ s/\s*upr\.//ms;
150 51         83 $ret_edition_number =~ s/\s*opr\.//ms;
151 51         115 $re = decode_utf8('revidované');
152 51         233 $ret_edition_number =~ s/\s*$re//ms;
153              
154             # Czech.
155 51         128 $re = decode_utf8('(v|V) českém jazyce');
156 51         233 $ret_edition_number =~ s/\s*$re//ms;
157 51         126 $re = decode_utf8('(Č|č)eské');
158 51         206 $ret_edition_number =~ s/\s*$re//ms;
159 51         135 $re = decode_utf8('(Č|č)es\.');
160 51         206 $ret_edition_number =~ s/\s*$re//ms;
161 51         134 $re = decode_utf8('(v|V) češtině\s*');
162 51         213 $ret_edition_number =~ s/\s*$re//ms;
163              
164             # With illustration.
165 51         132 $re = decode_utf8('s vyobrazeními');
166 51         223 $ret_edition_number =~ s/\s*$re//ms;
167              
168             # Remove trailing whitespace
169 51         108 $ret_edition_number = _remove_trailing_whitespace($ret_edition_number);
170              
171             # Rewrite number in Czech to number.
172 51         1237 my $dict_hr = {
173             decode_utf8('První') => 1,
174             decode_utf8('první') => 1,
175             decode_utf8('prvé') => 1,
176             decode_utf8('Druhé') => 2,
177             decode_utf8('druhé') => 2,
178             decode_utf8('Třetí') => 3,
179             decode_utf8('třetí') => 3,
180             decode_utf8('Čtvrté') => 4,
181             decode_utf8('čtvrté') => 4,
182             decode_utf8('Páté') => 5,
183             decode_utf8('páté') => 5,
184             decode_utf8('Šesté') => 6,
185             decode_utf8('šesté') => 6,
186             decode_utf8('Sedmé') => 7,
187             decode_utf8('sedmé') => 7,
188             decode_utf8('Osmé') => 8,
189             decode_utf8('osmé') => 8,
190             decode_utf8('Deváté') => 9,
191             decode_utf8('deváté') => 9,
192             decode_utf8('Desáté') => 10,
193             decode_utf8('desáté') => 10,
194             decode_utf8('Dvacáté') => 20,
195             decode_utf8('dvacáté') => 20,
196             };
197 51         105 foreach my $origin (keys %{$dict_hr}) {
  51         394  
198 1173         13711 $ret_edition_number =~ s/\s*$origin\s*/$dict_hr->{$origin}/ms;
199             }
200              
201             # Remove dots.
202 51         385 $ret_edition_number =~ s/\s*\.\s*//ms;
203              
204             # Remove :
205 51         119 $ret_edition_number =~ s/\s*:\s*//ms;
206              
207             # Rename roman to arabic
208 51 100       201 if (isroman($ret_edition_number)) {
209 3         33 $ret_edition_number = arabic($ret_edition_number);
210             }
211              
212 51 100       767 if ($ret_edition_number !~ m/^\d+$/ms) {
213 4 50       16 if ($DEBUG) {
214 0         0 warn "Edition number '$edition_number' couldn't clean ($ret_edition_number).";
215             }
216 4         11 $ret_edition_number = undef;
217             }
218              
219 51         428 return $ret_edition_number;
220             }
221              
222             sub clean_number_of_pages {
223 11     11 0 3754 my $number_of_pages = shift;
224              
225 11 50       40 if (! defined $number_of_pages) {
226 0         0 return;
227             }
228              
229 11         24 my $ret_number_of_pages = $number_of_pages;
230 11         45 $ret_number_of_pages =~ s/^\[(\d+)\]/$1/ms;
231 11         92 $ret_number_of_pages =~ s/^(\d+)\s*(s\.|stran).*$/$1/ms;
232              
233 11 50       65 if ($ret_number_of_pages !~ m/^\d+$/ms) {
234 0 0       0 if ($DEBUG) {
235 0         0 warn "Number of pages '$number_of_pages' couldn't clean.";
236             }
237 0         0 $ret_number_of_pages = undef;
238             }
239              
240 11         40 return $ret_number_of_pages;
241             }
242              
243             sub clean_oclc {
244 5     5 0 125 my $oclc = shift;
245              
246 5 50       20 if (! defined $oclc) {
247 0         0 return;
248             }
249              
250 5         18 my $ret_oclc = $oclc;
251 5         30 $ret_oclc =~ s/^\(OCoLC\)//ms;
252              
253 5         21 return $ret_oclc;
254             }
255              
256             sub clean_publication_date {
257 12     12 0 6946 my $publication_date = shift;
258              
259 12         30 my $ret_publication_date = $publication_date;
260              
261             # Remove [] on begin and end.
262 12         35 $ret_publication_date = _remove_square_brackets($ret_publication_date);
263              
264 12         46 my $option;
265 12 100 100     104 if ($ret_publication_date =~ s/^c(.*)$/$1/ms
266             || $ret_publication_date =~ s/^(.*)\?$/$1/ms) {
267              
268 4         10 $option = 'circa';
269             }
270              
271 12 100 100     76 if ($ret_publication_date !~ m/^\d+$/ms
272             && $ret_publication_date !~ m/^\d+\-\d*$/ms) {
273              
274 1 50       12 if ($DEBUG) {
275 0         0 warn "Publication date '$publication_date' couldn't clean.";
276             }
277 1         3 $ret_publication_date = undef;
278             }
279              
280 12         69 return ($ret_publication_date, $option);
281             }
282              
283             sub clean_publisher_name {
284 16     16 0 4368 my $publisher_name = shift;
285              
286 16 50       58 if (! defined $publisher_name) {
287 0         0 return;
288             }
289              
290 16         27 my $ret_publisher_name = $publisher_name;
291              
292             # Trailing whitespace on begin and end
293 16         41 $ret_publisher_name = _remove_trailing_whitespace($ret_publisher_name);
294              
295             # Separators on the end.
296 16         86 $ret_publisher_name =~ s/\s*,$//g;
297 16         53 $ret_publisher_name =~ s/\s*:$//g;
298 16         45 $ret_publisher_name =~ s/\s*;$//g;
299              
300             # Remove ( from begin and not ending.
301 16         58 $ret_publisher_name =~ s/^\(([^\)]+)$/$1/ms;
302              
303             # Remove [] on begin and end.
304 16         49 $ret_publisher_name = _remove_square_brackets($ret_publisher_name);
305              
306 16         47 return $ret_publisher_name;
307             }
308              
309             sub clean_publisher_place {
310 28     28 0 12141 my $publisher_place = shift;
311              
312 28 50       98 if (! defined $publisher_place) {
313 0         0 return;
314             }
315              
316 28         788 my $dict_hr = {
317             'Blansku' => 'Blansko',
318             decode_utf8('Č. Budějovice') => decode_utf8('České Budějovice'),
319             'Plzni' => decode_utf8('Plzeň'),
320             'Praze' => 'Praha',
321             decode_utf8('Pardubicích') => 'Pardubice',
322             decode_utf8('Brně') => 'Brno',
323             decode_utf8('Jičíně') => decode_utf8('Jičín'),
324             decode_utf8('Jihlavě') => 'Jihlava',
325             decode_utf8('Jimramově') => 'Jimramov',
326             decode_utf8('Karlových Varech') => 'Karlovy Vary',
327             'Liberci' => 'Liberec',
328             'Nymburce' => 'Nymburk',
329             'Olomouci' => 'Olomouc',
330             decode_utf8('Poděbradech') => decode_utf8('Poděbrady'),
331             decode_utf8('Přerově') => decode_utf8('Přerov'),
332             decode_utf8('Třebíč na Moravě') => decode_utf8('Třebíč'),
333             decode_utf8('Třebíči') => decode_utf8('Třebíč'),
334             decode_utf8('Třebíči na Moravě') => decode_utf8('Třebíč'),
335             decode_utf8('Ostravě') => 'Ostrava',
336             decode_utf8('Řevnicích') => decode_utf8('Řevnice'),
337             };
338              
339 28         68 my $ret_publisher_place = $publisher_place;
340              
341 28         140 $ret_publisher_place =~ s/\s+$//g;
342 28         130 $ret_publisher_place =~ s/\s*:$//g;
343 28         64 $ret_publisher_place =~ s/\s*;$//g;
344              
345             # [V Praze]
346 28         74 $ret_publisher_place =~ s/^\[(.*?)\]?$/$1/ms;
347              
348 28         84 $ret_publisher_place =~ s/^V\s+//ms;
349              
350 28         49 foreach my $origin (keys %{$dict_hr}) {
  28         201  
351 560         5102 $ret_publisher_place =~ s/^$origin$/$dict_hr->{$origin}/ms;
352             }
353              
354 28         122 $ret_publisher_place =~ s/^V\s+([\s\w]+)$/$1/ms;
355             # [Praha]
356 28         55 $ret_publisher_place =~ s/^\[(.*?)\]$/$1/ms;
357              
358 28         192 return $ret_publisher_place;
359             }
360              
361             sub clean_series_name {
362 6     6 0 1019 my $series_name = shift;
363              
364 6 50       38 if (! defined $series_name) {
365 0         0 return;
366             }
367              
368 6         15 my $ret_series_name = $series_name;
369              
370             # Trailing whitespace on begin and end
371 6         36 $ret_series_name = _remove_trailing_whitespace($ret_series_name);
372              
373 6         85 $ret_series_name =~ s/\s*;$//g;
374 6         46 $ret_series_name =~ s/\s*:$//g;
375              
376             # Remove [] on begin and end.
377 6         38 $ret_series_name = _remove_square_brackets($ret_series_name);
378              
379 6         24 return $ret_series_name;
380             }
381              
382             sub clean_series_ordinal {
383 16     16 0 7417 my $series_ordinal = shift;
384              
385 16 50       60 if (! defined $series_ordinal) {
386 0         0 return;
387             }
388              
389 16         31 my $ret_series_ordinal = $series_ordinal;
390              
391             # Trailing whitespace on begin and end
392 16         37 $ret_series_ordinal = _remove_trailing_whitespace($ret_series_ordinal);
393              
394 16         64 $ret_series_ordinal =~ s/^(S|s)v\.\s*//g;
395 16         36 $ret_series_ordinal =~ s/^svazek\s*//g;
396 16         34 $ret_series_ordinal =~ s/\s*svazek$//g;
397              
398 16         68 my $c = decode_utf8('(č|Č)');
399 16         203 $ret_series_ordinal =~ s/^$c\.\s*//ms;
400 16         58 $c = decode_utf8('(č|Č)íslo');
401 16         124 $ret_series_ordinal =~ s/^$c\s*//ms;
402              
403 16         64 $ret_series_ordinal =~ s/^(\d+)\.$/$1/ms;
404              
405 16 100       80 if ($ret_series_ordinal =~ m/^(\d+)-(\d+)$/ms) {
406 3         8 my $first = $1;
407 3         7 my $second = $2;
408 3 50       11 if ($second < $first) {
409 3         7 my $first_len = length $first;
410 3         6 my $second_len = length $second;
411 3         8 my $first_addition = substr $first, 0, ($first_len - $second_len);
412 3         12 $ret_series_ordinal = $first.'-'.$first_addition.$second;
413             }
414             }
415              
416 16         72 return $ret_series_ordinal;
417             }
418              
419             sub clean_subtitle {
420 19     19 0 2305 my $subtitle = shift;
421              
422 19 100       90 if (! defined $subtitle) {
423 11         36 return;
424             }
425              
426 8         18 my $ret_subtitle = $subtitle;
427 8         52 $ret_subtitle =~ s/\s+$//g;
428 8         51 $ret_subtitle =~ s/\/$//g;
429 8         38 $ret_subtitle =~ s/\s+$//g;
430 8         26 $ret_subtitle =~ s/,$//g;
431              
432 8         23 return $ret_subtitle;
433             }
434              
435             sub clean_title {
436 8     8 0 1715 my $title = shift;
437              
438 8 50       37 if (! defined $title) {
439 0         0 return;
440             }
441              
442 8         18 my $ret_title = $title;
443 8         36 $ret_title =~ s/\s+$//g;
444 8         27 $ret_title =~ s/\s*\/$//g;
445 8         35 $ret_title =~ s/\s*\:$//g;
446 8         26 $ret_title =~ s/\.$//g;
447              
448 8         23 return $ret_title;
449             }
450              
451             sub _remove_trailing_whitespace {
452 140     140   252 my $string = shift;
453              
454 140         436 $string =~ s/^\s+//g;
455 140         473 $string =~ s/\s+$//g;
456              
457 140         295 return $string;
458             }
459              
460             sub _remove_square_brackets {
461 85     85   187 my $string = shift;
462              
463 85         276 $string =~ s/^\[\s*(.*?)\s*\]$/$1/ms;
464 85         230 $string =~ s/^\[\s*([^\]]+)$/$1/ms;
465              
466 85         171 return $string;
467             }
468              
469             1;
470              
471             __END__