App::Serializer::OneLine - Interface for serialization and deserialization

    use App;

    $context = App->context();
    $serializer = $context->service("Serializer");  # or ...
    $serializer = $context->serializer();
    $data = {
        an => 'arbitrary',
        collection => [ 'of', 'data', ],
        of => {
            arbitrary => 'depth',
        },
    };
    $perl = $serializer->serialize($data);
    $data = $serializer->deserialize($perl);
    print $serializer->dump($data), "\n";

#############################################################################
## $Id: OneLine.pm 6001 2006-05-02 13:44:59Z spadkins $
#############################################################################

package App::Serializer::OneLine;
$VERSION = (q$Revision: 6001 $ =~ /(\d[\d\.]*)/)[0];  # VERSION numbers generated by svn

use App;
use App::Serializer;
@ISA = ( "App::Serializer" );

use strict;

sub serialize {
    my ($self, $data) = @_;
    my ($perl);
    if (ref($data) eq "ARRAY") {
        $perl = $self->_serialize(",",",",@$data);
    }
    else {
        $perl = $self->_serialize(",",",",$data);
    }
    return $perl;
}

sub _serialize {
    my ($self, $evensep, $oddsep, @data) = @_;
    my $perl = "";
    $evensep = "," if (! defined $evensep);
    $oddsep = $evensep if (! defined $oddsep);
    my ($nelem, $elem);
    for ($nelem = 0; $nelem <= $#data; $nelem++) {
        if ($nelem % 2 == 1) {
            $perl .= $oddsep;
        }
        else {
            $perl .= $evensep if ($nelem);
        }
        $elem = $data[$nelem];
        if (! defined $elem) {
            $perl .= "undef";
        }
        elsif (ref($elem) eq "") {
            $perl .= $elem;
        }
        elsif (ref($elem) eq "ARRAY") {
            $elem = $self->_serialize(",", ",", @$elem);
            $perl .= "[$elem]";
        }
        elsif (ref($elem) eq "HASH") {
            $elem = $self->_serialize(",", "=", %$elem);
            $perl .= "{$elem}";
        }
        else {
            $perl .= $elem;
        }
    }
    return $perl;
}

sub deserialize {
    my ($self, $perl) = @_;
    my (@perl, $elem, @remove);
    # print "\$PERL=($perl)\n";
    # SPECIAL CHARACTERS: \=,{}[]
    my %save_esc = (
        "," => 0x10,
        "=" => 0x11,
        "{" => 0x12,
        "}" => 0x13,
        "[" => 0x14,
        "]" => 0x15,
    );
    my %restore_esc = (reverse %save_esc);
    my $saved = $perl =~ s/\\([,\[\]\{\}])/$save_esc{$1}/ge;
    $perl =~ s/=/,/g;
    #@perl = grep s/([\x10\x11\x12\x13\x14\x15])/$restore_esc{$1}/e split(/([,\{\}\[\]])/, $perl);
    @perl = split(/([,\{\}\[\]])/, $perl);
    # print "\@PERL[split]=(", join("-",@perl), ")\n";
    for (my $i = $#perl; $i >= 0; $i--) {
        $elem = $perl[$i];
        if ($elem eq "") {
            if ($i == 0) {
                if ($perl[$i+1] =~ /^[\{\[]$/) {
                    $remove[$i] = 1;
                }
            }
            elsif ($i < $#perl) {
                if (($perl[$i-1] !~ /^[,\{\[]$/) ||
                    ($perl[$i-1] eq "," && $perl[$i+1] =~ /^[\{\[]$/)) {
                    $remove[$i] = 1;
                }
            }
            else {
                if ($perl[$i-1] =~ /^[\}\]]$/) {
                    $remove[$i] = 1;
                }
            }
        }
    }
    if ($perl[$#perl] eq ",") {
        push(@perl, "");
    }
    for (my $i = $#perl; $i >= 0; $i--) {
        $elem = $perl[$i];
        if ($elem eq "," || $remove[$i]) {
            splice(@perl, $i, 1);
        }
    }
    # print "\@PERL=(", join("-",@perl), ")\n";
    my @data = $self->_deserialize(\@perl, 0, $#perl);
    if ($#data > 0) {
        return(\@data);
    }
    elsif ($#data == 0) {
        return($data[0]);
    }
    else {
        return(\@data);
    }
}

sub _find_matchidx {
    my ($self, $perlparts, $idx) = @_;
    my ($matchidx, $depth);
    $depth = 0;
    for ($matchidx = $idx; $matchidx <= $#$perlparts; $matchidx++) {
        if ($perlparts->[$matchidx] eq "[" || $perlparts->[$matchidx] eq "{") {
            $depth++;
        }
        elsif ($perlparts->[$matchidx] eq "]" || $perlparts->[$matchidx] eq "}") {
            $depth--;
            last if ($depth == 0);
        }
    }
    return($matchidx);
}

sub _deserialize {
    my ($self, $perlparts, $startidx, $endidx) = @_;
    my (@data, $elem, @elems, $idx, $matchidx);
    $idx = $startidx;
    while ($idx <= $endidx) {
        if ($perlparts->[$idx] eq "[") {
            $matchidx = $self->_find_matchidx($perlparts, $idx);
            @elems = $self->_deserialize($perlparts, $idx+1, $matchidx-1);
            push(@data, [ @elems ]);
            $idx = $matchidx + 1;
        }
        elsif ($perlparts->[$idx] eq "{") {
            $matchidx = $self->_find_matchidx($perlparts, $idx);
            @elems = $self->_deserialize($perlparts, $idx+1, $matchidx-1);
            push(@elems, "") if ($#elems % 2 == 0);  # odd number not allowed
            push(@data, { @elems });
            $idx = $matchidx + 1;
        }
        else {
            $elem = $perlparts->[$idx];
            push(@data, ($elem eq "undef" ? undef : $elem));
            $idx++;
        }
    }
    return(@data);
}

sub serialized_content_type {
    'text/plain';
}

1;