Skip to content

Commit

Permalink
Sereal::Path: work in progress #7
Browse files Browse the repository at this point in the history
  • Loading branch information
Ivan Kruglov authored and Ivan Kruglov committed May 4, 2015
1 parent 5709dea commit 06804af
Show file tree
Hide file tree
Showing 5 changed files with 478 additions and 449 deletions.
85 changes: 51 additions & 34 deletions Perl/Path/Iterator.xs
View file
Expand Up @@ -48,41 +48,33 @@ eof(iter)
RETVAL = srl_eof(iter);
OUTPUT: RETVAL

UV
next(iter)
srl_iterator_t *iter;
CODE:
RETVAL = srl_next_n(iter, 1);
OUTPUT: RETVAL

UV
step(iter)
void
next(iter, n = NULL)
srl_iterator_t *iter;
SV *n;
CODE:
RETVAL = srl_step_n(iter, 1);
OUTPUT: RETVAL
srl_next(iter, n ? SvUV(n) : 1);

UV
next_n(iter, next)
void
step_in(iter, n = NULL)
srl_iterator_t *iter;
UV next;
SV *n;
CODE:
RETVAL = srl_next_n(iter, next);
OUTPUT: RETVAL
srl_step_in(iter, n ? SvUV(n) : 1);

UV
step_n(iter, step)
void
step_out(iter, n = NULL)
srl_iterator_t *iter;
UV step;
SV *n;
CODE:
RETVAL = srl_step_n(iter, step);
OUTPUT: RETVAL
srl_step_out(iter, n ? SvUV(n) : 1);

UV
parent(iter)
continue_until_depth(iter, depth)
srl_iterator_t *iter;
UV depth;
CODE:
RETVAL = srl_parent(iter);
RETVAL = srl_continue_until_depth(iter, depth);
OUTPUT: RETVAL

UV
Expand All @@ -92,34 +84,59 @@ offset(iter)
RETVAL = srl_offset(iter);
OUTPUT: RETVAL

SV *
type(iter)
void
info(iter)
srl_iterator_t *iter;
PREINIT:
SV *type;
UV length;
PPCODE:
type = srl_object_info(iter, &length);

EXTEND(SP, 2);
PUSHs(type);
PUSHs(sv_2mortal(newSVuv(length)));

UV
stack_depth(iter)
srl_iterator_t *iter;
CODE:
RETVAL = srl_object_type(iter);
SvREFCNT_inc(RETVAL);
RETVAL = srl_stack_depth(iter);
OUTPUT: RETVAL

UV
count(iter)
stack_index(iter)
srl_iterator_t *iter;
CODE:
RETVAL = srl_object_count(iter);
RETVAL = srl_stack_index(iter);
OUTPUT: RETVAL

UV
find_key(iter, name)
void
stack_info(iter)
srl_iterator_t *iter;
PREINIT:
SV *type;
UV length;
PPCODE:
type = srl_stack_info(iter, &length);

EXTEND(SP, 2);
PUSHs(type);
PUSHs(sv_2mortal(newSVuv(length)));

IV
hash_exists(iter, name)
srl_iterator_t *iter;
SV *name;
CODE:
RETVAL = srl_find_key(iter, name);
RETVAL = srl_hash_exists(iter, name);
OUTPUT: RETVAL

SV *
get_key(iter)
hash_key(iter)
srl_iterator_t *iter;
CODE:
RETVAL = srl_get_key(iter);
RETVAL = srl_hash_key(iter);
SvREFCNT_inc(RETVAL);
OUTPUT: RETVAL

Expand Down
159 changes: 29 additions & 130 deletions Perl/Path/lib/Sereal/Path.pm
View file
Expand Up @@ -86,165 +86,64 @@ sub trace {
$x = join ';', @x;
}

my $iter_type = $iter->type;
if ($iter_type eq 'ARRAY' && $loc =~ /^[0-9]+$/) { # /^\-?[0-9]+$/
my $iter_count = $iter->count;
if ($loc < $iter_count) { # TODO add support of negative $loc
$iter->step or die "failed to do step";
for (my $i = 0; $i < $loc; $i++) {
$iter->next or die "failed to do next";
}

return $self->trace($x, sprintf('%s;%s', $path, $loc));
}
my ($type, $cnt) = $iter->info;
if ($type eq 'ARRAY' && $loc =~ /^[0-9]+$/ && $loc < $cnt) {
# /^\-?[0-9]+$/ # TODO add support of negative $loc
$iter->step_in;
$iter->next foreach (1..$loc);
return $self->trace($x, sprintf('%s;%s', $path, $loc));
}

if ($iter_type eq 'HASH') {
$iter->step or die "failed to do step";
if ($iter->find_key($loc)) {
return $self->trace($x, sprintf('%s;%s', $path, $loc));
}

$iter->parent or die "failed to goto parent";
if ($type eq 'HASH') {
$iter->step_in;
return $self->trace($x, sprintf('%s;%s', $path, $loc))
if $iter->hash_exists($loc);
$iter->step_out;
}

if ($loc eq '*') {
return $self->walk($loc, $x, $path, \&_callback_03);
}

#elsif ($loc eq '..')
#{
# $self->trace($x, $val, $path);
# $self->walk($loc, $x, $val, $path, \&_callback_04);
#}

if ($loc =~ /\,/) { # [name1,name2,...]
$self->trace($_ . ';' . $x, $path) foreach split /\,/, $loc;
return;
}

#elsif ($loc =~ /^\(.*?\)$/) # [(expr)]
#{
# my $evalx = $self->evalx($loc, $val, substr($path, rindex($path,";")+1));
# $self->trace($evalx.';'.$x, $val, $path);
#}
#elsif ($loc =~ /^\?\(.*?\)$/) # [?(expr)]
#{
# # my $evalx = $self->evalx($loc, $val, substr($path, rindex($path,";")+1));
# $self->walk($loc, $x, $val, $path, \&_callback_05);
#}
#elsif ($loc =~ /^(-?[0-9]*):(-?[0-9]*):?(-?[0-9]*)$/) # [start:end:step] python slice syntax
#{
# $self->slice($loc, $x, $iter, $path);
#}
}

sub _callback_03 {
my ($self, $m, $loc, $expr, $path) = @_;
$self->trace($m . ";" . $expr, $path);
}

#sub _callback_04
#{
# my ($self, $m, $l, $x, $v, $p) = @_;
#
# if (isArray($v)
# and isArray($v->[$m]) || isObject($v->[$m]))
# {
# $self->trace("..;".$x, $v->[$m], $p.";".$m);
# }
# elsif (isObject($v)
# and isArray($v->{$m}) || isObject($v->{$m}))
# {
# $self->trace("..;".$x, $v->{$m}, $p.";".$m);
# }
#}
#
#sub _callback_05
#{
# my ($self, $m, $l, $x, $v, $p) = @_;
#
# $l =~ s/^\?\((.*?)\)$/$1/g;
#
# my $evalx;
# if (isArray($v))
# {
# $evalx = $self->evalx($l, $v->[$m]);
# }
# elsif (isObject($v))
# {
# $evalx = $self->evalx($l, $v->{$m});
# }
#
# $self->trace($m.";".$x, $v, $p)
# if $evalx;
#}

sub walk {
my ($self, $loc, $expr, $path, $f) = @_;
my $iter = $self->{iter};
my $iter_type = $iter->type;
my ($type, $cnt) = $iter->info;

if ($iter_type eq 'ARRAY') {
my $cnt = $iter->count;
if ($type eq 'ARRAY') {
#$iter->step_in;
my $depth = $iter->stack_depth + 1;
warn("------- ARRAY $depth ");
for (my $i = 0; $i < $cnt; $i++) {
warn("-----------------------------------");
$f->($self, $i, $loc, $expr, $path);
if ($iter->stack_depth > $depth) {
warn("------- ARRAY continue_until_depth($depth)");
$iter->continue_until_depth($depth)
}
}
} elsif ($iter_type eq 'HASH') {
my $cnt = $iter->count;
} elsif ($type eq 'HASH') {
$iter->step_in;
my $depth = $iter->depth;
warn("------- HASH $depth ");

for (my $i = 0; $i < $cnt; $i++) {
$iter->next or die "failed to do next";
$iter->next;
$f->($self, $i, $loc, $expr, $path);
$iter->continue_until_depth($depth)
if $iter->stack_depth > $depth;
}
} else {
croak('walk called on non hashref/arrayref value, died');
}
}

#sub slice {
# my ($self, $loc, $expr, $v, $path) = @_;
#
# $loc =~ s/^(-?[0-9]*):(-?[0-9]*):?(-?[0-9]*)$/$1:$2:$3/;
# my @s = split /\:/, $loc;
# my $len = scalar @$v;
#
# my $start = $s[0]+0 ? $s[0]+0 : 0;
# my $end = $s[1]+0 ? $s[1]+0 : $len;
# my $step = $s[2]+0 ? $s[2]+0 : 1;
#
# $start = ($start < 0) ? max(0,$start+$len) : min($len,$start);
# $end = ($end < 0) ? max(0,$end+$len) : min($len,$end);
#
# for (my $i=$start; $i<$end; $i+=$step)
# {
# $self->trace($i.";".$expr, $v, $path);
# }
#}
#
#sub max { return $_[0] > $_[1] ? $_[0] : $_[1] }
#sub min { return $_[0] < $_[1] ? $_[0] : $_[1] }
#
#sub evalx
#{
# my ($self, $x, $v, $vname) = @_;
#
# croak('non-safe evaluation, died') if $JSON::Path::Safe;
#
# my $expr = $x;
# $expr =~ s/\$root/\$self->{'obj'}/g;
# $expr =~ s/\$_/\$v/g;
#
# local $@ = undef;
# my $res = eval $expr;
#
# if ($@)
# {
# croak("eval failed: `$expr`, died");
# }
#
# return $res;
#}

1;

__END__
Expand Down

0 comments on commit 06804af

Please sign in to comment.