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 }