1package Pod::WSDL::Writer; 2 3use strict; 4use warnings; 5use XML::Writer; 6use Pod::WSDL::Utils ':writexml'; 7 8our $AUTOLOAD; 9our $VERSION = "0.05"; 10 11our $INDENT_CHAR = "\t"; 12our $NL_CHAR = "\n"; 13 14sub new { 15 my ($pkg, %data) = @_; 16 17 $data{pretty} ||= 0; 18 $data{withDocumentation} ||= 0; 19 20 my $outStr = ""; 21 22 my $me = bless { 23 _pretty => $data{pretty}, 24 _withDocumentation => $data{withDocumentation}, 25 _outStr => \$outStr, 26 _writer => undef, 27 _indent => 1, 28 _lastTag => '', 29 _faultMessageWritten => {}, 30 _emptyMessageWritten => 0, 31 }, $pkg; 32 33 $me->prepare; 34 35 return $me; 36 37} 38 39sub wrNewLine { 40 my $me = shift; 41 my $cnt = shift; 42 43 $cnt ||= 1; 44 45 return unless $me->{_pretty}; 46 47 $me->{_writer}->characters($NL_CHAR x $cnt); 48} 49 50sub wrElem { 51 my $me = shift; 52 my $type = shift; 53 54 if ($me->{_pretty}) { 55 if ($me->{_lastTag} eq $START_PREFIX_NAME and ($type eq $START_PREFIX_NAME or $type eq $EMPTY_PREFIX_NAME)) { 56 $me->{_indent}++; 57 } elsif ($me->{_lastTag} ne $START_PREFIX_NAME and $type eq $END_PREFIX_NAME) { 58 $me->{_indent}--; 59 } 60 61 $me->{_lastTag} = $type; 62 63 $me->{_writer}->characters($INDENT_CHAR x $me->{_indent}); 64 } 65 66 $type .= 'Tag'; 67 $me->{_writer}->$type(@_); 68 69 $me->wrNewLine; 70} 71 72sub wrDoc { 73 my $me = shift; 74 75 return unless $me->{_withDocumentation}; 76 77 my $txt = shift; 78 my %args = @_; 79 my $useAnnotation = 0; 80 my $docTagName = "wsdl:documentation"; 81 82 if (%args and $args{useAnnotation}) { 83 $useAnnotation = 1; 84 $docTagName = "documentation"; 85 } 86 87 88 $txt ||= ''; 89 $txt =~ s/\s+$//; 90 91 return unless $txt; 92 93 $me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty}; 94 95 if ($useAnnotation) { 96 $me->{_writer}->startTag("annotation") ; 97 $me->wrNewLine; 98 $me->{_indent}++; 99 $me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty}; 100 } 101 102 $me->{_writer}->startTag($docTagName); 103 $me->{_writer}->characters($txt); 104 $me->{_writer}->endTag($docTagName); 105 106 if ($useAnnotation) { 107 $me->wrNewLine; 108 $me->{_indent}--; 109 $me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty}; 110 $me->{_writer}->endTag("annotation"); 111 } 112 113 $me->wrNewLine; 114} 115 116sub output { 117 my $me = shift; 118 return ${$me->{_outStr}}; 119} 120 121sub prepare { 122 my $me = shift; 123 ${$me->{_outStr}} = ""; 124 $me->{_emptyMessageWritten} = 0; 125 $me->{_writer} = new XML::Writer(OUTPUT => $me->{_outStr}); 126 $me->{_writer}->xmlDecl("UTF-8"); 127} 128 129sub withDocumentation { 130 my $me = shift; 131 my $arg = shift; 132 133 if (defined $arg) { 134 $me->{_withDocumentation} = $arg; 135 return $me; 136 } else { 137 return $me->{_withDocumentation}; 138 } 139} 140 141sub pretty { 142 my $me = shift; 143 my $arg = shift; 144 145 if (defined $arg) { 146 $me->{_pretty} = $arg; 147 return $me; 148 } else { 149 return $me->{_pretty}; 150 } 151} 152 153sub registerWrittenFaultMessage { 154 my $me = shift; 155 my $arg = shift; 156 157 return $me->{_faultMessageWritten}->{$arg} = 1; 158} 159 160sub faultMessageWritten { 161 my $me = shift; 162 my $arg = shift; 163 164 return $me->{_faultMessageWritten}->{$arg}; 165} 166 167sub registerWrittenEmptyMessage { 168 my $me = shift; 169 170 return $me->{_emptyMessageWritten} = 1; 171} 172 173sub emptyMessageWritten { 174 my $me = shift; 175 176 return $me->{_emptyMessageWritten}; 177} 178 179sub AUTOLOAD { 180 my $me = shift; 181 182 my $method = $AUTOLOAD; 183 $method =~ s/.*:://; 184 185 if ($method eq "DESTROY"){ 186 return; 187 } else { 188 no strict 'refs'; 189 $me->{_writer}->$method(@_); 190 } 191} 192 1931; 194__END__ 195 196=head1 NAME 197 198Pod::WSDL::Writer - Writes XML output for Pod::WSDL (internal use only) 199 200=head1 SYNOPSIS 201 202 use Pod::WSDL::Writer; 203 my $wr = new Pod::WSDL::Writer(pretty => 1, withDocumentation => 1); 204 205=head1 DESCRIPTION 206 207This module is used internally by Pod::WSDL. By using AUTOLOADing it delegates all unknown methods to XML::Writer. 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. 208 209=head1 METHODS 210 211=head2 new 212 213Instantiates a new Pod::WSDL::Writer. The method can take two parameters C<pretty> with a true value triggers pretty printing of the WSDL output. C<withDocumentation> with a true value produces a WSDL docuemnt containing documentation for types and methods. 214 215=head2 wrNewLine 216 217Has XML::Writer write a newline 218 219=head2 wrElem 220 221Has XML::Writer write an Element. The first argument is one of (empty|start|end), to write an empty element, a start or an end tag. The second argument signifies the name of the tag. All further arguments are attributes of the tag (does not work, when first argument is 'end') 222 223=head2 wrDoc 224 225Writes the string passed to the method as a <wsdl:documentation> Element 226 227=head2 registerWrittenFaultMessage 228 229There needs to be only one fault message per fault type. Here the client class can register fault types already written. The fault name is passed as the single argument to this method. 230 231=head2 faultMessageWritten 232 233Counterpart to registerWrittenFaultMessage. The client can ask if a fault message has already written. The fault name is passed as the single argument to this method. 234 235=head2 output 236 237Returns XML output. 238 239=head1 EXTERNAL DEPENDENCIES 240 241 XML::Writer 242 243=head1 EXAMPLES 244 245see Pod::WSDL 246 247=head1 BUGS 248 249see Pod::WSDL 250 251=head1 TODO 252 253see Pod::WSDL 254 255=head1 SEE ALSO 256 257 Pod::WSDL 258 259=head1 AUTHOR 260 261Tarek Ahmed, E<lt>bloerch -the character every email address contains- oelbsk.orgE<gt> 262 263=head1 COPYRIGHT AND LICENSE 264 265Copyright (C) 2006 by Tarek Ahmed 266 267This library is free software; you can redistribute it and/or modify 268it under the same terms as Perl itself, either Perl version 5.8.5 or, 269at your option, any later version of Perl 5 you may have available. 270 271=cut 272