Open-ILS/src/extras/Perl2REST.pl

   1 #!/usr/bin/perl -w
   2 use strict;use warnings;
   3 use OpenSRF::EX qw/:try/;
   4 use 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 => '/pines/conf/bootstrap.conf' );
  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                 $$val .= '  'x$level . "<datum>$obj</datum>\n";
  58         } elsif (ref($obj) eq 'ARRAY') {
  59                 my $next = $level + 1;
  60                 $$val .= '  'x$level . "<array>\n";
  61                 Perl2REST($val, $_, $next) for (@$obj);
  62                 $$val .= '  'x$level . "</array>\n";
  63         } elsif (ref($obj) eq 'HASH') {
  64                 my $next = $level + 2;
  65                 $$val .= '  'x$level . "<hash>\n";
  66                 for (sort keys %$obj) {
  67                         $$val .= "  <pair>\n";
  68                         $$val .= '  'x$level . "    <key>$_</key>\n";
  69                         Perl2REST($val, $$obj{$_}, $next);
  70                         $$val .= '  'x$level . "  </pair>\n";
  71                 }
  72                 $$val .= '  'x$level . "</hash>\n";
  73         } elsif (UNIVERSAL::isa($obj, 'Fieldmapper')) {
  74                 my $class = ref($obj);
  75                 (my $class_name = $class) =~ s/::/_/go;
  76                 my $hint = $class->json_hint || $class_name;
  77                 my $json = JSON->perl2JSON($obj);
  78                 $json =~ s/&/&amp;/go;
  79                 $json =~ s/</&lt;/go;
  80                 $json =~ s/>/&gt;/go;
  81                 my %hash;
  82                 for ($obj->properties) {
  83                         $hash{$_} = $obj->$_;
  84                 }
  85                 my $next = $level + 2;
  86                 $$val .= '  'x$level . "<Fieldmapper hint='$hint' json='$json'>\n";
  87                 for (sort keys %hash) {
  88                         if ($hash{$_}) {
  89                                 $$val .= '  'x$level . "  <$_>\n";
  90                                 Perl2REST($val, $hash{$_}, $next);
  91                                 $$val .= '  'x$level . "  </$_>\n";
  92                         } else {
  93                                 $$val .= '  'x$level . "  <$_/>\n";
  94                         }
  95                 }
  96                 $$val .= '  'x$level . "</Fieldmapper>\n";
  97
  98         } elsif ($obj =~ /HASH/o) {
  99                 my $class = ref($obj);
 100                 $class =~ s/::/_/go;
 101                 $$val .= '  'x$level . "<$class>\n";
 102                 my $next = $level + 1;
 103                 for (sort keys %$obj) {
 104                         $$val .= "  <$_>\n";
 105                         Perl2REST($val, $$obj{$_}, $next);
 106                         $$val .= '  'x$level . "  </$_>\n";
 107                 }
 108                 $$val .= '  'x$level . "</$class>\n";
 109         } elsif ($obj =~ /ARRAY/o) {
 110                 my $class = ref($obj);
 111                 $class =~ s/::/_/go;
 112                 my $next = $level + 1;
 113                 $$val .= '  'x$level . "<$class>\n";
 114                 Perl2REST($val, $_, $next) for (@$obj);
 115                 $$val .= '  'x$level . "</$class>\n";
 116         } else {
 117                 my $class = ref($obj);
 118                 $class =~ s/::/_/go;
 119                 $$val .= '  'x$level . "<$class>$obj</$class>\n";
 120         }
 121 }