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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 279 - (view) (download)

1 : gage 279 #!/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