###########################################################################
#
# unicode.pm --
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

# useful functions for dealing with Unicode

# Unicode strings are stored as arrays of scalars as perl 
# lacks characters are 8-bit (currently)

package unicode;
use encodings;
use util;

# ascii2unicode takes an (extended) ascii string (ISO-8859-1)
# and returns a unicode array.
sub ascii2unicode {
    my ($in) = @_;
    my $out = [];

    my $i = 0;
    my $len = length($in);
    while ($i < $len) {
	push (@$out, ord(substr ($in, $i, 1)));	
	$i++;
    }

    return $out;
}

# ascii2utf8 takes a reference to an (extended) ascii string and returns a
# UTF-8 encoded string. This is just a faster version of
# "&unicode2utf8(&ascii2unicode($str));"
sub ascii2utf8 {
    my ($in) = @_;
    my $out = "";

    if (!defined($in)|| !defined($$in)) {
	return $out;
    }

    my ($c);
    my $i = 0;
    my $len = length($$in);
    while ($i < $len) {
	$c = ord (substr ($$in, $i, 1));
	if ($c < 0x80) {
	    # ascii character
	    $out .= chr ($c);

	} else {
	    # extended ascii character
	    $out .= chr (0xc0 + (($c >> 6) & 0x1f));
	    $out .= chr (0x80 + ($c & 0x3f));
	}
	$i++;
    }

    return $out;
}

# unicode2utf8 takes a unicode array as input and encodes it
# using utf-8
sub unicode2utf8 {
    my ($in) = @_;
    my $out = "";
    
    foreach $num (@$in) {
	next unless defined $num;
	if ($num < 0x80) {
	    $out .= chr ($num);

	} elsif ($num < 0x800) {
	    $out .= chr (0xc0 + (($num >> 6) & 0x1f));
	    $out .= chr (0x80 + ($num & 0x3f));

	} elsif ($num < 0xFFFF) {
	    $out .= chr (0xe0 + (($num >> 12) & 0xf));
	    $out .= chr (0x80 + (($num >> 6) & 0x3f));
	    $out .= chr (0x80 + ($num & 0x3f));

	} else {
	    # error, don't encode anything
	    die;
	}
    }
    return $out;
}

# utf82unicode takes a utf-8 string and produces a unicode
# array
sub utf82unicode {
    my ($in) = @_;
    my $out = [];

    my $i = 0;
    my ($c1, $c2, $c3);
    $len = length($in);
    while ($i < $len) {
	if (($c1 = ord(substr ($in, $i, 1))) < 0x80) {
	    # normal ascii character
	    push (@$out, $c1);

	} elsif ($c1 < 0xc0) {
	    # error, was expecting the first byte of an
	    # encoded character. Do nothing.

	} elsif ($c1 < 0xe0 && $i+1 < $len) {
	    # an encoded character with two bytes
	    $c2 = ord (substr ($in, $i+1, 1));
	    if ($c2 >= 0x80 && $c2 < 0xc0) {
		# everything looks ok
		push (@$out, ((($c1 & 0x1f) << 6) +
		      ($c2 & 0x3f)));
		$i++; # gobbled an extra byte
	    }

	} elsif ($c1 < 0xf0 && $i+2 < $len) {
	    # an encoded character with three bytes
	    $c2 = ord (substr ($in, $i+1, 1));
	    $c3 = ord (substr ($in, $i+2, 1));
	    if ($c2 >= 0x80 && $c2 < 0xc0 &&
		$c3 >= 0x80 && $c3 < 0xc0) {
		# everything looks ok
		push (@$out, ((($c1 & 0xf) << 12) +
		      (($c2 & 0x3f) << 6) +
		      ($c3 & 0x3f)));

		$i += 2; # gobbled an extra two bytes
	    }

	} else {
	    # error, only decode Unicode characters not full UCS.
	    # Do nothing.
	}

	$i++;
    }

    return $out;
}

# unicode2ucs2 takes a unicode array and produces a UCS-2
# unicode string (every two bytes forms a unicode character)
sub unicode2ucs2 {
    my ($in) = @_;
    my $out = "";

    foreach $num (@$in) {
	$out .= chr (($num & 0xff00) >> 8);
	$out .= chr ($num & 0xff);
    }

    return $out;
}

# ucs22unicode takes a UCS-2 string and produces a unicode array
sub ucs22unicode {
    my ($in) = @_;
    my $out = [];

    my $i = 0;
    my $len = length ($in);
    while ($i+1 < $len) {
	push (@$out, ord (substr($in, $i, 1)) << 8 +
	      ord (substr($in, $i+1, 1)));

	$i ++;
    }

    return $out;
}

# takes a reference to a string and returns a reference to a unicode array
sub convert2unicode {
    my ($encoding, $textref) = @_;

    if (!defined $encodings::encodings->{$encoding}) {
	print STDERR "unicode::convert2unicode: ERROR: Unsupported encoding ($encoding)\n";
	return [];
    }

    my $encodename = "$encoding-unicode";
    my $enc_info = $encodings::encodings->{$encoding};
    my $mapfile = &util::filename_cat($ENV{'GSDLHOME'}, "mappings",
				      "to_uc", $enc_info->{'mapfile'});
    if (!&loadmapencoding ($encodename, $mapfile)) {
	print STDERR "unicode: ERROR - could not load encoding $encodename\n";
	return [];
    }
    
    if (defined $enc_info->{'converter'}) {
	my $converter = $enc_info->{'converter'};
	return &$converter ($encodename, $textref);
    }

    if ($translations{$encodename}->{'count'} == 1) {
	return &singlebyte2unicode ($encodename, $textref);
    } else {
	return &doublebyte2unicode ($encodename, $textref);
    }
}

# singlebyte2unicode converts simple 8 bit encodings where characters below
# 0x80 are normal ascii characters and the rest are decoded using the
# appropriate mapping files.
#
# Examples of encodings that may be converted using singlebyte2unicode are
# the iso-8859 and windows-125* series).
sub singlebyte2unicode {
    my ($encodename, $textref) = @_;

    my @outtext = ();
    my $len = length($$textref);
    my ($c);
    my $i = 0;

    while ($i < $len) {
	if (($c = ord(substr($$textref, $i, 1))) < 0x80) {
	    # normal ascii character
	    push (@outtext, $c);
	} else {
	    $c = &transchar ($encodename, $c);
	    # put a black square if cannot translate
	    $c = 0x25A1 if $c == 0;
	    push (@outtext, $c);
	}
	$i ++;
    }
    return \@outtext;
}

# doublebyte2unicode converts simple two byte encodings where characters
# below code point 0x80 are single-byte characters and the rest are
# double-byte characters.
#
# Examples of encodings that may be converted using doublebyte2unicode are
# CJK encodings like GB encoded Chinese and UHC Korean.
#
# Note that no error checking is performed to make sure that the input text
# is valid for the given encoding.
#
# Also, encodings that may contain characters of more than two bytes are
# not supported (any EUC encoded text may in theory contain 3-byte
# characters but in practice only one and two byte characters are used).
sub doublebyte2unicode {
    my ($encodename, $textref) = @_;    
    
    my @outtext = ();
    my $len = length($$textref);
    my ($c1, $c2);
    my $i = 0;

    while ($i < $len) {
	if (($c1 = ord(substr($$textref, $i, 1))) >= 0x80) {
	    if ($i+1 < $len) {
		# double-byte character
		$c2 = ord(substr($$textref, $i+1, 1));
		my $c = &transchar ($encodename, ($c1 << 8) | $c2);
		# put a black square if cannot translate
		$c = 0x25A1 if $c == 0;
		push (@outtext, $c);
		$i += 2;
		
	    } else {
		# error
		print STDERR "unicode: ERROR missing second half of double-byte character\n";
		$i++;
	    }
	    
	} else {
	    # single-byte character
	    push (@outtext, $c1);
	    $i++;
	}
    }
    return \@outtext;
}

# Shift-JIS to unicode
# We can't use doublebyte2unicode for Shift-JIS because it uses some
# single-byte characters above code point 0x80 (i.e. half-width katakana
# characters in the range 0xA1-0xDF)
sub shiftjis2unicode {
    my ($encodename, $textref) = @_;
    
    my @outtext = ();
    my $len = length($$textref);
    my ($c1, $c2);
    my $i = 0;

    while ($i < $len) {
	$c1 = ord(substr($$textref, $i, 1));

	if (($c1 >= 0xA1 && $c1 <= 0xDF) || $c1 == 0x5c || $c1 == 0x7E) {
	    # Single-byte half-width katakana character or
	    # JIS Roman yen or overline characters
	    my $c = &transchar ($encodename, $c1);
	    # - put a black square if cannot translate
	    $c = 0x25A1 if $c == 0;
	    push (@outtext, $c);
	    $i++;

	} elsif ($c1 < 0x80) {
	    # ASCII
	    push (@outtext, $c1);
	    $i ++;

	} elsif ($c1 < 0xEF) {
	    if ($i+1 < $len) {
		$c2 = ord(substr($$textref, $i+1, 1));
		if (($c2 >= 0x40 && $c2 <= 0x7E) || ($c2 >= 0x80 && $c2 <= 0xFC)) {
		    # Double-byte shift-jis character
		    my $c = &transchar ($encodename, ($c1 << 8) | $c2);
		    # put a black square if cannot translate
		    $c = 0x25A1 if $c == 0;
		    push (@outtext, $c);
		} else {
		    # error
		    print STDERR "unicode: ERROR Invalid Shift-JIS character\n";
		}
		$i += 2;
	    } else {
		# error
		print STDERR "unicode: ERROR missing second half of Shift-JIS character\n";
		$i ++;
	    }
	} else {
	    # error
	    print STDERR "unicode: ERROR Invalid Shift-JIS character\n";
	    $i ++;
	}
    }
    return \@outtext;
}

sub transchar {
    my ($encoding, $from) = @_;
    my $high = ($from / 256) % 256;
    my $low = $from % 256;

    return 0 unless defined $translations{$encoding};

    my $block = $translations{$encoding}->{'map'};

    if (ref ($block->[$high]) ne "ARRAY") {
	return 0;
    }
    return $block->[$high]->[$low];
}

# %translations is of the form:
#
# encodings{encodingname-encodingname}->{'map'}->blocktranslation
# blocktranslation->[[0-255],[256-511], ..., [65280-65535]]
#
# Any of the top translation blocks can point to an undefined
# value. This data structure aims to allow fast translation and 
# efficient storage.
%translations = ();

# @array256 is used for initialisation, there must be
# a better way...
@array256 = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
	     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);

# returns 1 if successful, 0 if unsuccessful
sub loadmapencoding {
    my ($encoding, $mapfile) = @_;
    
    # check to see if the encoding has already been loaded
    return 1 if (defined $translations{$encoding});

    return 0 unless open (MAPFILE, $mapfile);
    binmode (MAPFILE);

    $translations{$encoding} = {'map' => [@array256], 'count' => 0};
    my $block = $translations{$encoding};

    my ($in,$i,$j);
    while (read(MAPFILE, $in, 1) == 1) {
	$i = unpack ("C", $in);
	$block->{'map'}->[$i] = [@array256];
	for ($j=0; $j<256 && read(MAPFILE, $in, 2)==2; $j++) {
	    my ($n1, $n2) = unpack ("CC", $in);
	    $block->{'map'}->[$i]->[$j] = ($n1*256) + $n2;
	}
	$block->{'count'} ++;
    }

    close (MAPFILE);
}

sub unicode2koi8r {
    my ($uniref) = @_;
    
    my $outtext = "";
    my $encodename = "unicode-koi8_r";
    my $enc_info = $encodings::encodings->{"koi8_r"};
    my $mapfile = &util::filename_cat($ENV{'GSDLHOME'}, "mappings",
				      "from_uc", $enc_info->{'mapfile'});
    if (!&loadmapencoding ($encodename, $mapfile)) {
	print STDERR "unicode: ERROR - could not load encoding $encodename\n";
	return "";
    }
    
    foreach my $c (@$uniref) {
	if ($c < 0x80) {
	    # normal ascii character
	    $outtext .= chr($c);
	} else {
	    # extended ascii character
	    $c = &transchar ($encodename, $c);

	    # put a question mark if cannot translate
	    if ($c == 0) {
		$outtext .= "?";
	    } else {
		$outtext .= chr($c);
	    }
	}
    }
    return $outtext;
}

1;