From: miker <miker@9efc2488-bf62-4759-914b-345cdb29e865>
Date: Mon, 7 Mar 2005 01:37:02 +0000 (+0000)
Subject: using an O(log n) [n=JSON elements] algo instead of the (worst case) O(2n**2) algo...
X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=f3e159a993853fad0b133a8068a099eb7ff09b04;p=opensrf%2Fbjwebb.git

using an O(log n) [n=JSON elements] algo instead of the (worst case) O(2n**2) algo...


git-svn-id: svn://svn.open-ils.org/OpenSRF/trunk@182 9efc2488-bf62-4759-914b-345cdb29e865
---

diff --git a/src/perlmods/JSON.pm b/src/perlmods/JSON.pm
index 1b86899..a403fa3 100644
--- a/src/perlmods/JSON.pm
+++ b/src/perlmods/JSON.pm
@@ -43,7 +43,51 @@ sub register_class_hint {
 	$_class_map{$args{name}} = \%args;
 }
 
+sub _JSON_regex {
+	my $string = shift;
+
+	$string =~ s/^\s* ( 
+			   {				| # start object
+			   \[				| # start array
+			   -?\d+\.?\d*			| # number literal
+			   "(?:(?:\\[\"])|[^\"])*"	| # string literal
+			   (?:\/\*.+?\*\/)		| # C comment
+			   true				| # bool true
+			   false			| # bool false
+			   null				| # undef()
+			   :				| # object key-value sep
+			   ,				| # list sep
+			   \]				| # array end
+			   }				  # object end
+			)
+		 \s*//sox;
+	return ($string,$1);
+}
+
 sub JSON2perl {
+	my $class = shift;
+	local $_ = shift;
+
+	# Grab strings...
+	my @strings = /(?:"((?:(?:\\[\"])|[^\"])*)")/sog;
+	# Replace with code...
+	s/(?:"(?:(?:\\[\"])|[^\"])*")/ shift(\@strings) /sog;
+
+	# handle class blessings
+	s/\/\*--\s*S\w*?\s+\w+\s*--\*\// bless(/sog;
+	s/\/\*--\s*E\w*?\s+(\w+)\s*--\*\// , "$_class_map{$1}{name}") /sog;
+
+	# Change javascript stuff to perl...
+	s/null/ undef /sog;
+	#s/(true|false)/ bless( {}, "JSON::bool::$1") /sog;
+	s/true/ bless( {}, "JSON::bool::true") /sog;
+	s/false/ bless( {}, "JSON::bool::false") /sog;
+	s/\b(-?\d+\.?\d*)/ do { JSON::number::new($1) } /sog;
+	
+	return eval $_;
+}
+
+sub old_JSON2perl {
 	my ($class, $json) = @_;
 
 	if (!defined($json)) {
@@ -57,23 +101,11 @@ sub JSON2perl {
 	my @casts;
 	my $casting_depth = 0;
 	my $current_cast;
+	my $element;
 	my $output = '';
-	while ($json =~ s/^\s* ( 
-				   {				| # start object
-				   \[				| # start array
-				   -?\d+\.?\d*			| # number literal
-				   "(?:(?:\\[\"])|[^\"])*"	| # string literal
-				   (?:\/\*.+?\*\/)		| # C comment
-				   true				| # bool true
-				   false			| # bool false
-				   null				| # undef()
-				   :				| # object key-value sep
-				   ,				| # list sep
-				   \]				| # array end
-				   }				  # object end
-				)
-			 \s*//sox) {
-		my $element = $1;
+	while (($json,$element) = _JSON_regex($json)) {
+
+		last unless ($element);
 
 		if ($element eq 'null') {
 			$output .= ' undef() ';