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
23 use MARC
::Charset qw
/marc8_to_utf8/;
27 use vars
qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
30 # 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);
114 =head2 MarcToUTF8Record
118 ($marc_record, $converted_from, $errors_arrayref) = MarcToUTF8Record($marc_blob, $marc_flavour, [, $source_encoding]);
122 Given a MARC blob or a C<MARC::Record>, the MARC flavour, and an
123 optional source encoding, return a C<MARC::Record> that is
126 The returned C<$marc_record> is guaranteed to be in valid UTF-8, but
127 is not guaranteed to have been converted correctly. Specifically,
128 if C<$converted_from> is 'failed', the MARC record returned failed
129 character conversion and had each of its non-ASCII octets changed
130 to the Unicode replacement character.
132 If the source encoding was not specified, this routine will
133 try to guess it; the character encoding used for a successful
134 conversion is returned in C<$converted_from>.
138 sub MarcToUTF8Record
{
140 my $marc_flavour = shift;
141 my $source_encoding = shift;
143 my $marc_blob_is_utf8 = 0;
144 if (ref($marc) eq 'MARC::Record') {
145 my $marc_blob = $marc->as_usmarc();
146 $marc_blob_is_utf8 = IsStringUTF8ish
($marc_blob);
147 $marc_record = $marc;
149 # dealing with a MARC blob
151 # remove any ersatz whitespace from the beginning and
152 # end of the MARC blob -- these can creep into MARC
153 # files produced by several sources -- caller really
154 # should be doing this, however
157 $marc_blob_is_utf8 = IsStringUTF8ish
($marc);
159 $marc_record = MARC
::Record
->new_from_usmarc($marc);
162 # if we fail the first time, one likely problem
163 # is that we have a MARC21 record that says that it's
164 # UTF-8 (Leader/09 = 'a') but contains non-UTF-8 characters.
165 # We'll try parsing it again.
166 substr($marc, 9, 1) = ' ';
168 $marc_record = MARC
::Record
->new_from_usmarc($marc);
171 # it's hopeless; return an empty MARC::Record
172 return MARC
::Record
->new(), 'failed', ['could not parse MARC blob'];
177 # If we do not know the source encoding, try some guesses
179 # 1. Record is UTF-8 already.
180 # 2. If MARC flavor is MARC21, then
181 # a. record is MARC-8
182 # b. record is ISO-8859-1
183 # 3. If MARC flavor is UNIMARC, then
184 if (not defined $source_encoding) {
185 if ($marc_blob_is_utf8) {
186 # note that for MARC21 we are not bothering to check
187 # if the Leader/09 is set to 'a' or not -- because
188 # of problems with various ILSs (including Koha in the
189 # past, alas), this just is not trustworthy.
190 SetMarcUnicodeFlag
($marc_record, $marc_flavour);
191 return $marc_record, 'UTF-8', [];
193 if ($marc_flavour eq 'MARC21') {
194 return _default_marc21_charconv_to_utf8
($marc_record, $marc_flavour);
195 } elsif ($marc_flavour =~/UNIMARC/) {
196 return _default_unimarc_charconv_to_utf8
($marc_record, $marc_flavour);
198 return _default_marc21_charconv_to_utf8
($marc_record, $marc_flavour);
202 # caller knows the character encoding
203 my $original_marc_record = $marc_record->clone();
205 if ($source_encoding =~ /utf-?8/i) {
206 if ($marc_blob_is_utf8) {
207 SetMarcUnicodeFlag
($marc_record, $marc_flavour);
208 return $marc_record, 'UTF-8', [];
210 push @errors, 'specified UTF-8 => UTF-8 conversion, but record is not in UTF-8';
212 } elsif ($source_encoding =~ /marc-?8/i) {
213 @errors = _marc_marc8_to_utf8
($marc_record, $marc_flavour);
214 } elsif ($source_encoding =~ /5426/) {
215 @errors = _marc_iso5426_to_utf8
($marc_record, $marc_flavour);
217 # assume any other character encoding is for Text::Iconv
218 @errors = _marc_to_utf8_via_text_iconv
($marc_record, $marc_flavour, $source_encoding);
222 _marc_to_utf8_replacement_char
($original_marc_record, $marc_flavour);
223 return $original_marc_record, 'failed', \
@errors;
225 return $marc_record, $source_encoding, [];
231 =head2 SetMarcUnicodeFlag
235 SetMarcUnicodeFlag($marc_record, $marc_flavour);
239 Set both the internal MARC::Record encoding flag
240 and the appropriate Leader/09 (MARC21) or
241 100/26-29 (UNIMARC) to indicate that the record
242 is in UTF-8. Note that this does B<not> do
243 any actual character conversion.
247 sub SetMarcUnicodeFlag
{
248 my $marc_record = shift;
249 my $marc_flavour = shift; # || C4::Context->preference("marcflavour");
251 $marc_record->encoding('UTF-8');
252 if ($marc_flavour eq 'MARC21') {
253 my $leader = $marc_record->leader();
254 substr($leader, 9, 1) = 'a';
255 $marc_record->leader($leader);
256 } elsif ($marc_flavour =~/UNIMARC/) {
258 my ($subflength,$encodingposition)=($marc_flavour=~/AUTH/?
(21,8):(36,22));
259 $string=$marc_record->subfield( 100, "a" );
260 if (length($string)==$subflength) {
261 $string = substr $string, 0,$subflength if (length($string)>$subflength);
264 $string = POSIX
::strftime
( "%Y%m%d", localtime );
266 $string = sprintf( "%-*s", $subflength, $string );
268 substr( $string, $encodingposition, 8, "frey50 " );
269 if ( $marc_record->subfield( 100, "a" ) ) {
270 $marc_record->field('100')->update(a
=>$string);
273 $marc_record->insert_grouped_field(
274 MARC
::Field
->new( 100, '', '', "a" => $string ) );
276 $debug && warn "encodage: ", substr( $marc_record->subfield(100, 'a'), $encodingposition, 8 );
278 warn "Unrecognized marcflavour: $marc_flavour";
282 =head2 StripNonXmlChars
286 my $new_str = StripNonXmlChars($old_str);
290 Given a string, return a copy with the
291 characters that are illegal in XML
294 This function exists to work around a problem
295 that can occur with badly-encoded MARC records.
296 Specifically, if a UTF-8 MARC record also
297 has excape (\x1b) characters, MARC::File::XML
298 will let the escape characters pass through
299 when as_xml() or as_xml_record() is called. The
300 problem is that the escape character is not
301 legal in well-formed XML documents, so when
302 MARC::File::XML attempts to parse such a record,
303 the XML parser will fail.
305 Stripping such characters will allow a
306 MARC::Record->new_from_xml()
307 to work, at the possible risk of some data loss.
311 sub StripNonXmlChars
{
313 if (!defined($str) || $str eq ""){
316 $str =~ s/[^\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
320 =head1 INTERNAL FUNCTIONS
322 =head2 _default_marc21_charconv_to_utf8
326 my ($new_marc_record, $guessed_charset) = _default_marc21_charconv_to_utf8($marc_record);
330 Converts a C<MARC::Record> of unknown character set to UTF-8,
331 first by trying a MARC-8 to UTF-8 conversion, then ISO-8859-1
332 to UTF-8, then a default conversion that replaces each non-ASCII
333 character with the replacement character.
335 The C<$guessed_charset> return value contains the character set
336 that resulted in a conversion to valid UTF-8; note that
337 if the MARC-8 and ISO-8859-1 conversions failed, the value of
342 sub _default_marc21_charconv_to_utf8
{
343 my $marc_record = shift;
344 my $marc_flavour = shift;
346 my $trial_marc8 = $marc_record->clone();
348 my @errors = _marc_marc8_to_utf8
($trial_marc8, $marc_flavour);
350 return $trial_marc8, 'MARC-8', [];
352 push @all_errors, @errors;
354 my $trial_8859_1 = $marc_record->clone();
355 @errors = _marc_to_utf8_via_text_iconv
($trial_8859_1, $marc_flavour, 'iso-8859-1');
357 return $trial_8859_1, 'iso-8859-1', []; # note -- we could return \@all_errors
358 # instead if we wanted to report details
359 # of the failed attempt at MARC-8 => UTF-8
361 push @all_errors, @errors;
363 my $default_converted = $marc_record->clone();
364 _marc_to_utf8_replacement_char
($default_converted, $marc_flavour);
365 return $default_converted, 'failed', \
@all_errors;
368 =head2 _default_unimarc_charconv_to_utf8
372 my ($new_marc_record, $guessed_charset) = _default_unimarc_charconv_to_utf8($marc_record);
376 Converts a C<MARC::Record> of unknown character set to UTF-8,
377 first by trying a ISO-5426 to UTF-8 conversion, then ISO-8859-1
378 to UTF-8, then a default conversion that replaces each non-ASCII
379 character with the replacement character.
381 The C<$guessed_charset> return value contains the character set
382 that resulted in a conversion to valid UTF-8; note that
383 if the MARC-8 and ISO-8859-1 conversions failed, the value of
388 sub _default_unimarc_charconv_to_utf8
{
389 my $marc_record = shift;
390 my $marc_flavour = shift;
392 my $trial_marc8 = $marc_record->clone();
394 my @errors = _marc_iso5426_to_utf8
($trial_marc8, $marc_flavour);
396 return $trial_marc8, 'iso-5426';
398 push @all_errors, @errors;
400 my $trial_8859_1 = $marc_record->clone();
401 @errors = _marc_to_utf8_via_text_iconv
($trial_8859_1, $marc_flavour, 'iso-8859-1');
403 return $trial_8859_1, 'iso-8859-1';
405 push @all_errors, @errors;
407 my $default_converted = $marc_record->clone();
408 _marc_to_utf8_replacement_char
($default_converted, $marc_flavour);
409 return $default_converted, 'failed', \
@all_errors;
412 =head2 _marc_marc8_to_utf8
416 my @errors = _marc_marc8_to_utf8($marc_record, $marc_flavour, $source_encoding);
420 Convert a C<MARC::Record> to UTF-8 in-place from MARC-8.
421 If the conversion fails for some reason, an
422 appropriate messages will be placed in the returned
427 sub _marc_marc8_to_utf8
{
428 my $marc_record = shift;
429 my $marc_flavour = shift;
431 my $prev_ignore = MARC
::Charset
->ignore_errors();
432 MARC
::Charset
->ignore_errors(1);
434 # trap warnings raised by MARC::Charset
436 local $SIG{__WARN__
} = sub {
438 if ($msg =~ /MARC.Charset/) {
439 # FIXME - purpose of this regexp is to strip out the
440 # line reference to MARC/Charset.pm, but as it
441 # exists probably won't work quite on Windows --
442 # some sort of minimal-bunch back-tracking RE
443 # would be helpful here
444 $msg =~ s/at [\/].*?.MARC.Charset\.pm line \d+\.\n$//;
447 # if warning doesn't come from MARC::Charset, just
453 foreach my $field ($marc_record->fields()) {
454 if ($field->is_control_field()) {
455 ; # do nothing -- control fields should not contain non-ASCII characters
457 my @converted_subfields;
458 foreach my $subfield ($field->subfields()) {
459 my $utf8sf = MARC
::Charset
::marc8_to_utf8
($subfield->[1]);
460 unless (IsStringUTF8ish
($utf8sf)) {
461 # Because of a bug in MARC::Charset 0.98, if the string
462 # has (a) one or more diacritics that (b) are only in character positions
463 # 128 to 255 inclusive, the resulting converted string is not in
464 # UTF-8, but the legacy 8-bit encoding (e.g., ISO-8859-1). If that
465 # occurs, upgrade the string in place. Moral of the story seems to be
466 # that pack("U", ...) is better than chr(...) if you need to guarantee
467 # that the resulting string is UTF-8.
468 utf8
::upgrade
($utf8sf);
470 push @converted_subfields, $subfield->[0], $utf8sf;
473 $field->replace_with(MARC
::Field
->new(
474 $field->tag(), $field->indicator(1), $field->indicator(2),
475 @converted_subfields)
480 MARC
::Charset
->ignore_errors($prev_ignore);
482 SetMarcUnicodeFlag
($marc_record, $marc_flavour);
487 =head2 _marc_iso5426_to_utf8
491 my @errors = _marc_iso5426_to_utf8($marc_record, $marc_flavour, $source_encoding);
495 Convert a C<MARC::Record> to UTF-8 in-place from ISO-5426.
496 If the conversion fails for some reason, an
497 appropriate messages will be placed in the returned
500 FIXME - is ISO-5426 equivalent enough to MARC-8
501 that C<MARC::Charset> can be used instead?
505 sub _marc_iso5426_to_utf8
{
506 my $marc_record = shift;
507 my $marc_flavour = shift;
511 foreach my $field ($marc_record->fields()) {
512 if ($field->is_control_field()) {
513 ; # do nothing -- control fields should not contain non-ASCII characters
515 my @converted_subfields;
516 foreach my $subfield ($field->subfields()) {
517 my $utf8sf = char_decode5426
($subfield->[1]);
518 push @converted_subfields, $subfield->[0], $utf8sf;
521 $field->replace_with(MARC
::Field
->new(
522 $field->tag(), $field->indicator(1), $field->indicator(2),
523 @converted_subfields)
528 SetMarcUnicodeFlag
($marc_record, $marc_flavour);
533 =head2 _marc_to_utf8_via_text_iconv
537 my @errors = _marc_to_utf8_via_text_iconv($marc_record, $marc_flavour, $source_encoding);
541 Convert a C<MARC::Record> to UTF-8 in-place using the
542 C<Text::Iconv> CPAN module. Any source encoding accepted
543 by the user's iconv installation should work. If
544 the source encoding is not recognized on the user's
545 server or the conversion fails for some reason,
546 appropriate messages will be placed in the returned
551 sub _marc_to_utf8_via_text_iconv
{
552 my $marc_record = shift;
553 my $marc_flavour = shift;
554 my $source_encoding = shift;
558 eval { $decoder = Text
::Iconv
->new($source_encoding, 'utf8'); };
560 push @errors, "Could not initialze $source_encoding => utf8 converter: $@";
564 my $prev_raise_error = Text
::Iconv
->raise_error();
565 Text
::Iconv
->raise_error(1);
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()) {
574 my $conversion_ok = 1;
575 eval { $converted_value = $decoder->convert($subfield->[1]); };
579 } elsif (not defined $converted_value) {
581 push @errors, "Text::Iconv conversion failed - retval is " . $decoder->retval();
584 if ($conversion_ok) {
585 push @converted_subfields, $subfield->[0], $converted_value;
587 $converted_value = $subfield->[1];
588 $converted_value =~ s/[\200-\377]/\xef\xbf\xbd/g;
589 push @converted_subfields, $subfield->[0], $converted_value;
593 $field->replace_with(MARC
::Field
->new(
594 $field->tag(), $field->indicator(1), $field->indicator(2),
595 @converted_subfields)
600 SetMarcUnicodeFlag
($marc_record, $marc_flavour);
601 Text
::Iconv
->raise_error($prev_raise_error);
606 =head2 _marc_to_utf8_replacement_char
610 _marc_to_utf8_replacement_char($marc_record, $marc_flavour);
614 Convert a C<MARC::Record> to UTF-8 in-place, adopting the
615 unsatisfactory method of replacing all non-ASCII (e.g.,
616 where the eight bit is set) octet with the Unicode
617 replacement character. This is meant as a last-ditch
618 method, and would be best used as part of a UI that
619 lets a cataloguer pick various character conversions
620 until he or she finds the right one.
624 sub _marc_to_utf8_replacement_char
{
625 my $marc_record = shift;
626 my $marc_flavour = shift;
628 foreach my $field ($marc_record->fields()) {
629 if ($field->is_control_field()) {
630 ; # do nothing -- control fields should not contain non-ASCII characters
632 my @converted_subfields;
633 foreach my $subfield ($field->subfields()) {
634 my $value = $subfield->[1];
635 $value =~ s/[\200-\377]/\xef\xbf\xbd/g;
636 push @converted_subfields, $subfield->[0], $value;
639 $field->replace_with(MARC
::Field
->new(
640 $field->tag(), $field->indicator(1), $field->indicator(2),
641 @converted_subfields)
646 SetMarcUnicodeFlag
($marc_record, $marc_flavour);
649 =head2 char_decode5426
653 my $utf8string = char_decode5426($iso_5426_string);
657 Converts a string from ISO-5426 to UTF-8.
663 $chars{0xb0}=0x0101;#3/0ayn[ain]
664 $chars{0xb1}=0x0623;#3/1alif/hamzah[alefwithhamzaabove]
665 #$chars{0xb2}=0x00e0;#'Ã ';
666 $chars{0xb2}=0x00e0;#3/2leftlowsinglequotationmark
667 #$chars{0xb3}=0x00e7;#'ç';
668 $chars{0xb3}=0x00e7;#3/2leftlowsinglequotationmark
673 $chars{0x97}=0x003c;#3/2leftlowsinglequotationmark
674 $chars{0x98}=0x003e;#3/2leftlowsinglequotationmark
675 $chars{0xfa}=0x0153;#oe
676 $chars{0x81d1}=0x00b0;
679 ## combined characters iso5426
681 $chars{0xc041}=0x1ea2; # capital a with hook above
682 $chars{0xc045}=0x1eba; # capital e with hook above
683 $chars{0xc049}=0x1ec8; # capital i with hook above
684 $chars{0xc04f}=0x1ece; # capital o with hook above
685 $chars{0xc055}=0x1ee6; # capital u with hook above
686 $chars{0xc059}=0x1ef6; # capital y with hook above
687 $chars{0xc061}=0x1ea3; # small a with hook above
688 $chars{0xc065}=0x1ebb; # small e with hook above
689 $chars{0xc069}=0x1ec9; # small i with hook above
690 $chars{0xc06f}=0x1ecf; # small o with hook above
691 $chars{0xc075}=0x1ee7; # small u with hook above
692 $chars{0xc079}=0x1ef7; # small y with hook above
695 $chars{0xc141}=0x00c0; # capital a with grave accent
696 $chars{0xc145}=0x00c8; # capital e with grave accent
697 $chars{0xc149}=0x00cc; # capital i with grave accent
698 $chars{0xc14f}=0x00d2; # capital o with grave accent
699 $chars{0xc155}=0x00d9; # capital u with grave accent
700 $chars{0xc157}=0x1e80; # capital w with grave
701 $chars{0xc159}=0x1ef2; # capital y with grave
702 $chars{0xc161}=0x00e0; # small a with grave accent
703 $chars{0xc165}=0x00e8; # small e with grave accent
704 $chars{0xc169}=0x00ec; # small i with grave accent
705 $chars{0xc16f}=0x00f2; # small o with grave accent
706 $chars{0xc175}=0x00f9; # small u with grave accent
707 $chars{0xc177}=0x1e81; # small w with grave
708 $chars{0xc179}=0x1ef3; # small y with grave
710 $chars{0xc241}=0x00c1; # capital a with acute accent
711 $chars{0xc243}=0x0106; # capital c with acute accent
712 $chars{0xc245}=0x00c9; # capital e with acute accent
713 $chars{0xc247}=0x01f4; # capital g with acute
714 $chars{0xc249}=0x00cd; # capital i with acute accent
715 $chars{0xc24b}=0x1e30; # capital k with acute
716 $chars{0xc24c}=0x0139; # capital l with acute accent
717 $chars{0xc24d}=0x1e3e; # capital m with acute
718 $chars{0xc24e}=0x0143; # capital n with acute accent
719 $chars{0xc24f}=0x00d3; # capital o with acute accent
720 $chars{0xc250}=0x1e54; # capital p with acute
721 $chars{0xc252}=0x0154; # capital r with acute accent
722 $chars{0xc253}=0x015a; # capital s with acute accent
723 $chars{0xc255}=0x00da; # capital u with acute accent
724 $chars{0xc257}=0x1e82; # capital w with acute
725 $chars{0xc259}=0x00dd; # capital y with acute accent
726 $chars{0xc25a}=0x0179; # capital z with acute accent
727 $chars{0xc261}=0x00e1; # small a with acute accent
728 $chars{0xc263}=0x0107; # small c with acute accent
729 $chars{0xc265}=0x00e9; # small e with acute accent
730 $chars{0xc267}=0x01f5; # small g with acute
731 $chars{0xc269}=0x00ed; # small i with acute accent
732 $chars{0xc26b}=0x1e31; # small k with acute
733 $chars{0xc26c}=0x013a; # small l with acute accent
734 $chars{0xc26d}=0x1e3f; # small m with acute
735 $chars{0xc26e}=0x0144; # small n with acute accent
736 $chars{0xc26f}=0x00f3; # small o with acute accent
737 $chars{0xc270}=0x1e55; # small p with acute
738 $chars{0xc272}=0x0155; # small r with acute accent
739 $chars{0xc273}=0x015b; # small s with acute accent
740 $chars{0xc275}=0x00fa; # small u with acute accent
741 $chars{0xc277}=0x1e83; # small w with acute
742 $chars{0xc279}=0x00fd; # small y with acute accent
743 $chars{0xc27a}=0x017a; # small z with acute accent
744 $chars{0xc2e1}=0x01fc; # capital ae with acute
745 $chars{0xc2f1}=0x01fd; # small ae with acute
746 # 4/3 circumflex accent
747 $chars{0xc341}=0x00c2; # capital a with circumflex accent
748 $chars{0xc343}=0x0108; # capital c with circumflex
749 $chars{0xc345}=0x00ca; # capital e with circumflex accent
750 $chars{0xc347}=0x011c; # capital g with circumflex
751 $chars{0xc348}=0x0124; # capital h with circumflex
752 $chars{0xc349}=0x00ce; # capital i with circumflex accent
753 $chars{0xc34a}=0x0134; # capital j with circumflex
754 $chars{0xc34f}=0x00d4; # capital o with circumflex accent
755 $chars{0xc353}=0x015c; # capital s with circumflex
756 $chars{0xc355}=0x00db; # capital u with circumflex
757 $chars{0xc357}=0x0174; # capital w with circumflex
758 $chars{0xc359}=0x0176; # capital y with circumflex
759 $chars{0xc35a}=0x1e90; # capital z with circumflex
760 $chars{0xc361}=0x00e2; # small a with circumflex accent
761 $chars{0xc363}=0x0109; # small c with circumflex
762 $chars{0xc365}=0x00ea; # small e with circumflex accent
763 $chars{0xc367}=0x011d; # small g with circumflex
764 $chars{0xc368}=0x0125; # small h with circumflex
765 $chars{0xc369}=0x00ee; # small i with circumflex accent
766 $chars{0xc36a}=0x0135; # small j with circumflex
767 $chars{0xc36e}=0x00f1; # small n with tilde
768 $chars{0xc36f}=0x00f4; # small o with circumflex accent
769 $chars{0xc373}=0x015d; # small s with circumflex
770 $chars{0xc375}=0x00fb; # small u with circumflex
771 $chars{0xc377}=0x0175; # small w with circumflex
772 $chars{0xc379}=0x0177; # small y with circumflex
773 $chars{0xc37a}=0x1e91; # small z with circumflex
775 $chars{0xc441}=0x00c3; # capital a with tilde
776 $chars{0xc445}=0x1ebc; # capital e with tilde
777 $chars{0xc449}=0x0128; # capital i with tilde
778 $chars{0xc44e}=0x00d1; # capital n with tilde
779 $chars{0xc44f}=0x00d5; # capital o with tilde
780 $chars{0xc455}=0x0168; # capital u with tilde
781 $chars{0xc456}=0x1e7c; # capital v with tilde
782 $chars{0xc459}=0x1ef8; # capital y with tilde
783 $chars{0xc461}=0x00e3; # small a with tilde
784 $chars{0xc465}=0x1ebd; # small e with tilde
785 $chars{0xc469}=0x0129; # small i with tilde
786 $chars{0xc46e}=0x00f1; # small n with tilde
787 $chars{0xc46f}=0x00f5; # small o with tilde
788 $chars{0xc475}=0x0169; # small u with tilde
789 $chars{0xc476}=0x1e7d; # small v with tilde
790 $chars{0xc479}=0x1ef9; # small y with tilde
792 $chars{0xc541}=0x0100; # capital a with macron
793 $chars{0xc545}=0x0112; # capital e with macron
794 $chars{0xc547}=0x1e20; # capital g with macron
795 $chars{0xc549}=0x012a; # capital i with macron
796 $chars{0xc54f}=0x014c; # capital o with macron
797 $chars{0xc555}=0x016a; # capital u with macron
798 $chars{0xc561}=0x0101; # small a with macron
799 $chars{0xc565}=0x0113; # small e with macron
800 $chars{0xc567}=0x1e21; # small g with macron
801 $chars{0xc569}=0x012b; # small i with macron
802 $chars{0xc56f}=0x014d; # small o with macron
803 $chars{0xc575}=0x016b; # small u with macron
804 $chars{0xc572}=0x0159; # small r with macron
805 $chars{0xc5e1}=0x01e2; # capital ae with macron
806 $chars{0xc5f1}=0x01e3; # small ae with macron
808 $chars{0xc641}=0x0102; # capital a with breve
809 $chars{0xc645}=0x0114; # capital e with breve
810 $chars{0xc647}=0x011e; # capital g with breve
811 $chars{0xc649}=0x012c; # capital i with breve
812 $chars{0xc64f}=0x014e; # capital o with breve
813 $chars{0xc655}=0x016c; # capital u with breve
814 $chars{0xc661}=0x0103; # small a with breve
815 $chars{0xc665}=0x0115; # small e with breve
816 $chars{0xc667}=0x011f; # small g with breve
817 $chars{0xc669}=0x012d; # small i with breve
818 $chars{0xc66f}=0x014f; # small o with breve
819 $chars{0xc675}=0x016d; # small u with breve
821 $chars{0xc7b0}=0x01e1; # Ain with dot above
822 $chars{0xc742}=0x1e02; # capital b with dot above
823 $chars{0xc743}=0x010a; # capital c with dot above
824 $chars{0xc744}=0x1e0a; # capital d with dot above
825 $chars{0xc745}=0x0116; # capital e with dot above
826 $chars{0xc746}=0x1e1e; # capital f with dot above
827 $chars{0xc747}=0x0120; # capital g with dot above
828 $chars{0xc748}=0x1e22; # capital h with dot above
829 $chars{0xc749}=0x0130; # capital i with dot above
830 $chars{0xc74d}=0x1e40; # capital m with dot above
831 $chars{0xc74e}=0x1e44; # capital n with dot above
832 $chars{0xc750}=0x1e56; # capital p with dot above
833 $chars{0xc752}=0x1e58; # capital r with dot above
834 $chars{0xc753}=0x1e60; # capital s with dot above
835 $chars{0xc754}=0x1e6a; # capital t with dot above
836 $chars{0xc757}=0x1e86; # capital w with dot above
837 $chars{0xc758}=0x1e8a; # capital x with dot above
838 $chars{0xc759}=0x1e8e; # capital y with dot above
839 $chars{0xc75a}=0x017b; # capital z with dot above
840 $chars{0xc761}=0x0227; # small b with dot above
841 $chars{0xc762}=0x1e03; # small b with dot above
842 $chars{0xc763}=0x010b; # small c with dot above
843 $chars{0xc764}=0x1e0b; # small d with dot above
844 $chars{0xc765}=0x0117; # small e with dot above
845 $chars{0xc766}=0x1e1f; # small f with dot above
846 $chars{0xc767}=0x0121; # small g with dot above
847 $chars{0xc768}=0x1e23; # small h with dot above
848 $chars{0xc76d}=0x1e41; # small m with dot above
849 $chars{0xc76e}=0x1e45; # small n with dot above
850 $chars{0xc770}=0x1e57; # small p with dot above
851 $chars{0xc772}=0x1e59; # small r with dot above
852 $chars{0xc773}=0x1e61; # small s with dot above
853 $chars{0xc774}=0x1e6b; # small t with dot above
854 $chars{0xc777}=0x1e87; # small w with dot above
855 $chars{0xc778}=0x1e8b; # small x with dot above
856 $chars{0xc779}=0x1e8f; # small y with dot above
857 $chars{0xc77a}=0x017c; # small z with dot above
858 # 4/8 trema, diaresis
859 $chars{0xc820}=0x00a8; # diaeresis
860 $chars{0xc841}=0x00c4; # capital a with diaeresis
861 $chars{0xc845}=0x00cb; # capital e with diaeresis
862 $chars{0xc848}=0x1e26; # capital h with diaeresis
863 $chars{0xc849}=0x00cf; # capital i with diaeresis
864 $chars{0xc84f}=0x00d6; # capital o with diaeresis
865 $chars{0xc855}=0x00dc; # capital u with diaeresis
866 $chars{0xc857}=0x1e84; # capital w with diaeresis
867 $chars{0xc858}=0x1e8c; # capital x with diaeresis
868 $chars{0xc859}=0x0178; # capital y with diaeresis
869 $chars{0xc861}=0x00e4; # small a with diaeresis
870 $chars{0xc865}=0x00eb; # small e with diaeresis
871 $chars{0xc868}=0x1e27; # small h with diaeresis
872 $chars{0xc869}=0x00ef; # small i with diaeresis
873 $chars{0xc86f}=0x00f6; # small o with diaeresis
874 $chars{0xc874}=0x1e97; # small t with diaeresis
875 $chars{0xc875}=0x00fc; # small u with diaeresis
876 $chars{0xc877}=0x1e85; # small w with diaeresis
877 $chars{0xc878}=0x1e8d; # small x with diaeresis
878 $chars{0xc879}=0x00ff; # small y with diaeresis
880 $chars{0xc920}=0x00a8; # [diaeresis]
881 $chars{0xc961}=0x00e4; # a with umlaut
882 $chars{0xc965}=0x00eb; # e with umlaut
883 $chars{0xc969}=0x00ef; # i with umlaut
884 $chars{0xc96f}=0x00f6; # o with umlaut
885 $chars{0xc975}=0x00fc; # u with umlaut
887 $chars{0xca41}=0x00c5; # capital a with ring above
888 $chars{0xcaad}=0x016e; # capital u with ring above
889 $chars{0xca61}=0x00e5; # small a with ring above
890 $chars{0xca75}=0x016f; # small u with ring above
891 $chars{0xca77}=0x1e98; # small w with ring above
892 $chars{0xca79}=0x1e99; # small y with ring above
893 # 4/11 high comma off centre
894 # 4/12 inverted high comma centred
895 # 4/13 double acute accent
896 $chars{0xcd4f}=0x0150; # capital o with double acute
897 $chars{0xcd55}=0x0170; # capital u with double acute
898 $chars{0xcd6f}=0x0151; # small o with double acute
899 $chars{0xcd75}=0x0171; # small u with double acute
901 $chars{0xce54}=0x01a0; # latin capital letter o with horn
902 $chars{0xce55}=0x01af; # latin capital letter u with horn
903 $chars{0xce74}=0x01a1; # latin small letter o with horn
904 $chars{0xce75}=0x01b0; # latin small letter u with horn
906 $chars{0xcf41}=0x01cd; # capital a with caron
907 $chars{0xcf43}=0x010c; # capital c with caron
908 $chars{0xcf44}=0x010e; # capital d with caron
909 $chars{0xcf45}=0x011a; # capital e with caron
910 $chars{0xcf47}=0x01e6; # capital g with caron
911 $chars{0xcf49}=0x01cf; # capital i with caron
912 $chars{0xcf4b}=0x01e8; # capital k with caron
913 $chars{0xcf4c}=0x013d; # capital l with caron
914 $chars{0xcf4e}=0x0147; # capital n with caron
915 $chars{0xcf4f}=0x01d1; # capital o with caron
916 $chars{0xcf52}=0x0158; # capital r with caron
917 $chars{0xcf53}=0x0160; # capital s with caron
918 $chars{0xcf54}=0x0164; # capital t with caron
919 $chars{0xcf55}=0x01d3; # capital u with caron
920 $chars{0xcf5a}=0x017d; # capital z with caron
921 $chars{0xcf61}=0x01ce; # small a with caron
922 $chars{0xcf63}=0x010d; # small c with caron
923 $chars{0xcf64}=0x010f; # small d with caron
924 $chars{0xcf65}=0x011b; # small e with caron
925 $chars{0xcf67}=0x01e7; # small g with caron
926 $chars{0xcf69}=0x01d0; # small i with caron
927 $chars{0xcf6a}=0x01f0; # small j with caron
928 $chars{0xcf6b}=0x01e9; # small k with caron
929 $chars{0xcf6c}=0x013e; # small l with caron
930 $chars{0xcf6e}=0x0148; # small n with caron
931 $chars{0xcf6f}=0x01d2; # small o with caron
932 $chars{0xcf72}=0x0159; # small r with caron
933 $chars{0xcf73}=0x0161; # small s with caron
934 $chars{0xcf74}=0x0165; # small t with caron
935 $chars{0xcf75}=0x01d4; # small u with caron
936 $chars{0xcf7a}=0x017e; # small z with caron
938 $chars{0xd020}=0x00b8; # cedilla
939 $chars{0xd043}=0x00c7; # capital c with cedilla
940 $chars{0xd044}=0x1e10; # capital d with cedilla
941 $chars{0xd047}=0x0122; # capital g with cedilla
942 $chars{0xd048}=0x1e28; # capital h with cedilla
943 $chars{0xd04b}=0x0136; # capital k with cedilla
944 $chars{0xd04c}=0x013b; # capital l with cedilla
945 $chars{0xd04e}=0x0145; # capital n with cedilla
946 $chars{0xd052}=0x0156; # capital r with cedilla
947 $chars{0xd053}=0x015e; # capital s with cedilla
948 $chars{0xd054}=0x0162; # capital t with cedilla
949 $chars{0xd063}=0x00e7; # small c with cedilla
950 $chars{0xd064}=0x1e11; # small d with cedilla
951 $chars{0xd065}=0x0119; # small e with cedilla
952 $chars{0xd067}=0x0123; # small g with cedilla
953 $chars{0xd068}=0x1e29; # small h with cedilla
954 $chars{0xd06b}=0x0137; # small k with cedilla
955 $chars{0xd06c}=0x013c; # small l with cedilla
956 $chars{0xd06e}=0x0146; # small n with cedilla
957 $chars{0xd072}=0x0157; # small r with cedilla
958 $chars{0xd073}=0x015f; # small s with cedilla
959 $chars{0xd074}=0x0163; # small t with cedilla
962 # 5/3 ogonek (hook to right
963 $chars{0xd320}=0x02db; # ogonek
964 $chars{0xd341}=0x0104; # capital a with ogonek
965 $chars{0xd345}=0x0118; # capital e with ogonek
966 $chars{0xd349}=0x012e; # capital i with ogonek
967 $chars{0xd34f}=0x01ea; # capital o with ogonek
968 $chars{0xd355}=0x0172; # capital u with ogonek
969 $chars{0xd361}=0x0105; # small a with ogonek
970 $chars{0xd365}=0x0119; # small e with ogonek
971 $chars{0xd369}=0x012f; # small i with ogonek
972 $chars{0xd36f}=0x01eb; # small o with ogonek
973 $chars{0xd375}=0x0173; # small u with ogonek
975 $chars{0xd441}=0x1e00; # capital a with ring below
976 $chars{0xd461}=0x1e01; # small a with ring below
977 # 5/5 half circle below
978 $chars{0xf948}=0x1e2a; # capital h with breve below
979 $chars{0xf968}=0x1e2b; # small h with breve below
981 $chars{0xd641}=0x1ea0; # capital a with dot below
982 $chars{0xd642}=0x1e04; # capital b with dot below
983 $chars{0xd644}=0x1e0c; # capital d with dot below
984 $chars{0xd645}=0x1eb8; # capital e with dot below
985 $chars{0xd648}=0x1e24; # capital h with dot below
986 $chars{0xd649}=0x1eca; # capital i with dot below
987 $chars{0xd64b}=0x1e32; # capital k with dot below
988 $chars{0xd64c}=0x1e36; # capital l with dot below
989 $chars{0xd64d}=0x1e42; # capital m with dot below
990 $chars{0xd64e}=0x1e46; # capital n with dot below
991 $chars{0xd64f}=0x1ecc; # capital o with dot below
992 $chars{0xd652}=0x1e5a; # capital r with dot below
993 $chars{0xd653}=0x1e62; # capital s with dot below
994 $chars{0xd654}=0x1e6c; # capital t with dot below
995 $chars{0xd655}=0x1ee4; # capital u with dot below
996 $chars{0xd656}=0x1e7e; # capital v with dot below
997 $chars{0xd657}=0x1e88; # capital w with dot below
998 $chars{0xd659}=0x1ef4; # capital y with dot below
999 $chars{0xd65a}=0x1e92; # capital z with dot below
1000 $chars{0xd661}=0x1ea1; # small a with dot below
1001 $chars{0xd662}=0x1e05; # small b with dot below
1002 $chars{0xd664}=0x1e0d; # small d with dot below
1003 $chars{0xd665}=0x1eb9; # small e with dot below
1004 $chars{0xd668}=0x1e25; # small h with dot below
1005 $chars{0xd669}=0x1ecb; # small i with dot below
1006 $chars{0xd66b}=0x1e33; # small k with dot below
1007 $chars{0xd66c}=0x1e37; # small l with dot below
1008 $chars{0xd66d}=0x1e43; # small m with dot below
1009 $chars{0xd66e}=0x1e47; # small n with dot below
1010 $chars{0xd66f}=0x1ecd; # small o with dot below
1011 $chars{0xd672}=0x1e5b; # small r with dot below
1012 $chars{0xd673}=0x1e63; # small s with dot below
1013 $chars{0xd674}=0x1e6d; # small t with dot below
1014 $chars{0xd675}=0x1ee5; # small u with dot below
1015 $chars{0xd676}=0x1e7f; # small v with dot below
1016 $chars{0xd677}=0x1e89; # small w with dot below
1017 $chars{0xd679}=0x1ef5; # small y with dot below
1018 $chars{0xd67a}=0x1e93; # small z with dot below
1019 # 5/7 double dot below
1020 $chars{0xd755}=0x1e72; # capital u with diaeresis below
1021 $chars{0xd775}=0x1e73; # small u with diaeresis below
1023 $chars{0xd820}=0x005f; # underline
1024 # 5/9 double underline
1025 $chars{0xd920}=0x2017; # double underline
1026 # 5/10 small low vertical bar
1027 $chars{0xda20}=0x02cc; #
1028 # 5/11 circumflex below
1029 # 5/12 (this position shall not be used)
1030 # 5/13 left half of ligature sign and of double tilde
1031 # 5/14 right half of ligature sign
1032 # 5/15 right half of double tilde
1033 # map {printf "%x :%x\n",$_,$chars{$_};}keys %chars;
1035 sub char_decode5426
{
1039 my @data = unpack("C*", $string);
1041 my $length=scalar(@data);
1042 for (my $i = 0; $i < scalar(@data); $i++) {
1043 my $char= $data[$i];
1044 if ($char >= 0x00 && $char <= 0x7F){
1047 push @characters,$char unless ($char<0x02 ||$char== 0x0F);
1048 }elsif (($char >= 0xC0 && $char <= 0xDF)) {
1051 if ($chars{$char*256+$data[$i+1]}) {
1052 $convchar= $chars{$char * 256 + $data[$i+1]};
1054 # printf "char %x $char, char to convert %x , converted %x\n",$char,$char * 256 + $data[$i - 1],$convchar;
1055 } elsif ($chars{$char}) {
1056 $convchar= $chars{$char};
1057 # printf "0xC char %x, converted %x\n",$char,$chars{$char};
1061 push @characters,$convchar;
1064 if ($chars{$char}) {
1065 $convchar= $chars{$char};
1066 # printf "char %x, converted %x\n",$char,$chars{$char};
1068 # printf "char %x $char\n",$char;
1071 push @characters,$convchar;
1074 $result=pack "U*",@characters;
1075 # $result=~s/\x01//;
1076 # $result=~s/\x00//;
1080 $result=~s/\x1b\x5b//;
1081 # map{printf "%x",$_} @characters;
1091 Koha Development Team <info@koha.org>
1093 Galen Charlton <galen.charlton@liblime.com>