/usr/share/perl5/Frontier/Client.pm is in libfrontier-rpc-perl 0.07b4-6.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 | #
# Copyright (C) 1998 Ken MacLeod
# Frontier::Client is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# $Id: Client.pm,v 1.8 2001/10/03 01:30:54 kmacleod Exp $
#
# NOTE: see Net::pRPC for a Perl RPC implementation
use strict;
package Frontier::Client;
use Frontier::RPC2;
use LWP::UserAgent;
use HTTP::Request;
use vars qw{$AUTOLOAD};
sub new {
my $class = shift;
my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
bless $self, $class;
die "Frontier::RPC::new: no url defined\n"
if !defined $self->{'url'};
$self->{'ua'} = LWP::UserAgent->new;
$self->{'ua'}->proxy('http', $self->{'proxy'})
if(defined $self->{'proxy'});
$self->{'rq'} = HTTP::Request->new (POST => $self->{'url'});
$self->{'rq'}->header('Content-Type' => 'text/xml');
my @options;
if(defined $self->{'encoding'}) {
push @options, 'encoding' => $self->{'encoding'};
}
if (defined $self->{'use_objects'} && $self->{'use_objects'}) {
push @options, 'use_objects' => $self->{'use_objects'};
}
$self->{'enc'} = Frontier::RPC2->new(@options);
return $self;
}
sub call {
my $self = shift;
my $text = $self->{'enc'}->encode_call(@_);
if ($self->{'debug'}) {
print "---- request ----\n";
print $text;
}
$self->{'rq'}->content($text);
my $response = $self->{'ua'}->request($self->{'rq'});
if (!$response->is_success) {
die $response->status_line . "\n";
}
my $content = $response->content;
if ($self->{'debug'}) {
print "---- response ----\n";
print $content;
}
my $result = $self->{'enc'}->decode($content);
if ($result->{'type'} eq 'fault') {
die "Fault returned from XML RPC Server, fault code " . $result->{'value'}[0]{'faultCode'} . ": "
. $result->{'value'}[0]{'faultString'} . "\n";
}
return $result->{'value'}[0];
}
# shortcuts
sub base64 {
my $self = shift;
return Frontier::RPC2::Base64->new(@_);
}
sub boolean {
my $self = shift;
return Frontier::RPC2::Boolean->new(@_);
}
sub double {
my $self = shift;
return Frontier::RPC2::Double->new(@_);
}
sub int {
my $self = shift;
return Frontier::RPC2::Integer->new(@_);
}
sub string {
my $self = shift;
return Frontier::RPC2::String->new(@_);
}
sub date_time {
my $self = shift;
return Frontier::RPC2::DateTime::ISO8601->new(@_);
}
# something like this could be used to get an effect of
#
# $server->examples_getStateName(41)
#
# instead of
#
# $server->call('examples.getStateName', 41)
#
# for Frontier's
#
# [server].examples.getStateName 41
#
# sub AUTOLOAD {
# my ($pkg, $method) = ($AUTOLOAD =~ m/^(.*::)(.*)$/);
# return if $method eq 'DESTROY';
#
# $method =~ s/__/=/g;
# $method =~ tr/_=/._/;
#
# splice(@_, 1, 0, $method);
#
# goto &call;
# }
=head1 NAME
Frontier::Client - issue Frontier XML RPC requests to a server
=head1 SYNOPSIS
use Frontier::Client;
$server = Frontier::Client->new( I<OPTIONS> );
$result = $server->call($method, @args);
$boolean = $server->boolean($value);
$date_time = $server->date_time($value);
$base64 = $server->base64($value);
$value = $boolean->value;
$value = $date_time->value;
$value = $base64->value;
=head1 DESCRIPTION
I<Frontier::Client> is an XML-RPC client over HTTP.
I<Frontier::Client> instances are used to make calls to XML-RPC
servers and as shortcuts for creating XML-RPC special data types.
=head1 METHODS
=over 4
=item new( I<OPTIONS> )
Returns a new instance of I<Frontier::Client> and associates it with
an XML-RPC server at a URL. I<OPTIONS> may be a list of key, value
pairs or a hash containing the following parameters:
=over 4
=item url
The URL of the server. This parameter is required. For example:
$server = Frontier::Client->new( 'url' => 'http://betty.userland.com/RPC2' );
=item proxy
A URL of a proxy to forward XML-RPC calls through.
=item encoding
The XML encoding to be specified in the XML declaration of outgoing
RPC requests. Incoming results may have a different encoding
specified; XML::Parser will convert incoming data to UTF-8. The
default outgoing encoding is none, which uses XML 1.0's default of
UTF-8. For example:
$server = Frontier::Client->new( 'url' => 'http://betty.userland.com/RPC2',
'encoding' => 'ISO-8859-1' );
=item use_objects
If set to a non-zero value will convert incoming E<lt>i4E<gt>,
E<lt>floatE<gt>, and E<lt>stringE<gt> values to objects instead of
scalars. See int(), float(), and string() below for more details.
=item debug
If set to a non-zero value will print the encoded XML request and the
XML response received.
=back
=item call($method, @args)
Forward a procedure call to the server, either returning the value
returned by the procedure or failing with exception. `C<$method>' is
the name of the server method, and `C<@args>' is a list of arguments
to pass. Arguments may be Perl hashes, arrays, scalar values, or the
XML-RPC special data types below.
=item boolean( $value )
=item date_time( $value )
=item base64( $base64 )
The methods `C<boolean()>', `C<date_time()>', and `C<base64()>' create
and return XML-RPC-specific datatypes that can be passed to
`C<call()>'. Results from servers may also contain these datatypes.
The corresponding package names (for use with `C<ref()>', for example)
are `C<Frontier::RPC2::Boolean>',
`C<Frontier::RPC2::DateTime::ISO8601>', and
`C<Frontier::RPC2::Base64>'.
The value of boolean, date/time, and base64 data can be set or
returned using the `C<value()>' method. For example:
# To set a value:
$a_boolean->value(1);
# To retrieve a value
$base64 = $base64_xml_rpc_data->value();
Note: `C<base64()>' does I<not> encode or decode base64 data for you,
you must use MIME::Base64 or similar module for that.
=item int( 42 );
=item float( 3.14159 );
=item string( "Foo" );
By default, you may pass ordinary Perl values (scalars) to be encoded.
RPC2 automatically converts them to XML-RPC types if they look like an
integer, float, or as a string. This assumption causes problems when
you want to pass a string that looks like "0096", RPC2 will convert
that to an E<lt>i4E<gt> because it looks like an integer. With these
methods, you could now create a string object like this:
$part_num = $server->string("0096");
and be confident that it will be passed as an XML-RPC string. You can
change and retrieve values from objects using value() as described
above.
=back
=head1 SEE ALSO
perl(1), Frontier::RPC2(3)
<http://www.scripting.com/frontier5/xml/code/rpc.html>
=head1 AUTHOR
Ken MacLeod <ken@bitsko.slc.ut.us>
=cut
1;
|