C4/Charset.pm

   1 package C4::Charset;
   2
   3 # Copyright (C) 2008 LibLime
   4 #
   5 # This file is part of Koha.
   6 #
   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
  10 # version.
  11 #
  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.
  15 #
  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
  19
  20 use strict;
  21 use warnings;
  22
  23 use MARC::Charset qw/marc8_to_utf8/;
  24 use Text::Iconv;
  25 use C4::Debug;
  26
  27 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  28
  29 BEGIN {
  30     # set the version for version checking
  31     $VERSION = 3.01;
  32     require Exporter;
  33     @ISA    = qw(Exporter);
  34     @EXPORT = qw(
  35         IsStringUTF8ish
  36         MarcToUTF8Record
  37         SetMarcUnicodeFlag
  38         StripNonXmlChars
  39     );
  40 }
  41
  42 =head1 NAME
  43
  44 C4::Charset - utilities for handling character set conversions.
  45
  46 =head1 SYNOPSIS
  47
  48 use C4::Charset;
  49
  50 =head1 DESCRIPTION
  51
  52 This module contains routines for dealing with character set
  53 conversions, particularly for MARC records.
  54
  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
  61 trust it.
  62
  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.
  70
  71 =cut
  72
  73 =head1 FUNCTIONS
  74
  75 =head2 IsStringUTF8ish
  76
  77 =over 4
  78
  79 my $is_utf8 = IsStringUTF8ish($str);
  80
  81 =back
  82
  83 Determines if C<$str> is valid UTF-8.  This can mean
  84 one of two things:
  85
  86 =over 2
  87
  88 =item *
  89
  90 The Perl UTF-8 flag is set and the string contains valid UTF-8.
  91
  92 =item *
  93
  94 The Perl UTF-8 flag is B<not> set, but the octets contain
  95 valid UTF-8.
  96
  97 =back
  98
  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.
 104
 105 =cut
 106
 107 sub IsStringUTF8ish {
 108     my $str = shift;
 109
 110     return 1 if utf8::is_utf8($str);
 111     return utf8::decode($str);
 112 }
 113
 114 =head2 MarcToUTF8Record
 115
 116 =over 4
 117
 118 ($marc_record, $converted_from, $errors_arrayref) = MarcToUTF8Record($marc_blob, $marc_flavour, [, $source_encoding]);
 119
 120 =back
 121
 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
 124 converted to UTF-8.
 125
 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.
 131
 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>.
 135
 136 =cut
 137
 138 sub MarcToUTF8Record {
 139     my $marc = shift;
 140     my $marc_flavour = shift;
 141     my $source_encoding = shift;
 142     my $marc_record;
 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;
 148     } else {
 149         # dealing with a MARC blob
 150
 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
 155         $marc =~ s/^\s+//;
 156         $marc =~ s/\s+$//;
 157         $marc_blob_is_utf8 = IsStringUTF8ish($marc);
 158         eval {
 159             $marc_record = MARC::Record->new_from_usmarc($marc);
 160         };
 161         if ($@) {
 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) = ' ';
 167             eval {
 168                 $marc_record = MARC::Record->new_from_usmarc($marc);
 169             };
 170             if ($@) {
 171                 # it's hopeless; return an empty MARC::Record
 172                 return MARC::Record->new(), 'failed', ['could not parse MARC blob'];
 173             }
 174         }
 175     }
 176
 177     # If we do not know the source encoding, try some guesses
 178     # as follows:
 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', [];
 192         } else {
 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);
 197             } else {
 198                 return _default_marc21_charconv_to_utf8($marc_record, $marc_flavour);
 199             }
 200         }
 201     } else {
 202         # caller knows the character encoding
 203         my $original_marc_record = $marc_record->clone();
 204         my @errors;
 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', [];
 209             } else {
 210                 push @errors, 'specified UTF-8 => UTF-8 conversion, but record is not in UTF-8';
 211             }
 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);
 216         } else {
 217             # assume any other character encoding is for Text::Iconv
 218             @errors = _marc_to_utf8_via_text_iconv($marc_record, $marc_flavour, $source_encoding);
 219         }
 220
 221         if (@errors) {
 222             _marc_to_utf8_replacement_char($original_marc_record, $marc_flavour);
 223             return $original_marc_record, 'failed', \@errors;
 224         } else {
 225             return $marc_record, $source_encoding, [];
 226         }
 227     }
 228
 229 }
 230
 231 =head2 SetMarcUnicodeFlag
 232
 233 =over 4
 234
 235 SetMarcUnicodeFlag($marc_record, $marc_flavour);
 236
 237 =back
 238
 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.
 244
 245 =cut
 246
 247 sub SetMarcUnicodeFlag {
 248     my $marc_record = shift;
 249     my $marc_flavour = shift; # || C4::Context->preference("marcflavour");
 250
 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/) {
 257         my $string;
 258                 my ($subflength,$encodingposition)=($marc_flavour=~/AUTH/?(21,9):(36,22));
 259                 $string=$marc_record->subfield( 100, "a" );
 260         if (defined $string && length($string)==$subflength) {
 261                         $string = substr $string, 0,$subflength if (length($string)>$subflength);
 262         }
 263         else {
 264             $string = POSIX::strftime( "%Y%m%d", localtime );
 265             $string =~ s/\-//g;
 266             $string = sprintf( "%-*s", $subflength, $string );
 267         }
 268         substr( $string, $encodingposition, 8, "frey50  " );
 269         if ( $marc_record->subfield( 100, "a" ) ) {
 270                         $marc_record->field('100')->update(a=>$string);
 271                 }
 272                 else {
 273             $marc_record->insert_grouped_field(
 274                 MARC::Field->new( 100, '', '', "a" => $string ) );
 275         }
 276                 $debug && warn "encodage: ", substr( $marc_record->subfield(100, 'a'), $encodingposition, 8 );
 277     } else {
 278         warn "Unrecognized marcflavour: $marc_flavour";
 279     }
 280 }
 281
 282 =head2 StripNonXmlChars
 283
 284 =over 4
 285
 286 my $new_str = StripNonXmlChars($old_str);
 287
 288 =back
 289
 290 Given a string, return a copy with the
 291 characters that are illegal in XML
 292 removed.
 293
 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.
 304
 305 Stripping such characters will allow a
 306 MARC::Record->new_from_xml()
 307 to work, at the possible risk of some data loss.
 308
 309 =cut
 310
 311 sub StripNonXmlChars {
 312     my $str = shift;
 313     if (!defined($str) || $str eq ""){
 314         return "";
 315     }
 316     $str =~ s/[^\x09\x0A\x0D\x{0020}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
 317     return $str;
 318 }
 319
 320 =head1 INTERNAL FUNCTIONS
 321
 322 =head2 _default_marc21_charconv_to_utf8
 323
 324 =over 4
 325
 326 my ($new_marc_record, $guessed_charset) = _default_marc21_charconv_to_utf8($marc_record);
 327
 328 =back
 329
 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.
 334
 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
 338 this is 'failed'.
 339
 340 =cut
 341
 342 sub _default_marc21_charconv_to_utf8 {
 343     my $marc_record = shift;
 344     my $marc_flavour = shift;
 345
 346     my $trial_marc8 = $marc_record->clone();
 347     my @all_errors = ();
 348     my @errors = _marc_marc8_to_utf8($trial_marc8, $marc_flavour);
 349     unless (@errors) {
 350         return $trial_marc8, 'MARC-8', [];
 351     }
 352     push @all_errors, @errors;
 353
 354     my $trial_8859_1 = $marc_record->clone();
 355     @errors = _marc_to_utf8_via_text_iconv($trial_8859_1, $marc_flavour, 'iso-8859-1');
 356     unless (@errors) {
 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
 360     }
 361     push @all_errors, @errors;
 362
 363     my $default_converted = $marc_record->clone();
 364     _marc_to_utf8_replacement_char($default_converted, $marc_flavour);
 365     return $default_converted, 'failed', \@all_errors;
 366 }
 367
 368 =head2 _default_unimarc_charconv_to_utf8
 369
 370 =over 4
 371
 372 my ($new_marc_record, $guessed_charset) = _default_unimarc_charconv_to_utf8($marc_record);
 373
 374 =back
 375
 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.
 380
 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
 384 this is 'failed'.
 385
 386 =cut
 387
 388 sub _default_unimarc_charconv_to_utf8 {
 389     my $marc_record = shift;
 390     my $marc_flavour = shift;
 391
 392     my $trial_marc8 = $marc_record->clone();
 393     my @all_errors = ();
 394     my @errors = _marc_iso5426_to_utf8($trial_marc8, $marc_flavour);
 395     unless (@errors) {
 396         return $trial_marc8, 'iso-5426';
 397     }
 398     push @all_errors, @errors;
 399
 400     my $trial_8859_1 = $marc_record->clone();
 401     @errors = _marc_to_utf8_via_text_iconv($trial_8859_1, $marc_flavour, 'iso-8859-1');
 402     unless (@errors) {
 403         return $trial_8859_1, 'iso-8859-1';
 404     }
 405     push @all_errors, @errors;
 406
 407     my $default_converted = $marc_record->clone();
 408     _marc_to_utf8_replacement_char($default_converted, $marc_flavour);
 409     return $default_converted, 'failed', \@all_errors;
 410 }
 411
 412 =head2 _marc_marc8_to_utf8
 413
 414 =over 4
 415
 416 my @errors = _marc_marc8_to_utf8($marc_record, $marc_flavour, $source_encoding);
 417
 418 =back
 419
 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
 423 C<@errors> array.
 424
 425 =cut
 426
 427 sub _marc_marc8_to_utf8 {
 428     my $marc_record = shift;
 429     my $marc_flavour = shift;
 430
 431     my $prev_ignore = MARC::Charset->ignore_errors();
 432     MARC::Charset->ignore_errors(1);
 433
 434     # trap warnings raised by MARC::Charset
 435     my @errors = ();
 436     local $SIG{__WARN__} = sub {
 437         my $msg = $_[0];
 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$//;
 445             push @errors, $msg;
 446         } else {
 447             # if warning doesn't come from MARC::Charset, just
 448             # pass it on
 449             warn $msg;
 450         }
 451     };
 452
 453     foreach my $field ($marc_record->fields()) {
 454         if ($field->is_control_field()) {
 455             ; # do nothing -- control fields should not contain non-ASCII characters
 456         } else {
 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);
 469                 }
 470                 push @converted_subfields, $subfield->[0], $utf8sf;
 471             }
 472
 473             $field->replace_with(MARC::Field->new(
 474                 $field->tag(), $field->indicator(1), $field->indicator(2),
 475                 @converted_subfields)
 476             );
 477         }
 478     }
 479
 480     MARC::Charset->ignore_errors($prev_ignore);
 481
 482     SetMarcUnicodeFlag($marc_record, $marc_flavour);
 483
 484     return @errors;
 485 }
 486
 487 =head2 _marc_iso5426_to_utf8
 488
 489 =over 4
 490
 491 my @errors = _marc_iso5426_to_utf8($marc_record, $marc_flavour, $source_encoding);
 492
 493 =back
 494
 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
 498 C<@errors> array.
 499
 500 FIXME - is ISO-5426 equivalent enough to MARC-8
 501 that C<MARC::Charset> can be used instead?
 502
 503 =cut
 504
 505 sub _marc_iso5426_to_utf8 {
 506     my $marc_record = shift;
 507     my $marc_flavour = shift;
 508
 509     my @errors = ();
 510
 511     foreach my $field ($marc_record->fields()) {
 512         if ($field->is_control_field()) {
 513             ; # do nothing -- control fields should not contain non-ASCII characters
 514         } else {
 515             my @converted_subfields;
 516             foreach my $subfield ($field->subfields()) {
 517                 my $utf8sf = char_decode5426($subfield->[1]);
 518                 push @converted_subfields, $subfield->[0], $utf8sf;
 519             }
 520
 521             $field->replace_with(MARC::Field->new(
 522                 $field->tag(), $field->indicator(1), $field->indicator(2),
 523                 @converted_subfields)
 524             );
 525         }
 526     }
 527
 528     SetMarcUnicodeFlag($marc_record, $marc_flavour);
 529
 530     return @errors;
 531 }
 532
 533 =head2 _marc_to_utf8_via_text_iconv
 534
 535 =over 4
 536
 537 my @errors = _marc_to_utf8_via_text_iconv($marc_record, $marc_flavour, $source_encoding);
 538
 539 =back
 540
 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
 547 C<@errors> array.
 548
 549 =cut
 550
 551 sub _marc_to_utf8_via_text_iconv {
 552     my $marc_record = shift;
 553     my $marc_flavour = shift;
 554     my $source_encoding = shift;
 555
 556     my @errors = ();
 557     my $decoder;
 558     eval { $decoder = Text::Iconv->new($source_encoding, 'utf8'); };
 559     if ($@) {
 560         push @errors, "Could not initialze $source_encoding => utf8 converter: $@";
 561         return @errors;
 562     }
 563
 564     my $prev_raise_error = Text::Iconv->raise_error();
 565     Text::Iconv->raise_error(1);
 566
 567     foreach my $field ($marc_record->fields()) {
 568         if ($field->is_control_field()) {
 569             ; # do nothing -- control fields should not contain non-ASCII characters
 570         } else {
 571             my @converted_subfields;
 572             foreach my $subfield ($field->subfields()) {
 573                 my $converted_value;
 574                 my $conversion_ok = 1;
 575                 eval { $converted_value = $decoder->convert($subfield->[1]); };
 576                 if ($@) {
 577                     $conversion_ok = 0;
 578                     push @errors, $@;
 579                 } elsif (not defined $converted_value) {
 580                     $conversion_ok = 0;
 581                     push @errors, "Text::Iconv conversion failed - retval is " . $decoder->retval();
 582                 }
 583
 584                 if ($conversion_ok) {
 585                     push @converted_subfields, $subfield->[0], $converted_value;
 586                 } else {
 587                     $converted_value = $subfield->[1];
 588                     $converted_value =~ s/[\200-\377]/\xef\xbf\xbd/g;
 589                     push @converted_subfields, $subfield->[0], $converted_value;
 590                 }
 591             }
 592
 593             $field->replace_with(MARC::Field->new(
 594                 $field->tag(), $field->indicator(1), $field->indicator(2),
 595                 @converted_subfields)
 596             );
 597         }
 598     }
 599
 600     SetMarcUnicodeFlag($marc_record, $marc_flavour);
 601     Text::Iconv->raise_error($prev_raise_error);
 602
 603     return @errors;
 604 }
 605
 606 =head2 _marc_to_utf8_replacement_char
 607
 608 =over 4
 609
 610 _marc_to_utf8_replacement_char($marc_record, $marc_flavour);
 611
 612 =back
 613
 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.
 621
 622 =cut
 623
 624 sub _marc_to_utf8_replacement_char {
 625     my $marc_record = shift;
 626     my $marc_flavour = shift;
 627
 628     foreach my $field ($marc_record->fields()) {
 629         if ($field->is_control_field()) {
 630             ; # do nothing -- control fields should not contain non-ASCII characters
 631         } else {
 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;
 637             }
 638
 639             $field->replace_with(MARC::Field->new(
 640                 $field->tag(), $field->indicator(1), $field->indicator(2),
 641                 @converted_subfields)
 642             );
 643         }
 644     }
 645
 646     SetMarcUnicodeFlag($marc_record, $marc_flavour);
 647 }
 648
 649 =head2 char_decode5426
 650
 651 =over 4
 652
 653 my $utf8string = char_decode5426($iso_5426_string);
 654
 655 =back
 656
 657 Converts a string from ISO-5426 to UTF-8.
 658
 659 =cut
 660
 661
 662 my %chars;
 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
 669 # $chars{0xb4}='è';
 670 $chars{0xb4}=0x00e8;
 671 # $chars{0xb5}='é';
 672 $chars{0xb5}=0x00e9;
 673 $chars{0x97}=0x003c;#3/2leftlowsinglequotationmark
 674 $chars{0x98}=0x003e;#3/2leftlowsinglequotationmark
 675 $chars{0xfa}=0x0153;#oe
 676 $chars{0x81d1}=0x00b0;
 677
 678 ####
 679 ## combined characters iso5426
 680
 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
 693
 694         # 4/1 grave accent
 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
 709         # 4/2 acute accent
 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
 774         # 4/4 tilde
 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
 791     # 4/5 macron
 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
 807         # 4/6 breve
 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
 820         # 4/7 dot above
 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
 879         # 4/9 umlaut
 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
 886         # 4/10 circle above
 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
 900         # 4/14 horn
 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
 905         # 4/15 caron (hacek
 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
 937         # 5/0 cedilla
 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
 960         # 5/1 rude
 961         # 5/2 hook to left
 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
 974         # 5/4 circle below
 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
 980         # 5/6 dot 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
1022         # 5/8 underline
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;
1034
1035 sub char_decode5426 {
1036     my ( $string) = @_;
1037     my $result;
1038
1039     my @data = unpack("C*", $string);
1040     my @characters;
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){
1045         #IsAscii
1046
1047           push @characters,$char unless ($char<0x02 ||$char== 0x0F);
1048       }elsif (($char >= 0xC0 && $char <= 0xDF)) {
1049         #Combined Char
1050         my $convchar ;
1051         if ($chars{$char*256+$data[$i+1]}) {
1052           $convchar= $chars{$char * 256 + $data[$i+1]};
1053           $i++;
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};
1058         }else {
1059           $convchar=$char;
1060         }
1061         push @characters,$convchar;
1062       } else {
1063         my $convchar;
1064         if ($chars{$char})  {
1065           $convchar= $chars{$char};
1066 #            printf "char %x,  converted %x\n",$char,$chars{$char};
1067         }else {
1068 #            printf "char %x $char\n",$char;
1069           $convchar=$char;
1070         }
1071         push @characters,$convchar;
1072       }
1073     }
1074     $result=pack "U*",@characters;
1075 #     $result=~s/\x01//;
1076 #     $result=~s/\x00//;
1077      $result=~s/\x0f//;
1078      $result=~s/\x1b.//;
1079      $result=~s/\x0e//;
1080      $result=~s/\x1b\x5b//;
1081 #   map{printf "%x",$_} @characters;
1082 #   printf "\n";
1083   return $result;
1084 }
1085
1086 1;
1087
1088
1089 =head1 AUTHOR
1090
1091 Koha Development Team <info@koha.org>
1092
1093 Galen Charlton <galen.charlton@liblime.com>
1094
1095 =cut