File Coverage

blib/lib/Pod/WSDL/Writer.pm
Criterion Covered Total %
statement 75 102 73.5
branch 12 36 33.3
condition 7 20 35.0
subroutine 15 18 83.3
pod 7 12 58.3
total 116 188 61.7


line stmt bran cond sub pod time code
1             package Pod::WSDL::Writer;
2              
3 9     9   18321 use strict;
  9         12  
  9         287  
4 9     9   39 use warnings;
  9         10  
  9         208  
5 9     9   5210 use XML::Writer;
  9         69494  
  9         251  
6 9     9   3204 use Pod::WSDL::Utils ':writexml';
  9         14  
  9         7802  
7              
8             our $AUTOLOAD;
9             our $VERSION = "0.05";
10              
11             our $INDENT_CHAR = "\t";
12             our $NL_CHAR = "\n";
13              
14             sub new {
15 11     11 1 960 my ($pkg, %data) = @_;
16              
17 11   100     67 $data{pretty} ||= 0;
18 11   100     40 $data{withDocumentation} ||= 0;
19            
20 11         16 my $outStr = "";
21              
22 11         121 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 11         29 $me->prepare;
34              
35 11         393 return $me;
36            
37             }
38              
39             sub wrNewLine {
40 14     14 1 15 my $me = shift;
41 14         13 my $cnt = shift;
42              
43 14   50     43 $cnt ||= 1;
44              
45 14 100       37 return unless $me->{_pretty};
46              
47 1         9 $me->{_writer}->characters($NL_CHAR x $cnt);
48             }
49              
50             sub wrElem {
51 11     11 1 344 my $me = shift;
52 11         10 my $type = shift;
53              
54 11 50       23 if ($me->{_pretty}) {
55 0 0 0     0 if ($me->{_lastTag} eq $START_PREFIX_NAME and ($type eq $START_PREFIX_NAME or $type eq $EMPTY_PREFIX_NAME)) {
    0 0        
      0        
56 0         0 $me->{_indent}++;
57             } elsif ($me->{_lastTag} ne $START_PREFIX_NAME and $type eq $END_PREFIX_NAME) {
58 0         0 $me->{_indent}--;
59             }
60            
61 0         0 $me->{_lastTag} = $type;
62              
63 0         0 $me->{_writer}->characters($INDENT_CHAR x $me->{_indent});
64             }
65              
66 11         12 $type .= 'Tag';
67 11         31 $me->{_writer}->$type(@_);
68              
69 11         418 $me->wrNewLine;
70             }
71              
72             sub wrDoc {
73 4     4 1 9 my $me = shift;
74              
75 4 100       11 return unless $me->{_withDocumentation};
76              
77 2         3 my $txt = shift;
78 2         3 my %args = @_;
79 2         3 my $useAnnotation = 0;
80 2         3 my $docTagName = "wsdl:documentation";
81            
82 2 50 33     5 if (%args and $args{useAnnotation}) {
83 0         0 $useAnnotation = 1;
84 0         0 $docTagName = "documentation";
85             }
86              
87              
88 2   50     5 $txt ||= '';
89 2         7 $txt =~ s/\s+$//;
90            
91 2 50       5 return unless $txt;
92            
93 2 0       5 $me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty};
    50          
94              
95 2 50       5 if ($useAnnotation) {
96 0         0 $me->{_writer}->startTag("annotation") ;
97 0         0 $me->wrNewLine;
98 0         0 $me->{_indent}++;
99 0 0       0 $me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty};
    0          
100             }
101            
102 2         5 $me->{_writer}->startTag($docTagName);
103 2         49 $me->{_writer}->characters($txt);
104 2         29 $me->{_writer}->endTag($docTagName);
105              
106 2 50       30 if ($useAnnotation) {
107 0         0 $me->wrNewLine;
108 0         0 $me->{_indent}--;
109 0 0       0 $me->{_writer}->characters($INDENT_CHAR x ($me->{_indent} + ($me->{_lastTag} eq $START_PREFIX_NAME ? 1 : 0))) if $me->{_pretty};
    0          
110 0         0 $me->{_writer}->endTag("annotation");
111             }
112            
113 2         4 $me->wrNewLine;
114             }
115              
116             sub output {
117 8     8 1 1623 my $me = shift;
118 8         11 return ${$me->{_outStr}};
  8         72  
119             }
120              
121             sub prepare {
122 11     11 0 14 my $me = shift;
123 11         16 ${$me->{_outStr}} = "";
  11         27  
124 11         16 $me->{_emptyMessageWritten} = 0;
125 11         51 $me->{_writer} = new XML::Writer(OUTPUT => $me->{_outStr});
126 11         1721 $me->{_writer}->xmlDecl("UTF-8");
127             }
128              
129             sub withDocumentation {
130 2     2 0 133 my $me = shift;
131 2         3 my $arg = shift;
132            
133 2 50       5 if (defined $arg) {
134 2         2 $me->{_withDocumentation} = $arg;
135 2         5 return $me;
136             } else {
137 0         0 return $me->{_withDocumentation};
138             }
139             }
140              
141             sub pretty {
142 0     0 0 0 my $me = shift;
143 0         0 my $arg = shift;
144            
145 0 0       0 if (defined $arg) {
146 0         0 $me->{_pretty} = $arg;
147 0         0 return $me;
148             } else {
149 0         0 return $me->{_pretty};
150             }
151             }
152              
153             sub registerWrittenFaultMessage {
154 1     1 1 3 my $me = shift;
155 1         3 my $arg = shift;
156            
157 1         4 return $me->{_faultMessageWritten}->{$arg} = 1;
158             }
159              
160             sub faultMessageWritten {
161 1     1 1 3 my $me = shift;
162 1         2 my $arg = shift;
163            
164 1         8 return $me->{_faultMessageWritten}->{$arg};
165             }
166              
167             sub registerWrittenEmptyMessage {
168 0     0 0 0 my $me = shift;
169            
170 0         0 return $me->{_emptyMessageWritten} = 1;
171             }
172              
173             sub emptyMessageWritten {
174 0     0 0 0 my $me = shift;
175            
176 0         0 return $me->{_emptyMessageWritten};
177             }
178              
179             sub AUTOLOAD {
180 3     3   7 my $me = shift;
181            
182 3         4 my $method = $AUTOLOAD;
183 3         20 $method =~ s/.*:://;
184              
185 3 50       11 if ($method eq "DESTROY"){
186 0         0 return;
187             } else {
188 9     9   49 no strict 'refs';
  9         12  
  9         437  
189 3         32 $me->{_writer}->$method(@_);
190             }
191             }
192              
193             1;
194             __END__