File Coverage

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 "\topen/close icon 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 or
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;