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	$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:operation', name => $name, parameterOrder => ($paramOrder ? $paramOrder : ""));
113	$me->writer->wrDoc($me->doc->descr);
114	$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:input', message => "$IMPL_NS_DECL:$inputName", name => $inputName);
115
116	# if method has no return, we treat it as one-way operation
117	unless ($me->oneway) {
118		if ($me->return) {
119			$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:output', message => "$IMPL_NS_DECL:$outputName", name => $outputName);
120		} else {
121			$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:output', message => "$IMPL_NS_DECL:$EMPTY_MESSAGE_NAME");
122		}
123	}
124
125	my $elemType;
126
127	# write methods faults
128	for my $fault (@{$me->faults}) {
129
130		# if we want documentation and have some documentation ...
131		if ($fault->descr and $me->writer->withDocumentation) {
132			$elemType = $START_PREFIX_NAME;
133		} else {
134			$elemType = $EMPTY_PREFIX_NAME;
135		}
136
137		$me->writer->wrElem($elemType, "wsdl:fault", message => "$IMPL_NS_DECL:" . $fault->wsdlName, name => $fault->wsdlName);
138
139		# only, if with documentation
140		if ($elemType eq $START_PREFIX_NAME) {
141			$me->writer->wrDoc($fault->descr);
142			$me->writer->wrElem($END_PREFIX_NAME, "wsdl:fault");
143		}
144	}
145
146	$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:operation');
147}
148
149sub _writeMessageRequestElem {
150	my $me      = shift;
151	my $types   = shift;
152	my $style   = shift;
153	my $wrapped = shift;
154
155	$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:message', name => $me->requestName);
156
157	if ($wrapped) {
158		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', name => 'parameters', element => $me->requestName);
159	} else {
160		for my $param (@{$me->params}) {
161			$me->_writePartElem($param->name, $param->type, $param->array, $param->descr, $style, 0, $types->{$param->type}) if $param->paramType =~ /^(INOUT|OUT|IN)$/;
162		}
163	}
164
165	$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:message');
166}
167
168sub _writeMessageResponseElem {
169	my $me      = shift;
170	my $types   = shift;
171	my $style   = shift;
172	my $wrapped = shift;
173
174	$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:message', name => $me->responseName);
175
176	if ($wrapped) {
177		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', name => 'parameters', element => $me->responseName);
178	} else {
179		for my $param (@{$me->params}) {
180			$me->_writePartElem($param->name, $param->type, $param->array, $param->descr, $style, 0, $types->{$param->type}) if $param->paramType =~ /^(INOUT|OUT)?$/;
181		}
182
183		if (defined $me->return) {
184			$me->_writePartElem($me->name . $RETURN_SUFFIX_NAME, $me->return->type, $me->return->array, $me->return->descr, $style, 1, $types->{$me->return->type});
185		}
186	}
187
188	$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:message');
189}
190
191sub _writeMessageFaultElem {
192	my $me      = shift;
193	my $name    = shift;
194	my $style   = shift;
195	my $wrapped = shift;
196
197	my %attrs = (name => $FAULT_NAME);
198
199	if ($style eq $RPC_STYLE) {
200		$attrs{type} = "$TARGET_NS_DECL:$name";
201	} elsif ($style eq $DOCUMENT_STYLE) {
202		$attrs{element} = $name . $MESSAGE_PART;
203	}
204
205	$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:message', name => $name);
206	$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', %attrs);
207	$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:message');
208}
209
210sub _writePartElem {
211	my $me       = shift;
212	my $name     = shift;
213	my $type     = shift;
214	my $array    = shift;
215	my $descr    = shift;
216	my $style    = shift;
217	my $isReturn = shift;
218	my $ownType  = shift;
219
220	my %attrs = (name => $name);
221
222	if ($style eq $RPC_STYLE) {
223		$attrs{type} = Pod::WSDL::Utils::getTypeDescr($type, $array, $ownType);
224	} elsif ($style eq $DOCUMENT_STYLE) {
225		$attrs{element} = ($isReturn ? lcfirst $RETURN_SUFFIX_NAME : $name) . $PART_IN . ucfirst $me->requestName
226	}
227
228	if ($descr and $me->writer->withDocumentation) {
229		$me->writer->wrElem($START_PREFIX_NAME, 'wsdl:part', %attrs);
230		$me->writer->wrDoc($descr);
231		$me->writer->wrElem($END_PREFIX_NAME, 'wsdl:part');
232
233	} else {
234		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'wsdl:part', %attrs);
235	}
236}
237
238sub writeBindingOperation {
239	my $me       = shift;
240	my $location = shift;
241	my $use      = shift;
242
243	$me->writer->wrElem($START_PREFIX_NAME, "wsdl:operation", name => $me->name);
244	$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:operation", soapAction => "");
245	$me->writer->wrElem($START_PREFIX_NAME, "wsdl:input", name => $me->requestName);
246	$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:body", encodingStyle => "http://schemas.xmlsoap.org/soap/encoding/", namespace => $location, use => $use);
247	$me->writer->wrElem($END_PREFIX_NAME, "wsdl:input");
248
249	unless ($me->oneway) {
250		$me->writer->wrElem($START_PREFIX_NAME, "wsdl:output", name => $me->return ? $me->responseName : $EMPTY_MESSAGE_NAME);
251		$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:body", encodingStyle => "http://schemas.xmlsoap.org/soap/encoding/", namespace => $location, use => $use);
252		$me->writer->wrElem($END_PREFIX_NAME, "wsdl:output");
253	}
254
255	for my $fault (@{$me->faults}) {
256		$me->writer->wrElem($START_PREFIX_NAME, "wsdl:fault", name => $fault->wsdlName);
257		$me->writer->wrElem($EMPTY_PREFIX_NAME, "wsdlsoap:fault", name => $fault->wsdlName, encodingStyle => "http://schemas.xmlsoap.org/soap/encoding/", namespace => $location, use => $use);
258		$me->writer->wrElem($END_PREFIX_NAME, "wsdl:fault");
259	}
260
261	$me->writer->wrElem($END_PREFIX_NAME, "wsdl:operation");
262}
263
264sub writeDocumentStyleSchemaElements {
265	my $me    = shift;
266	my $types = shift;
267
268	for my $param (@{$me->params}) {
269		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'element',
270			name => $param->name . $PART_IN . ucfirst $me->requestName,
271			type => Pod::WSDL::Utils::getTypeDescr($param->type, $param->array, $types->{$param->type}));
272	}
273
274	for my $fault (@{$me->faults}) {
275		next if $me->writer->faultMessageWritten($fault->wsdlName . $MESSAGE_PART);
276
277		$me->writer->registerWrittenFaultMessage($fault->wsdlName . $MESSAGE_PART);
278
279		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'element',
280			name => $fault->wsdlName . $MESSAGE_PART,
281			type => Pod::WSDL::Utils::getTypeDescr($fault->type, 0, $types->{$fault->type}));
282	}
283
284	if (!$me->oneway and $me->return) {
285		$me->writer->wrElem($EMPTY_PREFIX_NAME, 'element',
286			name => lcfirst $RETURN_SUFFIX_NAME . $PART_IN . ucfirst $me->requestName,
287			type => Pod::WSDL::Utils::getTypeDescr($me->return->type, $me->return->array, $types->{$me->return->type}));
288	}
289}
2901;
291__END__
292
293=head1 NAME
294
295Pod::WSDL::Method - Represents a method in Pod::WSDL (internal use only)
296
297=head1 SYNOPSIS
298
299  use Pod::WSDL::Method;
300  my $m = new Pod::WSDL::Method(name => 'mySub', writer => 'myWriter', doc => new Pod::WSDL::Doc($docStr), return => new Pod::WSDL::Return($retStr));
301
302=head1 DESCRIPTION
303
304This 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.
305
306=head1 METHODS
307
308=head2 new
309
310Instantiates a new Pod::WSDL::Method.
311
312=head2 Parameters
313
314=over 4
315
316=item
317
318name - name of the method, mandatory
319
320=item
321
322doc - a Pod::WSDL::Doc object, can be ommitted, use method doc later
323
324=item
325
326return - a Pod::WSDL::Return object, can be ommitted, use method return later
327
328=item
329
330params - ref to array of Pod::WSDL::Param objects, can be ommitted, use addParam() later
331
332=item
333
334faults - ref to array of Pod::WSDL::Fault objects, can be ommitted, use addFault() later
335
336=item
337
338oneway - if true, method is a one way operation
339
340=item
341
342writer - XML::Writer-Object for output, mandatory
343
344=back
345
346=head2 addParam
347
348Add a Pod::WSDL::Param object to Pod::WSDL::Method
349
350=head2 addFault
351
352Add a Pod::WSDL::Fault object to Pod::WSDL::Method
353
354=head2 return
355
356Get or Set the Pod::WSDL::Return object for Pod::WSDL::Method
357
358=head2 doc
359
360Get or Set the Pod::WSDL::Doc object for Pod::WSDL::Method
361
362=head2 requestName
363
364Get name for request in XML output
365
366=head2 responseName
367
368Get name for response in XML output
369
370=head2 writeBindingOperation
371
372Write operation child for binding element in XML output
373
374=head2 writeMessages
375
376Write message elements in XML output
377
378=head2 writePortTypeOperation
379
380Write operation child for porttype element in XML output
381
382=head1 EXTERNAL DEPENDENCIES
383
384  [none]
385
386=head1 EXAMPLES
387
388see Pod::WSDL
389
390=head1 BUGS
391
392see Pod::WSDL
393
394=head1 TODO
395
396see Pod::WSDL
397
398=head1 SEE ALSO
399
400  Pod::WSDL :-)
401
402=head1 AUTHOR
403
404Tarek Ahmed, E<lt>bloerch -the character every email address contains- oelbsk.orgE<gt>
405
406=head1 COPYRIGHT AND LICENSE
407
408Copyright (C) 2006 by Tarek Ahmed
409
410This library is free software; you can redistribute it and/or modify
411it under the same terms as Perl itself, either Perl version 5.8.5 or,
412at your option, any later version of Perl 5 you may have available.
413
414=cut
415