view release on metacpan or  search on metacpan

lib/Data/Pond.pm  view on Meta::CPAN

		while(1) {
			_subexpr_skip_ws($exprref);
			last if $$exprref =~ /\G$close/gc;
			push @data, _subexpr_datum($exprref);
			_subexpr_skip_ws($exprref);
			last if $$exprref =~ /\G$close/gc;
			die "Pond syntax error\n"
				unless $$exprref =~ /\G(?:,|=>)/gc;
		}
		return \@data if $type eq "ARRAY";
		die "Pond constraint error: ".
				"odd number of elements in hash constructor\n"
			if scalar(@data) & 1;
		for(my $i = @data; $i; ) {
			$i -= 2;
			die "Pond constraint error: non-string hash key\n"
				unless is_string($data[$i]);
		}
		return {@data};
	} else { die "Pond syntax error\n" }
}

sub pond_read_datum($) {
	my($text) = @_;
	die "Pond data error: text isn't a string\n" unless is_string($text);
	_subexpr_skip_ws(\$text);
	my $datum = _subexpr_datum(\$text);
	_subexpr_skip_ws(\$text);
	die "Pond syntax error\n" unless $text =~ /\G\z/gc;
	return $datum;
}

=item pond_write_datum(DATUM[, OPTIONS])

I<DATUM> is a Perl native datum.  This function serialises it as a
character string using Pond encoding.  The data to be serialised can
recursively contain Perl strings, arrays, and hashes.  Numbers are
implicitly stringified, and C<undef> is treated as the empty string.
C<die>s if an unserialisable datum is encountered.

I<OPTIONS>, if present, must be a reference to a hash, containing options
that control the serialisation process.  The recognised options are:

=over

=item B<indent>

If C<undef> (which is the default), no optional whitespace will be added.
Otherwise it must be a non-negative integer, and the datum will be laid
out with whitespace (where it is optional) to illustrate the structure by
indentation.  The number given must be the number of leading spaces on
the line on which the resulting element will be placed.  If whitespace
is added, the element will be arranged to end on a line of the same
indentation, and all intermediate lines will have greater indentation.

=item B<undef_is_empty>

If false (the default), C<undef> will be treated as invalid data.
If true, C<undef> will be serialised as an empty string.

=item B<unicode>

If false (the default), the datum will be expressed using only ASCII
characters.  If true, non-ASCII characters may be used in string literals.

=back

=cut

my %str_encode = (
	"\t" => "\\t",
	"\n" => "\\n",
	"\"" => "\\\"",
	"\$" => "\\\$",
	"\@" => "\\\@",
	"\\" => "\\\\",
);
foreach(0x00..0x1f, 0x7f..0xa0) {
	my $c = chr($_);
	$str_encode{$c} = sprintf("\\x%02x", $_) unless exists $str_encode{$c};
}

sub _strdatum_to_string($$) {
	my($str, $options) = @_;
	return $str if $str =~ /\A(?:0|[1-9][0-9]{0,8})\z/;
	die "Pond data error: invalid character\n"
		unless $str =~ /\A[\x{0}-\x{7fffffff}]*\z/;
	$str =~ s/([\x00-\x1f\"\$\@\\\x7f-\xa0])/$str_encode{$1}/eg;
	$str =~ s/([^\x00-\x7f])/sprintf("\\x{%02x}", ord($1))/eg
		unless $options->{unicode};
	return "\"$str\"";
}

sub _strdatum_to_bareword($$) {
	return $_[0] =~ /\A[A-Za-z_][0-9A-Za-z_]*\z/ ? $_[0] :
		&_strdatum_to_string;
}

sub pond_write_datum($;$);
sub pond_write_datum($;$) {
	my($datum, $options) = @_;
	$options = {} unless defined $options;
	if(is_undef($datum) && $options->{undef_is_empty}) {
		return '""';
	} elsif(is_string($datum)) {
		return _strdatum_to_string($datum, $options);
	} elsif(is_ref($datum, "ARRAY")) {
		return "[]" if @$datum == 0;
		if(defined $options->{indent}) {
			my $indent = $options->{indent};
			my $subindent = $indent + 4;
			my $indent_str = "\n"." "x$indent;
			my $subindent_str = "\n"." "x$subindent;
			my $suboptions = { %$options, indent => $subindent };
			return join("", "[", (map { (
				$subindent_str,
				pond_write_datum($_, $suboptions),
				",",
			) } @$datum), $indent_str, "]");
		} else {
			return "[".join(",", map {
				pond_write_datum($_, $options)
			} @$datum)."]";
		}
	} elsif(is_ref($datum, "HASH")) {
		return "{}" if keys(%$datum) == 0;
		if(defined $options->{indent}) {
			my $indent = $options->{indent};
			my $subindent = $indent + 4;
			my $indent_str = "\n"." "x$indent;
			my $subindent_str = "\n"." "x$subindent;
			my $suboptions = { %$options, indent => $subindent };
			return join("", "{", (map { (
				$subindent_str,
				_strdatum_to_bareword($_, $options),
				" => ",
				pond_write_datum($datum->{$_}, $suboptions),
				",",
			) } sort keys %$datum), $indent_str, "}");
		} else {
			return "{".join(",", map {
				_strdatum_to_bareword($_, $options)."=>".
				pond_write_datum($datum->{$_}, $options)
			} sort keys %$datum)."}";
		}
	} else {
		die "Pond data error: unsupported data type\n";
	}
}