1#!/usr/bin/env perl
2
3=head1 NAME
4
5fixcomments.pl
6
7=head1 SYNOPSIS
8
9fixcomments.pl [options] [infile]
10
11=head1 OPTIONS
12
13=over 4
14
15=item B<infile>
16
17Input file to process (uses stdin if not specified)
18
19=item B<--help|-h>
20
21A little help
22
23=item B<--verbose|-v>
24
25Output debug messages (to stderr), repeat for even more output
26
27=back
28
29=head1 DESCRIPTION
30
31This script will read a Fortran file and attempt to add doxify comments
32to both FUNCTIONs and SUBROUTINEs.
33
34=cut
35
36use strict;
37use warnings;
38use FindBin;
39use lib "$FindBin::RealBin/lib";
40use Pod::Usage qw(pod2usage);
41use Getopt::Long;
42
43my $verbose = 0;
44my $help = 0;
45
46GetOptions(
47    'verbose+' => \$verbose,
48    'help|?' => \$help) or pod2usage(2);
49pod2usage(1) if $help;
50
51sub print_debug {
52    print(STDERR "DEBUG: @_\n") if ($verbose > 0);
53}
54
55# Regular expressions for matching
56my $DOXYGEN_HEADER = "^!>";
57
58# The empty string
59my $EMPTY = q{};
60
61# Toggle variables to keep track of which doxygen item is being processed
62# in the current header.
63my ($hasParam,
64    $hasBrief,
65    $hasPar,
66    $hasDate,
67    $hasVersion,
68    $hasAuthor,
69    $hasNote,
70    $hasRetVal,
71    $hasReturn,
72    $hasRandom,
73    $hasRemainder);
74
75# Variables with s at the end contains the actual text read in from
76# existing doxygen header
77my (%params,
78    $briefs,
79    $dates,
80    $versions,
81    $pars,
82    $authors,
83    $notes,
84    $retVals,
85    $returns,
86    $randoms,
87    $remainders);
88
89# If currently in INTERFACE block
90my $insideInterface = 0;
91
92# Whether the SUBROUTINE/FUNCTION definition contains an & line continuation
93my $hasAmpersand = 0;
94
95# Whether when processing subroutine definition we are in brackets
96my $inParentheses = 0;
97
98# Whether the procedure definition contains the RETURN value
99my $hasReturnAsArg = 0;
100
101# Keeps track of which parameters in the current procedure have
102# a matching doxygen header
103my %matched;
104
105# Buffer for lines
106my $buffer = $EMPTY;
107
108# The old doxygen header as read from file
109my $oldheader = $EMPTY;
110
111# Any unprocessed lines
112my $leftoverlines = $EMPTY;
113
114# The name of the procedure being processed
115my $procedureName = $EMPTY;
116
117# Whether the procedure is a function
118my $isFunction;
119
120initVariables();
121
122# While there are still lines to read in our INPUT file
123while (<>) {
124    # Get the line we've just read in
125    my $currline = $_;
126
127    # If an existing doxygen header is encountered then process
128    if (matchDoxygenHeaderDefinition($currline)) {
129        print_debug("Matched doxygen header");
130        $currline = processDoxygenHeader($currline);
131    }
132
133    # Are we inside an interface block?
134    # If so we don't want to add any comments here
135    if ( $currline =~ m/^\s*INTERFACE\s*\n/xms ) {
136        print_debug("Start of INTERFACE encountered");
137        $insideInterface = 1;
138    }
139    if ( $currline =~ m/^\s*END\s+INTERFACE\s*\n/xms ) {
140        print_debug("End of INTERFACE encountered");
141        $insideInterface = 0;
142    }
143
144    # Look for procedure (SUBROUTINE/FUNCTION definitions)
145    # These can be the initial definiton line, or a continuation line
146    # We don't add comments to code inside an interface block
147    if ((matchSubroutineDefinition($currline) || $hasAmpersand)
148        && !($insideInterface)) {
149        print_debug("Matched subroutine definition");
150        processSubroutineDefinition($currline);
151    } else {
152        print_debug("Subroutine definition not matched");
153        if ($oldheader eq $EMPTY) {
154            # No header remaining so just print out line as read
155            print_debug("Empty old header, writing out line:");
156            print_debug($currline);
157            print $currline;
158        } else {
159            # Header has been processed, need to do something with remaining lines
160            print_debug("Non-empty old header for line:");
161            print_debug($currline);
162            if (($currline =~ m/^\s*$/xms) ||
163                ($currline =~ m/\#if/xms)) {
164                # Blank line or #if line, so store for printing later
165                print_debug("Empty line or #if, storing for later");
166                $leftoverlines = $leftoverlines . $currline;
167            } elsif ($currline =~ m/^\s*!\s*/xms) {
168                # Have a comment so add to header
169                print_debug("Inline comment, adding to header");
170                $oldheader = $oldheader . $currline;
171            } else {
172                # If it was a MODULE or TYPE header we still need to write
173                # it back out to file.
174                print_debug("Writing existing non FUNCTION/SUBROUTINE header to file");
175                print $oldheader;
176                print $leftoverlines;
177                print $currline;
178                # Reset variables after output
179                initVariables();
180            }
181        }
182    } # End of the if (($currline is SUBROUTINE or FUNCTION ) block
183} # End of main while loop
184
185# Perhaps do a second pass to remove any double occurrences of !> *** type lines
186
187sub initToggles {
188    $hasParam = 0;
189    $hasBrief = 0;
190    $hasPar = 0;
191    $hasDate = 0;
192    $hasVersion = 0;
193    $hasAuthor = 0;
194    $hasNote = 0;
195    $hasRetVal = 0;
196    $hasRandom = 0;
197    $hasRemainder = 0;
198    return;
199}
200
201sub initVariables {
202    initToggles();
203    undef %params;
204    undef %matched;
205    $briefs = $EMPTY;
206    $dates = $EMPTY;
207    $versions = $EMPTY;
208    $pars = $EMPTY;
209    $authors = $EMPTY;
210    $notes = $EMPTY;
211    $retVals = $EMPTY;
212    $returns = $EMPTY;
213    $randoms = $EMPTY;
214    $remainders = $EMPTY;
215    $buffer = $EMPTY;
216    $oldheader = $EMPTY;
217    $leftoverlines = $EMPTY;
218    $procedureName = $EMPTY;
219    $isFunction = 0;
220    $inParentheses = 0;
221    return;
222}
223
224# Look for a doxygen header definition in an input line.
225sub matchDoxygenHeaderDefinition {
226    my ($lineToProcess) = @_;
227
228    print_debug("Trying to match doxygen header $DOXYGEN_HEADER against line");
229    print_debug($lineToProcess);
230
231    my $match = 0;
232
233    if ($lineToProcess =~ m/$DOXYGEN_HEADER/xms) {
234        $match = 1;
235    }
236
237    print_debug("Doxygen header match value: $match");
238    return $match;
239}
240
241# Look for SUBROUTINE or FUNCTION definitions.
242sub matchSubroutineDefinition {
243    my ($lineToProcess) = @_;
244
245    print_debug("Trying to match subroutine definition against line:");
246    print_debug($lineToProcess);
247
248    # Immediately discount lines with comments at the start
249    my $commentPattern = '^\!';
250    if ($lineToProcess =~ m/$commentPattern/xms) {
251        print_debug("Matched comment");
252        return 0;
253    }
254    # Assume that lines contain SUBROUTINE or FUNCTION followed by space
255    # and then the name of the procedure which may have a space before the (
256    my $patternProcWithBrackets = '(SUBROUTINE|FUNCTION)'    # Subroutine or function
257                                 .'\s+'                      # followed by one or more whitespace characters
258                                 .'(\w|\[|\])+'              # followed by one or more of (word or [ or ])
259                                 .'\s*'                      # followed by zero or more whitespace characters
260                                 .'\(';                      # followed by open bracket.
261
262    # Need to allow for SUBROUTINE without any arguments or brackets too
263    my $patternSubNoBracketsAtStartOfLine = '^\s*'           # Start with zero or more whitespace
264                                           .'SUBROUTINE'     # then subroutine
265                                           .'\s*'            # then zero or more whitespace
266                                           .'(\w|\[|\])+'    # then one or more of (word or [ or ])
267                                           .'\s*.*';         # then zero or more whitespace
268
269    # We also protect against adding comments to commented out SUBROUTINE/FUNCTION calls
270    my $patternCommentedOut = '!\s*(SUBROUTINE|FUNCTION)';
271
272    # Protect against definitions inside quotes
273    my $patternInQuotes = '"\s*(SUBROUTINE|FUNCTION)';
274
275    my $match1 = 0;
276    my $match2 = 0;
277    my $match3 = 0;
278    my $match4 = 0;
279
280    if ($lineToProcess =~ m/$patternProcWithBrackets/xms) {
281        $match1 = 1;
282    }
283    if ($lineToProcess =~ m/$patternSubNoBracketsAtStartOfLine/xms) {
284        $match2 = 1;
285    }
286    if ($lineToProcess =~ m/$patternCommentedOut/xms) {
287        $match3 = 1;
288    }
289    if ($lineToProcess =~ m/$patternInQuotes/xms) {
290        $match4 = 1;
291    }
292
293    my $match = (($match1 || $match2) && !($match3) && !($match4));
294    print_debug("Subroutine definition match value: $match");
295    return $match
296}
297
298sub processDoxygenHeader {
299
300    my ($currline) = @_;
301
302    print_debug("Processing Doxygen Header");
303
304    # Each time we find a header we need to reset toggles and their data
305    initVariables();
306    my $paramName = $EMPTY;
307
308    # Start of do-while over match on ($currline =~ m/^\s*!/i)
309    do {
310        print_debug("Processing header line:");
311        print_debug($currline);
312        # Keep the headers safe, may need them! We use the oldheader variable to
313        # keep the complete headers for MODULE and TYPE intact such that we
314        # can just dump them straight back out without making any changes.
315        $oldheader = $oldheader . $currline;
316        # Pick up parameters - matches the word param separated by spaces
317        if (($currline =~ m/!>\s\\param\s+(\S+)\s*/xms) ||
318            ($currline =~ m/!>\s\\param\[.*\]\s+(\S+)\s*/xms)) {
319
320            # Get the param name
321            $paramName = $1;
322
323            print_debug("Got header for parameter $paramName");
324
325            # Cover the case where two arguments have the same name
326            if (exists $params{$paramName}) {
327                $paramName = $paramName . "new";
328            }
329            # Store the param into a hash indexed by its name
330            $params{$paramName} = $currline;
331            # Set matched for this param to zero as we don't
332            # yet have a match in the argument list
333            $matched{$paramName} = 0;
334            initToggles();
335            $hasParam = 1;
336        } elsif ($currline =~ m/!>\s\\brief\s*/xms) {
337            print_debug("Got briefs header");
338            $briefs = $briefs . $currline;
339            initToggles();
340            $hasBrief = 1;
341        } elsif ($currline =~ m/!>\s\\date*/xms) {
342            print_debug("Got dates header");
343            $dates = $dates . $currline;
344            initToggles();
345            $hasDate = 1;
346        } elsif ($currline =~ m/!>\s\\version\s*/xms) {
347            print_debug("Got version header");
348            $versions = $versions . $currline;
349            initToggles();
350            $hasVersion = 1;
351        } elsif ($currline =~ m/!>\s\\par\s*/xms) {
352            print_debug("Got par header");
353            $pars = $pars . $currline;
354            initToggles();
355            $hasPar = 1;
356        } elsif ($currline =~ m/!>\s\\author\s*/xms) {
357            print_debug("Got author header");
358            $authors = $authors . $currline;
359            initToggles();
360            $hasAuthor= 1;
361        } elsif ($currline =~ m/!>\s\\note\s*/xms) {
362            print_debug("Got note header");
363            $notes = $notes . $currline;
364            initToggles();
365            $hasNote = 1;
366        } elsif ($currline =~ m/!>\s\\retval\s*/xms) {
367            print_debug("Got retval header");
368            $retVals = $retVals . $currline;
369            initToggles();
370            $hasRetVal = 1;
371        } elsif ($currline =~ m/!>\s\\returns\s*/xms) {
372            print_debug("Got return header");
373            $returns = $returns . $currline;
374            initToggles();
375            $hasReturn = 1;
376        } elsif ($currline =~ m/!>\s\\return\s*/xms) {
377            print_debug("Got return header");
378            $returns = $returns . $currline;
379            initToggles();
380            $hasReturn = 1;
381        } elsif ($currline =~ m/!>\s\\\S+/xms) {
382            # Randoms contains anything else that looks
383            # like a DOXYGEN header. with a \whatever
384            # Must check to see if line has already been commented.
385            # We also avoid commenting a blank \param line
386            print_debug("Got random header");
387            if (($currline !~ m/UNKNOWN_DOXYGEN_COMMENT/xms) &&
388                ($currline !~ m/UNKNOWN_COMMENT/xms) &&
389                ($currline !~ m/!>\s*\\param\s*\n/xms)) {
390                $randoms = $randoms . $currline;
391                chomp($randoms);
392                # Add on text for output
393                $randoms = $randoms . " UNKNOWN_DOXYGEN_COMMENT\n";
394            } else {
395                # Otherwise just add to randoms
396                $randoms = $randoms . $currline;
397            }
398            initToggles();
399            $hasRandom = 1;
400        } elsif ($currline =~ m/^!>\s*/xms) {
401            # Handle multi line entries. Append what you find onto the
402            # previous one read in until you get to another \
403            # The \brief, \param, \par, \author, random and remainder
404            # entries can all be multi-line.
405            # The \version and \date entries should be single line and
406            # thus we don't have an elsif for them.
407            print_debug("Got line continuation");
408            if ($hasParam) {
409                $params{$paramName} = $params{$paramName} . $currline;
410            } elsif ($hasBrief) {
411                $briefs = $briefs . $currline;
412            } elsif ($hasPar) {
413                $pars = $pars . $currline;
414            } elsif ($hasAuthor) {
415                $authors = $authors . $currline;
416            } elsif ($hasNote){
417                $notes = $notes . $currline;
418            } elsif ($hasRetVal) {
419                $retVals = $retVals . $currline;
420            } elsif ($hasReturn) {
421                $returns = $returns . $currline;
422            } elsif ($hasRandom) {
423                # Must check to see if line has already been commented
424                if (($currline !~ m/UNKNOWN_DOXYGEN_COMMENT/xms) &&
425                    ($currline !~ m/UNKNOWN_COMMENT/xms)) {
426                    $randoms = $randoms . $currline;
427                    chomp($randoms);
428                    # Add on text for output
429                    $randoms = $randoms . " UNKNOWN_DOXYGEN_COMMENT\n";
430                } else {
431                    $randoms = $randoms . $currline;
432                }
433            } else {
434                # Get any header lines beginning with "!> some text but
435                # no \ thus not in DOXYGEN format
436                $hasRemainder = 1;
437                # Must check to see if the line has already been
438                # commented and also that it's not empty
439                if (($currline !~ m/UNKNOWN_COMMENT/xms) &&
440                    ($currline !~ m/!>\s*\n/xms)) {
441                    # Add on text for output
442                    $currline =~ s/!>/!> \\note UNKNOWN_COMMENT /gx;
443                    $remainders = $remainders . $currline;
444                } else {
445                    $remainders = $remainders . $currline;
446                }
447            }
448        } elsif ($currline !~ m/^!\s*\*/xms) {
449            # Any other header line that's not "***..." or a Doxygen
450            # comment, ie "! some comment or other"
451            print_debug("Got non-doxygen line");
452            if ($hasBrief) {
453                # Put comment in brief, replacing ! with !>
454                $currline =~ s/!/!>/xms;
455                $briefs = $briefs . $currline;
456            } else {
457                $currline =~ s/^\s+//;
458                # Must check to see if line has already been commented
459                if ($currline !~ m/UNKNOWN_COMMENT/xms) {
460                    # Add on text for output, changing ! for !>
461                    $currline =~ s/!/!> \\note UNKNOWN_COMMENT /gx;
462                    $remainders = $remainders . $currline;
463                } else {
464                    $remainders = $remainders . $currline;
465                }
466            }
467        }
468        # Get the next line in the header block
469        $currline = <>;
470    } while ($currline =~ m/^\s*!/xms); # Rule as to when you have finished a header. Currently Anything beginning with !
471    return $currline;
472} # End of header processing subroutine
473
474sub processSubroutineDefinition {
475
476    my ($currline) = @_;
477
478    print_debug("Processing Subroutine line:");
479    print_debug($currline);
480    # functionLine will contain the procedure definition with any
481    # unrequired text stripped off, $currline will still contain the actual code
482    my $functionLine = $EMPTY;
483    if (!($hasAmpersand)) {
484        # Remove anything preceeding the SUBROUTINE or FUNCTION definition
485        # e.g. RECURSIVE, REAL, INTEGER, (KIND=dp), ELEMENTAL etc etc.
486        $currline =~ /((\bFUNCTION\b|\bSUBROUTINE\b).+)/x;
487        # $1 contains whatever remains after removing anything before the
488        # word SUBROUTINE or FUNCTION
489        $functionLine = $1;
490    } else {
491        $functionLine = $currline;
492    }
493    # Remove BIND(*) from the definition
494    my $tmp = $functionLine;
495    $tmp =~ s/\bBIND\b\(\w+\W*\w*\W*\w*\W*\)//x;
496    $functionLine = $tmp;
497
498    # Strip the newline char from the end
499    chomp($functionLine);
500
501    $hasAmpersand = 0;
502    $hasReturnAsArg = 0;
503    my $lelement = $EMPTY;
504
505    # Split the subroutine or function definition by space or comma
506    my @string = split(/([,\(\)\s+]+)/x, $functionLine);
507    foreach (@string) {
508        if (defined) {
509        my $p = $_;
510        $p =~ s/^\s+|\s+$//gx;
511        if (($p ne $EMPTY) && ($p ne ",")) {
512        print_debug("Processing item $p");
513        if ($p eq "&") {
514            # If we encounter an & then it spans multiple lines
515            print_debug("Got & line continuation");
516            $hasAmpersand = 1;
517            # Buffer the line details as we can't print out yet
518            $buffer = "$buffer$currline";
519        } elsif ($p eq "(") {
520            print_debug("Entered parentheses");
521            $inParentheses = 1;
522        } elsif ($p eq ")") {
523            print_debug("Left parentheses");
524            $inParentheses = 0;
525        } elsif ($p eq ",") {
526            print_debug("Comma");
527        } else {
528            if ($inParentheses) {
529                print_debug("In parentheses, parameter: $p, previous parameter: $lelement");
530                # Must have either a parameter of a function return value
531                if (($lelement =~ m/RESULT/ixms) && ($hasReturnAsArg)) {
532                    print_debug("Got return parameter $p");
533                    if ($returns eq $EMPTY) {
534                        # If the previous element was RESULT outside of
535                        # parantheses then this element must be whatever
536                        # gets returned by the procedure.
537                        # if no return data is available print out the ...
538                        # to header
539                        # Only stored for now so it is always printed
540                        # in the same place (after the \params)
541                        $returns = "!> \\return ...\n";
542                    }
543                } else {
544                    # Must be parameter
545                    # Update the matched hash table so that all arguments
546                    # in subroutine/function header are set as true
547                    print_debug("Processing parameter $p");
548                    $matched{$p} = 1;
549                    if (!(exists($params{$p})) || !(defined($params{$p})) || ($params{$p} eq $EMPTY)) {
550                        # If the entry for this parameter is missing we use
551                        # the standard text for a missing entry
552                        print_debug("Missing entry for parameter $p, creating blank");
553                        print "!> \\param $p ...\n";
554                    } else {
555                        print_debug("Using existing entry for parameter $p");
556                        if ($params{$p} !~ m/\\param\s*(\w+|\[.*\]\s+\w+)\s*\n/xms ) {
557                            # Entry must contain some text after the parameter name
558                            print_debug("Using entry unchanged");
559                            print $params{$p};
560                        } else {
561                            if ($params{$p} =~ m/!>\s*\n$/x) {
562                                # We need to guard against \param entries which have
563                                # no text but have a blank line "!>" line appended
564                                # Need to split this parameter into it's individual lines
565                                my @tmpString = split(/\n/x, $params{$p});
566                                # Find out how many lines we have in this entry
567                                my $tmpLen = scalar(@tmpString);
568                                # Append on the ... to the first line
569                                $tmpString[0] = $tmpString[0] . " ...";
570                                for (my $i = 0; $i < $tmpLen; $i++) {
571                                    # Re-add the carriage return to each line
572                                    print "$tmpString[$i]\n";
573                                }
574                            } else {
575                                chomp($params{$p});
576                                print $params{$p}," ...\n";
577                            }
578                        }
579                    }
580                }
581            } else {
582                print_debug("Processing element not in parentheses: $p");
583                if ($lelement =~ m/(SUBROUTINE|FUNCTION)/ixms) {
584                    # Previous element is FUNCTION or SUBROUTINE so this must be name
585                    $procedureName = $p;
586                    print_debug("Got procedure name $procedureName");
587                    if ($lelement =~ m/FUNCTION/ixms) {
588                        $isFunction = 1;
589                    }
590                    if (($briefs eq $EMPTY) or ($briefs eq "!> \\brief\n")) {
591                        # \brief does not exist or is present but empty - add text
592                        print "! **************************************************************************************************\n";
593                        print "!> \\brief ...\n";
594                    } else {
595                        # \brief exists and contains text
596                        print $briefs;
597                    }
598                } elsif ($p =~ m/RESULT/ixms) {
599                    # Check to see if parameter is RESULT for a FUNCTION
600                    print_debug("Need to get function result parameter");
601                    $hasReturnAsArg = 1;
602                }
603            }
604            $lelement = $p; # Take a note of the array element for comparison, ignoring & and ()
605        } # End of if $p eq "&" conditional
606    }
607        }
608    } # End of for loop over @string
609
610    # Code to loop over all the elements of matched hash table. If any
611    # remain that were not in the function/subroutine header we want to
612    # make sure we keep this data in the header. It could be a comment
613    # or it could refer to old arguments that no longer exist.
614    # However, we don't want to throw the text away. We only print out
615    # if the argument doesn't match one of the arguments *and* there is
616    # no more of the procedure definition left to read, i.e. hasAmpersand is false
617    foreach my $paramName (sort keys %params) {
618        # We need to sort the keys otherwise the output order of the hash
619        # is given in internal order
620        if (!($matched{$paramName}) && !($hasAmpersand)) {
621            if ($params{$paramName} eq '!> \param '.$paramName." ...\n") {
622                # there was no comment, just drop parameter
623            } elsif ($params{$paramName} !~ m/UNMATCHED_PROCEDURE_ARGUMENT/) {
624                # Must protect against updating an existing comment
625                # Get rid of \n so UNMATCHED* text can be appended on.
626                chomp($params{$paramName});
627                print $params{$paramName} . " UNMATCHED_PROCEDURE_ARGUMENT: please check \n";
628            } else {
629                print $params{$paramName};
630            }
631        }
632    }
633
634    # If after looping through the elements there is no ampersand
635    # we close off the comment and write out the procedure definition
636    if (!($hasAmpersand)) {
637        if ($returns ne $EMPTY) {
638            # Print RESULT value first so that it should come straight after the \param definitions
639            print $returns;
640        } else {
641            # Get return value from function name
642            if ($isFunction) {
643                print "!> \\return ...\n";
644            }
645        }
646        if ($retVals ne $EMPTY) {
647            # Print return values definitions second so that they come after any \return definitions
648            print $retVals;
649        }
650        if (($dates eq $EMPTY) || ($dates eq "!> \\date\n")) {
651            # dates entry empty or exists and contains no text
652###            print "!> \\date MISSING_COMMENT: Unknown\n";  # Use this line if you want to add text to the entry
653            print $dates;
654        } else {
655            print $dates;
656        }
657        if (($pars eq $EMPTY) || ($pars eq "!> \\par History\n")) {
658            # pars entry empty or exists but contains no text
659###            print "!> \\par History\n"; # Use this line if you want to add text to the entry
660###            print "!>     MISSING_COMMENT: Unknown\n"; # Use this line if you want to add text to the entry
661            print $pars;
662        } else {
663            print $pars;
664        }
665        if (($authors eq $EMPTY) || ($authors eq "!> \\author\n")) {
666            # authors empty or exists but contains no text
667###            print "!> \\author MISSING_COMMENT: Unknown\n"; # Use this line if you want to add text to the entry
668            print $authors;
669        } else {
670            print $authors;
671        }
672        if ($versions ne $EMPTY) {
673            print $versions;
674        }
675        if ($randoms ne $EMPTY) {
676            print $randoms;
677        }
678        if ($notes ne $EMPTY){
679            print $notes;
680        }
681        if ($remainders ne $EMPTY) {
682            # Dumps out whatever else remainded in the header (e.g. stuff begining !> without a \ or stuff beginning with just a !) for the SUBROUTINE/FUNCTION at the end
683            print $remainders;
684        }
685        print "! **************************************************************************************************\n";
686        print "$leftoverlines$buffer$currline";
687        # Reset all the variables after writing out the header
688        initVariables();
689        return;
690    }
691}
692