Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: c5a7de30c2
Fetching contributors…

Cannot retrieve contributors at this time

450 lines (401 sloc) 12.91 kb
#!/usr/bin/perl
# JSONPath 0.8.1 - XPath for JSON
#
# A port of the JavaScript and PHP versions
# of JSONPath which is
# Copyright (c) 2007 Stefan Goessner (goessner.net)
# Licensed under the MIT licence:
#
# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation
# files (the "Software"), to deal in the Software without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following
# conditions:
#
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
package JSONPath;
use strict;
use lib '../../lib';
use JSON;
use Scalar::Util qw(looks_like_number);
sub new(){
my $class = shift;
my $self = bless {
obj => undef,
result_type => 'VALUE',
result => [],
subx => [],
reserved_locs => {
'*' => undef,
'..' => undef,
}
}, $class;
return $self;
}
sub run(){
my $self = shift;
$self->{'result'} = (); #reset it
$self->{'obj'} = undef;
my ($obj, $expr, $arg) = @_;
#my $self->{'obj'} = $obj;
#$self->logit( "arg: $arg");
if ($arg && $arg->{'result_type'}){
my $result_type = $arg->{'result_type'};
if ($result_type eq 'PATH' | $result_type eq 'VALUE'){
$self->{'result_type'} = $arg->{'result_type'};
}
}
if ($expr and $obj and ($self->{'result_type'} eq 'VALUE' || $self->{'result_type'} eq 'PATH')){
my $cleaned_expr = $self->normalize($expr);
$cleaned_expr =~ s/^\$;//;
$self->trace($cleaned_expr, $obj, '$');
my @result = @{$self->{'result'}};
#print STDERR " ending. result = @result\n";
if ($#result > -1){
#print STDERR " will return result\n";
return \@result;
}
#print STDERR "will return zero\n";
return 0;
}
}
=nd
normalize the path expression;
=cut
sub normalize (){
my $self = shift;
my $x = shift;
$x =~ s/"\/[\['](\??\(.*?\))[\]']\/"/&_callback_01($1)/eg;
$x =~ s/'?(?<!@|\d)\.'?|\['?/;/g; #added the negative lookbehind -krhodes
# added \d in it to compensate when
# comparinig against decimal numbers
$x =~ s/;;;|;;/;..;/g;
$x =~ s/;$|'?\]|'$//g;
$x =~ s/#([0-9]+)/&_callback_02($1)/eg;
$self->{'result'} = [];
return $x;
}
sub as_path(){
my $self = shift;
my $path = shift;
my @x = split(/;/, $path);
my $p = '';
#the JS and PHP versions of this are totally whack
#foreach my $piece (@x){
for(my $i =1; $i <= $#x; $i++){
my $piece = $x[$i];
if ($piece =~ m/^\d+$/){
$p .= "[$piece]";
} else {
$p .= "[\"$piece\"]";
}
}
return $p;
}
sub store(){
my $self = shift;
my $path = shift;
my $object = shift;
if ($path){
if ($self->{'result_type'} eq 'PATH'){
push @{$self->{'result'}}, $self->as_path($path);
} else {
push @{$self->{'result'}}, $object;
}
}
#print STDERR "-Updated Result to: \n";
foreach my $res (@{$self->{'result'}}){
#print STDERR "-- $res\n";
}
return $path;
}
sub trace(){
#$self->logit( "raw trace args: @_");
my $self = shift;
my ($expr, $obj, $path) = @_;
#$self->logit( "in trace. $expr /// $obj /// $path");
if ($expr){
my @x = split(/;/, $expr);
my $loc = shift(@x);
my $x_string = join(';', @x);
#$self->logit("trace... expr: $expr x_string: $x_string");
my $ref_type = ref $obj;
my $reserved_loc = 0;
if (exists $self->{'reserved_locs'}->{$loc}){
$reserved_loc = 1;
}
#$self->logit("loc: $loc // $reserved_loc // $ref_type");
if (! $reserved_loc and $ref_type eq 'HASH' and ($obj and exists $obj->{$loc}) ){
#$self->logit( "tracing loc($loc) obj (hash)?");
$self->trace($x_string, $obj->{$loc}, $path . ';' . $loc);
} elsif (! $reserved_loc and $ref_type eq 'ARRAY' and ($loc =~ m/^\d+$/ and $#{$obj} >= $loc and $obj->[$loc] != undef) ) {
$self->trace($x_string, $obj->[$loc], $path . ';' . $loc);
} elsif ($loc eq '*'){
#$self->logit( "tracing *");
$self->walk($loc, $x_string, $obj, $path, \&_callback_03);
} elsif ($loc eq '!'){
#$self->logit( "tracing !");
$self->walk($loc, $x_string, $obj, $path, \&_callback_06);
} elsif ($loc eq '..'){
#$self->logit( "tracing ..");
$self->trace($x_string, $obj, $path);
$self->walk($loc, $x_string, $obj, $path, \&_callback_04);
} elsif ($loc =~ /,/){
#$self->logit( "tracing loc w comma");
foreach my $piece ( split(/'?,'?/, $loc)){
$self->trace($piece . ';' . $x_string, $obj, $path);
}
} elsif ($loc =~ /^\(.*?\)$/){
#$self->logit( "tracing loc /^\(.*?\)\$/");
my $path_end = $path;
$path_end =~ s/.*;(.).*?$/$1/;
#WTF is eobjuate?!
$self->trace($self->eobjuate($loc, $obj, $path_end . ';' . $x_string, $obj, $path));
} elsif ($loc =~ /^\?\(.*?\)$/){
#$self->logit( "tracing loc /^\?\(.*?\)\$/");
$self->walk($loc, $x_string, $obj, $path, \&_callback_05);
#$self->logit( "after walk w/ 05");
} elsif ($loc =~ /^(-?[0-9]*):(-?[0-9]*):?([0-9]*)$/){
#$self->logit( "tracing loc ($loc) for slice");
$self->slice($loc, $x_string, $obj, $path);
} elsif (! $loc and $ref_type eq 'ARRAY'){
$self->store($path, $obj);
}
} else {
#$self->logit( "trace no expr. will store $obj");
$self->store($path, $obj);
}
#$self->logit( "leaving trace");
}
sub walk (){
my $self = shift;
my ($loc, $expr, $obj, $path, $funct) = @_;
#$self->logit( "in walk. $loc /// $expr /// $obj /// $path ");
if (ref $obj eq 'ARRAY'){
for (my $i = 0; $i <= $#{$obj}; $i++){
#$self->logit( "before Array func call: w/ $i /// $loc /// $expr /// $obj /// $path");
$funct->($self, $i, $loc, $expr, $obj, $path);
#$self->logit( "after func call");
}
} elsif (ref $obj eq 'HASH') { # a Hash
my @keys = keys %{$obj};
#print STDERR "$#keys keys in hash to iterate over:\n";
foreach my $key (@keys){
#$self->logit( "before Hash func call: w/ $key /// $loc /// $expr /// $obj /// $path");
$funct->($self, $key, $loc, $expr, $obj, $path);
#$self->logit( "after func call");
}
}
#$self->logit( " leaving walk");
}
sub slice(){
my $self = shift;
my ($loc, $expr, $obj, $path) = @_;
$loc =~ s/^(-?[0-9]*):(-?[0-9]*):?(-?[0-9]*)$/$1:$2:$3/;
# $3 would be if you wanted to specify the steps between the start and end.
my @s = split (/:|,/, $loc);
my $len = 0;
if (ref $obj eq 'HASH'){
$len = $#{keys %{$obj}};
} else { #array
$len = $#{$obj};
}
my $start = $s[0] ? $s[0] : 0;
my $end = undef;
if ($loc !~ m/^:(\d+):?$/){
$end = $s[1] ? $s[1] : $len;
} else {
$end = int($s[1]) -1;
}
my $step = $s[2] ? $s[2] : 1;
#$start = $start < 0 ? ($start + $len > 0 ? $start + $len : 0) : ($len > $start ? $start : $len);
if ($start < 0){
$start = $len > 0 ? $start + $len +1: 0 ;
#the +1 is so that -1 gets us the last entry, -2 gets us the last two, etc...
}
$end = $end < 0 ? ($end + $len > 0 ? $end + $len : 0) : ($len > $end ? $end : $len);
#$self->logit("start: $start end: $end step: $step");
for (my $x = $start; $x <= $end; $x += $step){
$self->trace("$x;$expr", $obj, $path);
}
}
sub evalx(){
my $self = shift;
my ($loc, $obj) = @_;
#$self->logit( "in evalx: $loc /// $obj");
#x: @.price<10: [object Object] _vname: 0
#need to convert @.price<10 to
#$obj->{'price'} < 10
#and then evaluate
#
#x: @.isbn
#needs to convert to
#exists $obj->{'isbn'}
if ($loc =~ m/^@\.[a-zA-Z0-9_-]*$/){
#$self->logit( "existence test ");
$loc =~ s/@\.([a-zA-Z0-9_-]*)$/exists \$obj->{'$1'}/;
} else { # it's a comparis on some sort?
my $obj_type = ref($obj);
$loc =~ s/@\.([a-zA-Z0-9_-]*)(.*)/\$obj->{'$1'}$2/;
$loc =~ s/(?<!=)(=)(?!=)/==/; #convert single equals to double
if ($loc =~ m/\s*(!|=)=['"](.*?)['"]/){
$loc =~ s/\s*==['"](.*?)['"]/ eq "$1"/;
$loc =~ s/\s*!=['"](.*?)['"]/ ne "$1"/;
my $string_match = 0;
if ($loc =~ m/ (eq|ne) /){ #dunno if those replacements happened...
$string_match =1;
}
#$self->logit( "comparison test of $1 and $2 ::loc:: $loc");
if ($obj_type ne 'HASH' and $obj_type ne 'ARRAY' and $obj){
if (! $string_match){
$loc =~s/\$obj->{(.*?)}(.*)/$obj $2/;
} else {
$loc =~s/\$obj->{(.*?)}(.*)/"$obj" $2/;
}
return ($obj and $loc and eval($loc)) ? 1 : 0;
}
} elsif ($loc =~ m/></){
my $query_item = $loc;
$query_item =~ s/.*><\s*['"]?([\w\.]*)['"]?\s*/$1/;
#$self->logit("includes test: $query_item :: $loc ::");
if (($obj_type eq 'HASH' or $obj_type eq 'ARRAY')){
#$self->logit("hash or array");
if ($obj_type eq 'HASH'){
#something like "$..book[?(@.ratings><'good')]"
#obj is book
my $eval_string = $loc;
my $sub_obj = undef;
$eval_string =~ s/(.*?)><.*/$1/;
#$eval_string =~ s/(.*?)><.*/\$sub_obj_type = ref $1\->{'$query_item'}/;
#$self->logit("eval_string: $eval_string");
#set the sub_obj_type
eval('$sub_obj = ' . $eval_string);
my $sub_obj_type =ref $sub_obj;
#$self->logit("sub_obj_type: $sub_obj_type");
if ($sub_obj){
if ($sub_obj_type eq 'ARRAY'){
foreach my $item (@{$sub_obj}){
if (looks_like_number($item)){
return 1 if $item == $query_item;
}else {
return 1 if $item eq $query_item;
}
}
return 0;
} elsif ($sub_obj_type eq 'HASH'){
return exists ($sub_obj->{$query_item}) ? 1 : 0;
}
} else {
#$self->logit("no sub_obj");
}
}
} else {
#$self->logit(" in array item evalling");
my $returnable = 0;
if (! looks_like_number($obj)){
#Does the string include the string they've provided?
#return ($obj eq $query_item or $obj =~ m/.*?$query_item.*?/) ? 1 : 0;
$returnable = ($obj eq $query_item or $obj =~ m/.*?$query_item.*?/) ? 1 : 0;
} else {
#return $obj == $query_item;
$returnable = ($obj == $query_item) ? 1 : 0;
}
#not the best use of the >< operator. we've been drilled down to
#
#$self->logit("returning $returnable");
return $returnable;
}
} else {
#$self->logit("loc not equality or includes test: $loc");
}
}
#print STDERR "loc: $loc\n";
return ($obj and $loc and eval($loc)) ? 1 : 0;
}
sub _callback_01(){
my $self = shift;
#$self->logit( "in 01");
my $arg = shift;
push @{$self->{'result'}}, $arg;
return '[#' . $#{$self->{'result'}} . ']';
}
sub _callback_02 {
my $self = shift;
#$self->logit( "in 02");
my $arg = shift;
return @{$self->{'result'}}[$arg];
}
sub _callback_03(){
my $self = shift;
#$self->logit( " in 03 ");
my ($key, $loc, $expr, $obj, $path) = @_;
$self ->trace($key . ';' . $expr , $obj, $path);
}
sub _callback_04(){
my $self = shift;
my ($key, $loc, $expr, $obj, $path) = @_;
#$self->logit( " in 04. expr = $expr");
if (ref $obj eq 'HASH'){
if (ref($obj->{$key}) eq 'HASH' ){
#$self->logit( "Passing this to trace: ..;$expr, " . $obj->{$key} . ", $path;$key\n";
$self->trace('..;'.$expr, $obj->{$key}, $path . ';' . $key);
} elsif (ref($obj->{$key})) { #array
#print STDERR "--- \$obj->{$key} wasn't a hash. it was a " . (ref $obj->{$key}) . "\n";
$self->trace('..;'.$expr, $obj->{$key}, $path . ';' . $key);
}
} else {
#print STDERR "-- obj wasn't a hash. it was a " . (ref $obj) . "\n";
if (ref($obj->[$key]) eq 'HASH' ){
$self->trace('..;'.$expr, $obj->[$key], $path . ';' . $key);
}
}
}
sub _callback_05(){
my $self = shift;
#$self->logit( "05");
my ($key, $loc, $expr, $obj, $path) = @_;
$loc =~ s/^\?\((.*?)\)$/$1/;
my $eval_result = 0;
if (ref $obj eq 'HASH'){
#$self->logit( " in 05 obj: $obj obj->{$key}: ". $obj->{$key});
$eval_result = $self->evalx($loc, $obj->{$key});
} else {
#$self->logit( " in 05 obj: $obj obj->[$key]: ". $obj->[$key] );
$eval_result = $self->evalx($loc, $obj->[$key]);
}
#$self->logit( "eval_result: $eval_result");
if ($eval_result){
#$self->logit("IT EVALLED! tracing..");
$self->trace("$key;$expr", $obj, $path);
}
#$self->logit( "leaving 05");
}
sub _callback_06(){
my $self = shift;
my ($key, $loc, $expr, $obj, $path) = @_;
#$self->logit("in 06 $key /// $loc /// $expr /// $obj /// $path" );
if (ref $obj eq 'HASH'){
$self->trace($expr, $key, $path);
}
}
my $log_count = 1;
sub logit(){
my $self = shift;
my $message = shift;
print STDERR "$log_count) $message\n";
$log_count++;
}
return 1;
Jump to Line
Something went wrong with that request. Please try again.