package Pod::WSDL::Writer; use strict; use warnings; use XML::Writer; use Pod::WSDL::Utils ':writexml'; our $AUTOLOAD; our $VERSION = "0.05"; our $INDENT_CHAR = "\t"; our $NL_CHAR = "\n"; sub new { my ($pkg, %data) = @_; $data{pretty} ||= 0; $data{withDocumentation} ||= 0; my $outStr = ""; my $me = bless { _pretty => $data{pretty}, _withDocumentation => $data{withDocumentation}, _outStr => \$outStr, _writer => undef, _indent => 1, _lastTag => '', _faultMessageWritten => {}, _emptyMessageWritten => 0, }, $pkg; $me->prepare; return $me; } sub wrNewLine { my $me = shift; my $cnt = shift; $cnt ||= 1; return unless $me->{_pretty}; $me->{_writer}->characters($NL_CHAR x $cnt); } sub wrElem { my $me = shift; my $type = shift; if ($me->{_pretty}) { if ($me->{_lastTag} eq $START_PREFIX_NAME and ($type eq $START_PREFIX_NAME or $type eq $EMPTY_PREFIX_NAME)) { $me->{_indent}++; } elsif ($me->{_lastTag} ne $START_PREFIX_NAME and $type eq $END_PREFIX_NAME) { $me->{_indent}--; } $me->{_lastTag} = $type; $me->{_writer}->characters($INDENT_CHAR x $me->{_indent}); } $type .= 'Tag'; $me->{_writer}->$type(@_); $me->wrNewLine; } sub wrDoc { my $me = shift; return unless $me->{_withDocumentation}; my $txt = shift; my %args = @_; my $useAnnotation = 0; my $docTagName = "wsdl:documentation"; if (%args and $args{useAnnotation}) { $useAnnotation = 1; $docTagName = "documentation"; } $txt ||= ''; $txt =~ s/\s+$//; return unless $txt; $me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty}; if ($useAnnotation) { $me->{_writer}->startTag("annotation") ; $me->wrNewLine; $me->{_indent}++; $me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty}; } $me->{_writer}->startTag($docTagName); $me->{_writer}->characters($txt); $me->{_writer}->endTag($docTagName); if ($useAnnotation) { $me->wrNewLine; $me->{_indent}--; $me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty}; $me->{_writer}->endTag("annotation"); } $me->wrNewLine; } sub output { my $me = shift; return ${$me->{_outStr}}; } sub prepare { my $me = shift; ${$me->{_outStr}} = ""; $me->{_emptyMessageWritten} = 0; $me->{_writer} = new XML::Writer(OUTPUT => $me->{_outStr}); $me->{_writer}->xmlDecl("UTF-8"); } sub withDocumentation { my $me = shift; my $arg = shift; if (defined $arg) { $me->{_withDocumentation} = $arg; return $me; } else { return $me->{_withDocumentation}; } } sub pretty { my $me = shift; my $arg = shift; if (defined $arg) { $me->{_pretty} = $arg; return $me; } else { return $me->{_pretty}; } } sub registerWrittenFaultMessage { my $me = shift; my $arg = shift; return $me->{_faultMessageWritten}->{$arg} = 1; } sub faultMessageWritten { my $me = shift; my $arg = shift; return $me->{_faultMessageWritten}->{$arg}; } sub registerWrittenEmptyMessage { my $me = shift; return $me->{_emptyMessageWritten} = 1; } sub emptyMessageWritten { my $me = shift; return $me->{_emptyMessageWritten}; } sub AUTOLOAD { my $me = shift; my $method = $AUTOLOAD; $method =~ s/.*:://; if ($method eq "DESTROY"){ return; } else { no strict 'refs'; $me->{_writer}->$method(@_); } } 1; __END__ =head1 NAME Pod::WSDL::Writer - Writes XML output for Pod::WSDL (internal use only) =head1 SYNOPSIS use Pod::WSDL::Writer; my $wr = new Pod::WSDL::Writer(pretty => 1, withDocumentation => 1); =head1 DESCRIPTION This 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. =head1 METHODS =head2 new Instantiates a new Pod::WSDL::Writer. The method can take two parameters C with a true value triggers pretty printing of the WSDL output. C with a true value produces a WSDL docuemnt containing documentation for types and methods. =head2 wrNewLine Has XML::Writer write a newline =head2 wrElem Has 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') =head2 wrDoc Writes the string passed to the method as a Element =head2 registerWrittenFaultMessage There 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. =head2 faultMessageWritten Counterpart 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. =head2 output Returns XML output. =head1 EXTERNAL DEPENDENCIES XML::Writer =head1 EXAMPLES see Pod::WSDL =head1 BUGS see Pod::WSDL =head1 TODO see Pod::WSDL =head1 SEE ALSO Pod::WSDL =head1 AUTHOR Tarek Ahmed, Ebloerch -the character every email address contains- oelbsk.orgE =head1 COPYRIGHT AND LICENSE Copyright (C) 2006 by Tarek Ahmed This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.5 or, at your option, any later version of Perl 5 you may have available. =cut