view release on metacpan or  search on metacpan

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

has path_style => (
   is      => 'ro',
   isa     => Str,
   default => sub { 'DZIL' },
   coerce  => sub {
      'Parse::Path::'.$_[0] unless ($_[0] =~ s/^\=//);  # NOTE: kill two birds with one stone
   },
);

has path_options => (
   is      => 'ro',
   isa     => HashRef,
   default => sub { {
      auto_normalize => 1,
      auto_cleanup   => 1,
   } },
);

has remove_undefs => (
   is      => 'ro',
   isa     => Bool,
   default => sub { 1 },
);

#############################################################################
# Pre/post-BUILD


sub BUILD {
   my $self = $_[0];

   # Load the path class
   use_module $self->path_style;

   return $self;
}

#############################################################################
# Methods

### FLATTENING ###

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

   my $type = ref $ref;
   die 'Reference must be an unblessed HASH or ARRAY!'
      unless (defined $ref && !blessed $ref && $type =~ /HASH|ARRAY/);

   return $self->serialize_refpath('', $ref);
}

sub serialize_refpath {
   my ($self, $path, $ref) = @_;
   $path //= '';

   my $prh = { $path => $ref };  # single row answer

   return $prh if blessed $ref;  # down that path leads madness...
   my $type = ref $ref || return $prh;        # that covers SCALARs...
   return $prh unless $type =~ /HASH|ARRAY/;  # ...and all other endpoints

   # Blessed is the path
   unless (blessed $path) {
      $path = $self->path_style->new(
         %{ $self->path_options },
         stash_obj => $self,
         path => $path,
      );
   }

   die sprintf("Too deep down the rabbit hole, stopped at '%s'", $path)
      if ($path->step_count > 255);

   my $hash = {};
   my @keys = $type eq 'HASH' ? (keys %$ref) : (0 .. $#$ref);
   foreach my $key (@keys) {
      my $val = $type eq 'HASH' ? $ref->{$key} : $ref->[$key];

      # Add on to $path
      my $newpath = $path->clone;
      $newpath->push( $newpath->key2hash($key, $type) );

      # Recurse back to give us a full set of $path => $val pairs
      my $newhash = $self->serialize_refpath($newpath, $val);

      # Merge (shallowly)
      $hash->{$_} = $newhash->{$_} for (grep { defined $newhash->{$_} or !$self->remove_undefs } keys %$newhash);
   }

   return $hash;
}

### EXPANSION ###

sub deserialize {
   my ($self, $hash) = @_;

   my $root;  # not sure if it's a hash or array yet
   foreach my $path (sort keys %$hash) {
      my $branch = $self->deserialize_pathval($path, $hash->{$path}) || return;  # error already set

      # New root?
      unless (defined $root) {
         $root = $branch;
         next;
      }

      # Our merge behavior might die on us (or Hash::Merge itself)
      my $err;
      try   { $root = $self->merge($root, $branch); }
      catch { $err = $_; };

      # Add path to error
      die sprintf("In path '%s', %s", $path, $err) if ($err);
   }

   return $root;
}

sub deserialize_pathval {