########################################################################### # # multiread.pm -- # # Copyright (C) 1999 DigiLib Systems Limited, NZ # Copyright (C) 2005 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. # ########################################################################### # 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 - 2-byte UCS (does endian detection) # # plus all encodings in the "encodings" package package multiread; eval {require bytes}; use strict; no strict 'refs'; # allow filehandles to be variables and viceversa use unicode; 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'} = shift; binmode( $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'} = shift; } 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 sub read_unicode_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 ($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))]); } 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->{'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 "iso_8859_1") { # we'll use ascii2utf8() for this as it's faster than going # through convert2unicode() my $line = ""; if (defined ($line = <$handle>)) { return &unicode::ascii2utf8 (\$line); } } # everything else uses unicode::convert2unicode my $line = ""; if (defined ($line = <$handle>)) { return &unicode::unicode2utf8 (&unicode::convert2unicode ($self->{'encoding'}, \$line)); } return undef; } # this will look for a Byte Order Marker at the start of the file, and # set the encoding appropriately if there is one, returning any # non-marker text on the first line (or returns undef). sub find_unicode_bom { my $self=shift; my $non_bom_text=""; # to return if we read in 'real' text if ($self->{'first'} == 0) { return } # make sure we have a file handle return if ($self->{'handle'} eq ""); my $handle = $self->{'handle'}; $self->{'first'} = 0; my $b1 = ord(getc ($handle)); my $b2; my $b3; if ($b1 == 0xfe || $b1 == 0xff) { $b2 = ord (getc ($handle)) if (!eof ($handle)); if ($b1 == 0xff && $b2 == 0xfe) { $self->{'encoding'} = "unicode"; $self->{'bigendian'} = 0; return; } elsif ($b1 == 0xfe && $b2 == 0xff) { $self->{'encoding'} = "unicode"; $self->{'bigendian'} = 1; return; } elsif ($b1 == 0xef && $b2 == 0xbb) { $b3 = ord(getc($handle)); if ($b3 == 0xbf) { $self->{'encoding'} = "utf8"; $self->{'bigendian'} = 1; return; } } } else { # $b1 != fe or ff $handle->ungetc($b1); return; } # if here, we have removed some chars and they aren't a BOM if ($self->{'encoding'} eq "unicode") { # return the 2byte char if (defined ($b3)) { # we looked at this... return it $handle->ungetc($b3); } return &unicode::unicode2utf8([$self->{'bigendian'}? ($b1*256+$b2) : ($b2*256+$b1)]); } # if here, it's utf-8 if ($b2 < 0x80) { if (defined ($b3)) { # we grabbed this, but don't need it now $handle->ungetc($b3); } return ($b1 . $b2); } # if here, we have taken part of a multi-byte char. we need to make # sure we return the entire character if (defined($b3) && $b3 < 0x80) { # we have all we need $handle->ungetc($b3); return ($b1 . $b2); } my $c=$b1.$b2.$b3; my $b4=$handle->getc(); while ($b4 > 0x7f) { # note - this will return consecutive mb utf8 chars $c .= $b4; $b4=$handle->getc(); if (eof($handle)) { last } } if (! eof($handle)) { $handle->ungetc($b4); # this byte is an ascii byte } return $c; } # 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 encoding is set to utf8 or unicode, sniff to see if there is a # byte order marker if ($self->{'first'} && ($self->{'encoding'} eq "utf8" || $self->{'encoding'} eq 'unicode')) { # this will change $self's encoding if there is a BOM my $read_text = $self->find_unicode_bom(); $$outputref .= $read_text if (defined($read_text)); } 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 "iso_8859_1" || $self->{'encoding'} eq "ascii") { # we'll use ascii2utf8() for this as it's faster than going # through convert2unicode() undef $/; my $text = <$handle>; $/ = "\n"; $$outputref .= &unicode::ascii2utf8 (\$text); return; } # everything else uses unicode::convert2unicode undef $/; my $text = <$handle>; $/ = "\n"; $$outputref .= &unicode::unicode2utf8 (&unicode::convert2unicode ($self->{'encoding'}, \$text)); } 1;