view release on metacpan or  search on metacpan

lib/App/GhaInstall/YAML.pm  view on Meta::CPAN

            if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
                die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
            }
            die \"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;
}

# Save an object to a file
sub write {
    my $self = shift;
    my $file = shift or return $self->_error('No file name provided');

    # Write it to the file
    open( CFG, '>' . $file ) or return $self->_error(
        "Failed to open file '$file' for writing: $!"
        );
    print CFG $self->write_string;
    close CFG;

    return 1;
}

# Save an object to a string
sub write_string {
    my $self = shift;
    return '' unless @$self;

    # Iterate over the documents
    my $indent = 0;
    my @lines  = ();
    foreach my $cursor ( @$self ) {
        push @lines, '---';

        # An empty document
        if ( ! defined $cursor ) {
            # Do nothing

        # A scalar document
        } elsif ( ! ref $cursor ) {
            $lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent );

        # A list at the root
        } elsif ( ref $cursor eq 'ARRAY' ) {
            unless ( @$cursor ) {
                $lines[-1] .= ' []';
                next;
            }
            push @lines, $self->_write_array( $cursor, $indent, {} );

        # A hash at the root
        } elsif ( ref $cursor eq 'HASH' ) {
            unless ( %$cursor ) {
                $lines[-1] .= ' {}';
                next;
            }
            push @lines, $self->_write_hash( $cursor, $indent, {} );

        } else {
            Carp::croak("Cannot serialize " . ref($cursor));
        }
    }

    join '', map { "$_\n" } @lines;
}

sub _write_scalar {
    my $string = $_[1];
    return '~'  unless defined $string;
    return "''" unless length  $string;
    if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) {
        $string =~ s/\\/\\\\/g;
        $string =~ s/"/\\"/g;
        $string =~ s/\n/\\n/g;
        $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
        return qq|"$string"|;
    }
    if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) {
        return "'$string'";
    }
    return $string;
}

sub _write_array {
    my ($self, $array, $indent, $seen) = @_;
    if ( $seen->{refaddr($array)}++ ) {
        die "YAML::Tiny does not support circular references";
    }
    my @lines  = ();
    foreach my $el ( @$array ) {
        my $line = ('  ' x $indent) . '-';
        my $type = ref $el;
        if ( ! $type ) {
            $line .= ' ' . $self->_write_scalar( $el, $indent + 1 );
            push @lines, $line;

        } elsif ( $type eq 'ARRAY' ) {
            if ( @$el ) {
                push @lines, $line;
                push @lines, $self->_write_array( $el, $indent + 1, $seen );
            } else {
                $line .= ' []';
                push @lines, $line;
            }

        } elsif ( $type eq 'HASH' ) {
            if ( keys %$el ) {
                push @lines, $line;
                push @lines, $self->_write_hash( $el, $indent + 1, $seen );
            } else {
                $line .= ' {}';
                push @lines, $line;
            }

        } else {
            die "YAML::Tiny does not support $type references";
        }
    }

    @lines;