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
This diff is collapsed.
# ======================================================================
#
# 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::Test;
use 5.004;
use vars qw($VERSION $TIMEOUT);
our $VERSION = 0.717;
$TIMEOUT = 5;
# ======================================================================
package My::PingPong; # we'll use this package in our tests
sub new {
my $self = shift;
my $class = ref($self) || $self;
bless {_num=>shift} => $class;
}
sub next {
my $self = shift;
$self->{_num}++;
}
sub value {
my $self = shift;
$self->{_num};
}
# ======================================================================
package XMLRPC::Test::Server;
use strict;
use Test;
use XMLRPC::Lite;
sub run_for {
my $proxy = shift or die "Proxy/endpoint is not specified";
# ------------------------------------------------------
my $s = XMLRPC::Lite->proxy($proxy)->on_fault(sub{});
eval { $s->transport->timeout($XMLRPC::Test::TIMEOUT) };
my $r = $s->test_connection;
unless (defined $r && defined $r->envelope) {
print "1..0 # Skip: ", $s->transport->status, "\n";
exit;
}
# ------------------------------------------------------
plan tests => 17;
eval q!use XMLRPC::Lite on_fault => sub{ref $_[1] ? $_[1] : new XMLRPC::SOM}; 1! or die;
print "Perl XMLRPC server test(s)...\n";
$s = XMLRPC::Lite
-> proxy($proxy)
;
ok($s->call('My.Examples.getStateName', 1)->result eq 'Alabama');
ok($s->call('My.Examples.getStateNames', 1,4,6,13)->result =~ /^Alabama\s+Arkansas\s+Colorado\s+Illinois\s*$/);
$r = $s->call('My.Examples.getStateList', [1,2,3,4])->result;
ok(ref $r && $r->[0] eq 'Alabama');
$r = $s->call('My.Examples.getStateStruct', {item1 => 1, item2 => 4})->result;
ok(ref $r && $r->{item2} eq 'Arkansas');
print "dispatch_from test(s)...\n";
eval "use XMLRPC::Lite
dispatch_from => ['A', 'B'],
proxy => '$proxy',
; 1" or die;
eval { C->c };
ok($@ =~ /Can't locate object method "c"/);
print "Object autobinding and XMLRPC:: prefix test(s)...\n";
eval "use XMLRPC::Lite +autodispatch =>
proxy => '$proxy'; 1" or die;
ok(XMLRPC::Lite->autodispatched);
# forget everything
XMLRPC::Lite->self(undef);
{
my $on_fault_was_called = 0;
print "Die in server method test(s)...\n";
my $s = XMLRPC::Lite
-> proxy($proxy)
-> on_fault(sub{$on_fault_was_called++;return})
;
ok($s->call('My.Parameters.die_simply')->faultstring =~ /Something bad/);
ok($on_fault_was_called > 0);
# get Fault as hash of subelements
my $fault = $s->call('My.Parameters.die_with_fault');
ok($fault->faultcode =~ 'Server\.Custom');
ok($fault->faultstring eq 'Died in server method');
}
print "Number of parameters test(s)...\n";
$s = XMLRPC::Lite
-> proxy($proxy)
;
{ my @all = $s->call('My.Parameters.echo')->paramsall; ok(@all == 0) }
{ my @all = $s->call('My.Parameters.echo', 1)->paramsall; ok(@all == 1) }
{ my @all = $s->call('My.Parameters.echo', (1) x 10)->paramsall; ok(@all == 10) }
print "Memory refresh test(s)...\n";
# Funny test.
# Let's forget about ALL settings we did before with 'use XMLRPC::Lite...'
XMLRPC::Lite->self(undef);
ok(!defined XMLRPC::Lite->self);
eval "use XMLRPC::Lite
proxy => '$proxy'; 1" or die;
print "Global settings test(s)...\n";
$s = new XMLRPC::Lite;
ok($s->call('My.Examples.getStateName', 1)->result eq 'Alabama');
SOAP::Trace->import(transport =>
sub {$_[0]->content_type('something/wrong') if UNIVERSAL::isa($_[0] => 'HTTP::Request')}
);
if ($proxy =~ /^tcp:/) {
skip('No Content-Type checks for tcp: protocol on server side' => undef);
} else {
ok($s->call('My.Examples.getStateName', 1)->faultstring =~ /Content-Type must be/);
}
# check status for fault messages
if ($proxy =~ /^http/) {
ok($s->transport->status =~ /^200/);
} else {
skip('No Status checks for non http protocols on server side' => undef);
}
}
# ======================================================================
1;
__END__
=head1 NAME
XMLRPC::Test - Test framework for XMLRPC::Lite
=head1 SYNOPSIS
use XMLRPC::Test;
XMLRPC::Test::Server::run_for('http://localhost/cgi-bin/XMLRPC.cgi');
=head1 DESCRIPTION
XMLRPC::Test provides simple framework for testing server implementations.
Specify your address (endpoint) and run provided tests against your server.
See t/1*.t for examples.
=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::Transport::HTTP;
use strict;
our $VERSION = 0.717;
use XMLRPC::Lite;
use SOAP::Transport::HTTP;
# ======================================================================
package XMLRPC::Transport::HTTP::CGI;
@XMLRPC::Transport::HTTP::CGI::ISA = qw(SOAP::Transport::HTTP::CGI);
sub initialize; *initialize = \&XMLRPC::Server::initialize;
sub make_fault {
local $SOAP::Constants::HTTP_ON_FAULT_CODE = 200;
shift->SUPER::make_fault(@_);
}
sub make_response {
local $SOAP::Constants::DO_NOT_USE_CHARSET = 1;
shift->SUPER::make_response(@_);
}
# ======================================================================
package XMLRPC::Transport::HTTP::Daemon;
@XMLRPC::Transport::HTTP::Daemon::ISA = qw(SOAP::Transport::HTTP::Daemon);
sub initialize; *initialize = \&XMLRPC::Server::initialize;
sub make_fault; *make_fault = \&XMLRPC::Transport::HTTP::CGI::make_fault;
sub make_response; *make_response = \&XMLRPC::Transport::HTTP::CGI::make_response;
# ======================================================================
package XMLRPC::Transport::HTTP::Apache;
@XMLRPC::Transport::HTTP::Apache::ISA = qw(SOAP::Transport::HTTP::Apache);
sub initialize; *initialize = \&XMLRPC::Server::initialize;
sub make_fault; *make_fault = \&XMLRPC::Transport::HTTP::CGI::make_fault;
sub make_response; *make_response = \&XMLRPC::Transport::HTTP::CGI::make_response;
# ======================================================================
1;
__END__
=head1 NAME
XMLRPC::Transport::HTTP - Server/Client side HTTP support for XMLRPC::Lite
=head1 SYNOPSIS
=over 4
=item Client
use XMLRPC::Lite
proxy => 'http://localhost/',
# proxy => 'http://localhost/cgi-bin/xmlrpc.cgi', # local CGI server
# proxy => 'http://localhost/', # local daemon server
# proxy => 'http://login:password@localhost/cgi-bin/xmlrpc.cgi', # local CGI server with authentication
;
print getStateName(1);
=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
This class encapsulates all HTTP related logic for a XMLRPC server,
independent of what web server it's attached to.
If you want to use this class you should follow simple guideline
mentioned above.
=head2 PROXY SETTINGS
You can use any proxy setting you use with LWP::UserAgent modules:
XMLRPC::Lite->proxy('http://endpoint.server/',
proxy => ['http' => 'http://my.proxy.server']);
or
$xmlrpc->transport->proxy('http' => 'http://my.proxy.server');
should specify proxy server for you. And if you use C<HTTP_proxy_user>
and C<HTTP_proxy_pass> for proxy authorization SOAP::Lite should know
how to handle it properly.
=head2 COOKIE-BASED AUTHENTICATION
use HTTP::Cookies;
my $cookies = HTTP::Cookies->new(ignore_discard => 1);
# you may also add 'file' if you want to keep them between sessions
my $xmlrpc = XMLRPC::Lite->proxy('http://localhost/');
$xmlrpc->transport->cookie_jar($cookies);
Cookies will be taken from response and provided for request. You may
always add another cookie (or extract what you need after response)
with HTTP::Cookies interface.
You may also do it in one line:
$xmlrpc->proxy('http://localhost/',
cookie_jar => HTTP::Cookies->new(ignore_discard => 1));
=head2 COMPRESSION
XMLRPC::Lite provides you option for enabling compression on wire (for HTTP
transport only). Both server and client should support this capability,
but this logic should be absolutely transparent for your application.
Server will respond with encoded message only if client can accept it
(client sends Accept-Encoding with 'deflate' or '*' values) and client
has fallback logic, so if server doesn't understand specified encoding
(Content-Encoding: deflate) and returns proper error code
(415 NOT ACCEPTABLE) client will repeat the same request not encoded and
will store this server in per-session cache, so all other requests will
go there without encoding.
Having options on client and server side that let you specify threshold
for compression you can safely enable this feature on both client and
server side.
Compression will be enabled on client side IF: threshold is specified AND
size of current message is bigger than threshold AND module Compress::Zlib
is available. Client will send header 'Accept-Encoding' with value 'deflate'
if threshold is specified AND module Compress::Zlib is available.
Server will accept compressed message if module Compress::Zlib is available,
and will respond with compressed message ONLY IF: threshold is specified AND
size of current message is bigger than threshold AND module Compress::Zlib
is available AND header 'Accept-Encoding' is presented in request.
=head1 DEPENDENCIES
Crypt::SSLeay for HTTPS/SSL
HTTP::Daemon for XMLRPC::Transport::HTTP::Daemon
Apache, Apache::Constants for XMLRPC::Transport::HTTP::Apache
=head1 SEE ALSO
See ::CGI, ::Daemon and ::Apache for implementation details.
See examples/XMLRPC/* for examples.
=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::Transport::POP3;
use strict;
our $VERSION = 0.717;
use XMLRPC::Lite;
use SOAP::Transport::POP3;
# ======================================================================
package XMLRPC::Transport::POP3::Server;
@XMLRPC::Transport::POP3::Server::ISA = qw(SOAP::Transport::POP3::Server);
sub initialize; *initialize = \&XMLRPC::Server::initialize;
# ======================================================================
1;
__END__
=head1 NAME
XMLRPC::Transport::POP3 - Server side POP3 support for XMLRPC::Lite
=head1 SYNOPSIS
use XMLRPC::Transport::POP3;
my $server = XMLRPC::Transport::POP3::Server
-> new('pop://pop.mail.server')
# if you want to have all in one place
# -> new('pop://user:password@pop.mail.server')
# or, if you have server that supports MD5 protected passwords
# -> new('pop://user:password;AUTH=+APOP@pop.mail.server')
# specify path to My/Examples.pm here
-> dispatch_to('/Your/Path/To/Deployed/Modules', 'Module::Name', 'Module::method');
# you don't need to use next line if you specified your password in new()
$server->login('user' => 'password') or die "Can't authenticate to POP3 server\n";
# handle will return number of processed mails
# you can organize loop if you want
do { $server->handle } while sleep 10;
# you may also call $server->quit explicitly to purge deleted messages