From 67e6f26f8567d0bed061eabc72734cd10c0c5bf8 Mon Sep 17 00:00:00 2001
From: miker <miker@9efc2488-bf62-4759-914b-345cdb29e865>
Date: Mon, 7 Mar 2005 16:20:15 +0000
Subject: [PATCH] fix for JSON::object_unknown

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

diff --git a/src/perlmods/JSON.pm b/src/perlmods/JSON.pm
index 4d21429..97d0ca0 100644
--- a/src/perlmods/JSON.pm
+++ b/src/perlmods/JSON.pm
@@ -41,8 +41,11 @@ sub register_class_hint {
 	my $class = shift;
 	my %args = @_;
 
-	$_class_map{$args{hint}} = \%args;
-	$_class_map{$args{name}} = \%args;
+	$args{hint_re} = qr/(?:\b$args{hint})\b/;
+	$args{class_re} = qr/(?:\b$args{name})\b/;
+
+	$_class_map{hints}{$args{hint}} = \%args;
+	$_class_map{classes}{$args{name}} = \%args;
 }
 JSON->register_class_hint(
 	name => 'JSON::object_unknown',
@@ -72,7 +75,7 @@ sub _JSON_regex {
 
 sub _json_hint_to_class {
 	my $hint = shift;
-	return $_class_map{$hint}{name} if (exists $_class_map{$hint});
+	return $_class_map{hints}{$hint}{name} if (exists $_class_map{hints}{$hint});
 	return 'JSON::object_unknown';
 }
 
@@ -85,9 +88,24 @@ sub JSON2perl {
 	# 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*--\*\// => _json_hint_to_class("$1")) /sog;
+	if (1) {
+		# 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;
+	} else {
+		warn $_."\n\n";
+		my $string = $_;
+		for my $hint (values %{$_class_map{hints}}) {
+			$string =~ s/\/\*--\s*S\w*?\s+$$hint{hint_re}\s*--\*\// bless(/sog;
+			$string =~ s/\/\*--\s*E\w*?\s+$$hint{hint_re}\s*--\*\// => "$$hint{name}") /sog;
+			warn $$hint{name}."\n\n";
+			warn '   '.$string."\n\n";
+		}
+		$_ = $string;
+		s/\/\*--\s*\w+\s+\S+\s*--\*\///sog;
+		warn $_."\n\n";
+	}
+
 	s/\b(-?\d+\.?\d*)/ do { JSON::number::new($1) } /sog;
 
 	# Change javascript stuff to perl...
@@ -125,7 +143,7 @@ sub old_JSON2perl {
 			next;
 		} elsif ($element =~ /^\/\*--\s*S\w*?\s+(\w+)\s*--\*\/$/) {
 			my $hint = $1;
-			if (exists $_class_map{$hint}) {
+			if (exists $_class_map{hints}{$hint}) {
 				$casts[$casting_depth] = $hint;
 				$output .= ' bless(';
 			}
@@ -141,8 +159,8 @@ sub old_JSON2perl {
 			$casting_depth--;
 			my $hint = $casts[$casting_depth];
 			$casts[$casting_depth] = undef;
-			if (defined $hint and exists $_class_map{$hint}) {
-				$output .= $element . ',"'. $_class_map{$hint}{name} . '")';
+			if (defined $hint and exists $_class_map{hints}{$hint}) {
+				$output .= $element . ',"'. $_class_map{hints}{$hint}{name} . '")';
 				next;
 			}
 		} elsif ($element eq ':') {
@@ -170,16 +188,16 @@ sub perl2JSON {
 		$output = 'null';
 	} elsif (ref($perl) and ref($perl) =~ /^JSON/) {
 		$output .= $perl;
-	} elsif ( ref($perl) && exists($_class_map{ref($perl)}) ) {
-		$output .= '/*--S '.$_class_map{ref($perl)}{hint}.'--*/';
-		if (lc($_class_map{ref($perl)}{type}) eq 'hash') {
+	} elsif ( ref($perl) && exists($_class_map{classes}{ref($perl)}) ) {
+		$output .= '/*--S '.$_class_map{classes}{ref($perl)}{hint}.'--*/';
+		if (lc($_class_map{classes}{ref($perl)}{type}) eq 'hash') {
 			my %hash =  %$perl;
 			$output .= perl2JSON(undef,\%hash);
-		} elsif (lc($_class_map{ref($perl)}{type}) eq 'array') {
+		} elsif (lc($_class_map{classes}{ref($perl)}{type}) eq 'array') {
 			my @array =  @$perl;
 			$output .= perl2JSON(undef,\@array);
 		}
-		$output .= '/*--E '.$_class_map{ref($perl)}{hint}.'--*/';
+		$output .= '/*--E '.$_class_map{classes}{ref($perl)}{hint}.'--*/';
 	} elsif (ref($perl) and ref($perl) =~ /HASH/) {
 		$output .= '{';
 		my $c = 0;
@@ -223,20 +241,20 @@ sub perl2prettyJSON {
 		$output = 'null';
 	} elsif (ref($perl) and ref($perl) =~ /^JSON/) {
 		$output .= $perl;
-	} elsif ( ref($perl) && exists($_class_map{ref($perl)}) ) {
+	} elsif ( ref($perl) && exists($_class_map{classes}{ref($perl)}) ) {
 		$depth++;
 		$output .= "\n";
 		$output .= "   "x$depth;
-		$output .= '/*--S '.$_class_map{ref($perl)}{hint}."--*/ ";
-		if (lc($_class_map{ref($perl)}{type}) eq 'hash') {
+		$output .= '/*--S '.$_class_map{classes}{ref($perl)}{hint}."--*/ ";
+		if (lc($_class_map{classes}{ref($perl)}{type}) eq 'hash') {
 			my %hash =  %$perl;
 			$output .= perl2prettyJSON(\%hash,undef,1);
-		} elsif (lc($_class_map{ref($perl)}{type}) eq 'array') {
+		} elsif (lc($_class_map{classes}{ref($perl)}{type}) eq 'array') {
 			my @array =  @$perl;
 			$output .= perl2prettyJSON(\@array,undef,1);
 		}
 		#$output .= "   "x$depth;
-		$output .= ' /*--E '.$_class_map{ref($perl)}{hint}.'--*/';
+		$output .= ' /*--E '.$_class_map{classes}{ref($perl)}{hint}.'--*/';
 		$depth--;
 	} elsif (ref($perl) and ref($perl) =~ /HASH/) {
 		#$depth++;
-- 
2.43.2