[system] / trunk / xmlrpc / RPC / RPC-XML-0.25 / etc / make_method Repository:
ViewVC logotype

View of /trunk/xmlrpc/RPC/RPC-XML-0.25/etc/make_method

Parent Directory Parent Directory | Revision Log Revision Log


Revision 279 - (download) (annotate)
Fri May 17 21:44:04 2002 UTC (17 years, 2 months ago) by gage
File size: 16346 byte(s)
Experimental xmlrpc WeBWorK webservices

    1 #!/usr/bin/perl
    2 ###############################################################################
    3 #
    4 # This file copyright (c) 2001 by Randy J. Ray, all rights reserved
    5 #
    6 # Copying and distribution are permitted under the terms of the Artistic
    7 # License as distributed with Perl versions 5.005 and later. See
    8 # http://language.perl.com/misc/Artistic.html
    9 #
   10 ###############################################################################
   11 #
   12 #   $Id: make_method,v 1.1.1.1 2002-05-17 21:44:03 gage Exp $
   13 #
   14 #   Description:    Simple tool to turn a Perl routine and the support data
   15 #                   into the simple XML representation that RPC::XML::Server
   16 #                   understands.
   17 #
   18 #   Functions:      write_file
   19 #
   20 #   Libraries:      Getopt::Long
   21 #
   22 #   Global Consts:  $VERSION
   23 #                   $cmd
   24 #
   25 #   Environment:    None.
   26 #
   27 ###############################################################################
   28 
   29 use 5.005;
   30 use strict;
   31 use vars qw($cmd $USAGE $VERSION $revision %opts $ifh $ofh $path
   32             $helptxt $codetxt @siglist $name $version $hidden $lang);
   33 use subs qw(read_external write_file);
   34 
   35 use Getopt::Long;
   36 use IO::File;
   37 use File::Spec;
   38 
   39 $VERSION = do { my @r=(q$Revision: 1.1.1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };
   40 ($cmd = $0) =~ s|.*/||;
   41 $USAGE = "$cmd [ --options ]
   42 
   43 Where:
   44 
   45 --help        Generate this message.
   46 
   47 --name        Specifies the external (published) name of the method.
   48 --version     Gives the version that should be attached to the method.
   49 --hidden      Takes no value; if passed, flags the method as hidden.
   50 --signature   Specifies one method signature. May be specified more than once.
   51 --helptext    Provides the help string.
   52 --helpfile    Gives the name of a file from which the help-text is read.
   53 --code        Gives the name of the file from which to read the code.
   54 --output      Name of the file to write the resulting XML to.
   55 
   56 --base        If passed, this is used as a base-name from which to derive all
   57               the other information. The file <base>.base must exist and be
   58               readable. That file will provide the information for the method,
   59               some of which may point to other files to be read. When done, the
   60               output is written to <base>.xpl.
   61 
   62               If --base is specified, all other options are ignored, and any
   63               missing information (such as no signatures, etc.) will cause an
   64               error.
   65 ";
   66 
   67 GetOptions(\%opts,
   68            qw(help
   69               base=s
   70               name=s version=s hidden signature=s@ helptext=s helpfile=s code=s
   71               output=s))
   72     or die "$USAGE\n\nStopped";
   73 
   74 if ($opts{help})
   75 {
   76     print $USAGE;
   77     exit;
   78 }
   79 
   80 #
   81 # First we start by getting all our data. Once that's all in place, then the
   82 # generation of the file is simple.
   83 #
   84 if ($opts{base})
   85 {
   86     # This simplifies a lot of it
   87 
   88     (undef, $path, $name) = File::Spec->splitpath($opts{base});
   89     $path = '.' unless $path;
   90     $codetxt = {};
   91 
   92     $ifh = new IO::File "< $opts{base}.base";
   93     die "Error opening $opts{base}.base for reading: $!\nStopped"
   94         unless ($ifh);
   95     while (defined($_ = <$ifh>))
   96     {
   97         chomp;
   98 
   99         if (/^name:\s+([\w\.]+)$/i)
  100         {
  101             $name = $1;
  102         }
  103         elsif (/^version:\s+(\S+)$/i)
  104         {
  105             $version = $1;
  106         }
  107         elsif (/^signature:\s+\b(.*)$/i)
  108         {
  109             push(@siglist, $1);
  110         }
  111         elsif (/^hidden:\s+(no|yes)/i)
  112         {
  113             $hidden = ($1 eq 'yes') ? 1 : 0;
  114         }
  115         elsif (/^helpfile:\s+(.*)/i)
  116         {
  117             $helptxt = read_external "$path/$1";
  118         }
  119         elsif (/^codefile(\[(.*)\])?:\s+(.*)/i)
  120         {
  121             $lang = $2 || 'perl';
  122             $codetxt->{$lang} = read_external "$path/$3";
  123         }
  124     }
  125     die "Error: no code specified in $opts{base}.base, stopped"
  126         unless (keys %$codetxt);
  127     die "Error: no signatures found in $opts{base}.base, stopped"
  128         unless (@siglist);
  129 
  130     $ofh = new IO::File "> $opts{base}.xpl";
  131     die "Error opening $opts{base}.xpl for writing: $!\nStopped"
  132         unless ($ofh);
  133 }
  134 else
  135 {
  136     if ($opts{name})
  137     {
  138         $name = $opts{name};
  139     }
  140     else
  141     {
  142         die 'No name was specified for the published routine, stopped';
  143     }
  144 
  145     $hidden = $opts{hidden}   || 0;
  146     $version = $opts{version} || '';
  147 
  148     if ($opts{signature})
  149     {
  150         @siglist = map { s/:/ /g; $_ } @{$opts{signature}};
  151     }
  152     else
  153     {
  154         die "At least one signature must be specified for $name, stopped";
  155     }
  156 
  157     if ($opts{helptext})
  158     {
  159         $$helptxt = "$opts{helptext}\n";
  160     }
  161     elsif ($opts{helpfile})
  162     {
  163         $helptxt = read_external($opts{helpfile});
  164     }
  165     else
  166     {
  167         $$helptxt = '';
  168     }
  169 
  170     if ($opts{code})
  171     {
  172         $$codetxt = read_external($opts{code});
  173     }
  174     else
  175     {
  176         $$codetxt = join('', <STDIN>);
  177     }
  178 
  179     if ($opts{output})
  180     {
  181         $ofh = new IO::File "> $opts{output}";
  182         die "Unable to open $opts{output} for writing: $!\nStopped"
  183             unless ($ofh);
  184     }
  185     else
  186     {
  187         $ofh = \*STDOUT;
  188     }
  189 }
  190 
  191 write_file($ofh, $name, $version, $hidden, $codetxt, $helptxt, \@siglist);
  192 
  193 exit;
  194 
  195 ###############################################################################
  196 #
  197 #   Sub Name:       read_external
  198 #
  199 #   Description:    Simple snippet to read in an external file and return the
  200 #                   results as a ref-to-scalar
  201 #
  202 #   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
  203 #                   $file     in      scalar    File to open and read
  204 #
  205 #   Globals:        None.
  206 #
  207 #   Environment:    None.
  208 #
  209 #   Returns:        Success:    scalar ref
  210 #                   Failure:    dies
  211 #
  212 ###############################################################################
  213 sub read_external
  214 {
  215     my $file = shift;
  216 
  217     my $fh = new IO::File "< $file";
  218     die "Cannot open file $file for reading: $!, stopped" unless ($fh);
  219 
  220     my $tmp = join('', <$fh>);
  221     \$tmp;
  222 }
  223 
  224 ###############################################################################
  225 #
  226 #   Sub Name:       write_file
  227 #
  228 #   Description:    Write the XML file that will describe a publishable method
  229 #
  230 #   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
  231 #                   $fh       in      IO        Filehandle to write to
  232 #                   $name     in      scalar    Name (external) of method
  233 #                   $version  in      scalar    Version string (if any)
  234 #                   $hidden   in      scalar    Boolean whether to hide it
  235 #                   $code     in      sc ref    Actual Perl code
  236 #                   $help     in      sc ref    Help text for the method
  237 #                   $sigs     in      listref   List of one or more signatures
  238 #                                                 for the method
  239 #
  240 #   Globals:        $cmd
  241 #                   $VERSION
  242 #
  243 #   Environment:    None.
  244 #
  245 #   Returns:        void
  246 #
  247 ###############################################################################
  248 sub write_file
  249 {
  250     my ($fh, $name, $version, $hidden, $code, $help, $sigs) = @_;
  251 
  252     my $date = scalar localtime;
  253 
  254     # Armor against XML confusion
  255     foreach ($name, $$help)
  256     {
  257         s/&/&amp;/g;
  258         s/</&lt;/g;
  259         s/>/&gt;/g;
  260     }
  261     for (keys %$code)
  262     {
  263 	${$code->{$_}} =~ s/&/&amp;/g;
  264 	${$code->{$_}} =~ s/</&lt;/g;
  265 	${$code->{$_}} =~ s/>/&gt;/g;
  266     }
  267 
  268     print $ofh <<"EO_HDR";
  269 <?xml version="1.0"?>
  270 <!DOCTYPE methoddef SYSTEM "rpc-method.dtd">
  271 <!--
  272     Generated automatically by $cmd v$VERSION, $date
  273 
  274     Any changes made here will be lost.
  275 -->
  276 <methoddef>
  277 EO_HDR
  278 
  279     print $ofh "<name>$name</name>\n";
  280     print $ofh "<version>$version</version>\n" if $version;
  281     print $ofh "<hidden />\n" if $hidden;
  282     print $ofh map { "<signature>$_</signature>\n" } @$sigs;
  283     print $ofh "<help>\n$$help</help>\n" if ($$help);
  284     for (sort keys %$code)
  285     {
  286         print $ofh qq{<code language="perl">\n$ {$code->{$_}}</code>\n};
  287     }
  288 
  289     print $ofh "</methoddef>\n";
  290 
  291     return;
  292 }
  293 
  294 __END__
  295 
  296 =head1 NAME
  297 
  298 make_method - Turn Perl code into an XML description for RPC::XML::Server
  299 
  300 =head1 SYNOPSIS
  301 
  302     make_method --name=system.identification --helptext='System ID string'
  303         --signature=string --code=ident.pl --output=ident.xpl
  304 
  305     make_method --base=methods/identification
  306 
  307 =head1 DESCRIPTION
  308 
  309 This is a simple tool to create the XML descriptive files for specifying
  310 methods to be published by an B<RPC::XML::Server>-based server.
  311 
  312 If a server is written such that the methods it exports (or I<publishes>) are
  313 a part of the running code, then there is no need for this tool. However, in
  314 cases where the server may be separate and distinct from the code (such as an
  315 Apache-based RPC server), specifying the routines and filling in the
  316 supporting information can be cumbersome.
  317 
  318 One solution that the B<RPC::XML::Server> package offers is the means to load
  319 publishable code from an external file. The file is in a simple XML dialect
  320 that clearly delinates the externally-visible name, the method signatures, the
  321 help text and the code itself. These files may be created manually, or this
  322 tool may be used as an aide.
  323 
  324 =head1 OPTIONS
  325 
  326 The tool recognizes the following options:
  327 
  328 =over 4
  329 
  330 =item --help
  331 
  332 Prints a short summary of the options.
  333 
  334 =item --name=STRING
  335 
  336 Specifies the published name of the method being encoded. This is the name by
  337 which it will be visible to clients of the server.
  338 
  339 =item --version=STRING
  340 
  341 Specify a version stamp for the code routine.
  342 
  343 =item --hidden
  344 
  345 If this is passe, the resulting file will include a tag that tells the server
  346 daemon to not make the routine visible through any introspection interfaces.
  347 
  348 =item --signature=STRING [ --signature=STRING ... ]
  349 
  350 Specify one or more signatures for the method. Signatures should be the type
  351 names as laid out in the documentation in L<RPC::XML>, with the elements
  352 separated by a colon. You may also separate them with spaces, if you quote the
  353 argument. This option may be specified more than once, as some methods may
  354 have several signatures.
  355 
  356 =item --helptext=STRING
  357 
  358 Specify the help text for the method as a simple string on the command line.
  359 Not suited for terribly long help strings.
  360 
  361 =item --helpfile=FILE
  362 
  363 Read the help text for the method from the file specified.
  364 
  365 =item --code=FILE
  366 
  367 Read the actual code for the routine from the file specifed. If this option is
  368 not given, the code is read from the standard input file descriptor.
  369 
  370 =item --output=FILE
  371 
  372 Write the resulting XML representation to the specified file. If this option
  373 is not given, then the output goes to the standard output file descriptor.
  374 
  375 =item --base=NAME
  376 
  377 This is a special, "all-in-one" option. If passed, all other options are
  378 ignored.
  379 
  380 The value is used as the base element for reading information from a file
  381 named B<BASE>.base. This file will contain specification of the name, version,
  382 hidden status, signatures and other method information. Each line of the file
  383 should look like one of the following:
  384 
  385 =over 4
  386 
  387 =item B<Name: I<STRING>>
  388 
  389 Specify the name of the routine being published. If this line does not appear,
  390 then the value of the B<--base> argument with all directory elements removed
  391 will be used.
  392 
  393 =item B<Version: I<STRING>>
  394 
  395 Provide a version stamp for the function. If no line matching this pattern is
  396 present, no version tag will be written.
  397 
  398 =item B<Hidden: I<STRING>>
  399 
  400 If present, I<STRING> should be either C<yes> or C<no> (case not important).
  401 If it is C<yes>, then the method is marked to be hidden from any introspection
  402 API.
  403 
  404 =item B<Signature: I<STRING>>
  405 
  406 This line may appear more than once, and is treated cumulatively. Other
  407 options override previous values if they appear more than once. The portion
  408 following the C<Signature:> part is taken to be a published signature for the
  409 method, with elements separated by whitespace. Each method must have at least
  410 one signature, so a lack of any will cause an error.
  411 
  412 =item B<Helpfile: I<STRING>>
  413 
  414 Specifies the file from which to read the help text. It is not an error if
  415 no help text is specified.
  416 
  417 =item B<Codefile: I<STRING>>
  418 
  419 Specifies the file from which to read the code. If no code has been read, then
  420 the tool will exit with an error message.
  421 
  422 =back
  423 
  424 Any other lines than the above patterns are ignored.
  425 
  426 The output is written to B<BASE>.xpl, preserving the path information so that
  427 the resulting file is right alongside the source files. This allows constructs
  428 such as:
  429 
  430     make_method --base=methods/introspection
  431 
  432 =back
  433 
  434 =head1 FILE FORMAT AND DTD
  435 
  436 The file format for these published routines is a very simple XML dialect.
  437 This is less due to XML being an ideal format than it is the availability of
  438 the parser, given that the B<RPC::XML::Server> class will already have the
  439 parser code in core. Writing a completely new format would not have gained
  440 anything.
  441 
  442 The Document Type Declaration for the format can be summarized by:
  443 
  444     <!ELEMENT  methoddef  (name, version?, hidden?, signature+,
  445                            help?, code)>
  446     <!ELEMENT  name       (#PCDATA)>
  447     <!ELEMENT  version    (#PCDATA)>
  448     <!ELEMENT  hidden     EMPTY>
  449     <!ELEMENT  signature  (#PCDATA)>
  450     <!ELEMENT  help       (#PCDATA)>
  451     <!ELEMENT  code       (#PCDATA)>
  452     <!ATTLIST  code       language (#PCDATA)>
  453 
  454 The file C<rpc-method.dtd> that comes with the distribution has some
  455 commentary in addition to the actual specification.
  456 
  457 A file is (for now) limited to one definition. This is started by the opening
  458 tag, C<E<lt>methoddefE<gt>>. This is followed by exactly one C<E<lt>nameE<gt>>
  459 container specifying the method name, an optional version stamp, an optional
  460 hide-from-introspection flag, one or more C<E<lt>signatureE<gt>> containers
  461 specifying signatures, an optional C<E<lt>helpE<gt>> container with the help
  462 text, then the C<E<lt>codeE<gt>> container with the actual program code. All
  463 text should use entity encoding for the symbols:
  464 
  465     & C<&amp;> (ampersand)
  466     E<lt> C<&lt;>  (less-than)
  467     E<gt> C<&gt;>  (greater-than)
  468 
  469 The parsing process within the server class will decode the entities. To make
  470 things easier, the tool scans all text elements and encodes the above entities
  471 before writing the file.
  472 
  473 =head2 The Specification of Code
  474 
  475 This is not I<"Programming 101">, nor is it I<"Perl for the Somewhat Dim">.
  476 The code that is passed in via one of the C<*.xpl> files gets passed to
  477 C<eval> with next to no modification (see below). Thus, badly-written or
  478 malicious code can very well wreak havoc on your server. This is not the fault
  479 of the server code. The price of the flexibility this system offers is the
  480 responsibility on the part of the developer to ensure that the code is tested
  481 and safe.
  482 
  483 That being said, the block of code will undergo one minor edit (aside from the
  484 entity expansion). The server looks for a pattern of C<sub NAME {>, which it
  485 assumes delinates the start of the declaration. The text is edited to remove
  486 the name, the result being an anonymous subroutine definition which is
  487 assigned to a lexically-scoped variable within the server. If something other
  488 than the subroutine declaration matches the pattern, then likely the
  489 declaration itself will generate an error in the C<eval>. Again, this is not
  490 I<"Teach Yourself Perl with only 24 Brain Cells">.
  491 
  492 =head1 EXAMPLES
  493 
  494 The B<RPC::XML> distribution comes with a number of default methods in a
  495 subdirectory called (cryptically enough) C<methods>. Each of these is
  496 expressed as a set of (C<*.base>, C<*.code>, C<*.help>) files. The Makefile.PL
  497 file configures the resulting Makefile such that these are used to create
  498 C<*.xpl> files using this tool, and then install them.
  499 
  500 =head1 DIAGNOSTICS
  501 
  502 Most problems come out in the form of error messages followed by an abrupt
  503 exit.
  504 
  505 =head1 CAVEATS
  506 
  507 I don't much like this approach to specifying the methods, but I liked my
  508 other ideas even less.
  509 
  510 =head1 CREDITS
  511 
  512 The B<XML-RPC> standard is Copyright (c) 1998-2001, UserLand Software, Inc.
  513 See <http://www.xmlrpc.com> for more information about the B<XML-RPC>
  514 specification.
  515 
  516 =head1 LICENSE
  517 
  518 This module is licensed under the terms of the Artistic License that covers
  519 Perl itself. See <http://language.perl.com/misc/Artistic.html> for the
  520 license itself.
  521 
  522 =head1 SEE ALSO
  523 
  524 L<RPC::XML>, L<RPC::XML::Server>
  525 
  526 =head1 AUTHOR
  527 
  528 Randy J. Ray <rjray@blackperl.com>
  529 
  530 =cut

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9