view release on metacpan or  search on metacpan

bin/cpant  view on Meta::CPAN

  			if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
  				die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'";
  			}
  			die \"CPAN::Meta::YAML 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)/ or $QUOTE{$string} ) {
  		return "'$string'";
  	}
  	return $string;
  }
  
  sub _write_array {
  	my ($self, $array, $indent, $seen) = @_;
  	if ( $seen->{refaddr($array)}++ ) {
  		die "CPAN::Meta::YAML 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 "CPAN::Meta::YAML does not support $type references";
  		}
  	}
  
  	@lines;