2 use strict;use warnings;
3 use OpenSRF::EX qw/:try/;
6 use OpenSRF::Application;
7 use OpenILS::Utils::Fieldmapper;
15 my $method = $cgi->param('method');
16 my $service = $cgi->param('service');
17 my @params = $cgi->param('param');
20 print "Content-Type: text/plain\n\n";
21 print "usage: $url?method={method}¶m={param1}¶m={param2}...\n";
25 OpenSRF::System->bootstrap_client( config_file => '/pines/conf/bootstrap.conf' );
26 print "Content-Type: text/xml\n\n";
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;
38 $method = OpenSRF::Application->method_lookup( $method );
39 @resp = $method->run(@params);
42 Perl2REST(\$val, $_, 1) for (@resp);
48 print "<response>\n" . $val . "</response>";
54 my $level = shift || 0;
55 return unless defined($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) {
68 $$val .= ' 'x$level . " <key>$_</key>\n";
69 Perl2REST($val, $$obj{$_}, $next);
70 $$val .= ' 'x$level . " </pair>\n";
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/&/&/go;
82 for ($obj->properties) {
85 my $next = $level + 2;
86 $$val .= ' 'x$level . "<Fieldmapper hint='$hint' json='$json'>\n";
87 for (sort keys %hash) {
89 $$val .= ' 'x$level . " <$_>\n";
90 Perl2REST($val, $hash{$_}, $next);
91 $$val .= ' 'x$level . " </$_>\n";
93 $$val .= ' 'x$level . " <$_/>\n";
96 $$val .= ' 'x$level . "</Fieldmapper>\n";
98 } elsif ($obj =~ /HASH/o) {
99 my $class = ref($obj);
101 $$val .= ' 'x$level . "<$class>\n";
102 my $next = $level + 1;
103 for (sort keys %$obj) {
105 Perl2REST($val, $$obj{$_}, $next);
106 $$val .= ' 'x$level . " </$_>\n";
108 $$val .= ' 'x$level . "</$class>\n";
109 } elsif ($obj =~ /ARRAY/o) {
110 my $class = ref($obj);
112 my $next = $level + 1;
113 $$val .= ' 'x$level . "<$class>\n";
114 Perl2REST($val, $_, $next) for (@$obj);
115 $$val .= ' 'x$level . "</$class>\n";
117 my $class = ref($obj);
119 $$val .= ' 'x$level . "<$class>$obj</$class>\n";