cvsuser 04/02/27 08:17:22
Added: App-Context/lib/App/Serializer OneLine.pm
Log:
new
Revision Changes Path
1.1 p5ee/App-Context/lib/App/Serializer/OneLine.pm
Index: OneLine.pm
===================================================================
#############################################################################
## $Id: OneLine.pm,v 1.1 2004/02/27 16:17:21 spadkins Exp $
#############################################################################
package App::Serializer::OneLine;
use App;
use App::Serializer;
@ISA = ( "App::Serializer" );
use strict;
=head1 NAME
App::Serializer::OneLine - Interface for serialization and deserialization
=head1 SYNOPSIS
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";
=head1 DESCRIPTION
A Serializer allows you to serialize a structure of data
of arbitrary depth to a scalar and deserialize it back to the
structure.
The OneLine serializer uses a simplified perl data structure syntax
as the serialized form of the data. It is meant for parsing
human-entered data and writing human-readable data.
(Sometimes, the one line does get pretty long.)
=cut
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 (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";
$perl =~ s/,/\|/g if ($perl !~ /\|/);
$perl =~ s/=>?/\|/g;
@perl = split(/([\|\{\}\[\]])/, $perl);
# print "[EMAIL PROTECTED](", join("-",@perl), ")\n";
for (my $i = $#perl; $i >= 0; $i--) {
$elem = $perl[$i];
$elem =~ s/^\s+//; # trim leading whitespace
$elem =~ s/\s+$//; # trim trailing whitespace
$perl[$i] = $elem;
if ($elem eq "") {
if ($i == 0) {
if ($perl[$i+1] =~ /^[\{\[]$/) { # match ]}
$remove[$i] = 1;
}
}
elsif ($i < $#perl) {
if (($perl[$i-1] !~ /^[\|\{\[]$/) || # match ]}
($perl[$i-1] eq "|" && $perl[$i+1] =~ /^[\{\[]$/)) { # match ]}
$remove[$i] = 1;
}
}
else { # match [{
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 "[EMAIL PROTECTED](", join("-",@perl), ")\n";
my @data = $self->_deserialize([EMAIL PROTECTED], 0, $#perl);
if ($#data > 0) {
return([EMAIL PROTECTED]);
}
elsif ($#data == 0 && !ref($data[0])) {
return([EMAIL PROTECTED]);
}
else {
return($data[0]);
}
}
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;
