accept any end of line terminator in any operating system
Salvador Fandino
8 years ago
| 6 | 6 | |
| 7 | 7 | use IO::Handle; |
| 8 | 8 | use Carp; |
| 9 | use PerlIO; | |
| 9 | use PerlIO qw(); | |
| 10 | use Errno qw(); | |
| 10 | 11 | |
| 11 | 12 | { |
| 12 | 13 | no warnings; |
| 75 | 76 | my $file = delete $opts{file}; |
| 76 | 77 | my $encoding = delete $opts{encoding} || 'latin1'; |
| 77 | 78 | _t_encoding($encoding); |
| 79 | my $eol_re = delete $opts{eol_re}; | |
| 80 | $eol_re = qr/\r\n|\n|\r/ unless defined $eol_re; | |
| 81 | my $line_re = qr/^(.*?)(?:$eol_re)/s; | |
| 78 | 82 | |
| 79 | 83 | %opts and croak "invalid option(s) '" . join("', '", keys %opts) . "'"; |
| 80 | 84 | |
| 96 | 100 | wrap => $wrap, |
| 97 | 101 | order => $order, |
| 98 | 102 | properties => {}, |
| 99 | next_line_number => 1, | |
| 103 | last_line_number => 0, | |
| 100 | 104 | property_line_numbers => {}, |
| 101 | 105 | file => $file, |
| 102 | encoding => $encoding }; | |
| 106 | encoding => $encoding, | |
| 107 | line_re => $line_re }; | |
| 103 | 108 | bless $self, $class; |
| 104 | 109 | |
| 105 | 110 | if (defined $file) { |
| 146 | 151 | defined(wantarray) and |
| 147 | 152 | carp "warning: setProperty doesn't return the old value anymore"; |
| 148 | 153 | |
| 149 | $self->{property_line_numbers}{$key} ||= $self->{next_line_number}++; | |
| 154 | $self->{property_line_numbers}{$key} ||= ++$self->{last_line_number}; | |
| 150 | 155 | $self->{properties}{$key} = $value; |
| 151 | 156 | } |
| 152 | 157 | |
| 248 | 253 | or croak "Unable to set file encoding layer: $!"; |
| 249 | 254 | } |
| 250 | 255 | } |
| 251 | $self->{properties}={}; | |
| 252 | $self->{property_line_numbers}={}; | |
| 253 | $self->{next_line_number}=1; | |
| 256 | $self->{properties} = {}; | |
| 257 | $self->{property_line_numbers} = {}; | |
| 258 | my $ln = $file->input_line_number; | |
| 259 | $self->{last_line_number} = ($ln > 0 ? $ln : 0); | |
| 260 | $self->{buffer_in} = ''; | |
| 254 | 261 | 1 while $self->process_line($file); |
| 262 | $self->{last_line_number}; | |
| 255 | 263 | } |
| 256 | 264 | |
| 257 | 265 | |
| 285 | 293 | defined $1 ? $unesc{$1}||$1 : chr hex $2 /ge; |
| 286 | 294 | } |
| 287 | 295 | |
| 296 | sub read_line { | |
| 297 | my ($self, $file) = @_; | |
| 298 | my $bin = \$self->{buffer_in}; | |
| 299 | my $line_re = $self->{line_re}; | |
| 300 | while (1) { | |
| 301 | if ($$bin =~ s/$line_re//) { | |
| 302 | $self->{last_line_number}++; | |
| 303 | return $1; | |
| 304 | } | |
| 305 | else { | |
| 306 | my $bytes = read($file, $$bin, 8192, length $$bin); | |
| 307 | last unless $bytes or (not defined $bytes and | |
| 308 | ($! == Errno::EGAIN() or | |
| 309 | $! == Errno::EWOULDBLOCK() or | |
| 310 | $! == Errno::EINTR())); | |
| 311 | } | |
| 312 | } | |
| 313 | ||
| 314 | if (length $$bin) { | |
| 315 | $self->{last_line_number}++; | |
| 316 | my $line = $$bin; | |
| 317 | $$bin = ''; | |
| 318 | return $line | |
| 319 | } | |
| 320 | undef; | |
| 321 | } | |
| 322 | ||
| 288 | 323 | |
| 289 | 324 | # process_line() - read and parse a line from the properties file. |
| 290 | 325 | |
| 293 | 328 | |
| 294 | 329 | sub process_line { |
| 295 | 330 | my ($self, $file) = @_; |
| 296 | my $line=<$file>; | |
| 331 | my $line = $self->read_line($file); | |
| 297 | 332 | defined $line or return undef; |
| 298 | $line =~ s/\r\n/\n/g; | |
| 299 | my $ln = $self->{line_number} = $file->input_line_number; | |
| 300 | if ($ln == 1) { | |
| 301 | # remove utf8 byte order mark | |
| 302 | $line =~ s/$bomre//; | |
| 303 | } | |
| 333 | ||
| 334 | # remove utf8 byte order mark | |
| 335 | my $ln = $self->{last_line_number}; | |
| 336 | $line =~ s/$bomre// if $ln < 2; | |
| 337 | ||
| 304 | 338 | # ignore comments |
| 305 | 339 | $line =~ /^\s*(\#|\!|$)/ and return 1; |
| 306 | ||
| 307 | $line =~ s/\x0D*\x0A$//; | |
| 308 | 340 | |
| 309 | 341 | # handle continuation lines |
| 310 | 342 | my @lines; |
| 311 | 343 | while ($line =~ /(\\+)$/ and length($1) & 1) { |
| 312 | 344 | $line =~ s/\\$//; |
| 313 | 345 | push @lines, $line; |
| 314 | $line = <$file>; | |
| 315 | $line =~ s/\x0D*\x0A$//; | |
| 346 | $line = $self->read_line($file); | |
| 347 | $line = '' unless defined $line; | |
| 316 | 348 | $line =~ s/^\s+//; |
| 317 | 349 | } |
| 318 | $line=join('', @lines, $line) if @lines; | |
| 350 | $line = join('', @lines, $line) if @lines; | |
| 319 | 351 | |
| 320 | 352 | my ($key, $value) = $line =~ /^ |
| 321 | 353 | \s* |
| 327 | 359 | $ |
| 328 | 360 | /x |
| 329 | 361 | or $self->fail("invalid property line '$line'"); |
| 330 | ||
| 362 | ||
| 331 | 363 | unescape $key; |
| 332 | 364 | unescape $value; |
| 333 | 365 | |
| 334 | 366 | $self->validate($key, $value); |
| 335 | 367 | |
| 336 | 368 | $self->{property_line_numbers}{$key} = $ln; |
| 337 | $self->{next_line_number}=$ln+1; | |
| 338 | ||
| 339 | 369 | $self->{properties}{$key} = $value; |
| 340 | 370 | |
| 341 | 371 | return 1; |
| 351 | 381 | |
| 352 | 382 | |
| 353 | 383 | # line_number() - number for the last line read from the configuration file |
| 354 | sub line_number { shift->{line_number} } | |
| 384 | sub line_number { shift->{last_line_number} } | |
| 355 | 385 | |
| 356 | 386 | |
| 357 | 387 | # fail(error) - report errors in the configuration file while reading. |
| 854 | 884 | |
| 855 | 885 | loads properties from the open file C<$file>. |
| 856 | 886 | |
| 857 | Old properties on the object are forgotten. | |
| 887 | Old properties on the object are discarded. | |
| 858 | 888 | |
| 859 | 889 | =item $p-E<gt>save($file) |
| 860 | 890 | |