fixed rt.cpan.org#113671: recognize BOM at start of a utf8 file

fixed rt.cpan.org#112857: Same Line Closing Block Breaks Parser



git-svn-id: http://dev.catalyst.perl.org/repos/Config-General/trunk@110 be1acefe-a474-0410-9a34-9b3221f2030f

Changelog

@@ -1,4 +1,5 @@
-next    - fix rt.cpan.org#113671: ignore utf BOM, if any.
+2.61    - fix rt.cpan.org#113671: ignore utf BOM, if any and turn on
+	  UTF8 support if not yet enabled.
 
 2.60    - fix rt.cpan.org#107929: added missing test config.
 

General.pm

@@ -38,6 +38,8 @@ use vars  qw(@ISA @EXPORT_OK);
 use base qw(Exporter);
 @EXPORT_OK = qw(ParseConfig SaveConfig SaveConfigString);
 
+use constant _UTF8_BOM => "\x{ef}\x{bb}\x{bf}";
+
 sub new {
   #
   # create new Config::General object
@@ -407,7 +409,7 @@ sub files {
 
 sub _open {
   #
-  # open the config file, or expand a directory or glob
+  # open the config file, or expand a directory or glob or include
   #
   my($this, $basefile, $basepath) = @_;
   my $cont;
@@ -490,14 +492,7 @@ sub _open {
       my $file = catfile($configfile, $_);
       if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) {
         # support re-read if used urged us to do so, otherwise ignore the file
-	if ($this->{UTF8}) {
-	  $fh = IO::File->new;
-	  open( $fh, "<:utf8", $file)
-	    or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
-	}
-	else {
-	  $fh = IO::File->new( $file, 'r') or croak "Config::General: Could not open $file!($!)\n";
-	}
+        $fh = $this->_openfile_for_read($file);
         $this->{files}->{"$file"} = 1;
         $this->_read($fh);
       }
@@ -516,16 +511,7 @@ sub _open {
       return;
     }
     else {
-      if ($this->{UTF8}) {
-	$fh = IO::File->new;
-	open( $fh, "<:utf8", $configfile)
-	  or croak "Config::General: Could not open $configfile in UTF8 mode!($!)\n";
-      }
-      else {
-	$fh = IO::File->new( "$configfile", 'r')
-	  or croak "Config::General: Could not open $configfile!($!)\n";
-      }
-
+      $fh = $this->_openfile_for_read($configfile);
       $this->{files}->{$configfile}    = 1;
 
       my ($volume, $path, undef)           = splitpath($configfile);
@@ -538,6 +524,30 @@ sub _open {
 }
 
 
+sub _openfile_for_read {
+  #
+  # actually open a file, turn on utf8 mode if requested by bom
+  #
+  my ($this, $file) = @_;
+
+  my $fh = IO::File->new( $file, 'r')
+    or croak "Config::General: Could not open $file!($!)\n";
+
+  # attempt to read an initial utf8 byte-order mark (BOM)
+  my $n_read  = sysread $fh, my $read_BOM, length(_UTF8_BOM);
+  my $has_BOM = $n_read == length(_UTF8_BOM) && $read_BOM eq _UTF8_BOM;
+
+  # set utf8 perlio layer if BOM was found or if option -UTF8 is turned on
+  binmode $fh, ":utf8" if $this->{UTF8} || $has_BOM;
+
+  # rewind to beginning of file if we read chars that were not the BOM
+  sysseek $fh, 0, 0 if $n_read && !$has_BOM;
+
+  return $fh;
+}
+
+
+
 sub _read {
   #
   # store the config contents in @content
@@ -2113,7 +2123,11 @@ The method B<getall> returns a hash of all values.
 
 You can define a B<block> of options. A B<block> looks much like a block
 in the wellknown Apache config format. It starts with E<lt>B<blockname>E<gt> and ends
-with E<lt>/B<blockname>E<gt>. An example:
+with E<lt>/B<blockname>E<gt>.
+
+A block start and end cannot be on the same line.
+
+An example:
 
 <database>
 host   = muli
@@ -2746,7 +2760,7 @@ I recommend you to read the following documents, which are supplied with Perl:
 
 =head1 LICENSE AND COPYRIGHT
 
-Copyright (c) 2000-2015 Thomas Linden
+Copyright (c) 2000-2016 Thomas Linden
 
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.

MANIFEST

@@ -51,3 +51,5 @@ t/test.rc
 t/Tie/IxHash.pm
 t/Tie/README
 t/cfg.51
+t/utf8_bom/bar.cfg
+t/utf8_bom/foo.cfg

t/run.t

@@ -8,7 +8,7 @@
 
 
 use Data::Dumper;
-use Test::More tests => 73;
+use Test::More tests => 75;
 #use Test::More qw(no_plan);
 
 # ahem, we deliver the test code with a local copy of
@@ -761,3 +761,16 @@ eval {
   $cfg56->save_file("t/56.out", { "new\nline" => 9, "brack<t" => 8 });
 };
 ok($@, "catch special chars in keys");
+
+
+# UTF8[BOM] tests
+my $cfg57 = "t/utf8_bom/foo.cfg";
+my $expected57 = {foo => {"\x{e9}" => "\x{e8}", bar => {"\x{f4}" => "\x{ee}"}}};
+
+for my $bool (0, 1) {
+  my $conf = Config::General->new(-ConfigFile      => $cfg57,
+                                  -IncludeRelative => 1,
+                                  -UTF8            => $bool);
+  my %hash = $conf->getall;
+  is_deeply \%hash, $expected57, "-UTF8 => $bool";
+}

t/utf8_bom/bar.cfg

@@ -0,0 +1,3 @@
+<bar>
+  ô = î
+</bar>

t/utf8_bom/foo.cfg

@@ -0,0 +1,4 @@
+<foo>
+  é = è
+  <<include bar.cfg>>
+</foo>