source: trunk/gsdl/perllib/multiread.pm@ 1844

###########################################################################
#
# multiread.pm --
#
# Copyright (C) 1999 DigiLib Systems Limited, NZ
#
# 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.
#
###########################################################################

# the multiread object will read in a number of encodings,
# the results are always returned in the utf-8 format

# encodings currently supported are
#
# utf8             - either utf8 or unicode (automatically detected)
# unicode          - just unicode (doesn't currently do endian detection)
# gb               - GB
# iso_8859_[1-9]   - 8 bit extended ascii encodings
# windows_125[0-6] - Windows codepages 1250 to 1256

package multiread;

use unicode;
use gb;

sub new {
    my ($class) = @_;

    my $self = {'handle'    => "",
        'first'     => 1,
        'encoding'  => "utf8",
        'bigendian' => 1};

    return bless $self, $class;
}

# set_handle expects the file to be already open but
# not read yet
sub set_handle {
    my $self = shift (@_);
    ($self->{'handle'}) = @_;
    $self->{'first'} = 1;
    $self->{'encoding'} = "utf8";
    $self->{'bigendian'} = 1;
}

# set_encoding should be called after set_handle
sub set_encoding {
    my $self = shift (@_);
    ($self->{'encoding'}) = @_;
}

sub get_encoding {
    my $self = shift (@_);
    return $self->{'encoding'};
}

# undef will be returned if the eof has been reached
# the result will always be returned in utf-8
# if automatic detection between utf8 and unicode is desired
# then the encoding should be initially set to utf8
sub read_char {
    my $self = shift (@_);

    # make sure we have a file handle
    return undef if ($self->{'handle'} eq "");
    my $handle = $self->{'handle'};

    if ($self->{'encoding'} eq "utf8") {
    # utf-8 text, how many characters we get depends 
    # on what we find
    my $c1 = "";
    my $c2 = "";
    my $c3 = "";

    while (!eof ($handle)) {
        $c1 = ord (getc ($handle));
        if ($self->{'first'}) {
        $self->{'first'} = 0;

        if ($c1 == 0xfe || $c1 == 0xff) {
            $c2 = ord (getc ($handle)) if (!eof ($handle));
            
            # if unicode fall through to the unicode reading code
            if ($c1 == 0xff && $c2 == 0xfe) {
            $self->{'encoding'} = "unicode";
            $self->{'bigendian'} = 0;
            if ($ENV{'GSDLOS'} =~ /windows/i) {
                binmode ($handle); # silly windows
            }
            last;

            } elsif ($c1 == 0xfe && $c2 == 0xff) {
            $self->{'encoding'} = "unicode";
            $self->{'bigendian'} = 1;
            if ($ENV{'GSDLOS'} =~ /windows/i) {
                binmode ($handle); # silly windows
            }
            last;
            }

            # an error, but we might be able to recover
            # from it
            $c1 = $c2;
        }
        }

        if ($c1 <= 0x7f) {
        # one byte character
        return chr ($c1);

        } elsif ($c1 >= 0xc0 && $c1 <= 0xdf) {
        # two byte character
        $c2 = getc ($handle) if (!eof ($handle));
        return chr ($c1) . $c2;

        } elsif ($c1 >= 0xe0 && $c1 <= 0xef) {
        # three byte character
        $c2 = getc ($handle) if (!eof ($handle));
        $c3 = getc ($handle) if (!eof ($handle));
        return chr ($c1) . $c2 . $c3;
        }

        # if we get here there was an error in the file, we should
        # be able to recover from it however, maybe the file is in
        # another encoding
    }

    return undef if (eof ($handle));
    }

    if ($self->{'encoding'} eq "unicode") {
    # unicode text, get the next two characters
    return undef if (eof ($handle));
    my $c1 = ord (getc ($handle));
    return undef if (eof ($handle));
    my $c2 = ord (getc ($handle));

    return &unicode::unicode2utf8 ([(($self->{'bigendian'}) ? ($c1*256+$c2) : ($c2*256+$c1))]);
    }

    if ($self->{'encoding'} eq "gb") {
    # GB or GBK
    return undef if (eof ($handle));
    my $c1 = getc ($handle);
    if (ord ($c1) >= 0x81) {
        # double byte character
        return undef if (eof ($handle));
        my $c2 = getc ($handle);
        return &unicode::unicode2utf8 (&gb::gb2unicode ($c1.$c2));
        
    } else {
        # single byte character
        return &unicode::ascii2utf8 ($c1);
    }
    }

    if ($self->{'encoding'} eq "iso_8859_1") {
    # special case for iso_8859_1 as &ascii2utf8($char) is faster than
    # &unicode2utf8(iso2unicode('1', $char))
    return undef if (eof ($handle));
    return &unicode::ascii2utf8 (getc ($handle));
    }
    
    if ($self->{'encoding'} =~ /^iso_8859_(\d+)$/) {
    return undef if (eof ($handle));
    return &unicode::unicode2utf8(&unicode::iso2unicode ($1, getc($handle)));
    }

    if ($self->{'encoding'} =~ /windows_(\d{4})$/) {
    return undef if (eof ($handle));
    return &unicode::unicode2utf8(&unicode::windows2unicode ($1, getc($handle)));
    }

    if ($self->{'encoding'} =~ /^koi8_[ru]$/) {
    return undef if (eof ($handle));
    return &unicode::unicode2utf8(&unicode::cyrillic2unicode ($self->{'encoding'}, getc($handle)));
    }

    # unknown encoding
    return undef;
}


# undef will be returned if the eof has been reached
# the result will always be returned in utf-8
sub read_line {
    my $self = shift (@_);

    # make sure we have a file handle
    return undef if ($self->{'handle'} eq "");

    my $handle = $self->{'handle'};

    if ($self->{'first'} && $self->{'encoding'} eq "utf8") {
    # special case for the first line of utf8 text to detect whether
    # the file is in utf8 or unicode
    my $out = "";
    my $thisc = "";
    while (defined ($thisc = $self->read_char())) {
        $out .= $thisc;
        last if ($thisc eq "\n");
    }
    
    return $out if (length ($out) > 0);
    return undef;
    }


    if ($self->{'encoding'} eq "utf8") {
    # utf-8 line
    return <$handle>;
    }

    if ($self->{'encoding'} eq "unicode") {
    # unicode line
    my $c = "";
    my ($c1, $c2) = ("", "");
    my $out = "";
    while (read ($handle, $c, 2) == 2) {
        $c1 = ord (substr ($c, 0, 1));
        $c2 = ord (substr ($c, 1, 1));
        $c = &unicode::unicode2utf8([(($self->{'bigendian'}) ? ($c1*256+$c2) : ($c2*256+$c1))]);
        $out .= $c;
        last if ($c eq "\n");
    }

    return $out if (length ($out) > 0);
    return undef;
    }

    if ($self->{'encoding'} eq "gb") {
    # GB or GBK
    my $line = "";
    if (defined ($line = <$handle>)) {
        return &unicode::unicode2utf8 (&gb::gb2unicode ($line));
    }
    return undef;
    }
    
    if ($self->{'encoding'} eq "iso_8859_1") {
    # special case for iso_8859_1 as &ascii2utf8($line) is faster than
    # &unicode2utf8(iso2unicode('1', $line))
    my $line = "";
    if (defined ($line = <$handle>)) {
        return &unicode::ascii2utf8 ($line);
    }
    return undef;
    }
    
    if ($self->{'encoding'} =~ /^iso_8859_(\d+)$/) {
    my $line = "";
    if (defined ($line = <$handle>)) {
        return &unicode::unicode2utf8(&unicode::iso2unicode ($1, $line));
    }
    return undef;
    }

    if ($self->{'encoding'} =~ /windows_(\d{4})$/) {
    my $line = "";
    if (defined ($line = <$handle>)) {
        return &unicode::unicode2utf8(&unicode::windows2unicode ($1, $line));
    }
    return undef;
    }

    if ($self->{'encoding'} =~ /^koi8_[ru]$/) {
    my $line = "";
    if (defined ($line = <$handle>)) {
        return &unicode::unicode2utf8(&unicode::cyrillic2unicode ($self->{'encoding'}, $line));
    }
    return undef;
    }

    # unknown encoding
    return undef;
}


# will convert entire contents of file to utf8 and append result to $outputref
# this may be a slightly faster way to get the contents of a file than by 
# recursively calling read_line()
sub read_file {
    my $self = shift (@_);
    my ($outputref) = @_;

    # make sure we have a file handle
    return if ($self->{'handle'} eq "");

    my $handle = $self->{'handle'};

    if ($self->{'first'} && $self->{'encoding'} eq "utf8") {
    # special case for the first line of utf8 text to detect whether
    # the file is in utf8 or unicode
    $$text .= $self->read_line ();
    }

    if ($self->{'encoding'} eq "utf8") {
    undef $/;
    $$outputref .=  <$handle>;
    $/ = "\n";
    return;
    }

    if ($self->{'encoding'} eq "unicode") {
    my $line = "";
    while (defined ($line = $self->read_line())) {
        $$outputref .= $line;
    }
    return;
    }

    if ($self->{'encoding'} eq "gb") {
    undef $/;
    my $text = <$handle>;
    $/ = "\n";
    $$outputref .= &unicode::unicode2utf8 (&gb::gb2unicode ($text));
    return;
    }
    
    if ($self->{'encoding'} eq "iso_8859_1") {
    # special case for iso_8859_1 as &ascii2utf8($text) is faster than
    # &unicode2utf8(iso2unicode('1', $text))
    undef $/;
    my $text = <$handle>;
    $/ = "\n";
    $$outputref .= &unicode::ascii2utf8 ($text);
    return;
    }
    
    if ($self->{'encoding'} =~ /^iso_8859_(\d+)$/) {
    undef $/;
    my $text = <$handle>;
    $/ = "\n";
    $$outputref .= &unicode::unicode2utf8(&unicode::iso2unicode ($1, $text));
    return;
    }

    if ($self->{'encoding'} =~ /windows_(\d{4})$/) {
    undef $/;
    my $text = <$handle>;
    $/ = "\n";
    $$outputref .= &unicode::unicode2utf8(&unicode::windows2unicode ($1, $text));
    return;
    }

    if ($self->{'encoding'} =~ /^koi8_[ru]$/) {
    undef $/;
    my $text = <$handle>;
    $/ = "\n";
    $$outputref .= &unicode::unicode2utf8(&unicode::cyrillic2unicode ($self->{'encoding'}, $text));
    return;
    }
}

1;