view release on metacpan or  search on metacpan

lib/DBIx/Wrapper.pm  view on Meta::CPAN

                }
                elsif ($char eq '*') {
                    # multiple line comment
                    _parse_json_next_char();
                    while (1) {
                        unless (defined($char)) {
                            # error - unterminated comment
                            last;
                        }

                        if ($char eq '*') {
                            if (defined(_parse_json_next_char()) and $char eq '/') {
                                _parse_json_next_char();
                                last;
                            }
                        }
                        else {
                            _parse_json_next_char();
                        }
                        
                    }
                    next;
                }
                else {
                    # error -- syntax error with comment -- can't have '/' by itself
                }
            }
            else {
                last;
            }
        }
    }
    
    sub _parse_json_parse_string {
        unless ($char eq '"' or $char eq "'") {
            warn "bad string at pos $looking_at, char=$char";
            return;
        }

        my $boundary = $char;
        my $str = '';
        my $start_pos = $looking_at;

        while ( defined(_parse_json_next_char()) ) {
            if ($char eq $boundary) {
                _parse_json_next_char();
                return $str;
            }
            elsif ($char eq '\\') {
                _parse_json_next_char();
                if (exists($json_escape_map->{$char})) {
                    $str .= $json_escape_map->{$char};
                }
                elsif ($char eq 'u') {
                    my $u = '';

                    for (1 .. 4) {
                        _parse_json_next_char();

                        if ($char !~ /[0-9A-Fa-f]/) {
                            # error -- bad unicode specifier
                            if ($json_warn) {
                                warn "bad unicode specifier at pos $looking_at, char=$char";
                            }
                            last;
                        }
                        $u .= $char;
                    }

                    my $full_char = chr(hex($u));
                    $str .= $full_char;
                }
                else {
                    $str .= $char;
                }
            }
            else {
                $str .= $char;
            }
        }

        # error -- unterminated string
        warn "unterminated string starting at $start_pos";
    }

    sub _parse_json_parse_object {
        return unless $char eq '{';

        my $obj = {};
        my $key;
        
        _parse_json_next_char();
        _parse_json_eat_whitespace();
        if ($char eq '}') {
            _parse_json_next_char();
            return $obj;
        }

        while (defined($char)) {
            $key = _parse_json_parse_string();
            _parse_json_eat_whitespace();
            
            unless ($char eq ':') {
                last;
            }

            _parse_json_next_char();
            _parse_json_eat_whitespace();
            $obj->{$key} = _parse_json_parse_value();
            _parse_json_eat_whitespace();

            if ($char eq '}') {
                _parse_json_next_char();
                return $obj;
            }
            elsif ($char eq ',') {
                _parse_json_next_char();
                _parse_json_eat_whitespace();
            }
            else {
                last;
            }
        }