### re: Daily Coding Problem #3 VIEW POST

The tricky part is to make it work for arbitrary values, i.e. drop the assumption the symbols for Empty_Marker and '-' are not going to be used in any node's value.

Here's such a solution in Perl, tests included:

``````#!/usr/bin/perl
use warnings;
use strict;

package Node {
use Moo;

has value => (is => 'ro', required => 1);
has left  => (is => 'ro', isa => sub { shift->isa('Node') or die });
has right => (is => 'ro', isa => sub { shift->isa('Node') or die });

my \$_escape_value = sub {
my (\$self) = @_;
my \$value = \$self->value;
\$value =~ s/\$_->[0]/\\\$_->[1]/g
for [qr/\\/ => '\\'],
[qr/"/  => '\''],
[qr/\(/ => '['],
[qr/\)/ => ']'];

return \$value
};

my \$unescape = sub {
my (\$value) = @_;

\$value =~ s/(?<!\\)\\\$_->[0]/\$_->[1]/g
for [qr/\]/ => ')'],
[qr/\[/ => '('],
[qr/'/  => '"'];
\$value =~ s/\\\\/\\/g;

return \$value
};

my \$parse = sub {
my (\$rest) = @_;
my \$pos = '(' eq substr \$rest, 0, 1;
my \$rank = \$pos;
until (0 == \$rank) {
++\$rank if '(' eq substr \$rest, \$pos, 1;
--\$rank if ')' eq substr \$rest, \$pos, 1;
++\$pos;
}

my \$left  = substr \$rest, 0, \$pos;
my \$right = substr \$rest, \$pos + (\$pos != length \$rest);

length \$_ and \$_  = __PACKAGE__->deserialize(\$_)
for \$left, \$right;

return \$left, \$right
};

sub serialize {
my (\$self) = @_;

my \$value = \$self->\$_escape_value;
my (\$left, \$right) = map \$_ ? \$_->serialize : "",
\$self->left,
\$self->right;

return '(' . join(',', qq("\$value"), \$left, \$right) . ')'
}

sub deserialize {
my (\$class, \$string) = @_;

return undef unless length \$string;

my (\$value, \$rest) = \$string =~ /^\("([^"]*)",(.*)\)\$/sg;

\$value = \$unescape->(\$value);
my (\$left, \$right) = \$parse->(\$rest);

return \$class->new(value => \$value,
(left  => \$left)  x !! ref \$left,
(right => \$right) x !! ref \$right)
}

};

use Test::More tests => 7;

my \$node1 = 'Node'->new(
value => 'root',
left  => 'Node'->new(
value => 'left',
left => 'Node'->new(value => my \$left_left = 'left.left')),
right => 'Node'->new(value => 'right'),
);

is 'Node'->deserialize(\$node1->serialize)->left->left->value, \$left_left;

my \$node2 = 'Node'->new(
value => my \$empty = "",
right => 'Node'->new(value => my \$special_chars = '("[,\'\\]"))',
right => 'Node'->new(
value => my \$newline = "1\n2")));

is 'Node'->deserialize(\$node2->serialize)->value,
\$empty;
is 'Node'->deserialize(\$node2->serialize)->right->value,
\$special_chars;
is 'Node'->deserialize(\$node2->serialize)->right->right->value,
\$newline;

my \$node3 = 'Node'->new(value => \$node1->serialize,
left  => 'Node'->new(value => \$node2->serialize));

is 'Node'->deserialize(\$node3->serialize)->value,
\$node1->serialize;
is 'Node'->deserialize(\$node3->serialize)->left->value,
\$node2->serialize;

my \$super = \$node3->serialize;

\$super = 'Node'->new(
value => 'Node'->deserialize(\$super)->serialize
)->serialize
for 1 .. 6;

my \$root = \$super;
\$root = 'Node'->deserialize(\$root)->value for 1 .. 8;
is \$root, 'root';
``````
code of conduct - report abuse