git.maemo.org Git - xmlrpc-c/blob - tools/xml-rpc-api2txt

   1 #!/usr/bin/perl -w
   2 #
   3 # A handy little program to get the documentation of the available
   4 # methods from an XML-RPC service (via XML-RPC Introspection) and
   5 # print it out nicely formatted.
   6 #
   7 # (I wrote this in Perl because of all the spiffy report-generation
   8 # features.)
   9 #
  10 # You'll need to get Ken MacLeod's Frontier::RPC2 module from CPAN to use
  11 # this.
  12 #
  13 # Eric Kidd <eric.kidd@pobox.com>
  14 #
  15 # This script is part of xmlrpc-c, and may be used and distributed under
  16 # the same terms as the rest of the package.
  17
  18 use strict;
  19
  20 # One global variable for use with Perl's format routines, and one for
  21 # use inside an 'exec' block.
  22 use vars qw/$helptext $method_list/;
  23
  24 # Try to load our Perl XML-RPC bindings, but fail gracefully.
  25 eval {
  26     require Frontier::Client;
  27 };
  28 if ($@) {
  29     print STDERR <<"EOD";
  30 This script requires Ken MacLeod\'s Frontier::RPC2 module. You can get this
  31 from CPAN or from his website at http://bitsko.slc.ut.us/~ken/xml-rpc/ .
  32
  33 For installation instructions, see the XML-RPC HOWTO at:
  34     http://www.linuxdoc.org/HOWTO/XML-RPC-HOWTO/index.html
  35
  36 EOD
  37     exit 1;
  38 }
  39
  40 # Parse our command-line arguments.
  41 if (@ARGV != 1 || $ARGV[0] eq "--help") {
  42     print STDERR "Usage: xml-rpc-api2txt serverURL\n";
  43     exit 1;
  44 }
  45
  46 my $server = Frontier::Client->new(url => $ARGV[0]);
  47
  48 # Try (very carefully) to get our a list of methods from the server.
  49 local $method_list;
  50 eval {
  51     $method_list = $server->call('system.listMethods');
  52 };
  53 if ($@) {
  54     print STDERR <<"EOD";
  55 An error occurred while trying to talk to the XML-RPC server:
  56
  57   $@
  58
  59 This may have been caused by several things--the server might not support
  60 introspection, it might not be an XML-RPC server, or your network might be
  61 down. Try the following:
  62
  63   xml-rpc-api2txt http://xmlrpc-c.sourceforge.net/api/sample.php
  64
  65 EOD
  66     exit 1;
  67 }
  68
  69 # Enter the methods into a hashtable.
  70 my @methods = sort @$method_list;
  71 my %method_table;
  72 foreach my $method (@methods) {
  73     $method_table{$method} = {};
  74 }
  75
  76 # Get more information for the hash table. Since we need to make lots and
  77 # lots of very small XML-RPC calls, we'd like to use system.multicall to
  78 # reduce the latency.
  79 if (defined $method_table{'system.multicall'}) {
  80
  81     # This is messy but fast. Everybody hates HTTP round-trip lag, right?
  82     my @call;
  83     foreach my $method (@methods) {
  84         push @call, {methodName => 'system.methodSignature',
  85                      params => [$method]};
  86         push @call, {methodName => 'system.methodHelp',
  87                      params => [$method]};
  88     }
  89     my @result = @{$server->call('system.multicall', \@call)};
  90     for (my $i = 0; $i < @methods; $i++) {
  91         my $method = $methods[$i];
  92         $method_table{$method}->{'signatures'} = $result[2*$i]->[0];
  93         $method_table{$method}->{'help'} = $result[2*$i+1]->[0];
  94     }
  95 } else {
  96
  97     # This is easy but slow (especially over backbone links).
  98     foreach my $method (@methods) {
  99         my $signature = $server->call('system.methodSignature', $method);
 100         my $help = $server->call('system.methodHelp', $method);
 101         $method_table{$method}->{'signatures'} = $signature;
 102         $method_table{$method}->{'help'} = $help;
 103     }
 104 }
 105
 106 # Now, we need to dump the API.
 107 print <<"EOD";
 108 XML-RPC API for $ARGV[0]
 109
 110 See http://www.linuxdoc.org/HOWTO/XML-RPC-HOWTO/index.html for instructions
 111 on using XML-RPC with Perl, Python, Java, C, C++, PHP, etc.
 112 EOD
 113 foreach my $method (@methods) {
 114     print "\n";
 115
 116     # Print a synopsis of the function.
 117     if ($method_table{$method}->{'signatures'} eq 'undef') {
 118         # No documentation. Bad server. No biscuit.
 119         print "unknown $method (...)\n";
 120     } else {
 121         for my $signature (@{$method_table{$method}->{'signatures'}}) {
 122             my $return_type = shift @$signature;
 123             my $arguments = join(", ", @$signature);
 124             print "$return_type $method ($arguments)\n";
 125         }
 126     }
 127     print "\n";
 128
 129     my $help = $method_table{$method}->{'help'};
 130     if ($help =~ /\n/) {
 131         # Text has already been broken into lines by the server, so just
 132         # indent it by two spaces and hope for the best.
 133         my @lines = split(/\n/, $help);
 134         my $help = "  " . join("\n  ", @lines);
 135         print "$help\n";
 136     } else {
 137         # Print our help text in a nicely-wrapped fashion using Perl's
 138         # formatting routines.
 139         $helptext = $method_table{$method}->{'help'};
 140         write;
 141     }
 142 }
 143
 144 format STDOUT =
 145   ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
 146   $helptext
 147 .