lib/Doxygen/Filter/Perl.pm | |||
---|---|---|---|
Criterion | Covered | Total | % |
statement | 95 | 543 | 17.5 |
branch | 14 | 206 | 6.8 |
condition | 4 | 75 | 5.3 |
subroutine | 20 | 36 | 55.5 |
pod | 0 | 11 | 0.0 |
total | 133 | 871 | 15.2 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | #** @file Perl.pm | ||||||
2 | # @verbatim | ||||||
3 | ##################################################################### | ||||||
4 | # This program is not guaranteed to work at all, and by using this # | ||||||
5 | # program you release the author of any and all liability. # | ||||||
6 | # # | ||||||
7 | # You may use this code as long as you are in compliance with the # | ||||||
8 | # license (see the LICENSE file) and this notice, disclaimer and # | ||||||
9 | # comment box remain intact and unchanged. # | ||||||
10 | # # | ||||||
11 | # Package: Doxygen::Filter # | ||||||
12 | # Class: Perl # | ||||||
13 | # Description: Methods for prefiltering Perl code for Doxygen # | ||||||
14 | # # | ||||||
15 | # Written by: Bret Jordan (jordan at open1x littledot org) # | ||||||
16 | # Created: 2011-10-13 # | ||||||
17 | ##################################################################### | ||||||
18 | # @endverbatim | ||||||
19 | # | ||||||
20 | # @copy 2011, Bret Jordan (jordan2175@gmail.com, jordan@open1x.org) | ||||||
21 | # $Id: Perl.pm 93 2015-03-17 13:08:02Z jordan2175 $ | ||||||
22 | #* | ||||||
23 | package Doxygen::Filter::Perl; | ||||||
24 | |||||||
25 | 1 | 1 | 1556 | use 5.8.8; | |||
1 | 4 | ||||||
26 | 1 | 1 | 5 | use strict; | |||
1 | 1 | ||||||
1 | 15 | ||||||
27 | 1 | 1 | 4 | use warnings; | |||
1 | 1 | ||||||
1 | 20 | ||||||
28 | 1 | 1 | 373 | use parent qw(Doxygen::Filter); | |||
1 | 278 | ||||||
1 | 5 | ||||||
29 | 1 | 1 | 56 | use Log::Log4perl; | |||
1 | 2 | ||||||
1 | 2 | ||||||
30 | 1 | 1 | 620 | use Pod::POM; | |||
1 | 19067 | ||||||
1 | 46 | ||||||
31 | 1 | 1 | 483 | use IO::Handle; | |||
1 | 5091 | ||||||
1 | 37 | ||||||
32 | 1 | 1 | 356 | use Doxygen::Filter::Perl::POD; | |||
1 | 2 | ||||||
1 | 5754 | ||||||
33 | |||||||
34 | our $VERSION = '1.72'; | ||||||
35 | $VERSION = eval $VERSION; | ||||||
36 | |||||||
37 | |||||||
38 | # Define State Engine Values | ||||||
39 | my $hValidStates = { | ||||||
40 | 'NORMAL' => 0, | ||||||
41 | 'COMMENT' => 1, | ||||||
42 | 'DOXYGEN' => 2, | ||||||
43 | 'POD' => 3, | ||||||
44 | 'METHOD' => 4, | ||||||
45 | 'DOXYFILE' => 21, | ||||||
46 | 'DOXYCLASS' => 22, | ||||||
47 | 'DOXYFUNCTION' => 23, | ||||||
48 | 'DOXYMETHOD' => 24, | ||||||
49 | 'DOXYCOMMENT' => 25, | ||||||
50 | }; | ||||||
51 | |||||||
52 | |||||||
53 | our %SYSTEM_PACKAGES = map({ $_ => 1 } qw( | ||||||
54 | base | ||||||
55 | warnings | ||||||
56 | strict | ||||||
57 | Exporter | ||||||
58 | vars | ||||||
59 | )); | ||||||
60 | |||||||
61 | |||||||
62 | |||||||
63 | sub new | ||||||
64 | { | ||||||
65 | #** @method private new () | ||||||
66 | # This is the constructor and it calls _init() to initiate | ||||||
67 | # the various variables | ||||||
68 | #* | ||||||
69 | 1 | 1 | 0 | 74 | my $pkg = shift; | ||
70 | 1 | 33 | 7 | my $class = ref($pkg) || $pkg; | |||
71 | |||||||
72 | 1 | 2 | my $self = {}; | ||||
73 | 1 | 2 | bless ($self, $class); | ||||
74 | |||||||
75 | # Lets send any passed in arguments to the _init method | ||||||
76 | 1 | 4 | $self->_init(@_); | ||||
77 | 1 | 2 | return $self; | ||||
78 | } | ||||||
79 | |||||||
80 | sub DESTROY | ||||||
81 | { | ||||||
82 | #** @method private DESTROY () | ||||||
83 | # This is the destructor | ||||||
84 | #* | ||||||
85 | 1 | 1 | 1016 | my $self = shift; | |||
86 | 1 | 113 | $self = {}; | ||||
87 | } | ||||||
88 | |||||||
89 | sub RESETSUB | ||||||
90 | { | ||||||
91 | 1 | 1 | 0 | 2 | my $self = shift; | ||
92 | 1 | 3 | $self->{'_iOpenBrace'} = 0; | ||||
93 | 1 | 9 | $self->{'_iCloseBrace'} = 0; | ||||
94 | 1 | 2 | $self->{'_sCurrentMethodName'} = undef; | ||||
95 | 1 | 2 | $self->{'_sCurrentMethodType'} = undef; | ||||
96 | 1 | 3 | $self->{'_sCurrentMethodState'} = undef; | ||||
97 | } | ||||||
98 | |||||||
99 | 1 | 1 | 0 | 3 | sub RESETFILE { shift->{'_aRawFileData'} = []; } | ||
100 | |||||||
101 | sub RESETCLASS | ||||||
102 | { | ||||||
103 | 1 | 1 | 0 | 1 | my $self = shift; | ||
104 | #$self->{'_sCurrentClass'} = 'main'; | ||||||
105 | #push (@{$self->{'_hData'}->{'class'}->{'classorder'}}, 'main'); | ||||||
106 | 1 | 2 | $self->_SwitchClass('main'); | ||||
107 | } | ||||||
108 | |||||||
109 | 1 | 1 | 0 | 2 | sub RESETDOXY { shift->{'_aDoxygenBlock'} = []; } | ||
110 | 1 | 1 | 0 | 2 | sub RESETPOD { shift->{'_aPodBlock'} = []; } | ||
111 | |||||||
112 | |||||||
113 | |||||||
114 | sub _init | ||||||
115 | { | ||||||
116 | #** @method private _init () | ||||||
117 | # This method is used in the constructor to initiate | ||||||
118 | # the various variables in the object | ||||||
119 | #* | ||||||
120 | 1 | 1 | 2 | my $self = shift; | |||
121 | 1 | 7 | $self->{'_iDebug'} = 0; | ||||
122 | 1 | 2 | $self->{'_sState'} = undef; | ||||
123 | 1 | 2 | $self->{'_sPreviousState'} = []; | ||||
124 | 1 | 4 | $self->_ChangeState('NORMAL'); | ||||
125 | 1 | 2 | $self->{'_hData'} = {}; | ||||
126 | 1 | 2 | $self->RESETFILE(); | ||||
127 | 1 | 3 | $self->RESETCLASS(); | ||||
128 | 1 | 3 | $self->RESETSUB(); | ||||
129 | 1 | 3 | $self->RESETDOXY(); | ||||
130 | 1 | 3 | $self->RESETPOD(); | ||||
131 | } | ||||||
132 | |||||||
133 | |||||||
134 | |||||||
135 | |||||||
136 | # ---------------------------------------- | ||||||
137 | # Public Methods | ||||||
138 | # ---------------------------------------- | ||||||
139 | sub GetCurrentClass | ||||||
140 | { | ||||||
141 | 0 | 0 | 0 | 0 | my $self = shift; | ||
142 | 0 | 0 | return $self->{'_hData'}->{'class'}->{$self->{'_sCurrentClass'}}; | ||||
143 | } | ||||||
144 | |||||||
145 | sub ReadFile | ||||||
146 | { | ||||||
147 | #** @method public ReadFile ($sFilename) | ||||||
148 | # This method will read the contents of the file in to an array | ||||||
149 | # and store that in the object as $self->{'_aRawFileData'} | ||||||
150 | # @param sFilename - required string (filename to use) | ||||||
151 | #* | ||||||
152 | 0 | 0 | 0 | 0 | my $self = shift; | ||
153 | 0 | 0 | my $sFilename = shift; | ||||
154 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
155 | 0 | 0 | $logger->debug("### Entering ReadFile ###"); | ||||
156 | |||||||
157 | # Lets record the file name in the data structure | ||||||
158 | 0 | 0 | $self->{'_hData'}->{'filename'}->{'fullpath'} = $sFilename; | ||||
159 | |||||||
160 | # Replace forward slash with a black slash | ||||||
161 | 0 | 0 | $sFilename =~ s/\\/\//g; | ||||
162 | # Remove windows style drive letters | ||||||
163 | 0 | 0 | $sFilename =~ s/^.*://; | ||||
164 | |||||||
165 | # Lets grab just the file name not the full path for the short name | ||||||
166 | 0 | 0 | $sFilename =~ /^(.*\/)*(.*)$/; | ||||
167 | 0 | 0 | $self->{'_hData'}->{'filename'}->{'shortname'} = $2; | ||||
168 | |||||||
169 | 0 | 0 | open(DATAIN, $sFilename); | ||||
170 | #my @aFileData = |
||||||
171 | 0 | 0 | my @aFileData = map({ s/\r$//g; $_; } |
||||
0 | 0 | ||||||
0 | 0 | ||||||
172 | 0 | 0 | close (DATAIN); | ||||
173 | 0 | 0 | $self->{'_aRawFileData'} = \@aFileData; | ||||
174 | } | ||||||
175 | |||||||
176 | sub ReportError | ||||||
177 | { | ||||||
178 | #** @method public void ReportError($message) | ||||||
179 | # @brief Reports an error message in the current context. | ||||||
180 | # | ||||||
181 | # The message is prepended by 'filename:lineno: error:' prefix so it is easily | ||||||
182 | # parseable by IDEs and advanced editors. | ||||||
183 | #* | ||||||
184 | 0 | 0 | 0 | 0 | my $self = shift; | ||
185 | 0 | 0 | my $message = shift; | ||||
186 | |||||||
187 | 0 | 0 | my $hData = $self->{'_hData'}; | ||||
188 | 0 | 0 | my $header = "$hData->{filename}->{fullpath}:$hData->{lineno}: error: "; | ||||
189 | 0 | 0 | 0 | $message .= "\n" if (substr($message, -1, 1) ne "\n"); | |||
190 | 0 | 0 | $message =~ s/^/$header/gm; | ||||
191 | 0 | 0 | STDERR->print($message); | ||||
192 | } | ||||||
193 | |||||||
194 | sub ProcessFile | ||||||
195 | { | ||||||
196 | #** @method public ProcessFile () | ||||||
197 | # This method is a state machine that will search down each line of code to see what it should do | ||||||
198 | #* | ||||||
199 | 3 | 3 | 0 | 1098 | my $self = shift; | ||
200 | 3 | 8 | my $logger = $self->GetLogger($self); | ||||
201 | 3 | 400 | $logger->debug("### Entering ProcessFile ###"); | ||||
202 | |||||||
203 | 3 | 21 | $self->{'_hData'}->{'lineno'} = 0; | ||||
204 | 3 | 5 | foreach my $line (@{$self->{'_aRawFileData'}}) | ||||
3 | 7 | ||||||
205 | { | ||||||
206 | 7 | 8 | $self->{'_hData'}->{'lineno'}++; | ||||
207 | # Convert syntax block header to supported doxygen form, if this line is a header | ||||||
208 | 7 | 11 | $line = $self->_ConvertToOfficialDoxygenSyntax($line); | ||||
209 | |||||||
210 | # Lets first figure out what state we SHOULD be in and then we will deal with | ||||||
211 | # processing that state. This first block should walk through all the possible | ||||||
212 | # transition states, aka, the states you can get to from the state you are in. | ||||||
213 | 7 | 50 | 12 | if ($self->{'_sState'} eq 'NORMAL') | |||
0 | |||||||
0 | |||||||
0 | |||||||
214 | { | ||||||
215 | 7 | 11 | $logger->debug("We are in state: NORMAL"); | ||||
216 | 7 | 50 | 33 | 58 | if ($line =~ /^\s*sub\s+([\w]+)/ and $line =~ /^\s*sub\s+([\D][\w]*)/) { $self->_ChangeState('METHOD'); } | ||
0 | 50 | 0 | |||||
50 | |||||||
217 | 0 | 0 | elsif ($line =~ /^\s*#\*\*\s*\@/) { $self->_ChangeState('DOXYGEN'); } | ||||
218 | 0 | 0 | elsif ($line =~ /^=.*/) { $self->_ChangeState('POD'); } | ||||
219 | } | ||||||
220 | elsif ($self->{'_sState'} eq 'METHOD') | ||||||
221 | { | ||||||
222 | 0 | 0 | $logger->debug("We are in state: METHOD"); | ||||
223 | 0 | 0 | 0 | if ($line =~ /^\s*#\*\*\s*\@/ ) { $self->_ChangeState('DOXYGEN'); } | |||
0 | 0 | ||||||
224 | } | ||||||
225 | elsif ($self->{'_sState'} eq 'DOXYGEN') | ||||||
226 | { | ||||||
227 | 0 | 0 | $logger->debug("We are in state: DOXYGEN"); | ||||
228 | # If there are no more comments, then reset the state to the previous state | ||||||
229 | 0 | 0 | 0 | unless ($line =~ /^\s*#/) | |||
230 | { | ||||||
231 | # The general idea is we gather the whole doxygen comment in to an array and process | ||||||
232 | # that array all at once in the _ProcessDoxygenCommentBlock. This way we do not have | ||||||
233 | # to artifically keep track of what type of comment block it is between each line | ||||||
234 | # that we read from the file. | ||||||
235 | 0 | 0 | $logger->debug("End of Doxygen Comment Block"); | ||||
236 | 0 | 0 | $self->_ProcessDoxygenCommentBlock(); | ||||
237 | 0 | 0 | $self->_RestoreState(); | ||||
238 | 0 | 0 | $logger->debug("We are in state $self->{'_sState'}"); | ||||
239 | 0 | 0 | 0 | if ($self->{'_sState'} eq 'NORMAL') | |||
240 | { | ||||||
241 | # If this comment block is right next to a subroutine, lets make sure we | ||||||
242 | # handle that condition | ||||||
243 | 0 | 0 | 0 | 0 | if ($line =~ /^\s*sub\s+([\w]+)/ and $line =~ /^\s*sub\s+([\D][\w]*)/) { $self->_ChangeState('METHOD'); } | ||
0 | 0 | ||||||
244 | } | ||||||
245 | } | ||||||
246 | } | ||||||
247 | elsif ($self->{'_sState'} eq 'POD') | ||||||
248 | { | ||||||
249 | 0 | 0 | 0 | if ($line =~ /^=cut/) | |||
250 | { | ||||||
251 | 0 | 0 | push (@{$self->{'_aPodBlock'}}, $line); | ||||
0 | 0 | ||||||
252 | 0 | 0 | $self->_ProcessPodCommentBlock(); | ||||
253 | 0 | 0 | $self->_RestoreState(); | ||||
254 | } | ||||||
255 | } | ||||||
256 | |||||||
257 | |||||||
258 | # Process states | ||||||
259 | 7 | 50 | 12 | if ($self->{'_sState'} eq 'NORMAL') | |||
0 | |||||||
0 | |||||||
0 | |||||||
260 | { | ||||||
261 | 7 | 50 | 34 | if ($line =~ /^\s*package\s*([^;]*)\;/) | |||
100 | |||||||
50 | |||||||
50 | |||||||
262 | { | ||||||
263 | #$self->{'_sCurrentClass'} = $1; | ||||||
264 | #push (@{$self->{'_hData'}->{'class'}->{'classorder'}}, $1); | ||||||
265 | 0 | 0 | $self->_SwitchClass($1); | ||||
266 | } | ||||||
267 | elsif ($line =~ /our\s+\$VERSION\s*=\s*(.*);$/) | ||||||
268 | { | ||||||
269 | # our $VERSION = '0.99_01'; | ||||||
270 | # use version; our $VERSION = qv('0.3.1'); - Thanks Hoppfrosch for the suggestion | ||||||
271 | 2 | 5 | my $version = $1; | ||||
272 | 2 | 9 | $version =~ s/[\'\"\(\)\;]//g; | ||||
273 | 2 | 4 | $version =~ s/qv//; | ||||
274 | 2 | 5 | $self->{'_hData'}->{'filename'}->{'version'} = $version; | ||||
275 | } | ||||||
276 | #elsif ($line =~ /^\s*use\s+([\w:]+)/) | ||||||
277 | elsif ($line =~ /^\s*use\s+([\w:]+)(|\s*(\S.*?)\s*;*)$/) | ||||||
278 | { | ||||||
279 | 0 | 0 | my $sIncludeModule = $1; | ||||
280 | 0 | 0 | my $x = $2; | ||||
281 | 0 | 0 | my $expr = $3; | ||||
282 | 0 | 0 | 0 | if (defined($sIncludeModule)) | |||
283 | { | ||||||
284 | #unless ($sIncludeModule eq "strict" || $sIncludeModule eq "warnings" || $sIncludeModule eq "vars" || $sIncludeModule eq "Exporter" || $sIncludeModule eq "base") | ||||||
285 | 0 | 0 | 0 | if ($sIncludeModule =~ m/^(base|strict|warnings|vars|Exporter)$/) | |||
286 | { | ||||||
287 | 0 | 0 | 0 | if ($sIncludeModule eq "base") | |||
288 | { | ||||||
289 | 0 | 0 | 0 | if (substr($expr,0,8) =~ /\"require/) { } | |||
290 | else | ||||||
291 | { | ||||||
292 | 0 | 0 | my @isa = eval($expr); | ||||
293 | 0 | 0 | 0 | push(@{$self->GetCurrentClass()->{inherits}}, _FilterOutSystemPackages(@isa)) unless ($@); | |||
0 | 0 | ||||||
294 | } | ||||||
295 | } | ||||||
296 | else | ||||||
297 | { | ||||||
298 | # ignore other system modules | ||||||
299 | } | ||||||
300 | } | ||||||
301 | else | ||||||
302 | { | ||||||
303 | # Allows doxygen to know where to look for other packages | ||||||
304 | 0 | 0 | $sIncludeModule =~ s/::/\//g; | ||||
305 | 0 | 0 | push (@{$self->{'_hData'}->{'includes'}}, $sIncludeModule); | ||||
0 | 0 | ||||||
306 | } | ||||||
307 | } | ||||||
308 | } | ||||||
309 | #elsif ($line =~ /^\s*(?:Readonly\s+)?(?:my|our)\s+([\$@%*]\w+)/) | ||||||
310 | #elsif ($line =~ /^\s*(?:Readonly\s+)?(my|our)\s+([\$@%*]\w+)([^=]*|\s*=\s*(\S.*?)\s*;*)$/) | ||||||
311 | elsif ($line =~ /^\s*(?:Readonly\s+)?(my|our)\s+(([\$@%*])(\w+))([^=]*|\s*=\s*(\S.*?)\s*;*)$/) | ||||||
312 | { | ||||||
313 | # Lets look for locally defined variables/arrays/hashes and capture them such as: | ||||||
314 | # my $var; | ||||||
315 | # my $var = ... | ||||||
316 | # our @var = ... | ||||||
317 | # Readonly our %var ... | ||||||
318 | #my $sAttrName = $1; | ||||||
319 | #if (defined($sAttrName) && $sAttrName !~ m/^(\@EXPORT|\@EXPORT_OK|\$VERSION)$/) | ||||||
320 | 0 | 0 | my $scope = $1; | ||||
321 | 0 | 0 | my $fullName = $2; | ||||
322 | 0 | 0 | my $typeCode = $3; | ||||
323 | 0 | 0 | my $sAttrName = $4; | ||||
324 | 0 | 0 | my $expr = $6; | ||||
325 | |||||||
326 | 0 | 0 | 0 | if (defined $sAttrName) | |||
327 | { | ||||||
328 | #my $sClassName = $self->{'_sCurrentClass'}; | ||||||
329 | #push (@{$self->{'_hData'}->{'class'}->{$sClassName}->{attributeorder}}, $sAttrName); | ||||||
330 | 0 | 0 | 0 | 0 | if ($scope eq "our" && $fullName =~ m/^(\@ISA|\@EXPORT|\@EXPORT_OK|\$VERSION)$/) | ||
331 | { | ||||||
332 | 0 | 0 | 0 | 0 | if ($fullName eq "\@ISA" && defined $expr) | ||
333 | { | ||||||
334 | 0 | 0 | my @isa = eval($expr); | ||||
335 | 0 | 0 | 0 | push(@{$self->GetCurrentClass()->{inherits}}, _FilterOutSystemPackages(@isa)) unless ($@); | |||
0 | 0 | ||||||
336 | } | ||||||
337 | else | ||||||
338 | { | ||||||
339 | # ignore other system variables | ||||||
340 | } | ||||||
341 | } | ||||||
342 | else | ||||||
343 | { | ||||||
344 | 0 | 0 | my $sClassName = $self->{'_sCurrentClass'}; | ||||
345 | 0 | 0 | 0 | if (!exists $self->{'_hData'}->{'class'}->{$sClassName}->{attributes}->{$sAttrName}) | |||
346 | { | ||||||
347 | # only define the attribute if it was not yet defined by doxygen comment | ||||||
348 | 0 | 0 | 0 | my $attrDef = $self->{'_hData'}->{'class'}->{$sClassName}->{attributes}->{$sAttrName} = { | |||
349 | type => $self->_ConvertTypeCode($typeCode), | ||||||
350 | modifiers => "static ", | ||||||
351 | state => $scope eq "my" ? "private" : "public", | ||||||
352 | }; | ||||||
353 | 0 | 0 | push(@{$self->{'_hData'}->{'class'}->{$sClassName}->{attributeorder}}, $sAttrName); | ||||
0 | 0 | ||||||
354 | } | ||||||
355 | } | ||||||
356 | } | ||||||
357 | 0 | 0 | 0 | if ($line =~ /(#\*\*\s+\@.*$)/) | |||
358 | { | ||||||
359 | # Lets look for an single in-line doxygen comment on a variable, array, or hash declaration | ||||||
360 | 0 | 0 | my $sBlock = $1; | ||||
361 | 0 | 0 | push (@{$self->{'_aDoxygenBlock'}}, $sBlock); | ||||
0 | 0 | ||||||
362 | 0 | 0 | $self->_ProcessDoxygenCommentBlock(); | ||||
363 | } | ||||||
364 | } | ||||||
365 | } | ||||||
366 | 0 | 0 | elsif ($self->{'_sState'} eq 'METHOD') { $self->_ProcessPerlMethod($line); } | ||||
367 | 0 | 0 | elsif ($self->{'_sState'} eq 'DOXYGEN') { push (@{$self->{'_aDoxygenBlock'}}, $line); } | ||||
0 | 0 | ||||||
368 | 0 | 0 | elsif ($self->{'_sState'} eq 'POD') { push (@{$self->{'_aPodBlock'}}, $line);} | ||||
0 | 0 | ||||||
369 | } | ||||||
370 | } | ||||||
371 | |||||||
372 | sub PrintAll | ||||||
373 | { | ||||||
374 | #** @method public PrintAll () | ||||||
375 | # This method will print out the entire data structure in a form that Doxygen can work with. | ||||||
376 | # It is important to note that you are basically making the output look like C code so that | ||||||
377 | # packages and classes need to have start and end blocks and need to include all of the | ||||||
378 | # elements that are part of that package or class | ||||||
379 | #* | ||||||
380 | 0 | 0 | 0 | 0 | my $self = shift; | ||
381 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
382 | 0 | 0 | $logger->debug("### Entering PrintAll ###"); | ||||
383 | |||||||
384 | 0 | 0 | binmode STDOUT, ":utf8"; | ||||
385 | |||||||
386 | 0 | 0 | $self->_PrintFilenameBlock(); | ||||
387 | 0 | 0 | $self->_PrintIncludesBlock(); | ||||
388 | |||||||
389 | 0 | 0 | foreach my $class (@{$self->{'_hData'}->{'class'}->{'classorder'}}) | ||||
0 | 0 | ||||||
390 | { | ||||||
391 | 0 | 0 | my $classDef = $self->{'_hData'}->{'class'}->{$class}; | ||||
392 | |||||||
393 | # skip the default main class unless we really have something to print | ||||||
394 | 0 | 0 | 0 | 0 | if ($class eq "main" && | ||
0 | |||||||
0 | |||||||
0 | |||||||
395 | 0 | 0 | @{$classDef->{attributeorder}} == 0 && | ||||
396 | 0 | 0 | @{$classDef->{subroutineorder}} == 0 && | ||||
397 | (!defined $classDef->{details}) && | ||||||
398 | (!defined $classDef->{comments}) | ||||||
399 | ) | ||||||
400 | { | ||||||
401 | 0 | 0 | next; | ||||
402 | } | ||||||
403 | |||||||
404 | 0 | 0 | $self->_PrintClassBlock($class); | ||||
405 | |||||||
406 | # Print all available attributes first that are defined at the global class level | ||||||
407 | 0 | 0 | foreach my $sAttrName (@{$self->{'_hData'}->{'class'}->{$class}->{'attributeorder'}}) | ||||
0 | 0 | ||||||
408 | { | ||||||
409 | 0 | 0 | my $attrDef = $self->{'_hData'}->{'class'}->{$class}->{'attributes'}->{$sAttrName}; | ||||
410 | |||||||
411 | 0 | 0 | 0 | my $sState = $attrDef->{'state'} || 'public'; | |||
412 | 0 | 0 | my $sComments = $attrDef->{'comments'}; | ||||
413 | 0 | 0 | my $sDetails = $attrDef->{'details'}; | ||||
414 | 0 | 0 | 0 | 0 | if (defined $sComments || defined $sDetails) | ||
415 | { | ||||||
416 | 0 | 0 | print "/**\n"; | ||||
417 | 0 | 0 | 0 | if (defined $sComments) | |||
418 | { | ||||||
419 | 0 | 0 | print " \* \@brief $sComments\n"; | ||||
420 | } | ||||||
421 | |||||||
422 | 0 | 0 | 0 | if ($sDetails) | |||
423 | { | ||||||
424 | 0 | 0 | print " * \n".$sDetails; | ||||
425 | } | ||||||
426 | |||||||
427 | 0 | 0 | print " */\n"; | ||||
428 | } | ||||||
429 | |||||||
430 | 0 | 0 | print("$sState:\n$attrDef->{modifiers}$attrDef->{type} $sAttrName;\n\n"); | ||||
431 | } | ||||||
432 | |||||||
433 | # Print all functions/methods in order of appearance, let doxygen take care of grouping them according to modifiers | ||||||
434 | # I added this print public line to make sure the functions print if one of | ||||||
435 | # the previous elements was a my $a = 1 and thus had a print "private:" | ||||||
436 | # This is no longer needed, fixed it in the Doxyfile instead. | ||||||
437 | # print("public:\n"); | ||||||
438 | 0 | 0 | foreach my $methodName (@{$self->{'_hData'}->{'class'}->{$class}->{'subroutineorder'}}) | ||||
0 | 0 | ||||||
439 | { | ||||||
440 | 0 | 0 | $self->_PrintMethodBlock($class, $methodName); | ||||
441 | } | ||||||
442 | # Print end of class mark | ||||||
443 | 0 | 0 | print "}\;\n"; | ||||
444 | # print end of namespace if class is nested | ||||||
445 | 0 | 0 | 0 | print "};\n" if ($class =~ /::/); | |||
446 | } | ||||||
447 | } | ||||||
448 | |||||||
449 | |||||||
450 | # ---------------------------------------- | ||||||
451 | # Private Methods | ||||||
452 | # ---------------------------------------- | ||||||
453 | sub _FilterOutSystemPackages | ||||||
454 | { | ||||||
455 | 0 | 0 | 0 | 0 | if (!defined($_)) { return @_}; | ||
0 | 0 | ||||||
456 | 0 | 0 | return grep({ !exists $SYSTEM_PACKAGES{$_} } @_); | ||||
0 | 0 | ||||||
457 | } | ||||||
458 | |||||||
459 | |||||||
460 | sub _SwitchClass | ||||||
461 | { | ||||||
462 | 1 | 1 | 2 | my $self = shift; | |||
463 | 1 | 1 | my $class = shift; | ||||
464 | |||||||
465 | 1 | 1 | $self->{'_sCurrentClass'} = $class; | ||||
466 | 1 | 50 | 4 | if (!exists $self->{'_hData'}->{'class'}->{$class}) | |||
467 | { | ||||||
468 | 1 | 2 | push(@{$self->{'_hData'}->{'class'}->{'classorder'}}, $class); | ||||
1 | 3 | ||||||
469 | 1 | 7 | $self->{'_hData'}->{'class'}->{$class} = { | ||||
470 | classname => $class, | ||||||
471 | inherits => [], | ||||||
472 | attributeorder => [], | ||||||
473 | subroutineorder => [], | ||||||
474 | }; | ||||||
475 | } | ||||||
476 | |||||||
477 | 1 | 2 | return $self->{'_hData'}->{'class'}->{$class}; | ||||
478 | } | ||||||
479 | |||||||
480 | 0 | 0 | 0 | sub _RestoreState { shift->_ChangeState(); } | |||
481 | sub _ChangeState | ||||||
482 | { | ||||||
483 | #** @method private _ChangeState ($state) | ||||||
484 | # This method will change and keep track of the various states that the state machine | ||||||
485 | # transitions to and from. Having this information allows you to return to a previous | ||||||
486 | # state. If you pass nothing in to this method it will restore the previous state. | ||||||
487 | # @param state - optional string (state to change to) | ||||||
488 | #* | ||||||
489 | 1 | 1 | 2 | my $self = shift; | |||
490 | 1 | 1 | my $state = shift; | ||||
491 | 1 | 6 | my $logger = $self->GetLogger($self); | ||||
492 | 1 | 412 | $logger->debug("### Entering _ChangeState ###"); | ||||
493 | |||||||
494 | 1 | 50 | 33 | 80 | if (defined $state && exists $hValidStates->{$state}) | ||
495 | { | ||||||
496 | # If there was a value passed in and it is a valid value lets make it active | ||||||
497 | 1 | 5 | $logger->debug("State passed in: $state"); | ||||
498 | 1 | 50 | 33 | 9 | unless (defined $self->{'_sState'} && $self->{'_sState'} eq $state) | ||
499 | { | ||||||
500 | # Need to push the current state to the array BEFORE we change it and only | ||||||
501 | # if we are not currently at that state | ||||||
502 | 1 | 1 | push (@{$self->{'_sPreviousState'}}, $self->{'_sState'}); | ||||
1 | 3 | ||||||
503 | 1 | 3 | $self->{'_sState'} = $state; | ||||
504 | } | ||||||
505 | } | ||||||
506 | else | ||||||
507 | { | ||||||
508 | # If nothing is passed in, lets set the current state to the preivous state. | ||||||
509 | 0 | 0 | $logger->debug("No state passed in, lets revert to previous state"); | ||||
510 | 0 | 0 | my $previous = pop @{$self->{'_sPreviousState'}}; | ||||
0 | 0 | ||||||
511 | 0 | 0 | 0 | if (defined $previous) | |||
512 | { | ||||||
513 | 0 | 0 | $logger->debug("Previous state was $previous"); | ||||
514 | } | ||||||
515 | else | ||||||
516 | { | ||||||
517 | 0 | 0 | $logger->error("There is no previous state! Setting to NORMAL"); | ||||
518 | 0 | 0 | $previous = 'NORMAL'; | ||||
519 | } | ||||||
520 | 0 | 0 | $self->{'_sState'} = $previous; | ||||
521 | } | ||||||
522 | } | ||||||
523 | |||||||
524 | sub _PrintFilenameBlock | ||||||
525 | { | ||||||
526 | #** @method private _PrintFilenameBlock () | ||||||
527 | # This method will print the filename section in appropriate doxygen syntax | ||||||
528 | #* | ||||||
529 | 0 | 0 | 0 | my $self = shift; | |||
530 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
531 | 0 | 0 | $logger->debug("### Entering _PrintFilenameBlock ###"); | ||||
532 | |||||||
533 | 0 | 0 | 0 | if (defined $self->{'_hData'}->{'filename'}->{'fullpath'}) | |||
534 | { | ||||||
535 | 0 | 0 | print "/** \@file \"$self->{'_hData'}->{'filename'}->{'fullpath'}\"\n"; | ||||
536 | 0 | 0 | 0 | if (defined $self->{'_hData'}->{'filename'}->{'details'}) { print "$self->{'_hData'}->{'filename'}->{'details'}\n"; } | |||
0 | 0 | ||||||
537 | 0 | 0 | 0 | if (defined $self->{'_hData'}->{'filename'}->{'version'}) { print "\@version $self->{'_hData'}->{'filename'}->{'version'}\n"; } | |||
0 | 0 | ||||||
538 | 0 | 0 | print "*/\n"; | ||||
539 | } | ||||||
540 | } | ||||||
541 | |||||||
542 | sub _PrintIncludesBlock | ||||||
543 | { | ||||||
544 | #** @method private _PrintIncludesBlock () | ||||||
545 | # This method will print the various extra modules that are used | ||||||
546 | #* | ||||||
547 | 0 | 0 | 0 | my $self = shift; | |||
548 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
549 | 0 | 0 | $logger->debug("### Entering _PrintIncludeBlock ###"); | ||||
550 | |||||||
551 | 0 | 0 | foreach my $include (@{$self->{'_hData'}->{'includes'}}) | ||||
0 | 0 | ||||||
552 | { | ||||||
553 | 0 | 0 | print "\#include \"$include.pm\"\n"; | ||||
554 | } | ||||||
555 | 0 | 0 | print "\n"; | ||||
556 | } | ||||||
557 | |||||||
558 | sub _PrintClassBlock | ||||||
559 | { | ||||||
560 | #** @method private _PrintClassBlock ($sFullClass) | ||||||
561 | # This method will print the class/package block in appropriate doxygen syntax | ||||||
562 | # @param sFullClass - required string (full name of the class) | ||||||
563 | #* | ||||||
564 | 0 | 0 | 0 | my $self = shift; | |||
565 | 0 | 0 | my $sFullClass = shift; | ||||
566 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
567 | 0 | 0 | $logger->debug("### Entering _PrintClassBlock ###"); | ||||
568 | |||||||
569 | # We need to reset the $1 / $2 match for perl scripts without package classes. | ||||||
570 | # so lets do it here just to be save. Yes this is an expensive way of doing it | ||||||
571 | # but it works. | ||||||
572 | 0 | 0 | $sFullClass =~ /./; | ||||
573 | 0 | 0 | $sFullClass =~ /(.*)\:\:(\w+)$/; | ||||
574 | 0 | 0 | my $parent = $1; | ||||
575 | 0 | 0 | 0 | my $class = $2 || $sFullClass; | |||
576 | |||||||
577 | 0 | 0 | print "/** \@class $sFullClass\n"; | ||||
578 | |||||||
579 | 0 | 0 | my $classDef = $self->{'_hData'}->{'class'}->{$sFullClass}; | ||||
580 | |||||||
581 | 0 | 0 | my $details = $self->{'_hData'}->{'class'}->{$sFullClass}->{'details'}; | ||||
582 | 0 | 0 | 0 | if (defined $details) { print "$details\n"; } | |||
0 | 0 | ||||||
583 | |||||||
584 | 0 | 0 | my $comments = $self->{'_hData'}->{'class'}->{$sFullClass}->{'comments'}; | ||||
585 | 0 | 0 | 0 | if (defined $comments) { print "$comments\n"; } | |||
0 | 0 | ||||||
586 | |||||||
587 | 0 | 0 | print "\@nosubgrouping */\n"; | ||||
588 | |||||||
589 | #if (defined $parent) { print "class $sFullClass : public $parent { \n"; } | ||||||
590 | #else { print "class $sFullClass { \n"; } | ||||||
591 | 0 | 0 | 0 | print "namespace $parent {\n" if ($parent); | |||
592 | 0 | 0 | print "class $class"; | ||||
593 | 0 | 0 | 0 | if (@{$classDef->{inherits}}) | |||
0 | 0 | ||||||
594 | { | ||||||
595 | 0 | 0 | my $count = 0; | ||||
596 | 0 | 0 | foreach my $inherit (@{$classDef->{inherits}}) | ||||
0 | 0 | ||||||
597 | { | ||||||
598 | 0 | 0 | 0 | if (defined($inherit)) | |||
599 | { | ||||||
600 | 0 | 0 | 0 | print(($count++ == 0 ? ": " : ", ")." public ::".$inherit); | |||
601 | } | ||||||
602 | |||||||
603 | } | ||||||
604 | } | ||||||
605 | 0 | 0 | print "\n{\n"; | ||||
606 | 0 | 0 | print "public:\n"; | ||||
607 | } | ||||||
608 | |||||||
609 | sub _PrintMethodBlock | ||||||
610 | { | ||||||
611 | #** @method private _PrintMethodBlock ($class, $methodDef) | ||||||
612 | # This method will print the various subroutines/functions/methods in apprporiate doxygen syntax | ||||||
613 | # @param class - required string (name of the class) | ||||||
614 | # @param state - required string (current state) | ||||||
615 | # @param type - required string (type) | ||||||
616 | # @param method - required string (name of method) | ||||||
617 | #* | ||||||
618 | 0 | 0 | 0 | my $self = shift; | |||
619 | 0 | 0 | my $class = shift; | ||||
620 | 0 | 0 | my $method = shift; | ||||
621 | |||||||
622 | 0 | 0 | my $methodDef = $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}; | ||||
623 | |||||||
624 | 0 | 0 | my $state = $methodDef->{state}; | ||||
625 | 0 | 0 | my $type = $methodDef->{type}; | ||||
626 | |||||||
627 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
628 | 0 | 0 | $logger->debug("### Entering _PrintMethodBlock ###"); | ||||
629 | |||||||
630 | 0 | 0 | 0 | my $returntype = $methodDef->{'returntype'} || $type; | |||
631 | 0 | 0 | 0 | my $parameters = $methodDef->{'parameters'} || ""; | |||
632 | 0 | 0 | 0 | my $prototype = $methodDef->{'prototype'} || ""; | |||
633 | |||||||
634 | 0 | 0 | 0 | if ($parameters =~ /^ *$/) | |||
635 | { | ||||||
636 | 0 | 0 | 0 | if ($prototype =~ /^ *$/) | |||
637 | { | ||||||
638 | 0 | 0 | print "/** \@fn $state $returntype $method\(\)\n"; | ||||
639 | } | ||||||
640 | else | ||||||
641 | { | ||||||
642 | 0 | 0 | print "/** \@fn $state $returntype $method\($prototype\)\n"; | ||||
643 | } | ||||||
644 | } | ||||||
645 | else | ||||||
646 | { | ||||||
647 | 0 | 0 | print "/** \@fn $state $returntype $method\($parameters\)\n"; | ||||
648 | } | ||||||
649 | |||||||
650 | 0 | 0 | my $details = $methodDef->{'details'}; | ||||
651 | 0 | 0 | 0 | if (defined $details) { print "$details\n"; } | |||
0 | 0 | ||||||
652 | 0 | 0 | else { print "Undocumented Method\n"; } | ||||
653 | |||||||
654 | 0 | 0 | my $comments = $methodDef->{'comments'}; | ||||
655 | 0 | 0 | 0 | if (defined $comments) { print "$comments\n"; } | |||
0 | 0 | ||||||
656 | |||||||
657 | # Print collapsible source code block | ||||||
658 | 0 | 0 | print "\@htmlonly[block]\n"; | ||||
659 | 0 | 0 | print " \n"; |
||||
660 | 0 | 0 | print "\t![]() |
||||
661 | 0 | 0 | print "\n"; | ||||
662 | 0 | 0 | print " click to view \n"; |
||||
663 | 0 | 0 | print " | ||||
664 | 0 | 0 | print "\@endhtmlonly\n"; | ||||
665 | |||||||
666 | 0 | 0 | print "\@code\n"; | ||||
667 | 0 | 0 | print "\# Number of lines of code in $method: $methodDef->{'length'}\n"; | ||||
668 | 0 | 0 | print "$methodDef->{'code'}\n"; | ||||
669 | 0 | 0 | print "\@endcode \@htmlonly[block]\n"; | ||||
670 | 0 | 0 | print "\n"; | ||||
671 | 0 | 0 | print "\@endhtmlonly */\n"; | ||||
672 | |||||||
673 | 0 | 0 | 0 | if ($parameters =~ /^ *$/) | |||
674 | { | ||||||
675 | 0 | 0 | 0 | if ($prototype =~ /^ *$/) | |||
676 | { | ||||||
677 | 0 | 0 | print "$state $returntype $method\(\)\;\n"; | ||||
678 | } | ||||||
679 | else | ||||||
680 | { | ||||||
681 | 0 | 0 | print "$state $returntype $method\($prototype\)\;\n"; | ||||
682 | } | ||||||
683 | } | ||||||
684 | else | ||||||
685 | { | ||||||
686 | 0 | 0 | print "$state $returntype $method\($parameters\)\;\n"; | ||||
687 | } | ||||||
688 | } | ||||||
689 | |||||||
690 | sub _ProcessPerlMethod | ||||||
691 | { | ||||||
692 | #** @method private _ProcessPerlMethod ($line) | ||||||
693 | # This method will process the contents of a subroutine/function/method and try to figure out | ||||||
694 | # the name and wether or not it is a private or public method. The private or public status, | ||||||
695 | # if not defined in a doxygen comment block will be determined based on the file name. As with | ||||||
696 | # C and other languages, an "_" should be the first character for all private functions/methods. | ||||||
697 | # @param line - required string (full line of code) | ||||||
698 | #* | ||||||
699 | 0 | 0 | 0 | my $self = shift; | |||
700 | 0 | 0 | my $line = shift; | ||||
701 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
702 | 0 | 0 | $logger->debug("### Entering _ProcessPerlMethod ###"); | ||||
703 | |||||||
704 | 0 | 0 | my $sClassName = $self->{'_sCurrentClass'}; | ||||
705 | |||||||
706 | 0 | 0 | 0 | 0 | if ($line =~ /^\s*sub\s+([\w]+)/ and $line =~ /^\s*sub\s+([\D][\w]*)/) | ||
707 | { | ||||||
708 | # We should keep track of the order in which the methods were written in the code so we can print | ||||||
709 | # them out in the same order | ||||||
710 | 0 | 0 | my $sName = $1; | ||||
711 | # If they have declared the subrountine with a brace on the same line, lets remove it | ||||||
712 | 0 | 0 | $sName =~ s/\{.*\}?//; | ||||
713 | # Remove any leading or trailing whitespace from the name, just to be safe | ||||||
714 | 0 | 0 | $sName =~ s/\s//g; | ||||
715 | # check if we have a prototype | ||||||
716 | 0 | 0 | my ($method, $proto) = split /[()]/, $sName; | ||||
717 | 0 | 0 | 0 | $sName = $method || ""; | |||
718 | 0 | 0 | $sName =~ s/\s//g; | ||||
719 | 0 | 0 | 0 | if (defined($proto)) {$proto =~ s/\s//g;} | |||
0 | 0 | ||||||
720 | 0 | 0 | 0 | my $sProtoType = $proto || ""; | |||
721 | 0 | 0 | $logger->debug("Method Name: $sName"); | ||||
722 | |||||||
723 | 0 | 0 | push (@{$self->{'_hData'}->{'class'}->{$sClassName}->{'subroutineorder'}}, $sName); | ||||
0 | 0 | ||||||
724 | 0 | 0 | $self->{'_sCurrentMethodName'} = $sName; | ||||
725 | 0 | 0 | $self->{'_sProtoType'} = $self->_ConvertParameters($sProtoType); | ||||
726 | } | ||||||
727 | 0 | 0 | 0 | if (!defined($self->{'_sCurrentMethodName'})) {$self->{'_sCurrentMethodName'}='';} | |||
0 | 0 | ||||||
728 | 0 | 0 | 0 | if (!defined($self->{'_sProtoType'})) {$self->{'_sProtoType'}='';} | |||
0 | 0 | ||||||
729 | |||||||
730 | 0 | 0 | my $sMethodName = $self->{'_sCurrentMethodName'}; | ||||
731 | 0 | 0 | my $sProtoType = $self->{'_sProtoType'}; | ||||
732 | |||||||
733 | # Lets find out if this is a public or private method/function based on a naming standard | ||||||
734 | 0 | 0 | 0 | if ($sMethodName =~ /^_/) { $self->{'_sCurrentMethodState'} = 'private'; } | |||
0 | 0 | ||||||
735 | 0 | 0 | else { $self->{'_sCurrentMethodState'} = 'public'; } | ||||
736 | |||||||
737 | 0 | 0 | my $sMethodState = $self->{'_sCurrentMethodState'}; | ||||
738 | 0 | 0 | $logger->debug("Method State: $sMethodState"); | ||||
739 | |||||||
740 | # We need to count the number of open and close braces so we can see if we are still in a subroutine or not | ||||||
741 | # but we need to becareful so that we do not count braces in comments and braces that are in match patters /\{/ | ||||||
742 | # If there are more open then closed, then we are still in a subroutine | ||||||
743 | 0 | 0 | my $cleanline = $line; | ||||
744 | 0 | 0 | $logger->debug("Cleanline: $cleanline"); | ||||
745 | |||||||
746 | # Remove any comments even those inline with code but not if the hash mark "#" is in a pattern match | ||||||
747 | # unless ($cleanline =~ /=~/) { $cleanline =~ s/#.*$//; } | ||||||
748 | # Patch from Stefan Tauner to address hash marks showing up at the last element of an array, $#array | ||||||
749 | 0 | 0 | 0 | unless ($cleanline =~ /=~/) { $cleanline =~ s/([^\$])#.*$/$1/; } | |||
0 | 0 | ||||||
750 | 0 | 0 | $logger->debug("Cleanline: $cleanline"); | ||||
751 | # Need to remove braces from counting when they are in a pattern match but not when they are supposed to be | ||||||
752 | # there as in the second use case listed below. Below the use cases is some ideas on how to do this. | ||||||
753 | # use case: $a =~ /\{/ | ||||||
754 | # use case: if (/\{/) { foo; } | ||||||
755 | # use case: unless ($cleanline =~ /=~/) { $cleanline =~ s/#.*$//; } | ||||||
756 | 0 | 0 | $cleanline =~ s#/.*?/##g; | ||||
757 | 0 | 0 | $logger->debug("Cleanline: $cleanline"); | ||||
758 | # Remove any braces found in a print statement lile: | ||||||
759 | # use case: print "some foo { bar somethingelse"; | ||||||
760 | # use case: print "$self->{'_hData'}->{'filename'}->{'details'}\n"; | ||||||
761 | 0 | 0 | 0 | if ($cleanline =~ /(.*?print\s*)(.*?);(.*)/) | |||
762 | { | ||||||
763 | 0 | 0 | my $sLineData1 = $1; | ||||
764 | 0 | 0 | my $sLineData2 = $2; | ||||
765 | 0 | 0 | my $sLineData3 = $3; | ||||
766 | 0 | 0 | $sLineData2 =~ s#[{}]##g; | ||||
767 | 0 | 0 | $cleanline = $sLineData1 . $sLineData2. $sLineData3; | ||||
768 | } | ||||||
769 | #$cleanline =~ s/(print\s*\".*){(.*\")/$1$2/g; | ||||||
770 | 0 | 0 | $logger->debug("Cleanline: $cleanline"); | ||||
771 | |||||||
772 | 0 | 0 | $self->{'_iOpenBrace'} += @{[$cleanline =~ /\{/g]}; | ||||
0 | 0 | ||||||
773 | 0 | 0 | $self->{'_iCloseBrace'} += @{[$cleanline =~ /\}/g]}; | ||||
0 | 0 | ||||||
774 | 0 | 0 | $logger->debug("Open Brace Number: $self->{'_iOpenBrace'}"); | ||||
775 | 0 | 0 | $logger->debug("Close Brace Number: $self->{'_iCloseBrace'}"); | ||||
776 | |||||||
777 | |||||||
778 | # Use Case 1: sub foo { return; } | ||||||
779 | # Use Case 2: sub foo {\n} | ||||||
780 | # Use Case 3: sub foo \n {\n } | ||||||
781 | |||||||
782 | 0 | 0 | 0 | 0 | if ($self->{'_iOpenBrace'} > $self->{'_iCloseBrace'}) | ||
0 | |||||||
783 | { | ||||||
784 | # Use Case 2, still in subroutine | ||||||
785 | 0 | 0 | $logger->debug("We are still in the subroutine"); | ||||
786 | } | ||||||
787 | elsif ($self->{'_iOpenBrace'} > 0 && $self->{'_iOpenBrace'} == $self->{'_iCloseBrace'}) | ||||||
788 | { | ||||||
789 | # Use Case 1, we are leaving a subroutine | ||||||
790 | 0 | 0 | $logger->debug("We are leaving the subroutine"); | ||||
791 | 0 | 0 | $self->_ChangeState('NORMAL'); | ||||
792 | 0 | 0 | $self->RESETSUB(); | ||||
793 | } | ||||||
794 | else | ||||||
795 | { | ||||||
796 | # Use Case 3, still in subroutine | ||||||
797 | 0 | 0 | $logger->debug("A subroutine has been started but we are not yet in it as we have yet to see an open brace"); | ||||
798 | } | ||||||
799 | |||||||
800 | # Doxygen makes use of the @ symbol and treats it as a special reserved character. This is a problem for perl | ||||||
801 | # and especailly when we are documenting our own Doxygen code we have print statements that include things like @endcode | ||||||
802 | # as is found in _PrintMethodBlock(). Lets convert those @ to @amp; | ||||||
803 | 0 | 0 | $line =~ s/\@endcode/\&\#64\;endcode/g; | ||||
804 | |||||||
805 | # Record the current line for code output | ||||||
806 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'code'} .= $line; | ||||
807 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'length'}++; | ||||
808 | |||||||
809 | # Only set these values if they were not already set by a comment block outside the subroutine | ||||||
810 | # This is for public/private | ||||||
811 | 0 | 0 | 0 | unless (defined $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'state'}) | |||
812 | { | ||||||
813 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'state'} = $sMethodState; | ||||
814 | } | ||||||
815 | # This is for function/method | ||||||
816 | 0 | 0 | 0 | unless (defined $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'type'}) | |||
817 | { | ||||||
818 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'type'} = "method"; | ||||
819 | } | ||||||
820 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'prototype'} = $sProtoType; | ||||
821 | } | ||||||
822 | |||||||
823 | sub _ProcessPodCommentBlock | ||||||
824 | { | ||||||
825 | #** @method private _ProcessPodCommentBlock () | ||||||
826 | # This method will process an entire POD block in one pass, after it has all been gathered by the state machine. | ||||||
827 | #* | ||||||
828 | 0 | 0 | 0 | my $self = shift; | |||
829 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
830 | 0 | 0 | $logger->debug("### Entering _ProcessPodCommentBlock ###"); | ||||
831 | |||||||
832 | 0 | 0 | my $sClassName = $self->{'_sCurrentClass'}; | ||||
833 | 0 | 0 | my @aBlock = @{$self->{'_aPodBlock'}}; | ||||
0 | 0 | ||||||
834 | |||||||
835 | # Lets clean up the array in the object now that we have a local copy as we will no longer need that. We want to make | ||||||
836 | # sure it is all clean and ready for the next comment block | ||||||
837 | 0 | 0 | $self->RESETPOD(); | ||||
838 | |||||||
839 | 0 | 0 | my $sPodRawText; | ||||
840 | 0 | 0 | foreach (@aBlock) | ||||
841 | { | ||||||
842 | # If we find any Doxygen special characters in the POD, lets escape them | ||||||
843 | 0 | 0 | s/(\@|\\|\%|#)/\\$1/g; | ||||
844 | 0 | 0 | $sPodRawText .= $_; | ||||
845 | } | ||||||
846 | |||||||
847 | 0 | 0 | my $parser = new Pod::POM(); | ||||
848 | 0 | 0 | my $pom = $parser->parse_text($sPodRawText); | ||||
849 | 0 | 0 | Doxygen::Filter::Perl::POD->setAsLabel($self->{'_hData'}->{'filename'}->{'fullpath'}); | ||||
850 | 0 | 0 | my $sPodParsedText = Doxygen::Filter::Perl::POD->print($pom); | ||||
851 | |||||||
852 | 0 | 0 | $sPodParsedText =~ s/\*\/\*/\\*\\/\\*/g; | ||||
853 | 0 | 0 | $sPodParsedText =~ s/\/\*/\/\\\*/g; | ||||
854 | 0 | 0 | $sPodParsedText =~ s/\*\//\\*\\//g; | ||||
855 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'comments'} .= $sPodParsedText; | ||||
856 | } | ||||||
857 | |||||||
858 | |||||||
859 | sub _ProcessDoxygenCommentBlock | ||||||
860 | { | ||||||
861 | #** @method private _ProcessDoxygenCommentBlock () | ||||||
862 | # This method will process an entire comment block in one pass, after it has all been gathered by the state machine | ||||||
863 | #* | ||||||
864 | 0 | 0 | 0 | my $self = shift; | |||
865 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
866 | 0 | 0 | $logger->debug("### Entering _ProcessDoxygenCommentBlock ###"); | ||||
867 | |||||||
868 | 0 | 0 | my @aBlock = @{$self->{'_aDoxygenBlock'}}; | ||||
0 | 0 | ||||||
869 | |||||||
870 | # Lets clean up the array in the object now that we have a local copy as we will no longer need that. We want to make | ||||||
871 | # sure it is all clean and ready for the next comment block | ||||||
872 | 0 | 0 | $self->RESETDOXY(); | ||||
873 | |||||||
874 | 0 | 0 | my $sClassName = $self->{'_sCurrentClass'}; | ||||
875 | 0 | 0 | my $sSubState = ''; | ||||
876 | 0 | 0 | $logger->debug("We are currently in class $sClassName"); | ||||
877 | |||||||
878 | # Lets grab the command line and put it in a variable for easier use | ||||||
879 | 0 | 0 | my $sCommandLine = $aBlock[0]; | ||||
880 | 0 | 0 | $logger->debug("The command line for this doxygen comment is $sCommandLine"); | ||||
881 | |||||||
882 | 0 | 0 | $sCommandLine =~ /^\s*#\*\*\s+\@([\w:]+)\s+(.*)/; | ||||
883 | 0 | 0 | my $sCommand = lc($1); | ||||
884 | 0 | 0 | my $sOptions = $2; | ||||
885 | 0 | 0 | 0 | if (!defined($sOptions)) | |||
886 | { | ||||||
887 | # Lets check special case with a '.' or ',' e.g @winchhooks. | ||||||
888 | 0 | 0 | $sCommandLine =~ /^\s*#\*\*\s+\@([\w:]+)([\.,].*)/; | ||||
889 | 0 | 0 | $sCommand = lc($1); | ||||
890 | 0 | 0 | $sOptions = ""; | ||||
891 | 0 | 0 | 0 | if (defined($2)) | |||
892 | { | ||||||
893 | 0 | 0 | $sOptions = "$2"; | ||||
894 | } | ||||||
895 | } | ||||||
896 | 0 | 0 | $logger->debug("Command: $sCommand"); | ||||
897 | 0 | 0 | $logger->debug("Options: $sOptions"); | ||||
898 | |||||||
899 | # If the user entered @fn instead of @function, lets change it | ||||||
900 | 0 | 0 | 0 | if ($sCommand eq "fn") { $sCommand = "function"; } | |||
0 | 0 | ||||||
901 | |||||||
902 | # Lets find out what doxygen sub state we should be in | ||||||
903 | 0 | 0 | 0 | if ($sCommand eq 'file') { $sSubState = 'DOXYFILE'; } | |||
0 | 0 | 0 | |||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
904 | 0 | 0 | elsif ($sCommand eq 'class') { $sSubState = 'DOXYCLASS'; } | ||||
905 | 0 | 0 | elsif ($sCommand eq 'package') { $sSubState = 'DOXYCLASS'; } | ||||
906 | 0 | 0 | elsif ($sCommand eq 'function') { $sSubState = 'DOXYFUNCTION'; } | ||||
907 | 0 | 0 | elsif ($sCommand eq 'method') { $sSubState = 'DOXYMETHOD'; } | ||||
908 | 0 | 0 | elsif ($sCommand eq 'attr') { $sSubState = 'DOXYATTR'; } | ||||
909 | 0 | 0 | elsif ($sCommand eq 'var') { $sSubState = 'DOXYATTR'; } | ||||
910 | 0 | 0 | else { $sSubState = 'DOXYCOMMENT'; } | ||||
911 | 0 | 0 | $logger->debug("Substate is now $sSubState"); | ||||
912 | |||||||
913 | 0 | 0 | 0 | 0 | if ($sSubState eq 'DOXYFILE' ) | ||
0 | |||||||
0 | |||||||
0 | |||||||
0 | |||||||
914 | { | ||||||
915 | 0 | 0 | $logger->debug("Processing a Doxygen file object"); | ||||
916 | # We need to remove the command line from this block | ||||||
917 | 0 | 0 | shift @aBlock; | ||||
918 | 0 | 0 | $self->{'_hData'}->{'filename'}->{'details'} = $self->_RemovePerlCommentFlags(\@aBlock); | ||||
919 | } | ||||||
920 | elsif ($sSubState eq 'DOXYCLASS') | ||||||
921 | { | ||||||
922 | 0 | 0 | $logger->debug("Processing a Doxygen class object"); | ||||
923 | #my $sClassName = $sOptions; | ||||||
924 | 0 | 0 | 0 | my $sClassName = $sOptions || $sClassName; | |||
925 | 0 | 0 | my $classDef = $self->_SwitchClass($sClassName); | ||||
926 | # We need to remove the command line from this block | ||||||
927 | 0 | 0 | shift @aBlock; | ||||
928 | #$self->{'_hData'}->{'class'}->{$sClassName}->{'details'} = $self->_RemovePerlCommentFlags(\@aBlock); | ||||||
929 | 0 | 0 | $classDef->{'details'} = $self->_RemovePerlCommentFlags(\@aBlock); | ||||
930 | } | ||||||
931 | elsif ($sSubState eq 'DOXYCOMMENT') | ||||||
932 | { | ||||||
933 | 0 | 0 | $logger->debug("Processing a Doxygen class object"); | ||||
934 | # For extra comment blocks we need to add the command and option line back to the front of the array | ||||||
935 | 0 | 0 | my $sMethodName = $self->{'_sCurrentMethodName'}; | ||||
936 | 0 | 0 | 0 | if (defined $sMethodName) | |||
937 | { | ||||||
938 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'comments'} .= "\n"; | ||||
939 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'comments'} .= $self->_RemovePerlCommentFlags(\@aBlock); | ||||
940 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'comments'} .= "\n"; | ||||
941 | } | ||||||
942 | else | ||||||
943 | { | ||||||
944 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'comments'} .= "\n"; | ||||
945 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'comments'} .= $self->_RemovePerlCommentFlags(\@aBlock); | ||||
946 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'comments'} .= "\n"; | ||||
947 | } | ||||||
948 | } | ||||||
949 | elsif ($sSubState eq 'DOXYATTR') | ||||||
950 | { | ||||||
951 | # Process the doxygen header first then loop through the rest of the comments | ||||||
952 | #my ($sState, $sAttrName, $sComments) = ($sOptions =~ /(?:(public|private)\s+)?([\$@%\*][\w:]+)\s+(.*)/); | ||||||
953 | 0 | 0 | my ($sState, $modifiers, $modifiersLoop, $modifiersChoice, $fullSpec, $typeSpec, $typeName, $typeLoop, $pointerLoop, $typeCode, $sAttrName, $sComments) = ($sOptions =~ /(?:(public|protected|private)\s+)?(((static|const)\s+)*)((((\w+::)*\w+(\s+|\s*\*+\s+|\s+\*+\s*))|)([\$@%\*])([\w:]+))\s+(.*)/); | ||||
954 | 0 | 0 | 0 | if (defined $sAttrName) | |||
955 | { | ||||||
956 | 0 | 0 | 0 | my $attrDef = $self->{'_hData'}->{'class'}->{$sClassName}->{'attributes'}->{$sAttrName} ||= {}; | |||
957 | 0 | 0 | 0 | if ($typeName) | |||
958 | { | ||||||
959 | 0 | 0 | $attrDef->{'type'} = $typeName; | ||||
960 | } | ||||||
961 | else | ||||||
962 | { | ||||||
963 | 0 | 0 | $attrDef->{'type'} = $self->_ConvertTypeCode($typeCode); | ||||
964 | } | ||||||
965 | 0 | 0 | 0 | if (defined $sState) | |||
966 | { | ||||||
967 | 0 | 0 | $attrDef->{'state'} = $sState; | ||||
968 | } | ||||||
969 | 0 | 0 | 0 | if (defined $sComments) | |||
970 | { | ||||||
971 | 0 | 0 | $attrDef->{'comments'} = $sComments; | ||||
972 | } | ||||||
973 | 0 | 0 | 0 | if (defined $modifiers) | |||
974 | { | ||||||
975 | 0 | 0 | $attrDef->{'modifiers'} = $modifiers; | ||||
976 | } | ||||||
977 | ## We need to remove the command line from this block | ||||||
978 | 0 | 0 | shift @aBlock; | ||||
979 | 0 | 0 | $attrDef->{'details'} = $self->_RemovePerlCommentFlags(\@aBlock); | ||||
980 | 0 | 0 | push(@{$self->GetCurrentClass()->{attributeorder}}, $sAttrName); | ||||
0 | 0 | ||||||
981 | } | ||||||
982 | else | ||||||
983 | { | ||||||
984 | 0 | 0 | $self->ReportError("invalid syntax for attribute: $sOptions\n"); | ||||
985 | } | ||||||
986 | } # End DOXYATTR | ||||||
987 | elsif ($sSubState eq 'DOXYFUNCTION' || $sSubState eq 'DOXYMETHOD') | ||||||
988 | { | ||||||
989 | # Process the doxygen header first then loop through the rest of the comments | ||||||
990 | 0 | 0 | $sOptions =~ /^(.*?)\s*\(\s*(.*?)\s*\)/; | ||||
991 | 0 | 0 | $sOptions = $1; | ||||
992 | 0 | 0 | my $sParameters = $2; | ||||
993 | |||||||
994 | 0 | 0 | my @aOptions; | ||||
995 | my $state; | ||||||
996 | 0 | 0 | my $sMethodName; | ||||
997 | |||||||
998 | 0 | 0 | 0 | if (defined $sOptions) | |||
999 | { | ||||||
1000 | 0 | 0 | @aOptions = split(/\s+/, $sOptions); | ||||
1001 | # State = Public/Private | ||||||
1002 | 0 | 0 | 0 | 0 | if ($aOptions[0] eq "public" || $aOptions[0] eq "private" || $aOptions[0] eq "protected") | ||
0 | |||||||
1003 | { | ||||||
1004 | 0 | 0 | $state = shift @aOptions; | ||||
1005 | } | ||||||
1006 | 0 | 0 | $sMethodName = pop(@aOptions); | ||||
1007 | } | ||||||
1008 | |||||||
1009 | 0 | 0 | 0 | 0 | if ($sSubState eq "DOXYFUNCTION" && !grep(/^static$/, @aOptions)) | ||
1010 | { | ||||||
1011 | 0 | 0 | unshift(@aOptions, "static"); | ||||
1012 | } | ||||||
1013 | |||||||
1014 | 0 | 0 | 0 | unless (defined $sMethodName) | |||
1015 | { | ||||||
1016 | # If we are already in a subroutine and a user uses sloppy documentation and only does | ||||||
1017 | # #**@method in side the subroutine, then lets pull the current method name from the object. | ||||||
1018 | # If there is no method defined there, we should die. | ||||||
1019 | 0 | 0 | 0 | if (defined $self->{'_sCurrentMethodName'}) { $sMethodName = $self->{'_sCurrentMethodName'}; } | |||
0 | 0 | ||||||
1020 | 0 | 0 | else { die "Missing method name in $sCommand syntax"; } | ||||
1021 | } | ||||||
1022 | |||||||
1023 | # If we are not yet in a subroutine, lets keep track that we are now processing a subroutine and its name | ||||||
1024 | 0 | 0 | 0 | unless (defined $self->{'_sCurrentMethodName'}) { $self->{'_sCurrentMethodName'} = $sMethodName; } | |||
0 | 0 | ||||||
1025 | |||||||
1026 | 0 | 0 | 0 | if (defined $sParameters) { $sParameters = $self->_ConvertParameters($sParameters); } | |||
0 | 0 | ||||||
1027 | |||||||
1028 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'returntype'} = join(" ", @aOptions); | ||||
1029 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'type'} = $sCommand; | ||||
1030 | 0 | 0 | 0 | if (defined $state) | |||
1031 | { | ||||||
1032 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'state'} = $state; | ||||
1033 | } | ||||||
1034 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'parameters'} = $sParameters; | ||||
1035 | # We need to remove the command line from this block | ||||||
1036 | 0 | 0 | shift @aBlock; | ||||
1037 | 0 | 0 | $self->{'_hData'}->{'class'}->{$sClassName}->{'subroutines'}->{$sMethodName}->{'details'} = $self->_RemovePerlCommentFlags(\@aBlock); | ||||
1038 | |||||||
1039 | } # End DOXYFUNCTION || DOXYMETHOD | ||||||
1040 | } | ||||||
1041 | |||||||
1042 | sub _RemovePerlCommentFlags | ||||||
1043 | { | ||||||
1044 | #** @method private _RemovePerlCommentFlags ($aBlock) | ||||||
1045 | # This method will remove all of the comment marks "#" for our output to Doxygen. If the line is | ||||||
1046 | # flagged for verbatim then lets not do anything. | ||||||
1047 | # @param aBlock - required array_ref (doxygen comment as an array of code lines) | ||||||
1048 | # @retval sBlockDetails - string (doxygen comments in one long string) | ||||||
1049 | #* | ||||||
1050 | 0 | 0 | 0 | my $self = shift; | |||
1051 | 0 | 0 | my $aBlock = shift; | ||||
1052 | 0 | 0 | my $logger = $self->GetLogger($self); | ||||
1053 | 0 | 0 | $logger->debug("### Entering _RemovePerlCommentFlags ###"); | ||||
1054 | |||||||
1055 | 0 | 0 | my $sBlockDetails = ""; | ||||
1056 | 0 | 0 | my $iInVerbatimBlock = 0; | ||||
1057 | 0 | 0 | foreach my $line (@$aBlock) | ||||
1058 | { | ||||||
1059 | # Lets check for a verbatim command option like '# @verbatim' | ||||||
1060 | 0 | 0 | 0 | if ($line =~ /^\s*#\s*\@verbatim/) | |||
0 | |||||||
1061 | { | ||||||
1062 | 0 | 0 | $logger->debug("Found verbatim command"); | ||||
1063 | # We need to remove the comment marker from the '# @verbaim' line now since it will not be caught later | ||||||
1064 | 0 | 0 | $line =~ s/^\s*#\s*/ /; | ||||
1065 | 0 | 0 | $iInVerbatimBlock = 1; | ||||
1066 | } | ||||||
1067 | elsif ($line =~ /^\s*#\s*\@endverbatim/) | ||||||
1068 | { | ||||||
1069 | 0 | 0 | $logger->debug("Found endverbatim command"); | ||||
1070 | 0 | 0 | $iInVerbatimBlock = 0; | ||||
1071 | } | ||||||
1072 | # Lets remove any doxygen command initiator | ||||||
1073 | 0 | 0 | $line =~ s/^\s*#\*\*\s*//; | ||||
1074 | # Lets remove any doxygen command terminators | ||||||
1075 | 0 | 0 | $line =~ s/^\s*#\*\s*//; | ||||
1076 | # Lets remove all of the Perl comment markers so long as we are not in a verbatim block | ||||||
1077 | # if ($iInVerbatimBlock == 0) { $line =~ s/^\s*#+//; } | ||||||
1078 | # Patch from Sebastian Rose to address spacing and indentation in code examples | ||||||
1079 | 0 | 0 | 0 | if ($iInVerbatimBlock == 0) { $line =~ s/^\s*#\s?//; } | |||
0 | 0 | ||||||
1080 | 0 | 0 | $logger->debug("code: $line"); | ||||
1081 | # Patch from Mihai MOJE to address method comments all on the same line. | ||||||
1082 | 0 | 0 | $sBlockDetails .= $line . " "; |
||||
1083 | #$sBlockDetails .= $line; | ||||||
1084 | } | ||||||
1085 | 0 | 0 | $sBlockDetails =~ s/^([ \t]*\n)+//s; | ||||
1086 | 0 | 0 | chomp($sBlockDetails); | ||||
1087 | 0 | 0 | 0 | if ($sBlockDetails) | |||
1088 | { | ||||||
1089 | 0 | 0 | $sBlockDetails =~ s/^/ \*/gm; | ||||
1090 | 0 | 0 | $sBlockDetails .= "\n"; | ||||
1091 | } | ||||||
1092 | 0 | 0 | return $sBlockDetails; | ||||
1093 | } | ||||||
1094 | |||||||
1095 | sub _ConvertToOfficialDoxygenSyntax | ||||||
1096 | { | ||||||
1097 | #** @method private _ConvertToOfficialDoxygenSyntax ($line) | ||||||
1098 | # This method will check the current line for various unsupported doxygen comment blocks and convert them | ||||||
1099 | # to the type we support, '#** @command'. The reason for this is so that we do not need to add them in | ||||||
1100 | # every if statement throughout the code. | ||||||
1101 | # @param line - required string (line of code) | ||||||
1102 | # @retval line - string (line of code) | ||||||
1103 | #* | ||||||
1104 | 7 | 7 | 7 | my $self = shift; | |||
1105 | 7 | 8 | my $line = shift; | ||||
1106 | 7 | 12 | my $logger = $self->GetLogger($self); | ||||
1107 | 7 | 483 | $logger->debug("### Entering _ConvertToOfficialDoxygenSyntax ###"); | ||||
1108 | |||||||
1109 | # This will match "## @command" and convert it to "#** @command" | ||||||
1110 | 7 | 50 | 44 | if ($line =~ /^\s*##\s+\@/) { $line =~ s/^(\s*)##(\s+\@)/$1#\*\*$2/; } | |||
0 | 0 | ||||||
1111 | else { | ||||||
1112 | 7 | 9 | $logger->debug('Nothing to do, did not find any ## @'); | ||||
1113 | } | ||||||
1114 | 7 | 37 | return $line; | ||||
1115 | } | ||||||
1116 | |||||||
1117 | sub _ConvertTypeCode | ||||||
1118 | { | ||||||
1119 | #** @method private _ConvertTypeCode($code) | ||||||
1120 | # This method will change the $, @, and %, etc to written names so that Doxygen does not have a problem with them | ||||||
1121 | # @param code | ||||||
1122 | # required prefix of variable | ||||||
1123 | #* | ||||||
1124 | 0 | 0 | my $self = shift; | ||||
1125 | 0 | my $code = shift; | |||||
1126 | 0 | my $logger = $self->GetLogger($self); | |||||
1127 | 0 | $logger->debug("### Entering _ConvertParameters ###"); | |||||
1128 | |||||||
1129 | # Lets clean up the parameters list so that it will work with Doxygen | ||||||
1130 | 0 | $code =~ s/\*/any_type /g; | |||||
1131 | 0 | $code =~ s/\$\$/scalar_ref/g; | |||||
1132 | 0 | $code =~ s/\@\$/array_ref/g; | |||||
1133 | 0 | $code =~ s/\%\$/hash_ref/g; | |||||
1134 | 0 | $code =~ s/\$/scalar/g; | |||||
1135 | 0 | $code =~ s/\&/subroutine/g; | |||||
1136 | 0 | $code =~ s/\@/array/g; | |||||
1137 | 0 | $code =~ s/\%/hash/g; | |||||
1138 | |||||||
1139 | 0 | return $code; | |||||
1140 | } | ||||||
1141 | |||||||
1142 | sub _ConvertParameters | ||||||
1143 | { | ||||||
1144 | #** @method private _ConvertParameters () | ||||||
1145 | # This method will change the $, @, and %, etc to written names so that Doxygen does not have a problem with them | ||||||
1146 | # @param sParameters - required string (variable parameter to change) | ||||||
1147 | #* | ||||||
1148 | 0 | 0 | my $self = shift; | ||||
1149 | 0 | my $sParameters = shift; | |||||
1150 | 0 | my $logger = $self->GetLogger($self); | |||||
1151 | 0 | $logger->debug("### Entering _ConvertParameters ###"); | |||||
1152 | |||||||
1153 | # Lets clean up the parameters list so that it will work with Doxygen | ||||||
1154 | 0 | $sParameters =~ s/\*/any_type /g; | |||||
1155 | 0 | $sParameters =~ s/\$\$/scalar_ref /g; | |||||
1156 | 0 | $sParameters =~ s/\@\$/array_ref /g; | |||||
1157 | 0 | $sParameters =~ s/\%\$/hash_ref /g; | |||||
1158 | 0 | $sParameters =~ s/\$/scalar /g; | |||||
1159 | 0 | $sParameters =~ s/\&/subroutine /g; | |||||
1160 | 0 | $sParameters =~ s/\@/array /g; | |||||
1161 | 0 | $sParameters =~ s/\%/hash /g; | |||||
1162 | |||||||
1163 | 0 | return $sParameters; | |||||
1164 | } | ||||||
1165 | |||||||
1166 | =head1 NAME | ||||||
1167 | |||||||
1168 | Doxygen::Filter::Perl - A perl code pre-filter for Doxygen | ||||||
1169 | |||||||
1170 | =head1 DESCRIPTION | ||||||
1171 | |||||||
1172 | The Doxygen::Filter::Perl module is designed to provide support for documenting | ||||||
1173 | perl scripts and modules to be used with the Doxygen engine. We plan on | ||||||
1174 | supporting most Doxygen style comments and POD (plain old documentation) style | ||||||
1175 | comments. The Doxgyen style comment blocks for methods/functions can be inside | ||||||
1176 | or outside the method/function. Doxygen::Filter::Perl is hosted at | ||||||
1177 | http://perldoxygen.sourceforge.net/ | ||||||
1178 | |||||||
1179 | =head1 USAGE | ||||||
1180 | |||||||
1181 | Install Doxygen::Filter::Perl via CPAN or from source. If you install from | ||||||
1182 | source then do: | ||||||
1183 | |||||||
1184 | perl Makefile.PL | ||||||
1185 | make | ||||||
1186 | make install | ||||||
1187 | |||||||
1188 | Make sure that the doxygen-filter-perl script was copied from this project into | ||||||
1189 | your path somewhere and that it has RX permissions. Example: | ||||||
1190 | |||||||
1191 | /usr/local/bin/doxygen-filter-perl | ||||||
1192 | |||||||
1193 | Copy over the Doxyfile file from this project into the root directory of your | ||||||
1194 | project so that it is at the same level as your lib directory. This file will | ||||||
1195 | have all of the presets needed for documenting Perl code. You can edit this | ||||||
1196 | file with the doxywizard tool if you so desire or if you need to change the | ||||||
1197 | lib directory location or the output location (the default output is ./doc). | ||||||
1198 | Please see the Doxygen manual for information on how to configure the Doxyfile | ||||||
1199 | via a text editor or with the doxywizard tool. | ||||||
1200 | Example: | ||||||
1201 | |||||||
1202 | /home/jordan/workspace/PerlDoxygen/trunk/Doxyfile | ||||||
1203 | /home/jordan/workspace/PerlDoxygen/trunk/lib/Doxygen/Filter/Perl.pm | ||||||
1204 | |||||||
1205 | Once you have done this you can simply run the following from the root of your | ||||||
1206 | project to document your Perl scripts or methods. Example: | ||||||
1207 | |||||||
1208 | /home/jordan/workspace/PerlDoxygen/trunk/> doxygen Doxyfile | ||||||
1209 | |||||||
1210 | All of your documentation will be in the ./doc/html/ directory inside of your | ||||||
1211 | project root. | ||||||
1212 | |||||||
1213 | =head1 DOXYGEN SUPPORT | ||||||
1214 | |||||||
1215 | The following Doxygen style comment is the preferred block style, though others | ||||||
1216 | are supported and are listed below: | ||||||
1217 | |||||||
1218 | #** | ||||||
1219 | # ........ | ||||||
1220 | #* | ||||||
1221 | |||||||
1222 | You can also start comment blocks with "##" and end comment blocks with a blank | ||||||
1223 | line or real code, this allows you to place comments right next to the | ||||||
1224 | subroutines that they refer to if you wish. A comment block must have | ||||||
1225 | continuous "#" comment markers as a blank line can be used as a termination | ||||||
1226 | mark for the doxygen comment block. | ||||||
1227 | |||||||
1228 | In other languages the Doxygen @fn structural indicator is used to document | ||||||
1229 | subroutines/functions/methods and the parsing engine figures out what is what. | ||||||
1230 | In Perl that is a lot harder to do so I have added a @method and @function | ||||||
1231 | structural indicator so that they can be documented seperatly. | ||||||
1232 | |||||||
1233 | =head2 Supported Structural Indicators | ||||||
1234 | |||||||
1235 | #** @file [filename] | ||||||
1236 | # ........ | ||||||
1237 | #* | ||||||
1238 | |||||||
1239 | #** @class [class name (ex. Doxygen::Filter::Perl)] | ||||||
1240 | # ........ | ||||||
1241 | #* | ||||||
1242 | |||||||
1243 | #** @method or @function [public|protected|private] [method-name] (parameters) | ||||||
1244 | # ........ | ||||||
1245 | #* | ||||||
1246 | |||||||
1247 | #** @attr or @var [public|protected|private] [type] {$%@}[attribute-name] [brief description] | ||||||
1248 | # ........ | ||||||
1249 | #* | ||||||
1250 | |||||||
1251 | #** @section [section-name] [section-title] | ||||||
1252 | # ........ | ||||||
1253 | #* | ||||||
1254 | |||||||
1255 | #** @brief [notes] | ||||||
1256 | # ........ | ||||||
1257 | #* | ||||||
1258 | |||||||
1259 | =head2 Support Style Options and Section Indicators | ||||||
1260 | |||||||
1261 | All doxygen style options and section indicators are supported inside the | ||||||
1262 | structural indicators that we currently support. | ||||||
1263 | |||||||
1264 | =head2 Documenting Subroutines/Functions/Methods | ||||||
1265 | |||||||
1266 | The Doxygen style comment blocks that describe a function or method can | ||||||
1267 | exist before, after, or inside the subroutine that it is describing. Examples | ||||||
1268 | are listed below. It is also important to note that you can leave the public/private | ||||||
1269 | out and the filter will guess based on the subroutine name. The normal convention | ||||||
1270 | in other languages like C is to have the function/method start with an "_" if it | ||||||
1271 | is private/protected. We do the same thing here even though there is really no | ||||||
1272 | such thing in Perl. The whole reason for this is to help users of the code know | ||||||
1273 | what functions they should call directly and which they should not. The generic | ||||||
1274 | documentation blocks for functions and methods look like: | ||||||
1275 | |||||||
1276 | #** @function [public|protected|private] [return-type] function-name (parameters) | ||||||
1277 | # @brief A brief description of the function | ||||||
1278 | # | ||||||
1279 | # A detailed description of the function | ||||||
1280 | # @params value [required|optional] [details] | ||||||
1281 | # @retval value [details] | ||||||
1282 | # .... | ||||||
1283 | #* | ||||||
1284 | |||||||
1285 | #** @method [public|protected|private] [return-type] method-name (parameters) | ||||||
1286 | # @brief A brief description of the method | ||||||
1287 | # | ||||||
1288 | # A detailed description of the method | ||||||
1289 | # @params value [required|optional] [details] | ||||||
1290 | # @retval value [details] | ||||||
1291 | # .... | ||||||
1292 | #* | ||||||
1293 | |||||||
1294 | The parameters would normally be something like $foo, @bar, or %foobar. I have | ||||||
1295 | also added support for scalar, array, and hash references and those would be | ||||||
1296 | documented as $$foo, @$bar, %$foobar. An example would look this: | ||||||
1297 | |||||||
1298 | #** @method public ProcessDataValues ($$sFile, %$hDataValues) | ||||||
1299 | |||||||
1300 | =head2 Function / Method Example | ||||||
1301 | |||||||
1302 | sub test1 | ||||||
1303 | { | ||||||
1304 | #** @method public test1 ($value) | ||||||
1305 | # .... | ||||||
1306 | #* | ||||||
1307 | } | ||||||
1308 | |||||||
1309 | #** @method public test2 ($value) | ||||||
1310 | # .... | ||||||
1311 | #* | ||||||
1312 | sub test2 | ||||||
1313 | { | ||||||
1314 | |||||||
1315 | } | ||||||
1316 | |||||||
1317 | =head1 DATA STRUCTURE | ||||||
1318 | |||||||
1319 | $self->{'_hData'}->{'filename'}->{'fullpath'} = string | ||||||
1320 | $self->{'_hData'}->{'filename'}->{'shortname'} = string | ||||||
1321 | $self->{'_hData'}->{'filename'}->{'version'} = string | ||||||
1322 | $self->{'_hData'}->{'filename'}->{'details'} = string | ||||||
1323 | $self->{'_hData'}->{'includes'} = array | ||||||
1324 | |||||||
1325 | $self->{'_hData'}->{'class'}->{'classorder'} = array | ||||||
1326 | $self->{'_hData'}->{'class'}->{$class}->{'subroutineorder'} = array | ||||||
1327 | $self->{'_hData'}->{'class'}->{$class}->{'attributeorder'} = array | ||||||
1328 | $self->{'_hData'}->{'class'}->{$class}->{'details'} = string | ||||||
1329 | $self->{'_hData'}->{'class'}->{$class}->{'comments'} = string | ||||||
1330 | |||||||
1331 | $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}->{'type'} = string (method / function) | ||||||
1332 | $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}->{'returntype'} = string (return type) | ||||||
1333 | $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}->{'state'} = string (public / private) | ||||||
1334 | $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}->{'parameters'} = string (method / function parameters) | ||||||
1335 | $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}->{'prototype'} = string (method / function prototype parameters) | ||||||
1336 | $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}->{'code'} = string | ||||||
1337 | $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}->{'length'} = integer | ||||||
1338 | $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}->{'details'} = string | ||||||
1339 | $self->{'_hData'}->{'class'}->{$class}->{'subroutines'}->{$method}->{'comments'} = string | ||||||
1340 | |||||||
1341 | $self->{'_hData'}->{'class'}->{$class}->{'attributes'}->{$variable}->{'state'} = string (public / private) | ||||||
1342 | $self->{'_hData'}->{'class'}->{$class}->{'attributes'}->{$variable}->{'modifiers'} = string | ||||||
1343 | $self->{'_hData'}->{'class'}->{$class}->{'attributes'}->{$variable}->{'comments'} = string | ||||||
1344 | $self->{'_hData'}->{'class'}->{$class}->{'attributes'}->{$variable}->{'details'} = string | ||||||
1345 | |||||||
1346 | =head1 AUTHOR | ||||||
1347 | |||||||
1348 | Bret Jordan |
||||||
1349 | |||||||
1350 | =head1 LICENSE | ||||||
1351 | |||||||
1352 | Doxygen::Filter::Perl is licensed with an Apache 2 license. See the LICENSE | ||||||
1353 | file for more details. | ||||||
1354 | |||||||
1355 | =cut | ||||||
1356 | |||||||
1357 | return 1; |