Open-ILS/src/extras/Perl2REST.pl

   1 #!/usr/bin/perl -w
   2 use strict;use warnings;
   3 use OpenSRF::EX qw/:try/;
   4 use OpenSRF::Utils::JSON;
   5 use OpenSRF::System;
   6 use OpenSRF::Application;
   7 use OpenILS::Utils::Fieldmapper;
   8 use CGI;
   9
  10 $| = 1;
  11
  12 my $cgi = new CGI;
  13 my $url = $cgi->url;
  14
  15 my $method = $cgi->param('method');
  16 my $service = $cgi->param('service');
  17 my @params = $cgi->param('param');
  18
  19 unless( $method ) {
  20         print "Content-Type: text/plain\n\n";
  21         print "usage:  $url?method={method}&param={param1}&param={param2}...\n";
  22         exit;
  23 }
  24
  25 OpenSRF::System->bootstrap_client( config_file => '/openils/conf/opensrf_core.xml' );
  26 print "Content-Type: text/xml\n\n";
  27
  28 my $val = '';
  29 try {
  30         my @resp;
  31         if ($service) {
  32                 my $session = OpenSRF::AppSession->create($service);
  33                 my $req = $session->request($method, @params);
  34                 while (my $res = $req->recv) {
  35                         push @resp, $res->content;
  36                 }
  37         } else {
  38                 $method = OpenSRF::Application->method_lookup( $method );
  39                 @resp = $method->run(@params);
  40         }
  41
  42         Perl2REST(\$val, $_, 1) for (@resp);
  43 } catch Error with {
  44         print "<response/>";
  45         exit;
  46 };
  47
  48 print "<response>\n" . $val . "</response>";
  49
  50
  51 sub Perl2REST {
  52         my $val = shift;
  53         my $obj = shift;
  54         my $level = shift || 0;
  55         return unless defined($obj);
  56         if (!ref($obj)) {
  57                 $obj =~ s/&/&amp;/osg;
  58                 $obj =~ s/</&lt;/osg;
  59                 $obj =~ s/</&gt;/osg;
  60                 $$val .= '  'x$level . "<datum>$obj</datum>\n";
  61         } elsif (ref($obj) eq 'ARRAY') {
  62                 my $next = $level + 1;
  63                 $$val .= '  'x$level . "<array>\n";
  64                 Perl2REST($val, $_, $next) for (@$obj);
  65                 $$val .= '  'x$level . "</array>\n";
  66         } elsif (ref($obj) eq 'HASH') {
  67                 my $next = $level + 2;
  68                 $$val .= '  'x$level . "<hash>\n";
  69                 for (sort keys %$obj) {
  70                         $$val .= "  <pair>\n";
  71                         $$val .= '  'x$level . "    <key>$_</key>\n";
  72                         Perl2REST($val, $$obj{$_}, $next);
  73                         $$val .= '  'x$level . "  </pair>\n";
  74                 }
  75                 $$val .= '  'x$level . "</hash>\n";
  76         } elsif (UNIVERSAL::isa($obj, 'Fieldmapper')) {
  77                 my $class = ref($obj);
  78                 (my $class_name = $class) =~ s/::/_/go;
  79                 my $hint = $class->json_hint || $class_name;
  80                 my %hash;
  81                 for ($obj->properties) {
  82                         $hash{$_} = $obj->$_;
  83                 }
  84                 my $next = $level + 2;
  85                 $$val .= '  'x$level . "<Fieldmapper hint='$hint'>\n";
  86                 for (sort keys %hash) {
  87                         if ($hash{$_}) {
  88                                 $$val .= '  'x$level . "  <$_>\n";
  89                                 Perl2REST($val, $hash{$_}, $next);
  90                                 $$val .= '  'x$level . "  </$_>\n";
  91                         } else {
  92                                 $$val .= '  'x$level . "  <$_/>\n";
  93                         }
  94                 }
  95                 $$val .= '  'x$level . "</Fieldmapper>\n";
  96
  97         } elsif ($obj =~ /HASH/o) {
  98                 my $class = ref($obj);
  99                 $class =~ s/::/_/go;
 100                 $$val .= '  'x$level . "<$class>\n";
 101                 my $next = $level + 1;
 102                 for (sort keys %$obj) {
 103                         $$val .= "  <$_>\n";
 104                         Perl2REST($val, $$obj{$_}, $next);
 105                         $$val .= '  'x$level . "  </$_>\n";
 106                 }
 107                 $$val .= '  'x$level . "</$class>\n";
 108         } elsif ($obj =~ /ARRAY/o) {
 109                 my $class = ref($obj);
 110                 $class =~ s/::/_/go;
 111                 my $next = $level + 1;
 112                 $$val .= '  'x$level . "<$class>\n";
 113                 Perl2REST($val, $_, $next) for (@$obj);
 114                 $$val .= '  'x$level . "</$class>\n";
 115         } else {
 116                 my $class = ref($obj);
 117                 $class =~ s/::/_/go;
 118                 $$val .= '  'x$level . "<$class>$obj</$class>\n";
 119         }
 120 }