view release on metacpan or  search on metacpan

lib/JSON/Transform.pm  view on Meta::CPAN

      my ($srcptr, $destptr, $mapping);
      if ($name eq 'transformImpliedDest') {
        ($srcptr, $mapping) = @{$_->{children}};
        $destptr = $srcptr;
      } elsif ($name eq 'transformCopy') {
        ($destptr, $srcptr, $mapping) = @{$_->{children}};
      } elsif ($name eq 'transformMove') {
        ($destptr, $srcptr) = @{$_->{children}};
        $srcptr = _eval_expr($data, $srcptr, _make_sysvals(), $uservals, 1);
        die "invalid src pointer '$srcptr'" if !_pointer(1, $data, $srcptr);
        my $srcdata = _pointer(0, $data, $srcptr, 1);
        _apply_destination($data, $destptr, $srcdata, $uservals);
        return $data;
      } else {
        die "Unknown transform type '$name'";
      }
      my $srcdata = _eval_expr($data, $srcptr, _make_sysvals(), $uservals);
      my $newdata;
      if ($mapping) {
        my $opFrom = $mapping->{attributes}{opFrom};
        die "Expected '$srcptr' to point to hash"
          if $opFrom eq '<%' and ref $srcdata ne 'HASH';
        die "Expected '$srcptr' to point to array"
          if $opFrom eq '<@' and ref $srcdata ne 'ARRAY';
        $newdata = _apply_mapping($data, $mapping->{children}[0], dclone $srcdata, $uservals);
      } else {
        $newdata = $srcdata;
      }
      _apply_destination($data, $destptr, $newdata, $uservals);
    }
    $data;
  };
}

sub _apply_destination {
  my ($topdata, $destptr, $newdata, $uservals) = @_;
  my $name = $destptr->{nodename};