#---------------------------------------------------------------
# ____                   _ _         ____  _
#|  _ \ ___  _   _  __ _| | |_ _   _/ ___|| |__   __ _ _ __ ___
#| |_) / _ \| | | |/ _` | | __| | | \___ \| '_ \ / _` | '__/ _ \
#|  _ < (_) | |_| | (_| | | |_| |_| |___) | | | | (_| | | |  __/
#|_| \_\___/ \__, |\__,_|_|\__|\__, |____/|_| |_|\__,_|_|  \___|
#            |___/             |___/
#
# Copyright (C) 2008 RoyaltyShare, Inc.      All Rights Reserved
#---------------------------------------------------------------

package Common::UTF8;
use strict;

use Devel::Peek;
use Encode;

# This is a 'smart' encoding.
# If the string already has the magic UTF-8 flag set, it does nothing.
# Otherwise, it examines the data.  If the data appears to be valid
# UTF-8, it will just set the flag.  If not, then it will attempt to
# encode it.
#
# If the incoming data is declared to be a 16-bit encoding, we just
# UTF-8 it without trying to be smart about it.

use constant kDefaultSourceEncoding => 'iso-8859-1';
use constant kEncodingLatin1        => 'iso-8859-1';
use constant kEncodingUCS2          => 'UCS-2BE';
use constant kEncodingUTF8LE        => 'UCS-2LE';
use constant kUTF8                  => 'utf8';

use constant kDowngradeChar => ' ';

# This function will examine the string byte-by-byte to see whether
# it appears to be valid utf-8 encoding.  Then will strip out all
# non-ascii chars
sub ToAscii {
    my $string = shift;
    my $replacementChar = shift || kDowngradeChar;
    my $result;
    my $utf8;

    my @bytes = unpack( "C*", $string );

    my $numBytes = scalar @bytes;
    my $i        = 0;
    for ( my $i = 0 ; $i < $numBytes ; $i++ ) {
        if ( $bytes[$i] < 128 ) {
            $result .= sprintf( "%c", $bytes[$i] );
            next;
        }

        # Check the high-order bits, to see how many multi-bytes to expect.
        #
        if ( 0xf0 == ( $bytes[$i] & 0xf0 ) ) {

            # Possibly 4-byte
            #
            $i += 3;

        } elsif ( 0xe0 == ( $bytes[$i] & 0xe0 ) ) {

            # Possibly 3-byte
            #
            $i += 2;
        } elsif ( 0xc0 == ( $bytes[$i] & 0xc0 ) ) {

            # Possibly 2-byte
            #
            $i += 1;
        } else {

            # It ain't utf8 so we'll just strip it out.
            #
        }

        $result .= $replacementChar;
    }

    return $result;
}

sub narrow_char {
    return join(
        '',
        map { chr( hex $_ ) }
          map {
            ( my $s = sprintf( "%x", ord($_) ) ) =~ s/00$//;
            $s;
          } split //,
        $_[0]
    );
}

sub Encode {
    my ( $string, $sourceEncoding ) = @_;

    $sourceEncoding = kDefaultSourceEncoding unless $sourceEncoding;

    # If this is latin1 or UTF8 then validate and sent the utf8 bit
    if ( $sourceEncoding eq kUTF8 || $sourceEncoding eq kEncodingLatin1 ) {
        if ( Encode::is_utf8($string) ) {
            return $string;
        }

        my $returnString = $string;

        if ( IsValidUTF8($string) ) {
            return SetUTF8Flag($returnString);
        }
    }

    # This seems to both:
    # - return a UTF-8 encoded string
    # - set the UTF-8 flag.
    #
    # I believe the idea here is that 'decode' translates the
    # string into a _character_ encoding.  UTF-8 is the default
    # 'wide' character encoding for perl.   So, this will translate
    # to utf8 if necessary, and sets the flag if necessary.
    #
    #print STDERR "pre-decode string\n";Dump($string);
    #my $decoded = Encode::decode($sourceEncoding, $string);
    #print STDERR "post-decode string\n";Dump($decoded);
    return Encode::decode( $sourceEncoding, $string );
}

# This simple forces Perl to think this scalar contains UTF8
sub SetUTF8Flag {
    my $string = shift;
    Encode::_utf8_on($string);
    return $string;
}

# This function filters out all ascii control characters;
sub FilterControlChars {
    my $string          = shift || return 1;
    my $replacementChar = shift || ' ';

    $string =~ s/[[:cntrl:]]/$replacementChar/g;
    return $string;
}

# This function will examine the string byte-by-byte to see whether
# it appears to be valid utf-8 encoding.
#
sub IsValidUTF8 {
    my ($string) = @_;

    my @bytes = unpack( "C*", $string );

    my $numBytes = scalar @bytes;
    my $i        = 0;
    for ( my $i = 0 ; $i < $numBytes ; $i++ ) {
        next if ( $bytes[$i] < 128 );

        # Check the high-order bits, to see how many multi-bytes to expect.
        #
        if ( 0xf0 == ( $bytes[$i] & 0xf0 ) ) {

            # Possibly 4-byte
            #
            return 0 unless _checkUTF8Bytes( \@bytes, 4, $i );
            $i += 3;

        } elsif ( 0xe0 == ( $bytes[$i] & 0xe0 ) ) {

            # Possibly 3-byte
            #
            return 0 unless _checkUTF8Bytes( \@bytes, 3, $i );
            $i += 2;
        } elsif ( 0xc0 == ( $bytes[$i] & 0xc0 ) ) {

            # Possibly 2-byte
            #
            return 0 unless _checkUTF8Bytes( \@bytes, 2, $i );
            $i += 1;
        } else {

            # It ain't utf8
            #
            return 0;
        }
    }

    return 1;
}

sub _checkUTF8Bytes {
    my ( $bytes, $order, $i ) = @_;

    # Do we have enough bytes left in the string?
    #
    return 0 if ( $i + $order >= ( scalar @$bytes + 1 ) );

    # All subsequent bytes should start with 0b10xxxxxx
    #
    for ( my $x = 1 ; $x < $order ; $x++ ) {
        my $j    = $i + $x;
        my $byte = $bytes->[$j];

        if ( 0x80 != ( $byte & 0xc0 ) ) {
            return 0;
        }
    }

    return 1;
}

###
1;    # Play nicely.
###