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