Commit 2f4202b8 authored by Florian Schlichting's avatar Florian Schlichting

Import original source of XMLRPC-Lite 0.717

parents
Revision history for Perl extension Perl-XMLRPC-Lite.
0.01 Thu May 16 18:50:17 2013
- original version; created by h2xs 1.23 with options
-X perl-XMLRPC-Lite
Changes
Makefile.PL
MANIFEST
README
lib/Apache/XMLRPC/Lite.pm
lib/XMLRPC/Lite.pm
lib/XMLRPC/Test.pm
lib/XMLRPC/Transport/HTTP.pm
lib/XMLRPC/Transport/POP3.pm
lib/XMLRPC/Transport/TCP.pm
t/07-xmlrpc_payload.t
t/26-xmlrpc.t
t/37-mod_xmlrpc.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
{
"abstract" : "client and server implementation of XML-RPC protocol",
"author" : [
"Paul Kulchenko (paulclinger@yahoo.com)"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "XMLRPC-Lite",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"SOAP::Lite" : "0.716",
"SOAP::Transport::TCP" : "0.715"
}
}
},
"release_status" : "stable",
"version" : "0.717"
}
---
abstract: 'client and server implementation of XML-RPC protocol'
author:
- 'Paul Kulchenko (paulclinger@yahoo.com)'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: XMLRPC-Lite
no_index:
directory:
- t
- inc
requires:
SOAP::Lite: 0.716
SOAP::Transport::TCP: 0.715
version: 0.717
#!/usr/bin/perl
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'XMLRPC-Lite',
VERSION_FROM => 'lib/XMLRPC/Lite.pm',
PREREQ_PM => {
'SOAP::Lite' => 0.716,
'SOAP::Transport::TCP' => 0.715
},
ABSTRACT_FROM => 'lib/XMLRPC/Lite.pm',
AUTHOR => 'Paul Kulchenko (paulclinger@yahoo.com)'
);
NAME
XMLRPC::Lite - client and server implementation of XML-RPC protocol
SYNOPSIS
Client
use XMLRPC::Lite;
print XMLRPC::Lite
-> proxy('http://betty.userland.com/RPC2')
-> call('examples.getStateStruct', {state1 => 12, state2 => 28})
-> result;
CGI server
use XMLRPC::Transport::HTTP;
my $server = XMLRPC::Transport::HTTP::CGI
-> dispatch_to('methodName')
-> handle
;
Daemon server
use XMLRPC::Transport::HTTP;
my $daemon = XMLRPC::Transport::HTTP::Daemon
-> new (LocalPort => 80)
-> dispatch_to('methodName')
;
print "Contact to XMLRPC server at ", $daemon->url, "\n";
$daemon->handle;
DESCRIPTION
XMLRPC::Lite is a Perl modules which provides a simple nterface to the
XML-RPC protocol both on client and server side. Based on SOAP::Lite
module, it gives you access to all features and transports available in
that module.
See t/26-xmlrpc.t for client examples and examples/XMLRPC/* for server
implementations.
DEPENDENCIES
SOAP::Lite
SEE ALSO
SOAP::Lite
CREDITS
The XML-RPC standard is Copyright (c) 1998-2001, UserLand Software, Inc.
See <http://www.xmlrpc.com> for more information about the XML-RPC
specification.
COPYRIGHT
Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
AUTHOR
Paul Kulchenko (paulclinger@yahoo.com)
# ======================================================================
#
# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com)
# SOAP::Lite is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# $Id$
#
# ======================================================================
package Apache::XMLRPC::Lite;
use strict;
use vars qw(@ISA $VERSION);
use XMLRPC::Transport::HTTP;
@ISA = qw(XMLRPC::Transport::HTTP::Apache);
our $VERSION = 0.717;
my $server = __PACKAGE__->new;
sub server {
return $server;
}
sub handler {
$server->configure(@_);
$server->SUPER::handler(@_);
}
# ======================================================================
1;
__END__
=head1 NAME
Apache::XMLRPC::Lite - mod_perl-based XML-RPC server with minimum configuration
=head1 SYNOPSIS
=over 4
=item httpd.conf (Location), directory-based access
<Location /mod_xmlrpc>
SetHandler perl-script
PerlHandler Apache::XMLRPC::Lite
PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
PerlSetVar options "compress_threshold => 10000"
</Location>
=item httpd.conf (Files), file-based access
<FilesMatch "\.xmlrpc$">
SetHandler perl-script
PerlHandler Apache::XMLRPC::Lite
PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
PerlSetVar options "compress_threshold => 10000"
</FilesMatch>
=item .htaccess, directory-based access
SetHandler perl-script
PerlHandler Apache::XMLRPC::Lite
PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
PerlSetVar options "compress_threshold => 10000"
=back
=head1 DESCRIPTION
This Apache Perl module provides the ability to add support for XML-RPC
protocol with easy configuration (either in .conf or in .htaccess file).
This functionality should give you lightweight option
for hosting SOAP services and greatly simplify configuration aspects. This
module inherites functionality from XMLRPC::Transport::HTTP::Apache component
of XMLRPC::Lite module.
=head1 CONFIGURATION
The module can be placed in <Location>, <Directory>, <Files>, <FilesMatch>
directives in main server configuration areas or directly in .htaccess file.
All parameters should be quoted and can be separated with commas or spaces
for lists ("a, b, c") and with 'wide arrows' and commas for hash parameters
("key1 => value1, key2 => value2").
All options that you can find in XMLRPC::Transport::HTTP::Apache component
are available for configuration. Here is the description of most important
ones.
=over 4
=item dispatch_to (LIST)
Specifies path to directory that contains Perl modules you'd like to give
access to, or just list of modules (for preloaded modules).
PerlSetVar dispatch_to "/Your/Path/To/Deployed/Modules, Module::Name, Module::method"
=item options (HASH)
Specifies list of options for your module, for example threshold for
compression. Future versions will support more options. See
XMLRPC::Transport::HTTP documentation for other options.
PerlSetVar options "compress_threshold => 10000"
=back
=head1 METHODS/SUBROUTINES
=head2 server
my $server = Apache::XMLRPC::Lite->server();
Returns the server object.
Useful if you need to manipulate the server object from your code.
=head2 handle
Request handler. Called by apache.
=head1 DEPENDENCIES
XMLRPC::Lite
mod_perl
=head1 SEE ALSO
XMLRPC::Transport::HTTP::Apache for implementation details,
XMLRPC::Lite for general information, and
F<examples/server/mod_xmlrpc.htaccess> for .htaccess example
=head1 COPYRIGHT
Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 AUTHOR
Paul Kulchenko (paulclinger@yahoo.com)
=cut
# ======================================================================
#
# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com)
# SOAP::Lite is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# $Id$
#
# ======================================================================
package XMLRPC::Lite;
use SOAP::Lite;
use strict;
our $VERSION = 0.717;
# ======================================================================
package XMLRPC::Constants;
BEGIN {
no strict 'refs';
for (qw(
FAULT_CLIENT FAULT_SERVER
HTTP_ON_SUCCESS_CODE HTTP_ON_FAULT_CODE
DO_NOT_USE_XML_PARSER DO_NOT_USE_CHARSET
DO_NOT_USE_LWP_LENGTH_HACK DO_NOT_CHECK_CONTENT_TYPE
)) {
*$_ = \${'SOAP::Constants::' . $_}
}
# XML-RPC spec requires content-type to be "text/xml"
$XMLRPC::Constants::DO_NOT_USE_CHARSET = 1;
}
# ======================================================================
package XMLRPC::Data;
@XMLRPC::Data::ISA = qw(SOAP::Data);
# ======================================================================
package XMLRPC::Serializer;
@XMLRPC::Serializer::ISA = qw(SOAP::Serializer);
sub new {
my $class = shift;
return $class if ref $class;
return $class->SUPER::new(
typelookup => {
base64 => [10, sub {$_[0] =~ /[^\x09\x0a\x0d\x20-\x7f]/}, 'as_base64'],
int => [20, sub {$_[0] =~ /^[+-]?\d+$/}, 'as_int'],
double => [30, sub {$_[0] =~ /^(-?(?:\d+(?:\.\d*)?|\.\d+)|([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)$/}, 'as_double'],
dateTime => [35, sub {$_[0] =~ /^\d{8}T\d\d:\d\d:\d\d$/}, 'as_dateTime'],
string => [40, sub {1}, 'as_string'],
},
attr => {},
namespaces => {},
@_,
);
}
sub envelope {
my $self = shift;
$self = $self->new() if not ref $self; # serves a method call if object
my $type = shift;
my $body;
if ($type eq 'response') {
# shift off method name to make XMLRPT happy
my $method = shift
or die "Unspecified method for XMLRPC call\n";
$body = XMLRPC::Data->name( methodResponse => \XMLRPC::Data->value(
XMLRPC::Data->type(params => [@_])
)
);
}
elsif ($type eq 'method') {
# shift off method name to make XMLRPT happy
my $method = shift
or die "Unspecified method for XMLRPC call\n";
$body = XMLRPC::Data->name( methodCall => \XMLRPC::Data->value(
XMLRPC::Data->type(
methodName => UNIVERSAL::isa($method => 'XMLRPC::Data')
? $method->name
: $method
),
XMLRPC::Data->type(params => [@_])
));
}
elsif ($type eq 'fault') {
$body = XMLRPC::Data->name(methodResponse =>
\XMLRPC::Data->type(fault => {faultCode => $_[0], faultString => $_[1]}),
);
}
else {
die "Wrong type of envelope ($type) for XMLRPC call\n";
}
# SOAP::Lite keeps track of objects for XML aliasing and multiref
# encoding.
# Set/reset seen() hashref before/after encode_object avoids a
# memory leak
$self->seen({}); # initialize multiref table
my $envelope = $self->xmlize($self->encode_object($body));
$self->seen({}); # delete multi-ref table - avoids a memory hole...
return $envelope;
}
sub encode_object {
my $self = shift;
my @encoded = $self->SUPER::encode_object(@_);
return $encoded[0]->[0] =~ /^(?:array|struct|i4|int|boolean|string|double|dateTime\.iso8601|base64)$/o
? ['value', {}, [@encoded]]
: @encoded;
}
sub encode_scalar {
my $self = shift;
return ['value', {}] unless defined $_[0];
return $self->SUPER::encode_scalar(@_);
}
sub encode_array {
my ($self, $array) = @_;
return ['array', {}, [
['data', {}, [ map {$self->encode_object($_)} @{ $array } ] ]
]];
}
sub encode_hash {
my ($self, $hash) = @_;
return ['struct', {}, [
map {
['member', {}, [['name', {}, SOAP::Utils::encode_data($_)], $self->encode_object($hash->{$_})]]
} keys %{ $hash }
]];
}
sub as_methodName {
my ($self, $value, $name, $type, $attr) = @_;
return [ 'methodName', $attr, $value ];
}
sub as_params {
my ($self, $params, $name, $type, $attr) = @_;
return ['params', $attr, [
map {
['param', {}, [ $self->encode_object($_) ] ]
} @$params
]];
}
sub as_fault {
my ($self, $fault) = @_;
return ['fault', {}, [ $self->encode_object($fault) ] ];
}
sub BEGIN {
no strict 'refs';
for my $type (qw(double i4 int)) {
my $method = 'as_' . $type;
*$method = sub {
my($self, $value) = @_;
return [ $type, {}, $value ];
}
}
}
sub as_base64 {
my ($self, $value) = @_;
require MIME::Base64;
return ['base64', {}, MIME::Base64::encode_base64($value,'')];
}
sub as_string {
my ($self, $value) = @_;
return ['string', {}, SOAP::Utils::encode_data($value)];
}
sub as_dateTime {
my ($self, $value) = @_;
return ['dateTime.iso8601', {}, $value];
}
sub as_boolean {
my ($self, $value) = @_;
return ['boolean', {}, $value ? 1 : 0];
}
sub typecast {
my ($self, $value, $name, $type, $attr) = @_;
die "Wrong/unsupported datatype '$type' specified\n" if defined $type;
$self->SUPER::typecast(@_);
}
# ======================================================================
package XMLRPC::SOM;
@XMLRPC::SOM::ISA = qw(SOAP::SOM);
sub BEGIN {
no strict 'refs';
my %path = (
root => '/',
envelope => '/[1]',
method => '/methodCall/methodName',
fault => '/methodResponse/fault',
);
for my $method (keys %path) {
*$method = sub {
my $self = shift;
ref $self or return $path{$method};
Carp::croak "Method '$method' is readonly and doesn't accept any parameters" if @_;
$self->valueof($path{$method});
};
}
my %fault = (
faultcode => 'faultCode',
faultstring => 'faultString',
);
for my $method (keys %fault) {
*$method = sub {
my $self = shift;
ref $self or Carp::croak "Method '$method' doesn't have shortcut";
Carp::croak "Method '$method' is readonly and doesn't accept any parameters" if @_;
defined $self->fault ? $self->fault->{$fault{$method}} : undef;
};
}
my %results = (
result => '/methodResponse/params/[1]',
paramsin => '/methodCall/params/param',
paramsall => '/methodResponse/params/param',
);
for my $method (keys %results) {
*$method = sub {
my $self = shift;
ref $self or return $results{$method};
Carp::croak "Method '$method' is readonly and doesn't accept any parameters" if @_;
defined $self->fault()
? undef
: $self->valueof($results{$method});
};
}
}
# ======================================================================
package XMLRPC::Deserializer;
@XMLRPC::Deserializer::ISA = qw(SOAP::Deserializer);
BEGIN {
no strict 'refs';
for my $method (qw(o_child o_qname o_chars)) { # import from SOAP::Utils
*$method = \&{'SOAP::Utils::'.$method};
}
}
sub deserialize {
# just deserialize with SOAP::Lite's deserializer, and re-bless as
# XMLRPC::SOM
bless shift->SUPER::deserialize(@_) => 'XMLRPC::SOM';
}
sub decode_value {
my $self = shift;
my $ref = shift;
my($name, $attrs, $children, $value) = @$ref;
if ($name eq 'value') {
$children ? scalar(($self->decode_object($children->[0]))[1]) : $value;
}
elsif ($name eq 'array') {
return [map {scalar(($self->decode_object($_))[1])} @{o_child($children->[0]) || []}];
}
elsif ($name eq 'struct') {
return {
map {
my %hash = map { o_qname($_) => $_ } @{o_child($_) || []};
# v----- scalar is required here, because 5.005 evaluates 'undef' in list context as empty array
(o_chars($hash{name}) => scalar(($self->decode_object($hash{value}))[1]));
} @{$children || []}};
}
elsif ($name eq 'base64') {
require MIME::Base64;
MIME::Base64::decode_base64($value);
}
elsif ($name =~ /^(?:int|i4|boolean|string|double|dateTime\.iso8601|methodName)$/) {
return $value;
}
elsif ($name =~ /^(?:params)$/) {
return [map {scalar(($self->decode_object($_))[1])} @{$children || []}];
}
elsif ($name =~ /^(?:methodResponse|methodCall)$/) {
return +{map {$self->decode_object($_)} @{$children || []}};
}
elsif ($name =~ /^(?:param|fault)$/) {
return scalar(($self->decode_object($children->[0]))[1]);
}
elsif ($name =~ /^(?:nil)$/) {
return undef;
}
else {
die "wrong element '$name'\n";
}
}
# ======================================================================
package XMLRPC::Server;
@XMLRPC::Server::ISA = qw(SOAP::Server);
sub initialize {
return (
deserializer => XMLRPC::Deserializer->new,
serializer => XMLRPC::Serializer->new,
on_action => sub {},
on_dispatch => sub { return map {s!\.!/!g; $_} shift->method =~ /^(?:(.*)\.)?(\w+)$/ },
);
}
# ======================================================================
package XMLRPC::Server::Parameters;
@XMLRPC::Server::Parameters::ISA = qw(SOAP::Server::Parameters);
# ======================================================================
package XMLRPC;
@XMLRPC::ISA = qw(SOAP);
# ======================================================================
package XMLRPC::Lite;
@XMLRPC::Lite::ISA = qw(SOAP::Lite);
sub new {
my $class = shift;
return $class if ref $class;
return $class->SUPER::new(
serializer => XMLRPC::Serializer->new,
deserializer => XMLRPC::Deserializer->new,
on_action => sub {return},
default_ns => 'http://unspecified/',
@_
);
}
# ======================================================================
1;
__END__
=head1 NAME
XMLRPC::Lite - client and server implementation of XML-RPC protocol
=head1 SYNOPSIS
=over 4
=item Client
use XMLRPC::Lite;
print XMLRPC::Lite
-> proxy('http://betty.userland.com/RPC2')
-> call('examples.getStateStruct', {state1 => 12, state2 => 28})
-> result;
=item CGI server
use XMLRPC::Transport::HTTP;
my $server = XMLRPC::Transport::HTTP::CGI
-> dispatch_to('methodName')
-> handle
;
=item Daemon server
use XMLRPC::Transport::HTTP;
my $daemon = XMLRPC::Transport::HTTP::Daemon
-> new (LocalPort => 80)
-> dispatch_to('methodName')
;
print "Contact to XMLRPC server at ", $daemon->url, "\n";
$daemon->handle;
=back
=head1 DESCRIPTION
XMLRPC::Lite is a Perl modules which provides a simple nterface to the
XML-RPC protocol both on client and server side. Based on SOAP::Lite module,
it gives you access to all features and transports available in that module.
See F<t/26-xmlrpc.t> for client examples and F<examples/XMLRPC/*> for server
implementations.
=head1 DEPENDENCIES
SOAP::Lite
=head1 SEE ALSO
SOAP::Lite
=head1 CREDITS
The B<XML-RPC> standard is Copyright (c) 1998-2001, UserLand Software, Inc.
See <http://www.xmlrpc.com> for more information about the B<XML-RPC>
specification.
=head1 COPYRIGHT
Copyright (C) 2000-2001 Paul Kulchenko. All rights reserved.