From 2d14e4dc4f6d09ceca34cf8c217683e5bcfd8c53 Mon Sep 17 00:00:00 2001
From: miker <miker@dcc99617-32d9-48b4-a31d-7c20da2025e4>
Date: Tue, 5 Jul 2005 16:03:38 +0000
Subject: [PATCH] some debugging

git-svn-id: svn://svn.open-ils.org/ILS/trunk@1041 dcc99617-32d9-48b4-a31d-7c20da2025e4
---
 Open-ILS/src/extras/Perl2REST.pl | 41 ++++++++++++++++++++++++--------
 1 file changed, 31 insertions(+), 10 deletions(-)

diff --git a/Open-ILS/src/extras/Perl2REST.pl b/Open-ILS/src/extras/Perl2REST.pl
index 3fa48307b4..e205994387 100755
--- a/Open-ILS/src/extras/Perl2REST.pl
+++ b/Open-ILS/src/extras/Perl2REST.pl
@@ -1,5 +1,7 @@
 #!/usr/bin/perl -w
 use strict;use warnings;
+use OpenSRF::EX qw/:try/;
+use JSON;
 use OpenSRF::System;
 use OpenSRF::Application;
 use OpenILS::Utils::Fieldmapper;
@@ -11,6 +13,7 @@ my $cgi = new CGI;
 my $url = $cgi->url;
 
 my $method = $cgi->param('method');
+my $service = $cgi->param('service');
 my @params = $cgi->param('param');
 
 unless( $method ) {
@@ -19,24 +22,37 @@ unless( $method ) {
 	exit;
 }
 
-print "Content-Type: text/xml\n\n";
-
 OpenSRF::System->bootstrap_client( config_file => '/pines/conf/bootstrap.conf' );
-$method = OpenSRF::Application->method_lookup( $method );
-
-my @resp = $method->run(@params);
+print "Content-Type: text/xml\n\n";
 
 my $val = '';
+try {
+	my @resp;
+	if ($service) {
+		my $session = OpenSRF::AppSession->create($service);
+		my $req = $session->request($method, @params);
+		while (my $res = $req->recv) {
+			push @resp, $res->content;
+		}
+	} else {
+		$method = OpenSRF::Application->method_lookup( $method );
+		@resp = $method->run(@params);
+	}
 
-Perl2REST(\$val, $_) for (@resp);
+	Perl2REST(\$val, $_, 1) for (@resp);
+} catch Error with {
+	print "<response/>";
+	exit;
+};
 
-print $val;
+print "<response>\n" . $val . "</response>";
 
 
 sub Perl2REST {
 	my $val = shift;
 	my $obj = shift;
 	my $level = shift || 0;
+	return unless defined($obj);
 	if (!ref($obj)) {
 		$$val .= '  'x$level . "<datum>$obj</datum>\n";
 	} elsif (ref($obj) eq 'ARRAY') {
@@ -56,13 +72,18 @@ sub Perl2REST {
 		$$val .= '  'x$level . "</hash>\n";
 	} elsif (UNIVERSAL::isa($obj, 'Fieldmapper')) {
 		my $class = ref($obj);
-		$class =~ s/::/_/go;
+		(my $class_name = $class) =~ s/::/_/go;
+		my $hint = $class->json_hint || $class_name;
+		my $json = JSON->perl2JSON($obj);
+		$json =~ s/&/&amp;/go;
+		$json =~ s/</&lt;/go;
+		$json =~ s/>/&gt;/go;
 		my %hash;
 		for ($obj->properties) {
 			$hash{$_} = $obj->$_;
 		}
 		my $next = $level + 2;
-		$$val .= '  'x$level . "<$class>\n";
+		$$val .= '  'x$level . "<Fieldmapper hint='$hint' json='$json'>\n";
 		for (sort keys %hash) {
 			if ($hash{$_}) {
 				$$val .= '  'x$level . "  <$_>\n";
@@ -72,7 +93,7 @@ sub Perl2REST {
 				$$val .= '  'x$level . "  <$_/>\n";
 			}
 		}
-		$$val .= '  'x$level . "</$class>\n";
+		$$val .= '  'x$level . "</Fieldmapper>\n";
 
 	} elsif ($obj =~ /HASH/o) {
 		my $class = ref($obj);
-- 
2.43.2