libraries are now filtered on id (there are duplicate names, such as "Bookmobile")
[Evergreen.git] / Open-ILS / src / extras / Perl2REST.pl
index b7414b2..2f5fe3d 100755 (executable)
@@ -1,64 +1,62 @@
 #!/usr/bin/perl -w
 use strict;use warnings;
-use OpenSRF::System qw(/pines/conf/client.conf);
 use OpenSRF::EX qw/:try/;
+use JSON;
+use OpenSRF::System;
+use OpenSRF::Application;
 use OpenILS::Utils::Fieldmapper;
-use Time::HiRes (qw/time/);
+use CGI;
 
 $| = 1;
 
-# ----------------------------------------------------------------------------------------
-# This is a quick and dirty script to perform benchmarking against the math server.
-# Note: 1 request performs a batch of 4 queries, one for each supported method: add, sub,
-# mult, div.
-# Usage: $ perl math_bench.pl <num_requests>
-# ----------------------------------------------------------------------------------------
+my $cgi = new CGI;
+my $url = $cgi->url;
 
-
-my $method = shift;
+my $method = $cgi->param('method');
+my $service = $cgi->param('service');
+my @params = $cgi->param('param');
 
 unless( $method ) {
-       print "usage: $0 method\n";
+       print "Content-Type: text/plain\n\n";
+       print "usage:  $url?method={method}&param={param1}&param={param2}...\n";
        exit;
 }
 
-OpenSRF::System->bootstrap_client();
-$method = OpenSRF::Application->method_lookup( $method );
-my $resp = $method->run(@ARGV);
-
-#my $usr = new Fieldmapper::actor::user;
-#$usr->first_given_name('mike');
-#$usr->family_name('rylander');
-#
-#my $addr = new Fieldmapper::actor::user_address;
-#$addr->street1('123 main st');
-#$addr->post_code('30144');
-#
-#$usr->billing_address($addr);
-
-#my $resp =  {
-#      a => 'hash',
-#      b => 'value',
-#      c => { nested => 'hash' },
-#      d => [ qw/with an array inside/ ],
-#      e => $usr,
-#};
+OpenSRF::System->bootstrap_client( config_file => '/pines/conf/bootstrap.conf' );
+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);
+       }
 
-my $start = time;
-Perl2REST(\$val, $resp);
-my $end = time;
+       Perl2REST(\$val, $_, 1) for (@resp);
+} catch Error with {
+       print "<response/>";
+       exit;
+};
 
-print $val;
-print "\nTIME: ". ($end - $start) . "s\n";
+print "<response>\n" . $val . "</response>";
 
 
 sub Perl2REST {
        my $val = shift;
        my $obj = shift;
        my $level = shift || 0;
+       return unless defined($obj);
        if (!ref($obj)) {
+               $obj =~ s/&/&amp;/osg;
+               $obj =~ s/</&lt;/osg;
+               $obj =~ s/</&gt;/osg;
                $$val .= '  'x$level . "<datum>$obj</datum>\n";
        } elsif (ref($obj) eq 'ARRAY') {
                my $next = $level + 1;
@@ -77,13 +75,14 @@ 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 %hash;
                for ($obj->properties) {
                        $hash{$_} = $obj->$_;
                }
                my $next = $level + 2;
-               $$val .= '  'x$level . "<$class>\n";
+               $$val .= '  'x$level . "<Fieldmapper hint='$hint'>\n";
                for (sort keys %hash) {
                        if ($hash{$_}) {
                                $$val .= '  'x$level . "  <$_>\n";
@@ -93,9 +92,9 @@ sub Perl2REST {
                                $$val .= '  'x$level . "  <$_/>\n";
                        }
                }
-               $$val .= '  'x$level . "</$class>\n";
+               $$val .= '  'x$level . "</Fieldmapper>\n";
 
-       } elsif (ref($obj) =~ /HASH/o) {
+       } elsif ($obj =~ /HASH/o) {
                my $class = ref($obj);
                $class =~ s/::/_/go;
                $$val .= '  'x$level . "<$class>\n";
@@ -106,7 +105,7 @@ sub Perl2REST {
                        $$val .= '  'x$level . "  </$_>\n";
                }
                $$val .= '  'x$level . "</$class>\n";
-       } elsif (ref($obj) =~ /ARRAY/o) {
+       } elsif ($obj =~ /ARRAY/o) {
                my $class = ref($obj);
                $class =~ s/::/_/go;
                my $next = $level + 1;