| 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 Code:\n"; |
||||
| 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; |