1package Pod::WSDL::Method;
2
3use strict;
4use warnings;
5use Pod::WSDL::Param;
6use Pod::WSDL::Fault;
7use Pod::WSDL::Return;
8use Pod::WSDL::Doc;
9use Pod::WSDL::Writer;
10use Pod::WSDL::Utils qw(:writexml :namespaces :messages);
11use Pod::WSDL::AUTOLOAD;
12
13our $VERSION = "0.05";
14our @ISA = qw/Pod::WSDL::AUTOLOAD/;
15
16our $EMPTY_MESSAGE_NAME    = 'empty';
17our $REQUEST_SUFFIX_NAME   = 'Request';
18our $RESPONSE_SUFFIX_NAME  = 'Response';
19our $RETURN_SUFFIX_NAME    = 'Return';
20our $TARGET_NS_DECL        = 'tns1';
21
22our %FORBIDDEN_METHODS = (
23	name     => {get => 1, set =>  0},
24	params   => {get => 1, set =>  0},
25	doc      => {get => 1, set =>  1},
26	return   => {get => 1, set =>  1},
27	faults   => {get => 1, set =>  0},
28	oneway   => {get => 1, set =>  1},
29	writer   => {get => 0, set =>  0},
30);
31
32sub new {
33	my ($pkg, %data) = @_;
34
35	die "A method needs a name, died"   unless defined $data{name};
36	die "A method needs a writer, died" unless defined $data{writer} and ref $data{writer} eq 'Pod::WSDL::Writer';
37
38	bless {
39		_name                => $data{name},
40		_params              => $data{params} || [],
41		_return              => $data{return},
42		_doc                 => $data{doc} || new Pod::WSDL::Doc('_DOC'),
43		_faults              => $data{faults} || [],
44		_oneway              => $data{oneWay} || 0,
45		_writer              => $data{writer},
46		_emptyMessageWritten => 0,
47	}, $pkg;
48}
49
50sub addParam {
51	push @{$_[0]->{_params}}, $_[1] if defined $_[1];
52}
53
54sub addFault {
55	push @{$_[0]->{_faults}}, $_[1] if defined $_[1];
56}
57
58sub requestName {
59	return $_[0]->name . $REQUEST_SUFFIX_NAME;
60}
61
62sub responseName {
63	return $_[0]->name . $RESPONSE_SUFFIX_NAME;
64}
65
66sub writeMessages {
67	my $me      = shift;
68	my $types   = shift;
69	my $style   = shift;
70	my $wrapped = shift;
71
72	$me->_writeMessageRequestElem($types, $style, $wrapped);
73	$me->writer->wrNewLine;
74
75	unless ($me->oneway) {
76		if ($me->return) {
77			$me->_writeMessageResponseElem($types, $style, $wrapped);
78			$me->writer->wrNewLine;
79		} else {
80			unless ($me->writer->emptyMessageWritten) {
81				$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:message', name => $EMPTY_MESSAGE_NAME);
82				$me->writer->registerWrittenEmptyMessage;
83				$me->writer->wrNewLine;
84			}
85		}
86	}
87
88	for my $fault (@{$me->faults}) {
89		next if $me->writer->faultMessageWritten($fault->wsdlName);
90
91		$me->_writeMessageFaultElem($fault->wsdlName, $style, $wrapped);
92		$me->writer->registerWrittenFaultMessage($fault->wsdlName);
93		$me->writer->wrNewLine;
94	}
95}
96
97sub writePortTypeOperation {
98	my $me = shift;
99
100	my $name = $me->name;
101	my $paramOrder = '';
102
103	for my $param (@{$me->params}) {
104		$paramOrder .= $param->name . ' ';
105	}
106
107	$paramOrder =~ s/\s+$//;
108
109	my $inputName  = $name . $REQUEST_SUFFIX_NAME;
110	my $outputName = $name . $RESPONSE_SUFFIX_NAME;
111
112    # maintain param order, name always first
113    # if no params, don't send and element with that name
114    my @p_order = $paramOrder ? ('parameterOrder', $paramOrder) : () ;
115
116    $me->writer->wrElem($START_PREFIX_NAME, 'wsdl:operation', name => $name, @p_order);
117	$me->writer->wrDoc($me->doc->descr);
118	$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:input', message => "$IMPL_NS_DECL:$inputName", name => $inputName);
119
120	# if method has no return, we treat it as one-way operation
121	unless ($me->oneway) {
122		if ($me->return) {
123			$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:output', message => "$IMPL_NS_DECL:$outputName", name => $outputName);
124		} else {
125			$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:output', message => "$IMPL_NS_DECL:$EMPTY_MESSAGE_NAME");
126		}
127	}
128
129	my $elemType;
130
131	# write methods faults
132	for my $fault (@{$me->faults}) {
133
134		# if we want documentation and have some documentation ...
135		if ($fault->descr and $me->writer->withDocumentation) {
136			$elemType = $START_PREFIX_NAME;
137		} else {
138			$elemType = $EMPTY_PREFIX_NAME;
139		}
140
141		$me->writer->wrElem($elemType, "wsdl:fault", message => "$IMPL_NS_DECL:" . $fault->wsdlName, name => $fault->wsdlName);
142
143		# only, if with documentation
144		if ($elemType eq $START_PREFIX_NAME) {
145			$me->writer->wrDoc($fault->descr);
146			$me->writer->wrElem($END_PREFIX_NAME, "wsdl:fault");
147		}
148	}
149
150	$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:operation');
151}
152
153sub _writeMessageRequestElem {
154	my $me      = shift;
155	my $types   = shift;
156	my $style   = shift;
157	my $wrapped = shift;
158
159	$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:message', name => $me->requestName);
160
161	if ($wrapped) {
162		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', name => 'parameters', element => $me->requestName);
163	} else {
164		for my $param (@{$me->params}) {
165			$me->_writePartElem($param->name, $param->type, $param->array, $param->descr, $style, 0, $types->{$param->type}) if $param->paramType =~ /^(INOUT|OUT|IN)$/;
166		}
167	}
168
169	$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:message');
170}
171
172sub _writeMessageResponseElem {
173	my $me      = shift;
174	my $types   = shift;
175	my $style   = shift;
176	my $wrapped = shift;
177
178	$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:message', name => $me->responseName);
179
180	if ($wrapped) {
181		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', name => 'parameters', element => $me->responseName);
182	} else {
183		for my $param (@{$me->params}) {
184			$me->_writePartElem($param->name, $param->type, $param->array, $param->descr, $style, 0, $types->{$param->type}) if $param->paramType =~ /^(INOUT|OUT)?$/;
185		}
186
187		if (defined $me->return) {
188			$me->_writePartElem($me->name . $RETURN_SUFFIX_NAME, $me->return->type, $me->return->array, $me->return->descr, $style, 1, $types->{$me->return->type});
189		}
190	}
191
192	$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:message');
193}
194
195sub _writeMessageFaultElem {
196	my $me      = shift;
197	my $name    = shift;
198	my $style   = shift;
199	my $wrapped = shift;
200
201	my %attrs = (name => $FAULT_NAME);
202
203	if ($style eq $RPC_STYLE) {
204		$attrs{type} = "$TARGET_NS_DECL:$name";
205	} elsif ($style eq $DOCUMENT_STYLE) {
206		$attrs{element} = $name . $MESSAGE_PART;
207	}
208
209	$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:message', name => $name);
210	$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', %attrs);
211	$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:message');
212}
213
214sub _writePartElem {
215	my $me       = shift;
216	my $name     = shift;
217	my $type     = shift;
218	my $array    = shift;
219	my $descr    = shift;
220	my $style    = shift;
221	my $isReturn = shift;
222	my $ownType  = shift;
223
224	my %attrs = (name => $name);
225
226	if ($style eq $RPC_STYLE) {
227		$attrs{type} = Pod::WSDL::Utils::getTypeDescr($type, $array, $ownType);
228	} elsif ($style eq $DOCUMENT_STYLE) {
229		$attrs{element} = ($isReturn ? lcfirst $RETURN_SUFFIX_NAME : $name) . $PART_IN . ucfirst $me->requestName
230	}
231
232	if ($descr and $me->writer->withDocumentation) {
233		$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:part', %attrs);
234		$me->writer->wrDoc($descr);
235		$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:part');
236
237	} else {
238		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', %attrs);
239	}
240}
241
242sub writeBindingOperation {
243	my $me       = shift;
244	my $location = shift;
245	my $use      = shift;
246
247	$me->writer->wrElem($START_PREFIX_NAME, "wsdl:operation", name => $me->name);
248	$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:operation", soapAction => "");
249	$me->writer->wrElem($START_PREFIX_NAME, "wsdl:input", name => $me->requestName);
250	$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:body", encodingStyle => "http://schemas.xmlsoap.org/soap/encoding/", namespace => $location, use => $use);
251	$me->writer->wrElem($END_PREFIX_NAME, "wsdl:input");
252
253	unless ($me->oneway) {
254		$me->writer->wrElem($START_PREFIX_NAME, "wsdl:output", name => $me->return ? $me->responseName : $EMPTY_MESSAGE_NAME);
255		$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:body", encodingStyle => "http://schemas.xmlsoap.org/soap/encoding/", namespace => $location, use => $use);
256		$me->writer->wrElem($END_PREFIX_NAME, "wsdl:output");
257	}
258
259	for my $fault (@{$me->faults}) {
260		$me->writer->wrElem($START_PREFIX_NAME, "wsdl:fault", name => $fault->wsdlName);
261		$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:fault", name => $fault->wsdlName, encodingStyle => "http://schemas.xmlsoap.org/soap/encoding/", namespace => $location, use => $use);
262		$me->writer->wrElem($END_PREFIX_NAME, "wsdl:fault");
263	}
264
265	$me->writer->wrElem($END_PREFIX_NAME, "wsdl:operation");
266}
267
268sub writeDocumentStyleSchemaElements {
269	my $me    = shift;
270	my $types = shift;
271
272	for my $param (@{$me->params}) {
273		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'element',
274			name => $param->name . $PART_IN . ucfirst $me->requestName,
275			type => Pod::WSDL::Utils::getTypeDescr($param->type, $param->array, $types->{$param->type}));
276	}
277
278	for my $fault (@{$me->faults}) {
279		next if $me->writer->faultMessageWritten($fault->wsdlName . $MESSAGE_PART);
280
281		$me->writer->registerWrittenFaultMessage($fault->wsdlName . $MESSAGE_PART);
282
283		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'element',
284			name => $fault->wsdlName . $MESSAGE_PART,
285			type => Pod::WSDL::Utils::getTypeDescr($fault->type, 0, $types->{$fault->type}));
286	}
287
288	if (!$me->oneway and $me->return) {
289		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'element',
290			name => lcfirst $RETURN_SUFFIX_NAME . $PART_IN . ucfirst $me->requestName,
291			type => Pod::WSDL::Utils::getTypeDescr($me->return->type, $me->return->array, $types->{$me->return->type}));
292	}
293}
2941;
295__END__
296
297=head1 NAME
298
299Pod::WSDL::Method - Represents a method in Pod::WSDL (internal use only)
300
301=head1 SYNOPSIS
302
303  use Pod::WSDL::Method;
304  my $m = new Pod::WSDL::Method(name => 'mySub', writer => 'myWriter', doc => new Pod::WSDL::Doc($docStr), return => new Pod::WSDL::Return($retStr));
305
306=head1 DESCRIPTION
307
308This module is used internally by Pod::WSDL. It is unlikely that you have to interact directly with it. If that is the case, take a look at the code, it is rather simple.
309
310=head1 METHODS
311
312=head2 new
313
314Instantiates a new Pod::WSDL::Method.
315
316=head2 Parameters
317
318=over 4
319
320=item
321
322name - name of the method, mandatory
323
324=item
325
326doc - a Pod::WSDL::Doc object, can be ommitted, use method doc later
327
328=item
329
330return - a Pod::WSDL::Return object, can be ommitted, use method return later
331
332=item
333
334params - ref to array of Pod::WSDL::Param objects, can be ommitted, use addParam() later
335
336=item
337
338faults - ref to array of Pod::WSDL::Fault objects, can be ommitted, use addFault() later
339
340=item
341
342oneway - if true, method is a one way operation
343
344=item
345
346writer - XML::Writer-Object for output, mandatory
347
348=back
349
350=head2 addParam
351
352Add a Pod::WSDL::Param object to Pod::WSDL::Method
353
354=head2 addFault
355
356Add a Pod::WSDL::Fault object to Pod::WSDL::Method
357
358=head2 return
359
360Get or Set the Pod::WSDL::Return object for Pod::WSDL::Method
361
362=head2 doc
363
364Get or Set the Pod::WSDL::Doc object for Pod::WSDL::Method
365
366=head2 requestName
367
368Get name for request in XML output
369
370=head2 responseName
371
372Get name for response in XML output
373
374=head2 writeBindingOperation
375
376Write operation child for binding element in XML output
377
378=head2 writeMessages
379
380Write message elements in XML output
381
382=head2 writePortTypeOperation
383
384Write operation child for porttype element in XML output
385
386=head1 EXTERNAL DEPENDENCIES
387
388  [none]
389
390=head1 EXAMPLES
391
392see Pod::WSDL
393
394=head1 BUGS
395
396see Pod::WSDL
397
398=head1 TODO
399
400see Pod::WSDL
401
402=head1 SEE ALSO
403
404  Pod::WSDL :-)
405
406=head1 AUTHOR
407
408Tarek Ahmed, E<lt>bloerch -the character every email address contains- oelbsk.orgE<gt>
409
410=head1 COPYRIGHT AND LICENSE
411
412Copyright (C) 2006 by Tarek Ahmed
413
414This library is free software; you can redistribute it and/or modify
415it under the same terms as Perl itself, either Perl version 5.8.5 or,
416at your option, any later version of Perl 5 you may have available.
417
418=cut
419