the start of a REST-ful ws interface to OpenSRF
[Evergreen.git] / Open-ILS / src / extras / Perl2REST.pl
1 #!/usr/bin/perl -w
2 use strict;use warnings;
3 use OpenSRF::System qw(/pines/conf/client.conf);
4 use OpenSRF::EX qw/:try/;
5 use OpenILS::Utils::Fieldmapper;
6 use Time::HiRes (qw/time/);
7
8 $| = 1;
9
10 # ----------------------------------------------------------------------------------------
11 # This is a quick and dirty script to perform benchmarking against the math server.
12 # Note: 1 request performs a batch of 4 queries, one for each supported method: add, sub,
13 # mult, div.
14 # Usage: $ perl math_bench.pl <num_requests>
15 # ----------------------------------------------------------------------------------------
16
17
18 my $method = shift;
19
20 unless( $method ) {
21         print "usage: $0 method\n";
22         exit;
23 }
24
25 OpenSRF::System->bootstrap_client();
26 $method = OpenSRF::Application->method_lookup( $method );
27 my $resp = $method->run(@ARGV);
28
29 #my $usr = new Fieldmapper::actor::user;
30 #$usr->first_given_name('mike');
31 #$usr->family_name('rylander');
32 #
33 #my $addr = new Fieldmapper::actor::user_address;
34 #$addr->street1('123 main st');
35 #$addr->post_code('30144');
36 #
37 #$usr->billing_address($addr);
38
39 #my $resp =  {
40 #       a => 'hash',
41 #       b => 'value',
42 #       c => { nested => 'hash' },
43 #       d => [ qw/with an array inside/ ],
44 #       e => $usr,
45 #};
46
47 my $val = '';
48
49 my $start = time;
50 Perl2REST(\$val, $resp);
51 my $end = time;
52
53 print $val;
54 print "\nTIME: ". ($end - $start) . "s\n";
55
56
57 sub Perl2REST {
58         my $val = shift;
59         my $obj = shift;
60         my $level = shift || 0;
61         if (!ref($obj)) {
62                 $$val .= '  'x$level . "<datum>$obj</datum>\n";
63         } elsif (ref($obj) eq 'ARRAY') {
64                 my $next = $level + 1;
65                 $$val .= '  'x$level . "<array>\n";
66                 Perl2REST($val, $_, $next) for (@$obj);
67                 $$val .= '  'x$level . "</array>\n";
68         } elsif (ref($obj) eq 'HASH') {
69                 my $next = $level + 2;
70                 $$val .= '  'x$level . "<hash>\n";
71                 for (sort keys %$obj) {
72                         $$val .= "  <pair>\n";
73                         $$val .= '  'x$level . "    <key>$_</key>\n";
74                         Perl2REST($val, $$obj{$_}, $next);
75                         $$val .= '  'x$level . "  </pair>\n";
76                 }
77                 $$val .= '  'x$level . "</hash>\n";
78         } elsif (UNIVERSAL::isa($obj, 'Fieldmapper')) {
79                 my $class = ref($obj);
80                 $class =~ s/::/_/go;
81                 my %hash;
82                 for ($obj->properties) {
83                         $hash{$_} = $obj->$_;
84                 }
85                 my $next = $level + 2;
86                 $$val .= '  'x$level . "<$class>\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 . "</$class>\n";
97
98         } elsif (ref($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 (ref($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 }