view release on metacpan or  search on metacpan

t/000-report-versions.t  view on Meta::CPAN

                push @$self, $self->_read_scalar( "$1", [ undef ], \@lines );
                next;
            }
        }

        if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
            # A naked document
            push @$self, undef;
            while ( @lines and $lines[0] !~ /^---/ ) {
                shift @lines;
            }

        } elsif ( $lines[0] =~ /^\s*\-/ ) {
            # An array at the root
            my $document = [ ];
            push @$self, $document;
            $self->_read_array( $document, [ 0 ], \@lines );

        } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
            # A hash at the root
            my $document = { };
            push @$self, $document;
            $self->_read_hash( $document, [ length($1) ], \@lines );

        } else {
            croak("YAML::Tiny failed to classify the line '$lines[0]'");
        }
    }

    $self;
}

# Deparse a scalar string to the actual scalar
sub _read_scalar {
    my ($self, $string, $indent, $lines) = @_;

    # Trim trailing whitespace
    $string =~ s/\s*\z//;

    # Explitic null/undef
    return undef if $string eq '~';

    # Quotes
    if ( $string =~ /^\'(.*?)\'\z/ ) {
        return '' unless defined $1;
        $string = $1;
        $string =~ s/\'\'/\'/g;
        return $string;
    }
    if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
        # Reusing the variable is a little ugly,
        # but avoids a new variable and a string copy.
        $string = $1;
        $string =~ s/\\"/"/g;
        $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
        return $string;
    }

    # Special cases
    if ( $string =~ /^[\'\"!&]/ ) {
        croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
    }
    return {} if $string eq '{}';
    return [] if $string eq '[]';

    # Regular unquoted string
    return $string unless $string =~ /^[>|]/;

    # Error
    croak("YAML::Tiny failed to find multi-line scalar content") unless @$lines;

    # Check the indent depth
    $lines->[0]   =~ /^(\s*)/;
    $indent->[-1] = length("$1");
    if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
        croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
    }

    # Pull the lines
    my @multiline = ();
    while ( @$lines ) {
        $lines->[0] =~ /^(\s*)/;
        last unless length($1) >= $indent->[-1];
        push @multiline, substr(shift(@$lines), length($1));
    }

    my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
    my $t = (substr($string, 1, 1) eq '-') ? ''  : "\n";
    return join( $j, @multiline ) . $t;
}

# Parse an array
sub _read_array {
    my ($self, $array, $indent, $lines) = @_;

    while ( @$lines ) {
        # Check for a new document
        if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
            while ( @$lines and $lines->[0] !~ /^---/ ) {
                shift @$lines;
            }
            return 1;
        }

        # Check the indent level
        $lines->[0] =~ /^(\s*)/;
        if ( length($1) < $indent->[-1] ) {
            return 1;
        } elsif ( length($1) > $indent->[-1] ) {
            croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
        }

        if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
            # Inline nested hash
            my $indent2 = length("$1");
            $lines->[0] =~ s/-/ /;
            push @$array, { };
            $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );

        } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
            # Array entry with a value

t/000-report-versions.t  view on Meta::CPAN

                my $indent2 = length("$1");
                if ( $indent->[-1] == $indent2 ) {
                    # Null array entry
                    push @$array, undef;
                } else {
                    # Naked indenter
                    push @$array, [ ];
                    $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
                }

            } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
                push @$array, { };
                $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );

            } else {
                croak("YAML::Tiny failed to classify line '$lines->[0]'");
            }

        } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
            # This is probably a structure like the following...
            # ---
            # foo:
            # - list
            # bar: value
            #
            # ... so lets return and let the hash parser handle it
            return 1;

        } else {
            croak("YAML::Tiny failed to classify line '$lines->[0]'");
        }
    }

    return 1;
}

# Parse an array
sub _read_hash {
    my ($self, $hash, $indent, $lines) = @_;

    while ( @$lines ) {
        # Check for a new document
        if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
            while ( @$lines and $lines->[0] !~ /^---/ ) {
                shift @$lines;
            }
            return 1;
        }

        # Check the indent level
        $lines->[0] =~ /^(\s*)/;
        if ( length($1) < $indent->[-1] ) {
            return 1;
        } elsif ( length($1) > $indent->[-1] ) {
            croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
        }

        # Get the key
        unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
            if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
                croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
            }
            croak("YAML::Tiny failed to classify line '$lines->[0]'");
        }
        my $key = $1;

        # Do we have a value?
        if ( length $lines->[0] ) {
            # Yes
            $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
        } else {
            # An indent
            shift @$lines;
            unless ( @$lines ) {
                $hash->{$key} = undef;
                return 1;
            }
            if ( $lines->[0] =~ /^(\s*)-/ ) {
                $hash->{$key} = [];
                $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
            } elsif ( $lines->[0] =~ /^(\s*)./ ) {
                my $indent2 = length("$1");
                if ( $indent->[-1] >= $indent2 ) {
                    # Null hash entry
                    $hash->{$key} = undef;
                } else {
                    $hash->{$key} = {};
                    $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
                }
            }
        }
    }

    return 1;
}

# Set error
sub _error {
    $YAML::Tiny::errstr = $_[1];
    undef;
}

# Retrieve error
sub errstr {
    $YAML::Tiny::errstr;
}



#####################################################################
# Use Scalar::Util if possible, otherwise emulate it

BEGIN {
    eval {
        require Scalar::Util;
    };
    if ( $@ ) {
        # Failed to load Scalar::Util
        eval <<'END_PERL';
sub refaddr {
    my $pkg = ref($_[0]) or return undef;