3fa48307b45bd5a66ba2f132424967d6009312e6
[Evergreen.git] / 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 }