Open-ILS/src/extras/Perl2REST.pl

   1 #!/usr/bin/perl -w
   2 use strict;use warnings;
   3 use OpenSRF::System;
   4 use OpenSRF::Application;
   5 use OpenILS::Utils::Fieldmapper;
   6 use CGI;
   7
   8 $| = 1;
   9
  10 my $cgi = new CGI;
  11 my $url = $cgi->url;
  12
  13 my $method = $cgi->param('method');
  14 my @params = $cgi->param('param');
  15
  16 unless( $method ) {
  17         print "Content-Type: text/plain\n\n";
  18         print "usage:  $url?method={method}&param={param1}&param={param2}...\n";
  19         exit;
  20 }
  21
  22 print "Content-Type: text/xml\n\n";
  23
  24 OpenSRF::System->bootstrap_client( config_file => '/pines/conf/bootstrap.conf' );
  25 $method = OpenSRF::Application->method_lookup( $method );
  26
  27 my @resp = $method->run(@params);
  28
  29 my $val = '';
  30
  31 Perl2REST(\$val, $_) for (@resp);
  32
  33 print $val;
  34
  35
  36 sub Perl2REST {
  37         my $val = shift;
  38         my $obj = shift;
  39         my $level = shift || 0;
  40         if (!ref($obj)) {
  41                 $$val .= '  'x$level . "<datum>$obj</datum>\n";
  42         } elsif (ref($obj) eq 'ARRAY') {
  43                 my $next = $level + 1;
  44                 $$val .= '  'x$level . "<array>\n";
  45                 Perl2REST($val, $_, $next) for (@$obj);
  46                 $$val .= '  'x$level . "</array>\n";
  47         } elsif (ref($obj) eq 'HASH') {
  48                 my $next = $level + 2;
  49                 $$val .= '  'x$level . "<hash>\n";
  50                 for (sort keys %$obj) {
  51                         $$val .= "  <pair>\n";
  52                         $$val .= '  'x$level . "    <key>$_</key>\n";
  53                         Perl2REST($val, $$obj{$_}, $next);
  54                         $$val .= '  'x$level . "  </pair>\n";
  55                 }
  56                 $$val .= '  'x$level . "</hash>\n";
  57         } elsif (UNIVERSAL::isa($obj, 'Fieldmapper')) {
  58                 my $class = ref($obj);
  59                 $class =~ s/::/_/go;
  60                 my %hash;
  61                 for ($obj->properties) {
  62                         $hash{$_} = $obj->$_;
  63                 }
  64                 my $next = $level + 2;
  65                 $$val .= '  'x$level . "<$class>\n";
  66                 for (sort keys %hash) {
  67                         if ($hash{$_}) {
  68                                 $$val .= '  'x$level . "  <$_>\n";
  69                                 Perl2REST($val, $hash{$_}, $next);
  70                                 $$val .= '  'x$level . "  </$_>\n";
  71                         } else {
  72                                 $$val .= '  'x$level . "  <$_/>\n";
  73                         }
  74                 }
  75                 $$val .= '  'x$level . "</$class>\n";
  76
  77         } elsif ($obj =~ /HASH/o) {
  78                 my $class = ref($obj);
  79                 $class =~ s/::/_/go;
  80                 $$val .= '  'x$level . "<$class>\n";
  81                 my $next = $level + 1;
  82                 for (sort keys %$obj) {
  83                         $$val .= "  <$_>\n";
  84                         Perl2REST($val, $$obj{$_}, $next);
  85                         $$val .= '  'x$level . "  </$_>\n";
  86                 }
  87                 $$val .= '  'x$level . "</$class>\n";
  88         } elsif ($obj =~ /ARRAY/o) {
  89                 my $class = ref($obj);
  90                 $class =~ s/::/_/go;
  91                 my $next = $level + 1;
  92                 $$val .= '  'x$level . "<$class>\n";
  93                 Perl2REST($val, $_, $next) for (@$obj);
  94                 $$val .= '  'x$level . "</$class>\n";
  95         } else {
  96                 my $class = ref($obj);
  97                 $class =~ s/::/_/go;
  98                 $$val .= '  'x$level . "<$class>$obj</$class>\n";
  99         }
 100 }