From a0e62386c7707099c064b1ec310f21cb5e238186 Mon Sep 17 00:00:00 2001
From: miker <miker@9efc2488-bf62-4759-914b-345cdb29e865>
Date: Thu, 10 Mar 2005 04:52:46 +0000
Subject: [PATCH] magically handle any class in JSON.  no need to register
 class hints anymore!

git-svn-id: svn://svn.open-ils.org/OpenSRF/trunk@208 9efc2488-bf62-4759-914b-345cdb29e865
---
 src/perlmods/JSON.pm | 37 ++++++++++++++++++++++++-------------
 1 file changed, 24 insertions(+), 13 deletions(-)

diff --git a/src/perlmods/JSON.pm b/src/perlmods/JSON.pm
index 178f487..2fd01f4 100644
--- a/src/perlmods/JSON.pm
+++ b/src/perlmods/JSON.pm
@@ -1,5 +1,3 @@
-package JSON::object_unknown;
-
 package JSON::number;
 sub new {
 	my $class = shift;
@@ -44,11 +42,6 @@ sub register_class_hint {
 	$_class_map{hints}{$args{hint}} = \%args;
 	$_class_map{classes}{$args{name}} = \%args;
 }
-JSON->register_class_hint(
-	name => 'JSON::object_unknown',
-	hint => 'DUNNO',
-	type => 'hash',
-);
 
 sub _JSON_regex {
 	my $string = shift;
@@ -72,9 +65,17 @@ sub _JSON_regex {
 }
 
 sub _json_hint_to_class {
+	my $type = shift;
 	my $hint = shift;
+
 	return $_class_map{hints}{$hint}{name} if (exists $_class_map{hints}{$hint});
-	return 'JSON::object_unknown';
+	
+	$type = 'hash' if ($type eq '}');
+	$type = 'array' if ($type eq ']');
+
+	JSON->register_class_hint(name => $hint, hint => $hint, type => $type);
+
+	return $hint;
 }
 
 sub JSON2perl {
@@ -84,6 +85,10 @@ sub JSON2perl {
 	# Convert JSON Unicode...
 	s/\\u(\d{4})/chr(hex($1))/esog;
 
+	# handle class blessings
+	s/\/\*--\s*S\w*?\s+\S+\s*--\*\// bless(/sog;
+	s/(\]|\}|")\s*\/\*--\s*E\w*?\s+(\S+)\s*--\*\//$1 => _json_hint_to_class("$1", "$2")) /sog;
+
 	# Grab strings...
 	my @strings = /"((?:(?:\\[\"])|[^\"])*)"/sog;
 
@@ -93,13 +98,9 @@ sub JSON2perl {
 	# Perlify hash notation
 	s/:/ => /sog;
 
-	# handle class blessings
-	s/\/\*--\s*S\w*?\s+\S+\s*--\*\// bless(/sog;
-	s/\/\*--\s*E\w*?\s+(\S+)\s*--\*\// => _json_hint_to_class("$1")) /sog;
-
+	# Do numbers...
 	s/\b(-?\d+\.?\d*)\b/ JSON::number::new($1) /sog;
 
-
 	# Change javascript stuff to perl...
 	s/null/ undef /sog;
 	s/true/ bless( {}, "JSON::bool::true") /sog;
@@ -209,6 +210,11 @@ sub perl2JSON {
 			$c++;
 		}
 		$output .= ']';
+	} elsif (ref($perl) and ("$perl" =~ /^([^=]+)=(\w+)/o)) {
+		my $type = $2;
+		my $name = $1;
+		JSON->register_class_hint(name => $name, hint => $name, type => lc($type));
+		$output .= perl2JSON(undef,$perl);
 	} else {
 		$perl =~ s/\\/\\\\/sgo;
 		$perl =~ s/"/\\"/sgo;
@@ -279,6 +285,11 @@ sub perl2prettyJSON {
 		$output .= "\n";
 		$output .= "   "x$depth;
 		$output .= "]";
+	} elsif (ref($perl) and "$perl" =~ /^([^=]+)=(\w{4,5})\(0x/) {
+		my $type = $2;
+		my $name = $1;
+		register_class_hint(undef, name => $name, hint => $name, type => lc($type));
+		$output .= perl2prettyJSON(undef,$perl);
 	} else {
 		$perl =~ s/\\/\\\\/sgo;
 		$perl =~ s/"/\\"/sgo;
-- 
2.43.2