view release on metacpan or  search on metacpan

lib/File/ValueFile/Simple/Reader.pm  view on Meta::CPAN

sub _handle_special {
    my ($self, $type, $marker, @args) = @_;
    my $line = $self->{fh}->input_line_number;

    if ($marker eq 'ValueFile') {
        @args = @args[0,1] if scalar(@args) == 4 && !defined($args[-1]) && !defined($args[-2]);
        croak 'ValueFile (magic) marker at wrong line' unless $line == 1;
        croak 'ValueFile (magic) marker not marked required' unless $type eq '!';
        croak 'ValueFile (magic) marker with wrong number of arguments' unless scalar(@args) && scalar(@args) <= 2;
        croak 'ValueFile (magic) marker not using supported format' unless $args[0] eq FORMAT_ISE;

        if (scalar(@args) > 1) {
            $self->_check_supported(supported_formats => $self->{format} = Data::Identifier->new(ise => $args[1]));
        }

        $self->_check_utf8($marker => $self->{format}) if $self->{utf8} eq 'auto';

        return;
    } elsif ($marker eq 'Feature') {
        my $id;

        croak 'Feature marker with wrong number of arguments' unless scalar(@args) == 1;

        push(@{$self->{features} //= []}, $id = Data::Identifier->new(ise => $args[0]));

        $self->_check_supported(supported_features => $id) if $type eq '!';
        $self->_check_utf8($marker => $id) if $self->{utf8} eq 'auto';
        $self->{dot_repreat} ||= $id->eq(DOT_REPEAT_ISE);

        return;
    }

    croak 'Invalid marker: '.$marker;
}

sub _check_utf8 {
    my ($self, $marker, $id) = @_;
    if (File::ValueFile->_is_utf8($id)) {
        $self->{unescape} = \&_unescape_utf8;
        $self->{utf8} = 1;
    }
}


sub read_to_cb {
    my ($self, $cb) = @_;
    my $fh = $self->{fh};
    my $unescape = $self->{unescape};
    my @last_line;

    $fh->seek(0, SEEK_SET);
    $fh->input_line_number(0);

    delete $self->{format};
    delete $self->{features};

    while (my $line = <$fh>) {
        $line =~ s/\r?\n$//;
        $line =~ s/#.*$//;
        $line =~ s/^\xEF\xBB\xBF//; # skip BOMs.
        $line =~ s/\s+/ /g;
        $line =~ s/ $//;
        $line =~ s/^ //;

        next unless length $line;

        if ($line =~ s/^\!([\!\?\&])//) {
            my $type = $1;

            if ($self->{dot_repreat}) {
                my @line = split(/\s+/, $line);
                my $x = 0;
                foreach my $e (@line) {
                    if ($e eq '.') {
                        $e = $last_line[$x];
                    } elsif ($e =~ s/^\.\.+$//) {
                        # done in match
                    } elsif ($e =~ KEYWORD_OK) {
                        # no-op
                    } elsif ($e =~ /^\!/) {
                        $e = _special($_);
                    } else {
                        $e = $unescape->($e);
                    }
                    $x++;
                }

                $self->_handle_special($type, @line);
                @last_line = @line;
            } else {
                $self->_handle_special($type, map{
                        $_ =~ KEYWORD_OK ? $_ :
                        $_ =~ /^\!/ ? _special($_) : $unescape->($_)
                    }(split(/\s+/, $line)));
            }

            # Reload:
            $unescape = $self->{unescape};

            next;
        }

        if ($self->{dot_repreat}) {
            my @line = split(/\s+/, $line);
            my $x = 0;
            foreach my $e (@line) {
                if ($e eq '.') {
                    $e = $last_line[$x];
                } elsif ($e =~ /^\.+$/) {
                    $e =~ s/^\.//;
                } elsif ($e =~ KEYWORD_OK) {
                    # no-op
                } elsif ($e =~ /^\!/) {
                    $e = _special($e);
                } else {
                    $e = $unescape->($e);
                }
                $x++;
            }