3 # Copyright (C) 2008 LibLime
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
21 use MARC::Charset qw/marc8_to_utf8/;
24 use Unicode::Normalize;
26 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
29 # set the version for version checking
44 C4::Charset - utilities for handling character set conversions.
52 This module contains routines for dealing with character set
53 conversions, particularly for MARC records.
55 A variety of character encodings are in use by various MARC
56 standards, and even more character encodings are used by
57 non-standard MARC records. The various MARC formats generally
58 do not do a good job of advertising a given record's character
59 encoding, and even when a record does advertise its encoding,
60 e.g., via the Leader/09, experience has shown that one cannot
63 Ultimately, all MARC records are stored in Koha in UTF-8 and
64 must be converted from whatever the source character encoding is.
65 The goal of this module is to ensure that these conversions
66 take place accurately. When a character conversion cannot take
67 place, or at least not accurately, the module was provide
68 enough information to allow user-facing code to inform the user
69 on how to deal with the situation.
75 =head2 IsStringUTF8ish
79 my $is_utf8 = IsStringUTF8ish($str);
83 Determines if C<$str> is valid UTF-8. This can mean
90 The Perl UTF-8 flag is set and the string contains valid UTF-8.
94 The Perl UTF-8 flag is B<not> set, but the octets contain
99 The function is named C<IsStringUTF8ish> instead of C<IsStringUTF8>
100 because in one could be presented with a MARC blob that is
101 not actually in UTF-8 but whose sequence of octets appears to be
102 valid UTF-8. The rest of the MARC character conversion functions
103 will assume that this situation occur does not very often.
107 sub IsStringUTF8ish {
110 return 1 if utf8::is_utf8($str);
111 return utf8::decode($str);
118 my $marc_record = SetUTF8Flag($marc_record);
122 This function sets the PERL UTF8 flag for data.
123 It is required when using new_from_usmarc
124 since MARC::File::USMARC does not handle PERL UTF8 setting.
125 When editing unicode marc records fields and subfields, you
126 would end up in double encoding without using this function.
129 In my opinion, this function belongs to MARC::Record and not
131 But since it handles charset, and MARC::Record, it finds its way in that package
137 return unless ($record && $record->fields());
138 foreach my $field ($record->fields()){
139 if ($field->tag()>=10){
141 foreach my $subfield ($field->subfields()){
142 push @subfields,($$subfield[0],NormalizeString($$subfield[1]));
144 my $newfield=MARC::Field->new(
146 $field->indicator(1),
147 $field->indicator(2),
150 $field->replace_with($newfield);
155 =head2 NormalizeString
159 my $normalized_string=NormalizeString($string);
164 nfc : If you want to set NFC and not NFD
165 transform : If you expect all the signs to be removed
166 Sets the PERL UTF8 Flag on your initial data if need be
167 and applies cleaning if required
169 Returns a utf8 NFD normalized string
172 my $string=NormalizeString ("l'ornithoptère");
173 #results into ornithoptère in NFD form and sets UTF8 Flag
177 my ($string,$nfc,$transform)=@_;
178 utf8::decode($string) unless (utf8::is_utf8($string));
180 $string= NFD($string);
183 $string=NFC($string);
186 $string=~s/\<|\>|\^|\;|\.|\?|,|\-|\(|\)|\[|\]|\{|\}|\$|\%|\!|\*|\:|\\|\/|\&|\"|\'/ /g;
187 #removing one letter words "d'" "l'" was changed into "d " "l "
188 $string=~s/\b\S\b//g;
194 =head2 MarcToUTF8Record
198 ($marc_record, $converted_from, $errors_arrayref) = MarcToUTF8Record($marc_blob, $marc_flavour, [, $source_encoding]);
202 Given a MARC blob or a C<MARC::Record>, the MARC flavour, and an
203 optional source encoding, return a C<MARC::Record> that is
206 The returned C<$marc_record> is guaranteed to be in valid UTF-8, but
207 is not guaranteed to have been converted correctly. Specifically,
208 if C<$converted_from> is 'failed', the MARC record returned failed
209 character conversion and had each of its non-ASCII octets changed
210 to the Unicode replacement character.
212 If the source encoding was not specified, this routine will
213 try to guess it; the character encoding used for a successful
214 conversion is returned in C<$converted_from>.
218 sub MarcToUTF8Record {
220 my $marc_flavour = shift;
221 my $source_encoding = shift;
224 my $marc_blob_is_utf8 = 0;
225 if (ref($marc) eq 'MARC::Record') {
226 my $marc_blob = $marc->as_usmarc();
227 $marc_blob_is_utf8 = IsStringUTF8ish($marc_blob);
228 $marc_record = $marc;
230 # dealing with a MARC blob
232 # remove any ersatz whitespace from the beginning and
233 # end of the MARC blob -- these can creep into MARC
234 # files produced by several sources -- caller really
235 # should be doing this, however
238 $marc_blob_is_utf8 = IsStringUTF8ish($marc);
239 $marc_record = MARC::Record->new_from_usmarc($marc);
242 # If we do not know the source encoding, try some guesses
244 # 1. Record is UTF-8 already.
245 # 2. If MARC flavor is MARC21, then
246 # a. record is MARC-8
247 # b. record is ISO-8859-1
248 # 3. If MARC flavor is UNIMARC, then
249 if (not defined $source_encoding) {
250 if ($marc_blob_is_utf8) {
251 # note that for MARC21 we are not bothering to check
252 # if the Leader/09 is set to 'a' or not -- because
253 # of problems with various ILSs (including Koha in the
254 # past, alas), this just is not trustworthy.
255 SetMarcUnicodeFlag($marc_record, $marc_flavour);
256 return $marc_record, 'UTF-8', [];
258 if ($marc_flavour eq 'MARC21') {
259 return _default_marc21_charconv_to_utf8($marc_record, $marc_flavour);
260 } elsif ($marc_flavour eq 'UNIMARC') {
261 return _default_unimarc_charconv_to_utf8($marc_record, $marc_flavour);
263 return _default_marc21_charconv_to_utf8($marc_record, $marc_flavour);
267 # caller knows the character encoding
268 my $original_marc_record = $marc_record->clone();
270 if ($source_encoding =~ /utf-?8/i) {
271 if ($marc_blob_is_utf8) {
272 SetMarcUnicodeFlag($marc_record, $marc_flavour);
273 return $marc_record, 'UTF-8', [];
275 push @errors, 'specified UTF-8 => UTF-8 conversion, but record is not in UTF-8';
277 } elsif ($source_encoding =~ /marc-?8/i) {
278 @errors = _marc_marc8_to_utf8($marc_record, $marc_flavour);
279 } elsif ($source_encoding =~ /5426/) {
280 @errors = _marc_iso5426_to_utf8($marc_record, $marc_flavour);
282 # assume any other character encoding is for Text::Iconv
283 @errors = _marc_to_utf8_via_text_iconv($marc_record, $marc_flavour, 'iso-8859-1');
287 _marc_to_utf8_replacement_char($original_marc_record, $marc_flavour);
288 return $original_marc_record, 'failed', \@errors;
290 return $marc_record, $source_encoding, [];
296 =head2 SetMarcUnicodeFlag
300 SetMarcUnicodeFlag($marc_record, $marc_flavour);
304 Set both the internal MARC::Record encoding flag
305 and the appropriate Leader/09 (MARC21) or
306 100/26-29 (UNIMARC) to indicate that the record
307 is in UTF-8. Note that this does B<not> do
308 any actual character conversion.
312 sub SetMarcUnicodeFlag {
313 my $marc_record = shift;
314 my $marc_flavour = shift; # || C4::Context->preference("marcflavour");
316 $marc_record->encoding('UTF-8');
317 if ($marc_flavour eq 'MARC21') {
318 my $leader = $marc_record->leader();
319 substr($leader, 9, 1) = 'a';
320 $marc_record->leader($leader);
321 } elsif ($marc_flavour eq "UNIMARC") {
322 if (my $field = $marc_record->field('100')) {
323 my $sfa = $field->subfield('a');
326 # fix the length of the field
327 $sfa = substr $sfa, 0, $subflength if (length($sfa) > $subflength);
328 $sfa = sprintf( "%-*s", 35, $sfa ) if (length($sfa) < $subflength);
330 substr($sfa, 26, 4) = '50 ';
331 $field->update('a' => $sfa);
334 warn "Unrecognized marcflavour: $marc_flavour";
338 =head2 StripNonXmlChars
342 my $new_str = StripNonXmlChars($old_str);
346 Given a string, return a copy with the
347 characters that are illegal in XML
350 This function exists to work around a problem
351 that can occur with badly-encoded MARC records.
352 Specifically, if a UTF-8 MARC record also
353 has excape (\x1b) characters, MARC::File::XML
354 will let the escape characters pass through
355 when as_xml() or as_xml_record() is called. The
356 problem is that the escape character is not
357 legal in well-formed XML documents, so when
358 MARC::File::XML attempts to parse such a record,
359 the XML parser will fail.
361 Stripping such characters will allow a
362 MARC::Record->new_from_xml()
363 to work, at the possible risk of some data loss.
367 sub StripNonXmlChars {
369 if (!defined($str) || $str eq ""){
372 $str =~ s/[^\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
376 =head1 INTERNAL FUNCTIONS
378 =head2 _default_marc21_charconv_to_utf8
382 my ($new_marc_record, $guessed_charset) = _default_marc21_charconv_to_utf8($marc_record);
386 Converts a C<MARC::Record> of unknown character set to UTF-8,
387 first by trying a MARC-8 to UTF-8 conversion, then ISO-8859-1
388 to UTF-8, then a default conversion that replaces each non-ASCII
389 character with the replacement character.
391 The C<$guessed_charset> return value contains the character set
392 that resulted in a conversion to valid UTF-8; note that
393 if the MARC-8 and ISO-8859-1 conversions failed, the value of
398 sub _default_marc21_charconv_to_utf8 {
399 my $marc_record = shift;
400 my $marc_flavour = shift;
402 my $trial_marc8 = $marc_record->clone();
404 my @errors = _marc_marc8_to_utf8($trial_marc8, $marc_flavour);
406 return $trial_marc8, 'MARC-8', [];
408 push @all_errors, @errors;
410 my $trial_8859_1 = $marc_record->clone();
411 @errors = _marc_to_utf8_via_text_iconv($trial_8859_1, $marc_flavour, 'iso-8859-1');
413 return $trial_8859_1, 'iso-8859-1', []; # note -- we could return \@all_errors
414 # instead if we wanted to report details
415 # of the failed attempt at MARC-8 => UTF-8
417 push @all_errors, @errors;
419 my $default_converted = $marc_record->clone();
420 _marc_to_utf8_replacement_char($default_converted, $marc_flavour);
421 return $default_converted, 'failed', \@all_errors;
424 =head2 _default_unimarc_charconv_to_utf8
428 my ($new_marc_record, $guessed_charset) = _default_unimarc_charconv_to_utf8($marc_record);
432 Converts a C<MARC::Record> of unknown character set to UTF-8,
433 first by trying a ISO-5426 to UTF-8 conversion, then ISO-8859-1
434 to UTF-8, then a default conversion that replaces each non-ASCII
435 character with the replacement character.
437 The C<$guessed_charset> return value contains the character set
438 that resulted in a conversion to valid UTF-8; note that
439 if the MARC-8 and ISO-8859-1 conversions failed, the value of
444 sub _default_unimarc_charconv_to_utf8 {
445 my $marc_record = shift;
446 my $marc_flavour = shift;
448 my $trial_marc8 = $marc_record->clone();
450 my @errors = _marc_iso5426_to_utf8($trial_marc8, $marc_flavour);
452 return $trial_marc8, 'iso-5426';
454 push @all_errors, @errors;
456 my $trial_8859_1 = $marc_record->clone();
457 @errors = _marc_to_utf8_via_text_iconv($trial_8859_1, $marc_flavour, 'iso-8859-1');
459 return $trial_8859_1, 'iso-8859-1';
461 push @all_errors, @errors;
463 my $default_converted = $marc_record->clone();
464 _marc_to_utf8_replacement_char($default_converted, $marc_flavour);
465 return $default_converted, 'failed', \@all_errors;
468 =head2 _marc_marc8_to_utf8
472 my @errors = _marc_marc8_to_utf8($marc_record, $marc_flavour, $source_encoding);
476 Convert a C<MARC::Record> to UTF-8 in-place from MARC-8.
477 If the conversion fails for some reason, an
478 appropriate messages will be placed in the returned
483 sub _marc_marc8_to_utf8 {
484 my $marc_record = shift;
485 my $marc_flavour = shift;
487 my $prev_ignore = MARC::Charset->ignore_errors();
488 MARC::Charset->ignore_errors(1);
490 # trap warnings raised by MARC::Charset
492 local $SIG{__WARN__} = sub {
494 if ($msg =~ /MARC.Charset/) {
495 # FIXME - purpose of this regexp is to strip out the
496 # line reference to MARC/Charset.pm, but as it
497 # exists probably won't work quite on Windows --
498 # some sort of minimal-bunch back-tracking RE
499 # would be helpful here
500 $msg =~ s/at [\/].*?.MARC.Charset\.pm line \d+\.\n$//;
503 # if warning doesn't come from MARC::Charset, just
509 foreach my $field ($marc_record->fields()) {
510 if ($field->is_control_field()) {
511 ; # do nothing -- control fields should not contain non-ASCII characters
513 my @converted_subfields;
514 foreach my $subfield ($field->subfields()) {
515 my $utf8sf = MARC::Charset::marc8_to_utf8($subfield->[1]);
516 unless (IsStringUTF8ish($utf8sf)) {
517 # Because of a bug in MARC::Charset 0.98, if the string
518 # has (a) one or more diacritics that (b) are only in character positions
519 # 128 to 255 inclusive, the resulting converted string is not in
520 # UTF-8, but the legacy 8-bit encoding (e.g., ISO-8859-1). If that
521 # occurs, upgrade the string in place. Moral of the story seems to be
522 # that pack("U", ...) is better than chr(...) if you need to guarantee
523 # that the resulting string is UTF-8.
524 utf8::upgrade($utf8sf);
526 push @converted_subfields, $subfield->[0], $utf8sf;
529 $field->replace_with(MARC::Field->new(
530 $field->tag(), $field->indicator(1), $field->indicator(2),
531 @converted_subfields)
536 MARC::Charset->ignore_errors($prev_ignore);
538 SetMarcUnicodeFlag($marc_record, $marc_flavour);
543 =head2 _marc_iso5426_to_utf8
547 my @errors = _marc_iso5426_to_utf8($marc_record, $marc_flavour, $source_encoding);
551 Convert a C<MARC::Record> to UTF-8 in-place from ISO-5426.
552 If the conversion fails for some reason, an
553 appropriate messages will be placed in the returned
556 FIXME - is ISO-5426 equivalent enough to MARC-8
557 that C<MARC::Charset> can be used instead?
561 sub _marc_iso5426_to_utf8 {
562 my $marc_record = shift;
563 my $marc_flavour = shift;
567 foreach my $field ($marc_record->fields()) {
568 if ($field->is_control_field()) {
569 ; # do nothing -- control fields should not contain non-ASCII characters
571 my @converted_subfields;
572 foreach my $subfield ($field->subfields()) {
573 my $utf8sf = char_decode5426($subfield->[1]);
574 push @converted_subfields, $subfield->[0], $utf8sf;
577 $field->replace_with(MARC::Field->new(
578 $field->tag(), $field->indicator(1), $field->indicator(2),
579 @converted_subfields)
584 SetMarcUnicodeFlag($marc_record, $marc_flavour);
589 =head2 _marc_to_utf8_via_text_iconv
593 my @errors = _marc_to_utf8_via_text_iconv($marc_record, $marc_flavour, $source_encoding);
597 Convert a C<MARC::Record> to UTF-8 in-place using the
598 C<Text::Iconv> CPAN module. Any source encoding accepted
599 by the user's iconv installation should work. If
600 the source encoding is not recognized on the user's
601 server or the conversion fails for some reason,
602 appropriate messages will be placed in the returned
607 sub _marc_to_utf8_via_text_iconv {
608 my $marc_record = shift;
609 my $marc_flavour = shift;
610 my $source_encoding = shift;
614 eval { $decoder = Text::Iconv->new($source_encoding, 'utf8'); };
616 push @errors, "Could not initialze $source_encoding => utf8 converter: $@";
620 my $prev_raise_error = Text::Iconv->raise_error();
621 Text::Iconv->raise_error(1);
623 foreach my $field ($marc_record->fields()) {
624 if ($field->is_control_field()) {
625 ; # do nothing -- control fields should not contain non-ASCII characters
627 my @converted_subfields;
628 foreach my $subfield ($field->subfields()) {
630 my $conversion_ok = 1;
631 eval { $converted_value = $decoder->convert($subfield->[1]); };
635 } elsif (not defined $converted_value) {
637 push @errors, "Text::Iconv conversion failed - retval is " . $decoder->retval();
640 if ($conversion_ok) {
641 push @converted_subfields, $subfield->[0], $converted_value;
643 $converted_value = $subfield->[1];
644 $converted_value =~ s/[\200-\377]/\xef\xbf\xbd/g;
645 push @converted_subfields, $subfield->[0], $converted_value;
649 $field->replace_with(MARC::Field->new(
650 $field->tag(), $field->indicator(1), $field->indicator(2),
651 @converted_subfields)
656 SetMarcUnicodeFlag($marc_record, $marc_flavour);
657 Text::Iconv->raise_error($prev_raise_error);
662 =head2 _marc_to_utf8_replacement_char
666 _marc_to_utf8_replacement_char($marc_record, $marc_flavour);
670 Convert a C<MARC::Record> to UTF-8 in-place, adopting the
671 unsatisfactory method of replacing all non-ASCII (e.g.,
672 where the eight bit is set) octet with the Unicode
673 replacement character. This is meant as a last-ditch
674 method, and would be best used as part of a UI that
675 lets a cataloguer pick various character conversions
676 until he or she finds the right one.
680 sub _marc_to_utf8_replacement_char {
681 my $marc_record = shift;
682 my $marc_flavour = shift;
684 foreach my $field ($marc_record->fields()) {
685 if ($field->is_control_field()) {
686 ; # do nothing -- control fields should not contain non-ASCII characters
688 my @converted_subfields;
689 foreach my $subfield ($field->subfields()) {
690 my $value = $subfield->[1];
691 $value =~ s/[\200-\377]/\xef\xbf\xbd/g;
692 push @converted_subfields, $subfield->[0], $value;
695 $field->replace_with(MARC::Field->new(
696 $field->tag(), $field->indicator(1), $field->indicator(2),
697 @converted_subfields)
702 SetMarcUnicodeFlag($marc_record, $marc_flavour);
705 =head2 char_decode5426
709 my $utf8string = char_decode5426($iso_5426_string);
713 Converts a string from ISO-5426 to UTF-8.
719 # $chars{0xb0}=0x0101;#3/0ayn[ain] # commented because it seems to be wrong at use
720 $chars{0xb1}=0x0623;#3/1alif/hamzah[alefwithhamzaabove]
721 #$chars{0xb2}=0x00e0;#'à';
722 $chars{0xb2}=0x00e0;#3/2leftlowsinglequotationmark
723 #$chars{0xb3}=0x00e7;#'ç';
724 $chars{0xb3}=0x00e7;#3/2leftlowsinglequotationmark
729 $chars{0x97}=0x003c;#3/2leftlowsinglequotationmark
730 $chars{0x98}=0x003e;#3/2leftlowsinglequotationmark
731 $chars{0xfa}=0x0153;#oe
732 $chars{0x81d1}=0x00b0;
735 ## combined characters iso5426
737 $chars{0xc041}=0x1ea2; # capital a with hook above
738 $chars{0xc045}=0x1eba; # capital e with hook above
739 $chars{0xc049}=0x1ec8; # capital i with hook above
740 $chars{0xc04f}=0x1ece; # capital o with hook above
741 $chars{0xc055}=0x1ee6; # capital u with hook above
742 $chars{0xc059}=0x1ef6; # capital y with hook above
743 $chars{0xc061}=0x1ea3; # small a with hook above
744 $chars{0xc065}=0x1ebb; # small e with hook above
745 $chars{0xc069}=0x1ec9; # small i with hook above
746 $chars{0xc06f}=0x1ecf; # small o with hook above
747 $chars{0xc075}=0x1ee7; # small u with hook above
748 $chars{0xc079}=0x1ef7; # small y with hook above
751 $chars{0xc141}=0x00c0; # capital a with grave accent
752 $chars{0xc145}=0x00c8; # capital e with grave accent
753 $chars{0xc149}=0x00cc; # capital i with grave accent
754 $chars{0xc14f}=0x00d2; # capital o with grave accent
755 $chars{0xc155}=0x00d9; # capital u with grave accent
756 $chars{0xc157}=0x1e80; # capital w with grave
757 $chars{0xc159}=0x1ef2; # capital y with grave
758 $chars{0xc161}=0x00e0; # small a with grave accent
759 $chars{0xc165}=0x00e8; # small e with grave accent
760 $chars{0xc169}=0x00ec; # small i with grave accent
761 $chars{0xc16f}=0x00f2; # small o with grave accent
762 $chars{0xc175}=0x00f9; # small u with grave accent
763 $chars{0xc177}=0x1e81; # small w with grave
764 $chars{0xc179}=0x1ef3; # small y with grave
766 $chars{0xc241}=0x00c1; # capital a with acute accent
767 $chars{0xc243}=0x0106; # capital c with acute accent
768 $chars{0xc245}=0x00c9; # capital e with acute accent
769 $chars{0xc247}=0x01f4; # capital g with acute
770 $chars{0xc249}=0x00cd; # capital i with acute accent
771 $chars{0xc24b}=0x1e30; # capital k with acute
772 $chars{0xc24c}=0x0139; # capital l with acute accent
773 $chars{0xc24d}=0x1e3e; # capital m with acute
774 $chars{0xc24e}=0x0143; # capital n with acute accent
775 $chars{0xc24f}=0x00d3; # capital o with acute accent
776 $chars{0xc250}=0x1e54; # capital p with acute
777 $chars{0xc252}=0x0154; # capital r with acute accent
778 $chars{0xc253}=0x015a; # capital s with acute accent
779 $chars{0xc255}=0x00da; # capital u with acute accent
780 $chars{0xc257}=0x1e82; # capital w with acute
781 $chars{0xc259}=0x00dd; # capital y with acute accent
782 $chars{0xc25a}=0x0179; # capital z with acute accent
783 $chars{0xc261}=0x00e1; # small a with acute accent
784 $chars{0xc263}=0x0107; # small c with acute accent
785 $chars{0xc265}=0x00e9; # small e with acute accent
786 $chars{0xc267}=0x01f5; # small g with acute
787 $chars{0xc269}=0x00ed; # small i with acute accent
788 $chars{0xc26b}=0x1e31; # small k with acute
789 $chars{0xc26c}=0x013a; # small l with acute accent
790 $chars{0xc26d}=0x1e3f; # small m with acute
791 $chars{0xc26e}=0x0144; # small n with acute accent
792 $chars{0xc26f}=0x00f3; # small o with acute accent
793 $chars{0xc270}=0x1e55; # small p with acute
794 $chars{0xc272}=0x0155; # small r with acute accent
795 $chars{0xc273}=0x015b; # small s with acute accent
796 $chars{0xc275}=0x00fa; # small u with acute accent
797 $chars{0xc277}=0x1e83; # small w with acute
798 $chars{0xc279}=0x00fd; # small y with acute accent
799 $chars{0xc27a}=0x017a; # small z with acute accent
800 $chars{0xc2e1}=0x01fc; # capital ae with acute
801 $chars{0xc2f1}=0x01fd; # small ae with acute
802 # 4/3 circumflex accent
803 $chars{0xc341}=0x00c2; # capital a with circumflex accent
804 $chars{0xc343}=0x0108; # capital c with circumflex
805 $chars{0xc345}=0x00ca; # capital e with circumflex accent
806 $chars{0xc347}=0x011c; # capital g with circumflex
807 $chars{0xc348}=0x0124; # capital h with circumflex
808 $chars{0xc349}=0x00ce; # capital i with circumflex accent
809 $chars{0xc34a}=0x0134; # capital j with circumflex
810 $chars{0xc34f}=0x00d4; # capital o with circumflex accent
811 $chars{0xc353}=0x015c; # capital s with circumflex
812 $chars{0xc355}=0x00db; # capital u with circumflex
813 $chars{0xc357}=0x0174; # capital w with circumflex
814 $chars{0xc359}=0x0176; # capital y with circumflex
815 $chars{0xc35a}=0x1e90; # capital z with circumflex
816 $chars{0xc361}=0x00e2; # small a with circumflex accent
817 $chars{0xc363}=0x0109; # small c with circumflex
818 $chars{0xc365}=0x00ea; # small e with circumflex accent
819 $chars{0xc367}=0x011d; # small g with circumflex
820 $chars{0xc368}=0x0125; # small h with circumflex
821 $chars{0xc369}=0x00ee; # small i with circumflex accent
822 $chars{0xc36a}=0x0135; # small j with circumflex
823 $chars{0xc36e}=0x00f1; # small n with tilde
824 $chars{0xc36f}=0x00f4; # small o with circumflex accent
825 $chars{0xc373}=0x015d; # small s with circumflex
826 $chars{0xc375}=0x00fb; # small u with circumflex
827 $chars{0xc377}=0x0175; # small w with circumflex
828 $chars{0xc379}=0x0177; # small y with circumflex
829 $chars{0xc37a}=0x1e91; # small z with circumflex
831 $chars{0xc441}=0x00c3; # capital a with tilde
832 $chars{0xc445}=0x1ebc; # capital e with tilde
833 $chars{0xc449}=0x0128; # capital i with tilde
834 $chars{0xc44e}=0x00d1; # capital n with tilde
835 $chars{0xc44f}=0x00d5; # capital o with tilde
836 $chars{0xc455}=0x0168; # capital u with tilde
837 $chars{0xc456}=0x1e7c; # capital v with tilde
838 $chars{0xc459}=0x1ef8; # capital y with tilde
839 $chars{0xc461}=0x00e3; # small a with tilde
840 $chars{0xc465}=0x1ebd; # small e with tilde
841 $chars{0xc469}=0x0129; # small i with tilde
842 $chars{0xc46e}=0x00f1; # small n with tilde
843 $chars{0xc46f}=0x00f5; # small o with tilde
844 $chars{0xc475}=0x0169; # small u with tilde
845 $chars{0xc476}=0x1e7d; # small v with tilde
846 $chars{0xc479}=0x1ef9; # small y with tilde
848 $chars{0xc541}=0x0100; # capital a with macron
849 $chars{0xc545}=0x0112; # capital e with macron
850 $chars{0xc547}=0x1e20; # capital g with macron
851 $chars{0xc549}=0x012a; # capital i with macron
852 $chars{0xc54f}=0x014c; # capital o with macron
853 $chars{0xc555}=0x016a; # capital u with macron
854 $chars{0xc561}=0x0101; # small a with macron
855 $chars{0xc565}=0x0113; # small e with macron
856 $chars{0xc567}=0x1e21; # small g with macron
857 $chars{0xc569}=0x012b; # small i with macron
858 $chars{0xc56f}=0x014d; # small o with macron
859 $chars{0xc575}=0x016b; # small u with macron
860 $chars{0xc572}=0x0159; # small r with macron
861 $chars{0xc5e1}=0x01e2; # capital ae with macron
862 $chars{0xc5f1}=0x01e3; # small ae with macron
864 $chars{0xc641}=0x0102; # capital a with breve
865 $chars{0xc645}=0x0114; # capital e with breve
866 $chars{0xc647}=0x011e; # capital g with breve
867 $chars{0xc649}=0x012c; # capital i with breve
868 $chars{0xc64f}=0x014e; # capital o with breve
869 $chars{0xc655}=0x016c; # capital u with breve
870 $chars{0xc661}=0x0103; # small a with breve
871 $chars{0xc665}=0x0115; # small e with breve
872 $chars{0xc667}=0x011f; # small g with breve
873 $chars{0xc669}=0x012d; # small i with breve
874 $chars{0xc66f}=0x014f; # small o with breve
875 $chars{0xc675}=0x016d; # small u with breve
877 $chars{0xc7b0}=0x01e1; # Ain with dot above
878 $chars{0xc742}=0x1e02; # capital b with dot above
879 $chars{0xc743}=0x010a; # capital c with dot above
880 $chars{0xc744}=0x1e0a; # capital d with dot above
881 $chars{0xc745}=0x0116; # capital e with dot above
882 $chars{0xc746}=0x1e1e; # capital f with dot above
883 $chars{0xc747}=0x0120; # capital g with dot above
884 $chars{0xc748}=0x1e22; # capital h with dot above
885 $chars{0xc749}=0x0130; # capital i with dot above
886 $chars{0xc74d}=0x1e40; # capital m with dot above
887 $chars{0xc74e}=0x1e44; # capital n with dot above
888 $chars{0xc750}=0x1e56; # capital p with dot above
889 $chars{0xc752}=0x1e58; # capital r with dot above
890 $chars{0xc753}=0x1e60; # capital s with dot above
891 $chars{0xc754}=0x1e6a; # capital t with dot above
892 $chars{0xc757}=0x1e86; # capital w with dot above
893 $chars{0xc758}=0x1e8a; # capital x with dot above
894 $chars{0xc759}=0x1e8e; # capital y with dot above
895 $chars{0xc75a}=0x017b; # capital z with dot above
896 $chars{0xc761}=0x0227; # small b with dot above
897 $chars{0xc762}=0x1e03; # small b with dot above
898 $chars{0xc763}=0x010b; # small c with dot above
899 $chars{0xc764}=0x1e0b; # small d with dot above
900 $chars{0xc765}=0x0117; # small e with dot above
901 $chars{0xc766}=0x1e1f; # small f with dot above
902 $chars{0xc767}=0x0121; # small g with dot above
903 $chars{0xc768}=0x1e23; # small h with dot above
904 $chars{0xc76d}=0x1e41; # small m with dot above
905 $chars{0xc76e}=0x1e45; # small n with dot above
906 $chars{0xc770}=0x1e57; # small p with dot above
907 $chars{0xc772}=0x1e59; # small r with dot above
908 $chars{0xc773}=0x1e61; # small s with dot above
909 $chars{0xc774}=0x1e6b; # small t with dot above
910 $chars{0xc777}=0x1e87; # small w with dot above
911 $chars{0xc778}=0x1e8b; # small x with dot above
912 $chars{0xc779}=0x1e8f; # small y with dot above
913 $chars{0xc77a}=0x017c; # small z with dot above
914 # 4/8 trema, diaresis
915 $chars{0xc820}=0x00a8; # diaeresis
916 $chars{0xc841}=0x00c4; # capital a with diaeresis
917 $chars{0xc845}=0x00cb; # capital e with diaeresis
918 $chars{0xc848}=0x1e26; # capital h with diaeresis
919 $chars{0xc849}=0x00cf; # capital i with diaeresis
920 $chars{0xc84f}=0x00d6; # capital o with diaeresis
921 $chars{0xc855}=0x00dc; # capital u with diaeresis
922 $chars{0xc857}=0x1e84; # capital w with diaeresis
923 $chars{0xc858}=0x1e8c; # capital x with diaeresis
924 $chars{0xc859}=0x0178; # capital y with diaeresis
925 $chars{0xc861}=0x00e4; # small a with diaeresis
926 $chars{0xc865}=0x00eb; # small e with diaeresis
927 $chars{0xc868}=0x1e27; # small h with diaeresis
928 $chars{0xc869}=0x00ef; # small i with diaeresis
929 $chars{0xc86f}=0x00f6; # small o with diaeresis
930 $chars{0xc874}=0x1e97; # small t with diaeresis
931 $chars{0xc875}=0x00fc; # small u with diaeresis
932 $chars{0xc877}=0x1e85; # small w with diaeresis
933 $chars{0xc878}=0x1e8d; # small x with diaeresis
934 $chars{0xc879}=0x00ff; # small y with diaeresis
936 $chars{0xc920}=0x00a8; # [diaeresis]
937 $chars{0xc961}=0x00e4; # a with umlaut
938 $chars{0xc965}=0x00eb; # e with umlaut
939 $chars{0xc969}=0x00ef; # i with umlaut
940 $chars{0xc96f}=0x00f6; # o with umlaut
941 $chars{0xc975}=0x00fc; # u with umlaut
943 $chars{0xca41}=0x00c5; # capital a with ring above
944 $chars{0xcaad}=0x016e; # capital u with ring above
945 $chars{0xca61}=0x00e5; # small a with ring above
946 $chars{0xca75}=0x016f; # small u with ring above
947 $chars{0xca77}=0x1e98; # small w with ring above
948 $chars{0xca79}=0x1e99; # small y with ring above
949 # 4/11 high comma off centre
950 # 4/12 inverted high comma centred
951 # 4/13 double acute accent
952 $chars{0xcd4f}=0x0150; # capital o with double acute
953 $chars{0xcd55}=0x0170; # capital u with double acute
954 $chars{0xcd6f}=0x0151; # small o with double acute
955 $chars{0xcd75}=0x0171; # small u with double acute
957 $chars{0xce54}=0x01a0; # latin capital letter o with horn
958 $chars{0xce55}=0x01af; # latin capital letter u with horn
959 $chars{0xce74}=0x01a1; # latin small letter o with horn
960 $chars{0xce75}=0x01b0; # latin small letter u with horn
962 $chars{0xcf41}=0x01cd; # capital a with caron
963 $chars{0xcf43}=0x010c; # capital c with caron
964 $chars{0xcf44}=0x010e; # capital d with caron
965 $chars{0xcf45}=0x011a; # capital e with caron
966 $chars{0xcf47}=0x01e6; # capital g with caron
967 $chars{0xcf49}=0x01cf; # capital i with caron
968 $chars{0xcf4b}=0x01e8; # capital k with caron
969 $chars{0xcf4c}=0x013d; # capital l with caron
970 $chars{0xcf4e}=0x0147; # capital n with caron
971 $chars{0xcf4f}=0x01d1; # capital o with caron
972 $chars{0xcf52}=0x0158; # capital r with caron
973 $chars{0xcf53}=0x0160; # capital s with caron
974 $chars{0xcf54}=0x0164; # capital t with caron
975 $chars{0xcf55}=0x01d3; # capital u with caron
976 $chars{0xcf5a}=0x017d; # capital z with caron
977 $chars{0xcf61}=0x01ce; # small a with caron
978 $chars{0xcf63}=0x010d; # small c with caron
979 $chars{0xcf64}=0x010f; # small d with caron
980 $chars{0xcf65}=0x011b; # small e with caron
981 $chars{0xcf67}=0x01e7; # small g with caron
982 $chars{0xcf69}=0x01d0; # small i with caron
983 $chars{0xcf6a}=0x01f0; # small j with caron
984 $chars{0xcf6b}=0x01e9; # small k with caron
985 $chars{0xcf6c}=0x013e; # small l with caron
986 $chars{0xcf6e}=0x0148; # small n with caron
987 $chars{0xcf6f}=0x01d2; # small o with caron
988 $chars{0xcf72}=0x0159; # small r with caron
989 $chars{0xcf73}=0x0161; # small s with caron
990 $chars{0xcf74}=0x0165; # small t with caron
991 $chars{0xcf75}=0x01d4; # small u with caron
992 $chars{0xcf7a}=0x017e; # small z with caron
994 $chars{0xd020}=0x00b8; # cedilla
995 $chars{0xd043}=0x00c7; # capital c with cedilla
996 $chars{0xd044}=0x1e10; # capital d with cedilla
997 $chars{0xd047}=0x0122; # capital g with cedilla
998 $chars{0xd048}=0x1e28; # capital h with cedilla
999 $chars{0xd04b}=0x0136; # capital k with cedilla
1000 $chars{0xd04c}=0x013b; # capital l with cedilla
1001 $chars{0xd04e}=0x0145; # capital n with cedilla
1002 $chars{0xd052}=0x0156; # capital r with cedilla
1003 $chars{0xd053}=0x015e; # capital s with cedilla
1004 $chars{0xd054}=0x0162; # capital t with cedilla
1005 $chars{0xd063}=0x00e7; # small c with cedilla
1006 $chars{0xd064}=0x1e11; # small d with cedilla
1007 $chars{0xd065}=0x0119; # small e with cedilla
1008 $chars{0xd067}=0x0123; # small g with cedilla
1009 $chars{0xd068}=0x1e29; # small h with cedilla
1010 $chars{0xd06b}=0x0137; # small k with cedilla
1011 $chars{0xd06c}=0x013c; # small l with cedilla
1012 $chars{0xd06e}=0x0146; # small n with cedilla
1013 $chars{0xd072}=0x0157; # small r with cedilla
1014 $chars{0xd073}=0x015f; # small s with cedilla
1015 $chars{0xd074}=0x0163; # small t with cedilla
1018 # 5/3 ogonek (hook to right
1019 $chars{0xd320}=0x02db; # ogonek
1020 $chars{0xd341}=0x0104; # capital a with ogonek
1021 $chars{0xd345}=0x0118; # capital e with ogonek
1022 $chars{0xd349}=0x012e; # capital i with ogonek
1023 $chars{0xd34f}=0x01ea; # capital o with ogonek
1024 $chars{0xd355}=0x0172; # capital u with ogonek
1025 $chars{0xd361}=0x0105; # small a with ogonek
1026 $chars{0xd365}=0x0119; # small e with ogonek
1027 $chars{0xd369}=0x012f; # small i with ogonek
1028 $chars{0xd36f}=0x01eb; # small o with ogonek
1029 $chars{0xd375}=0x0173; # small u with ogonek
1031 $chars{0xd441}=0x1e00; # capital a with ring below
1032 $chars{0xd461}=0x1e01; # small a with ring below
1033 # 5/5 half circle below
1034 $chars{0xf948}=0x1e2a; # capital h with breve below
1035 $chars{0xf968}=0x1e2b; # small h with breve below
1037 $chars{0xd641}=0x1ea0; # capital a with dot below
1038 $chars{0xd642}=0x1e04; # capital b with dot below
1039 $chars{0xd644}=0x1e0c; # capital d with dot below
1040 $chars{0xd645}=0x1eb8; # capital e with dot below
1041 $chars{0xd648}=0x1e24; # capital h with dot below
1042 $chars{0xd649}=0x1eca; # capital i with dot below
1043 $chars{0xd64b}=0x1e32; # capital k with dot below
1044 $chars{0xd64c}=0x1e36; # capital l with dot below
1045 $chars{0xd64d}=0x1e42; # capital m with dot below
1046 $chars{0xd64e}=0x1e46; # capital n with dot below
1047 $chars{0xd64f}=0x1ecc; # capital o with dot below
1048 $chars{0xd652}=0x1e5a; # capital r with dot below
1049 $chars{0xd653}=0x1e62; # capital s with dot below
1050 $chars{0xd654}=0x1e6c; # capital t with dot below
1051 $chars{0xd655}=0x1ee4; # capital u with dot below
1052 $chars{0xd656}=0x1e7e; # capital v with dot below
1053 $chars{0xd657}=0x1e88; # capital w with dot below
1054 $chars{0xd659}=0x1ef4; # capital y with dot below
1055 $chars{0xd65a}=0x1e92; # capital z with dot below
1056 $chars{0xd661}=0x1ea1; # small a with dot below
1057 $chars{0xd662}=0x1e05; # small b with dot below
1058 $chars{0xd664}=0x1e0d; # small d with dot below
1059 $chars{0xd665}=0x1eb9; # small e with dot below
1060 $chars{0xd668}=0x1e25; # small h with dot below
1061 $chars{0xd669}=0x1ecb; # small i with dot below
1062 $chars{0xd66b}=0x1e33; # small k with dot below
1063 $chars{0xd66c}=0x1e37; # small l with dot below
1064 $chars{0xd66d}=0x1e43; # small m with dot below
1065 $chars{0xd66e}=0x1e47; # small n with dot below
1066 $chars{0xd66f}=0x1ecd; # small o with dot below
1067 $chars{0xd672}=0x1e5b; # small r with dot below
1068 $chars{0xd673}=0x1e63; # small s with dot below
1069 $chars{0xd674}=0x1e6d; # small t with dot below
1070 $chars{0xd675}=0x1ee5; # small u with dot below
1071 $chars{0xd676}=0x1e7f; # small v with dot below
1072 $chars{0xd677}=0x1e89; # small w with dot below
1073 $chars{0xd679}=0x1ef5; # small y with dot below
1074 $chars{0xd67a}=0x1e93; # small z with dot below
1075 # 5/7 double dot below
1076 $chars{0xd755}=0x1e72; # capital u with diaeresis below
1077 $chars{0xd775}=0x1e73; # small u with diaeresis below
1079 $chars{0xd820}=0x005f; # underline
1080 # 5/9 double underline
1081 $chars{0xd920}=0x2017; # double underline
1082 # 5/10 small low vertical bar
1083 $chars{0xda20}=0x02cc; #
1084 # 5/11 circumflex below
1085 # 5/12 (this position shall not be used)
1086 # 5/13 left half of ligature sign and of double tilde
1087 # 5/14 right half of ligature sign
1088 # 5/15 right half of double tilde
1089 # map {printf "%x :%x\n",$_,$chars{$_};}keys %chars;
1091 sub char_decode5426 {
1095 my @data = unpack("C*", $string);
1097 my $length=scalar(@data);
1098 for (my $i = 0; $i < scalar(@data); $i++) {
1099 my $char= $data[$i];
1100 if ($char >= 0x00 && $char <= 0x7F){
1103 push @characters,$char unless ($char<0x02 ||$char== 0x0F);
1104 }elsif (($char >= 0xC0 && $char <= 0xDF)) {
1107 if ($chars{$char*256+$data[$i+1]}) {
1108 $convchar= $chars{$char * 256 + $data[$i+1]};
1110 # printf "char %x $char, char to convert %x , converted %x\n",$char,$char * 256 + $data[$i - 1],$convchar;
1111 } elsif ($chars{$char}) {
1112 $convchar= $chars{$char};
1113 # printf "0xC char %x, converted %x\n",$char,$chars{$char};
1117 push @characters,$convchar;
1120 if ($chars{$char}) {
1121 $convchar= $chars{$char};
1122 # printf "char %x, converted %x\n",$char,$chars{$char};
1124 # printf "char %x $char\n",$char;
1127 push @characters,$convchar;
1130 $result=pack "U*",@characters;
1131 # $result=~s/\x01//;
1132 # $result=~s/\x00//;
1136 $result=~s/\x1b\x5b//;
1137 # map{printf "%x",$_} @characters;
1147 Koha Development Team <info@koha.org>
1149 Galen Charlton <galen.charlton@liblime.com>