From 1f9820e5e758bf7c9bf0d9890e4842234a2d65a5 Mon Sep 17 00:00:00 2001 From: miker Date: Mon, 7 Mar 2005 06:29:49 +0000 Subject: [PATCH] fixed minor bug in the class casting regex; added class finder sub to support said bugfix; added a default class (type hash) for unknown hints git-svn-id: svn://svn.open-ils.org/ILS/trunk@243 dcc99617-32d9-48b4-a31d-7c20da2025e4 --- OpenSRF/src/perlmods/JSON.pm | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/OpenSRF/src/perlmods/JSON.pm b/OpenSRF/src/perlmods/JSON.pm index a403fa3836..d927a78d65 100644 --- a/OpenSRF/src/perlmods/JSON.pm +++ b/OpenSRF/src/perlmods/JSON.pm @@ -1,3 +1,5 @@ +package JSON::object_unknown; + package JSON::number; sub new { my $class = shift; @@ -42,6 +44,10 @@ sub register_class_hint { $_class_map{$args{hint}} = \%args; $_class_map{$args{name}} = \%args; } +JSON->register_class_hint( + name => 'JSON::object_unknown', + type => 'hash', +); sub _JSON_regex { my $string = shift; @@ -64,25 +70,32 @@ sub _JSON_regex { return ($string,$1); } +sub _json_hint_to_class { + my $hint = shift; + return $_class_map{$hint}{name} if (exists $_class_map{$hint}); + return 'JSON::object_unknown'; +} + sub JSON2perl { my $class = shift; local $_ = shift; # Grab strings... - my @strings = /(?:"((?:(?:\\[\"])|[^\"])*)")/sog; + my @strings = /"((?:(?:\\[\"])|[^\"])*)"/sog; # Replace with code... - s/(?:"(?:(?:\\[\"])|[^\"])*")/ shift(\@strings) /sog; + 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; + s/\/\*--\s*E\w*?\s+(\w+)\s*--\*\// => _json_hint_to_class("$1")) /sog; + s/\b(-?\d+\.?\d*)/ do { JSON::number::new($1) } /sog; # Change javascript stuff to perl... s/null/ undef /sog; - #s/(true|false)/ bless( {}, "JSON::bool::$1") /sog; + s/:/ => /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 $_; } -- 2.43.2