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