1#!/usr/bin/perl 2############################################################################### 3# 4# This file copyright (c) 2001-2011 Randy J. Ray, all rights reserved 5# 6# See "LICENSE AND COPYRIGHT" in the documentation for licensing and 7# redistribution terms. 8# 9############################################################################### 10# 11# Description: Simple tool to turn a Perl routine and the support data 12# into the simple XML representation that RPC::XML::Server 13# understands. 14# 15# Functions: read_external 16# write_file 17# 18# Libraries: Config 19# Getopt::Long 20# IO::File 21# File::Spec 22# 23# Global Consts: $VERSION 24# $cmd 25# 26# Environment: None. 27# 28############################################################################### 29 30use 5.006001; 31use strict; 32use warnings; 33use vars qw($USAGE $VERSION); 34use subs qw(read_from_file read_from_opts read_external write_file); 35 36use Config; 37use Carp 'croak'; 38use Getopt::Long; 39use File::Spec; 40 41my ($cmd, %opts, $ofh, %attrs); 42 43$VERSION = '1.15'; 44($cmd = $0) =~ s{.*/}{}; 45$USAGE = "$cmd [ --options ] 46 47Where: 48 49--help Generate this message. 50 51--name Specifies the external (published) name of the method. 52--namespace Specify an explicit namespace for the method to be created in 53--type Specify whether this defines a PROCEDURE, a METHOD or a 54 FUNCTION (case-free) 55--version Gives the version that should be attached to the method. 56--hidden Takes no value; if passed, flags the method as hidden. 57--signature Specifies one method signature. May be specified more than once. 58--helptext Provides the help string. 59--helpfile Gives the name of a file from which the help-text is read. 60--code Gives the name of the file from which to read the code. 61--output Name of the file to write the resulting XML to. 62 63--base If passed, this is used as a base-name from which to derive all 64 the other information. The file <base>.base must exist and be 65 readable. That file will provide the information for the method, 66 some of which may point to other files to be read. When done, the 67 output is written to <base>.xpl. 68 69 If --base is specified, all other options are ignored, and any 70 missing information (such as no signatures, etc.) will cause an 71 error. 72"; 73 74GetOptions(\%opts, 75 qw(help 76 base=s 77 name=s namespace=s type=s version=s hidden signature=s@ helptext=s 78 helpfile=s code=s 79 output=s)) 80 or croak "$USAGE\n\nStopped"; 81 82if ($opts{help}) 83{ 84 print $USAGE; 85 exit 0; 86} 87 88# First we start by getting all our data. Once that's all in place, then the 89# generation of the file is simple. 90if ($opts{base}) 91{ 92 read_from_file($opts{base}); 93 94 $ofh = "$opts{base}.xpl"; 95} 96else 97{ 98 read_from_opts(); 99 100 if ($opts{output}) 101 { 102 $ofh = $opts{output}; 103 } 104 else 105 { 106 $ofh = \*STDOUT; 107 } 108} 109 110write_file( 111 $ofh, 112 { 113 name => $attrs{name}, 114 namespace => $attrs{namespace}, 115 type => $attrs{type}, 116 version => $attrs{version}, 117 hidden => $attrs{hidden}, 118 code => $attrs{codetxt}, 119 help => $attrs{helptxt}, 120 sigs => $attrs{siglist}, 121 } 122); 123 124exit 0; 125 126############################################################################### 127# 128# Sub Name: read_from_file 129# 130# Description: Read method data from the given *.base file 131# 132# Arguments: NAME IN/OUT TYPE DESCRIPTION 133# $file in scalar File to read, minus the ".base" 134# 135# Globals: %attrs 136# 137# Returns: Success: void 138# Failure: croaks 139# 140############################################################################### 141sub read_from_file 142{ 143 my $file = shift; 144 145 my ($volume, $path) = File::Spec->splitpath($file); 146 $path ||= q{.}; 147 148 $attrs{type} = 'm'; # Default the type to 'm'ethod. 149 $attrs{codetxt} = {}; 150 $attrs{siglist} = []; 151 $attrs{namespace} = q{}; 152 $attrs{hidden} = 0; 153 $attrs{version} = q{}; 154 155 156 my @lines; 157 if (open my $fh, '<', "$file.base") 158 { 159 @lines = <$fh>; 160 close $fh or croak "Error closing $file.base: $!\nStopped"; 161 } 162 else 163 { 164 croak "Error opening $file.base for reading: $!\nStopped"; 165 } 166 167 for my $line (@lines) 168 { 169 chomp $line; 170 171 # Skip blanks and comments 172 next if ($line =~ /^\s*(?:#.*)?$/); 173 174 # I'm using a horrendous if-else cascade to avoid moving the required 175 # version of Perl to 5.012 just for the "when" construct. 176 ## no critic (ProhibitCascadingIfElse) 177 if ($line =~ /^name:\s+([\w.]+)$/i) 178 { 179 $attrs{name} = $1; 180 } 181 elsif ($line =~ /^namespace:\s+([\w.]+)$/i) 182 { 183 $attrs{namespace} = $1; 184 } 185 elsif ($line =~ /^type:\s+(\S+)$/i) 186 { 187 $attrs{type} = substr lc $1, 0, 1; 188 } 189 elsif ($line =~ /^version:\s+(\S+)$/i) 190 { 191 $attrs{version} = $1; 192 } 193 elsif ($line =~ /^signature:\s+\b(.*)$/i) 194 { 195 push @{$attrs{siglist}}, $1; 196 } 197 elsif ($line =~ /^hidden:\s+(no|yes)/i) 198 { 199 $attrs{hidden} = (lc $1 eq 'yes') ? 1 : 0; 200 } 201 elsif ($line =~ /^helpfile:\s+(.*)/i) 202 { 203 $attrs{helptxt} = 204 read_external(File::Spec->catpath($volume, $path, $1)); 205 } 206 elsif ($line =~ /^codefile(?:\[(.*)\])?:\s+(.*)/i) 207 { 208 $attrs{codetxt}->{$1 || 'perl'} = 209 read_external(File::Spec->catpath($volume, $path, $2)); 210 } 211 } 212 if (! keys %{$attrs{codetxt}}) 213 { 214 croak "Error: no code specified in $opts{base}.base, stopped"; 215 } 216 if (! @{$attrs{siglist}}) 217 { 218 croak "Error: no signatures found in $opts{base}.base, stopped"; 219 } 220 221 return; 222} 223 224############################################################################### 225# 226# Sub Name: read_from_opts 227# 228# Description: Read method data from the command-line options 229# 230# Arguments: None. 231# 232# Globals: %opts 233# %attrs 234# 235# Returns: Success: void 236# Failure: croaks 237# 238############################################################################### 239sub read_from_opts 240{ 241 $attrs{siglist} = []; 242 243 if ($opts{name}) 244 { 245 $attrs{name} = $opts{name}; 246 } 247 else 248 { 249 croak 'No name was specified for the published routine, stopped'; 250 } 251 252 $attrs{namespace} = $opts{namespace} || q{}; 253 $attrs{type} = $opts{type} || 'm'; 254 $attrs{hidden} = $opts{hidden} || 0; 255 $attrs{version} = $opts{version} || q{}; 256 257 if ($opts{signature}) 258 { 259 for my $val (@{$opts{signature}}) 260 { 261 $val =~ s/:/ /g; 262 push @{$attrs{siglist}}, $val; 263 } 264 } 265 else 266 { 267 croak "At least one signature must be specified for $attrs{name}, " . 268 'stopped'; 269 } 270 271 if ($opts{helptext}) 272 { 273 $attrs{helptxt} = \"$opts{helptext}\n"; 274 } 275 elsif ($opts{helpfile}) 276 { 277 $attrs{helptxt} = read_external($opts{helpfile}); 278 } 279 else 280 { 281 $attrs{helptxt} = \q{}; 282 } 283 284 if ($opts{code}) 285 { 286 $attrs{codetxt}->{perl} = read_external($opts{code}); 287 } 288 else 289 { 290 $attrs{codetxt}->{perl} = do { local $/ = undef; <> }; 291 } 292 293 return; 294} 295 296############################################################################### 297# 298# Sub Name: read_external 299# 300# Description: Simple snippet to read in an external file and return the 301# results as a ref-to-scalar 302# 303# Arguments: NAME IN/OUT TYPE DESCRIPTION 304# $file in scalar File to open and read 305# 306# Returns: Success: scalar ref 307# Failure: dies 308# 309############################################################################### 310sub read_external 311{ 312 my $file = shift; 313 my ($fh, $content); 314 315 if (! open $fh, '<', $file) 316 { 317 croak "Cannot open file $file for reading: $!, stopped"; 318 } 319 else 320 { 321 $content = do { local $/ = undef; <$fh> }; 322 close $fh or 323 croak "Error closing $file: $!, stopped"; 324 } 325 326 return \$content; 327} 328 329############################################################################### 330# 331# Sub Name: write_file 332# 333# Description: Write the XML file that will describe a publishable method 334# 335# Arguments: NAME IN/OUT TYPE DESCRIPTION 336# $fh in IO Filehandle to write to 337# $args in hashref Hashref of arguments 338# 339# Globals: $cmd 340# $VERSION 341# 342# Environment: None. 343# 344# Returns: void 345# 346############################################################################### 347sub write_file 348{ 349 my ($fh, $args) = @_; 350 351 # Might need to open a FH here, and keep it open for a while. 352 ## no critic (RequireBriefOpen) 353 354 if (! ref $fh) 355 { 356 if (! open my $newfh, '>', $fh) 357 { 358 croak "Error opening $fh for writing: $!, stopped"; 359 } 360 else 361 { 362 $fh = $newfh; 363 } 364 } 365 366 my %typemap = ( 367 'm' => 'method', 368 p => 'procedure', 369 f => 'function', 370 ); 371 my $tag = "$typemap{$args->{type}}def"; 372 373 # Armor against XML confusion 374 foreach (qw(name namespace version help)) 375 { 376 $args->{$_} =~ s/&/&/g; 377 $args->{$_} =~ s/</</g; 378 $args->{$_} =~ s/>/>/g; 379 } 380 for (keys %{$args->{code}}) 381 { 382 if (($_ eq 'perl') and (index(${$args->{code}->{$_}}, ']]>') == -1) and 383 (index(${$args->{code}->{$_}}, '__END__') == -1)) 384 { 385 ${$args->{code}->{$_}} = 386 "<![CDATA[\n$Config{startperl}\n${$args->{code}->{$_}}\n" . 387 "__END__\n]]>"; 388 } 389 else 390 { 391 ${$args->{code}->{$_}} =~ s/&/&/g; 392 ${$args->{code}->{$_}} =~ s/</</g; 393 ${$args->{code}->{$_}} =~ s/>/>/g; 394 } 395 } 396 397 print {$fh} <<"EO_HDR"; 398<?xml version="1.0" encoding="iso-8859-1"?> 399<!DOCTYPE $tag SYSTEM "rpc-method.dtd"> 400<!-- 401 Generated automatically by $cmd $VERSION 402 403 Any changes made here will be lost. 404--> 405<$tag> 406EO_HDR 407 408 print {$fh} "<name>$args->{name}</name>\n"; 409 if ($args->{namespace}) 410 { 411 print {$fh} "<namespace>$args->{namespace}</namespace>\n"; 412 } 413 if ($args->{version}) 414 { 415 print {$fh} "<version>$args->{version}</version>\n"; 416 } 417 if ($args->{hidden}) 418 { 419 print {$fh} "<hidden />\n"; 420 } 421 print {$fh} map { "<signature>$_</signature>\n" } @{$args->{sigs}}; 422 if ($args->{help}) 423 { 424 print {$fh} "<help>\n${$args->{help}}</help>\n"; 425 } 426 for (sort keys %{$args->{code}}) 427 { 428 print {$fh} qq{<code language="$_">\n${$args->{code}->{$_}}</code>\n}; 429 } 430 431 print {$fh} "</$tag>\n"; 432 433 return; 434} 435 436__END__ 437 438=head1 NAME 439 440make_method - Turn Perl code into an XML description for RPC::XML::Server 441 442=head1 SYNOPSIS 443 444 make_method --name=system.identification --helptext='System ID string' 445 --signature=string --code=ident.pl --output=ident.xpl 446 447 make_method --base=methods/identification 448 449=head1 DESCRIPTION 450 451This is a simple tool to create the XML descriptive files for specifying 452methods to be published by an B<RPC::XML::Server>-based server. 453 454If a server is written such that the methods it exports (or I<publishes>) are 455a part of the running code, then there is no need for this tool. However, in 456cases where the server may be separate and distinct from the code (such as an 457Apache-based RPC server), specifying the routines and filling in the 458supporting information can be cumbersome. 459 460One solution that the B<RPC::XML::Server> package offers is the means to load 461publishable code from an external file. The file is in a simple XML dialect 462that clearly delinates the externally-visible name, the method signatures, the 463help text and the code itself. These files may be created manually, or this 464tool may be used as an aide. 465 466=head1 REQUIRED ARGUMENTS 467 468There are no required arguments, but if there are not sufficient options passed 469you will be told by an error message. 470 471=head1 OPTIONS 472 473The tool recognizes the following options: 474 475=over 4 476 477=item --help 478 479Prints a short summary of the options. 480 481=item --name=STRING 482 483Specifies the published name of the method being encoded. This is the name by 484which it will be visible to clients of the server. 485 486=item --namespace=STRING 487 488Specifies a namespace that the code of the method will be evaluated in, 489when the XPL file is loaded by a server instance. 490 491=item --type=STRING 492 493Specify the type for the resulting file. "Type" here refers to whether the 494container tag used in the resulting XML will specify a B<procedure> or a 495B<method>. The default is B<method>. The string is treated case-independant, 496and only the first character (C<m> or C<p>) is actually regarded. 497 498=item --version=STRING 499 500Specify a version stamp for the code routine. 501 502=item --hidden 503 504If this is passe, the resulting file will include a tag that tells the server 505daemon to not make the routine visible through any introspection interfaces. 506 507=item --signature=STRING [ --signature=STRING ... ] 508 509Specify one or more signatures for the method. Signatures should be the type 510names as laid out in the documentation in L<RPC::XML|RPC::XML>, with the 511elements separated by a colon. You may also separate them with spaces, if you 512quote the argument. This option may be specified more than once, as some 513methods may have several signatures. 514 515=item --helptext=STRING 516 517Specify the help text for the method as a simple string on the command line. 518Not suited for terribly long help strings. 519 520=item --helpfile=FILE 521 522Read the help text for the method from the file specified. 523 524=item --code=FILE 525 526Read the actual code for the routine from the file specified. If this option is 527not given, the code is read from the standard input file descriptor. 528 529=item --output=FILE 530 531Write the resulting XML representation to the specified file. If this option 532is not given, then the output goes to the standard output file descriptor. 533 534=item --base=NAME 535 536This is a special, "all-in-one" option. If passed, all other options are 537ignored. 538 539The value is used as the base element for reading information from a file 540named B<BASE>.base. This file will contain specification of the name, version, 541hidden status, signatures and other method information. Each line of the file 542should look like one of the following: 543 544=over 4 545 546=item B<Name: I<STRING>> 547 548Specify the name of the routine being published. If this line does not appear, 549then the value of the B<--base> argument with all directory elements removed 550will be used. 551 552=item B<Version: I<STRING>> 553 554Provide a version stamp for the function. If no line matching this pattern is 555present, no version tag will be written. 556 557=item B<Hidden: I<STRING>> 558 559If present, I<STRING> should be either C<yes> or C<no> (case not important). 560If it is C<yes>, then the method is marked to be hidden from any introspection 561API. 562 563=item B<Signature: I<STRING>> 564 565This line may appear more than once, and is treated cumulatively. Other 566options override previous values if they appear more than once. The portion 567following the C<Signature:> part is taken to be a published signature for the 568method, with elements separated by whitespace. Each method must have at least 569one signature, so a lack of any will cause an error. 570 571=item B<Helpfile: I<STRING>> 572 573Specifies the file from which to read the help text. It is not an error if 574no help text is specified. 575 576=item B<Codefile: I<STRING>> 577 578Specifies the file from which to read the code. Code is assumed to be Perl, 579and will be tagged as such in the resulting file. 580 581=item B<Codefile[lang]: I<string>> 582 583Specifies the file from which to read code, while also identifying the 584language that the code is in. This allows for the creation of a B<XPL> file 585that includes multiple language implementations of the given method or 586procedure. 587 588=back 589 590Any other lines than the above patterns are ignored. 591 592If no code has been read, then the tool will exit with an error message. 593 594The output is written to B<BASE>.xpl, preserving the path information so that 595the resulting file is right alongside the source files. This allows constructs 596such as: 597 598 make_method --base=methods/introspection 599 600=back 601 602=head1 FILE FORMAT AND DTD 603 604The file format for these published routines is a very simple XML dialect. 605This is less due to XML being an ideal format than it is the availability of 606the parser, given that the B<RPC::XML::Server> class will already have the 607parser code in core. Writing a completely new format would not have gained 608anything. 609 610The Document Type Declaration for the format can be summarized by: 611 612 <!ELEMENT proceduredef (name, namespace?, version?, hidden?, 613 signature+, help?, code)> 614 <!ELEMENT methoddef (name, namespace?, version?, hidden?, 615 signature+, help?, code)> 616 <!ELEMENT functiondef (name, namespace?, version?, hidden?, 617 signature+, help?, code)> 618 <!ELEMENT name (#PCDATA)> 619 <!ELEMENT namespace (#PCDATA)> 620 <!ELEMENT version (#PCDATA)> 621 <!ELEMENT hidden EMPTY> 622 <!ELEMENT signature (#PCDATA)> 623 <!ELEMENT help (#PCDATA)> 624 <!ELEMENT code (#PCDATA)> 625 <!ATTLIST code language (#PCDATA)> 626 627The file C<rpc-method.dtd> that comes with the distribution has some 628commentary in addition to the actual specification. 629 630A file is (for now) limited to one definition. This is started by the one of 631the opening tags C<E<lt>methoddefE<gt>>, C<E<lt>functiondefE<gt>> or 632C<E<lt>proceduredefE<gt>>. This is followed by exactly one C<E<lt>nameE<gt>> 633container specifying the method name, an optional version stamp, an optional 634hide-from-introspection flag, one or more C<E<lt>signatureE<gt>> containers 635specifying signatures, an optional C<E<lt>helpE<gt>> container with the help 636text, then the C<E<lt>codeE<gt>> container with the actual program code. All 637text should use entity encoding for the symbols: 638 639 & C<&> (ampersand) 640 E<lt> C<<> (less-than) 641 E<gt> C<>> (greater-than) 642 643The parsing process within the server class will decode the entities. To make 644things easier, the tool scans all text elements and encodes the above entities 645before writing the file. 646 647=head2 The Specification of Code 648 649This is not I<"Programming 101">, nor is it I<"Perl for the Somewhat Dim">. 650The code that is passed in via one of the C<*.xpl> files gets passed to 651C<eval> with next to no modification (see below). Thus, badly-written or 652malicious code can very well wreak havoc on your server. This is not the fault 653of the server code. The price of the flexibility this system offers is the 654responsibility on the part of the developer to ensure that the code is tested 655and safe. 656 657Code itself is treated as verbatim as possible. Some edits may occur on the 658server-side, as it make the code suitable for creating an anonymous subroutine 659from. The B<make_method> tool will attempt to use a C<CDATA> section to embed 660the code within the XML document, so that there is no need to encode entities 661or such. This allows for the resulting F<*.xpl> files to be syntax-testable 662with C<perl -cx>. You can aid this by ensuring that the code does not contain 663either of the two following character sequences: 664 665 ]]> 666 667 __DATA__ 668 669The first is the C<CDATA> terminator. If it occurs naturally in the code, it 670would trigger the end-of-section in the parser. The second is the familiar 671Perl token, which is inserted so that the remainder of the XML document does 672not clutter up the Perl parser. 673 674=head1 EXAMPLES 675 676The B<RPC::XML> distribution comes with a number of default methods in a 677subdirectory called (cryptically enough) C<methods>. Each of these is 678expressed as a set of (C<*.base>, C<*.code>, C<*.help>) files. The Makefile.PL 679file configures the resulting Makefile such that these are used to create 680C<*.xpl> files using this tool, and then install them. 681 682=head1 DIAGNOSTICS 683 684Most problems come out in the form of error messages followed by an abrupt 685exit. 686 687=head1 EXIT STATUS 688 689The tool exits with a status of 0 upon success, and 255 otherwise. 690 691=head1 CAVEATS 692 693I don't much like this approach to specifying the methods, but I liked my 694other ideas even less. 695 696=head1 BUGS 697 698Please report any bugs or feature requests to 699C<bug-rpc-xml at rt.cpan.org>, or through the web interface at 700L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=RPC-XML>. I will be 701notified, and then you'll automatically be notified of progress on 702your bug as I make changes. 703 704=head1 SUPPORT 705 706=over 4 707 708=item * RT: CPAN's request tracker 709 710L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=RPC-XML> 711 712=item * AnnoCPAN: Annotated CPAN documentation 713 714L<http://annocpan.org/dist/RPC-XML> 715 716=item * CPAN Ratings 717 718L<http://cpanratings.perl.org/d/RPC-XML> 719 720=item * Search CPAN 721 722L<http://search.cpan.org/dist/RPC-XML> 723 724=item * Source code on GitHub 725 726L<http://github.com/rjray/rpc-xml> 727 728=back 729 730=head1 LICENSE AND COPYRIGHT 731 732This module and the code within are released under the terms of the Artistic 733License 2.0 734(http://www.opensource.org/licenses/artistic-license-2.0.php). This code may 735be redistributed under either the Artistic License or the GNU Lesser General 736Public License (LGPL) version 2.1 737(http://www.opensource.org/licenses/lgpl-2.1.php). 738 739=head1 SEE ALSO 740 741L<RPC::XML|RPC::XML>, L<RPC::XML::Server|RPC::XML::Server> 742 743=head1 CREDITS 744 745The B<XML-RPC> standard is Copyright (c) 1998-2001, UserLand Software, Inc. 746See <http://www.xmlrpc.com> for more information about the B<XML-RPC> 747specification. 748 749=head1 AUTHOR 750 751Randy J. Ray <rjray@blackperl.com> 752 753=cut 754