<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#
#                            DocExtractor.pm
#                            ---------------
#
# Description:
#   Extract Documentation strings following variable declarations and
#   Collect in LaTeX longtable environment for inclusion in the manual.
# Author: wd (wdobler#cpan:org =~ tr/:#/.@/)
# $Id$
#
# This file is part of the Pencil Code and licensed under the GNU Public
# License version 3 or later; see $PENCIL_HOME/license/GNU_public_license.txt.
#

package Pencil::DocExtractor;

use warnings;
use strict;
use Carp;
use vars qw($VERSION);

##use critic

$VERSION = '0.1';

# ---------------------------------------------------------------------- #
##
## Object constructor
##

sub new {
#
# Takes configuration parameters as argument, either in a (flattened) hash
#
#   Pencil::DocExtractor-&gt;new(marker   =&gt; qr/!\s*DIAG_DOC:/,
#                             prefix   =&gt; qr/integer\s*::\s*idiag_/,
#                             whatelse =&gt; somethingelse);
#
# or in a hashref
#
#   Pencil::DocExtractor-&gt;new({ marker =&gt; qr/!\s*BC[XYZ]_DOC:/});
#
    my $proto = shift;          # either classref or object ref or string
    my @argv  = @_;

    my $self = {};
    my $class;
    my $parent = {};
    if (ref($proto)) {
        $class = ref($proto);
        # If this is a call of the form $object-&gt;new(), extract properties
        # of original object and use them as default values.
        if ($proto-&gt;isa('Pencil::DocExtractor')) {
            $parent = $proto;
        }
    } else {
        $class = $proto;
    }

    # Parse argument(s) (name =&gt; &lt;nlname&gt;); may be list or hashref
    my %args;
    if (@argv) {
        if (ref($argv[0]) eq 'HASH') { # parse($hashref)
            %args = %{$argv[0]};
        } else {                # parse(%hash) or parse(@list)
            %args = @argv;
        }
    }
    # Set object fields based on
    # 1. explicitly given parameters,
    # 2. existing fields (this could be an object constructor [as in
    #   $bcx_doc = $bc_doc-&gt;new(marker =&gt; qr/!\s*BCX_DOC:/);] or a class
    #   constructor)
    # 3. a default value

    $self-&gt;{MARKER}  = $args{marker}  || $parent-&gt;{MARKER} || qr/!\s*[A-Z]+_DOC:/ ;
    $self-&gt;{PREFIX}  = $args{prefix}  || $parent-&gt;{PREFIX} || qr/\s*/;
    $self-&gt;{DEBUG}   = $args{debug}   || $parent-&gt;{DEBUG}  || 0;
    $self-&gt;{VERBOSE} = $args{verbose} || $parent-&gt;{DEBUG}  || 0;
    # debugging implies verbosity:
    $self-&gt;{VERBOSE} = $self-&gt;{DEBUG} || 0;

    bless($self, $class);
    return($self);
}
# ====================================================================== #

##
## Methods
##

sub parse {
#
# Parse a file and collect the docstrings.
#
    my $self = shift();
    my $file = shift();

    carp("Cannot read file &lt;$file&gt;\n") unless (-r $file);

    my @localdoc = get_docs_from_file($file,
                                      $self-&gt;{MARKER},
                                      $self-&gt;{PREFIX},
                                      $self-&gt;{DEBUG},
                                      $self-&gt;{VERBOSE});
    (my $sfile = $file) =~ s{.*/}{}; # remove path
    $self-&gt;{DOC}{$sfile} = \@localdoc if (@localdoc);
    my $count = scalar @localdoc;

    return $count;
}

# ---------------------------------------------------------------------- #

sub write_mod_to_file {
#
#   $doc-&gt;write_mod_to_file(file)
#   $doc-&gt;write_mod_to_file(file      =&gt; 'filename',
#                           sort_files    =&gt; 1/0,
#                           print_empty   =&gt; 0/1,
#                           descr_width   =&gt; '0.7\textwidth',
#                           selfcontained =&gt; 0/1)
#
# Write LaTeX {longtable} environment of docstrings to given file.
# Just a convenience wrapper around longtable().
#
    my $self = shift();
    my @args = @_;
    my %args;
    # Parse arguments (sort_files =&gt; &lt;true/false&gt;, etc.); may be hash or hashref
    if (ref($args[0]) eq 'HASH') { # longtable($hashref)
        %args = %{$args[0]};
    } else {                    # longtable(%hash)
        %args = @args;
    }

    my $file = $args{file} or croak "write_to_file() needs a &lt;file&gt; argument";
    open(my $fh, "&gt; $file") or croak "Cannot open $file for writing: $!";
    print $fh $self-&gt;module_table(@args);
    close $fh;
}

# ---------------------------------------------------------------------- #

sub write_to_file {
#
#   $doc-&gt;write_to_file(file)
#   $doc-&gt;write_to_file(file          =&gt; 'filename',
#                       sort_files    =&gt; 1/0,
#                       print_empty   =&gt; 0/1,
#                       descr_width   =&gt; '0.7\textwidth',
#                       selfcontained =&gt; 0/1)
#
# Write LaTeX {longtable} environment of docstrings to given file.
# Just a convenience wrapper around longtable().
#
    my $self = shift();
    my @args = @_;
    my %args;
    # Parse arguments (sort_files =&gt; &lt;true/false&gt;, etc.); may be hash or hashref
    if (ref($args[0]) eq 'HASH') { # longtable($hashref)
        %args = %{$args[0]};
    } else {                    # longtable(%hash)
        %args = @args;
    }

    my $file = $args{file} or croak "write_to_file() needs a &lt;file&gt; argument";
    open(my $fh, "&gt; $file") or croak "Cannot open $file for writing: $!";
    print $fh $self-&gt;longtable(@args);
    close $fh;
}

# ---------------------------------------------------------------------- #

sub longtable {
#
#   $doc-&gt;longtable()
#   $doc-&gt;longtable(sort_files    =&gt; 1/0,
#                   print_empty   =&gt; 0/1,
#                   descr_width   =&gt; '0.7\textwidth',
#                   selfcontained =&gt; 0/1)
#
# Output docstrings in a LaTeX {longtable} environment.
#
    my $self = shift;
    my @args = @_;

    my %args;
    # Parse arguments (sort_files =&gt; &lt;true/false&gt;, etc.); may be hash or hashref
    if (ref($args[0]) eq 'HASH') { # longtable($hashref)
        %args = %{$args[0]};
    } else {                    # longtable(%hash)
        %args = @args;
    }

    my $docref = $self-&gt;{DOC};
    my @files = keys %$docref;

    my $sort = 1;
    $sort = $args{sort_files} if defined $args{sort_files};

    my $print_empty = $args{print_empty} || 0;

    # Sort file names in pre-defined order
    if ($sort) {
        @files = sort { smart_compare($a, $b) } @files;
    }

    my $text  = header(\@files, $args{selfcontained}, $args{descr_width});

    foreach my $module (@files) {
        # Header line for each section of table
        $text .=
            "\\midrule\n"
          . "  \\multicolumn{2}{c}{Module \\file{$module}} \\\\\n"
          . "\\midrule\n";

        # Loop through variables
        my @file_docs = @{$docref-&gt;{$module}}; # (['var1', 'doc1'],
                                               #  ['var2', 'doc2'], ...)
        foreach my $vardocref (@file_docs) {
            my ($var,$doc) = @$vardocref;

            next unless ($print_empty || $doc =~ /\S/);

            # Indent continued lines, so LaTeX code is easier to read:
            $doc =~ s{\n}{\n                  }g;

            $text .= sprintf "  %-15s &amp; %s \\\\\n", "\\var{$var}", $doc;
        }

    }

    $text .= footer($args{selfcontained});

}

# ====================================================================== #
sub module_table {
#
#   $doc-&gt;module_table()
#   $doc-&gt;module_table(sort_files    =&gt; 1/0,
#                   print_empty   =&gt; 0/1,
#                   descr_width   =&gt; '0.7\textwidth',
#                   selfcontained =&gt; 0/1)
#
# Output docstrings in a LaTeX {longtable} environment.
#
    my $self = shift;
    my @args = @_;

    my %args;
    # Parse arguments (sort_files =&gt; &lt;true/false&gt;, etc.); may be hash or hashref
    if (ref($args[0]) eq 'HASH') { # longtable($hashref)
        %args = %{$args[0]};
    } else {                    # longtable(%hash)
        %args = @args;
    }

    my $docref = $self-&gt;{DOC};
    my @files = keys %$docref;

    my $sort = 1;
    $sort = $args{sort_files} if defined $args{sort_files};

    my $print_empty = $args{print_empty} || 0;

    # Sort file names in pre-defined order
    if ($sort) {
        @files = sort { smart_compare($a, $b) } @files;
    }

    my $text  = mod_header(\@files, $args{selfcontained}, $args{descr_width});

    foreach my $module (@files) {
        # Header line for each section of table
        $text .=
            "\\midrule\n";
#          . "  \\multicolumn{2}{c}{Module \\file{$module}} \\\\\n"
#          . "\\midrule\n";

        # Loop through variables
        my @file_docs = @{$docref-&gt;{$module}}; # (['var1', 'doc1'],
                                               #  ['var2', 'doc2'], ...)
        foreach my $vardocref (@file_docs) {
            my ($var,$doc) = @$vardocref;

            next unless ($print_empty || $doc =~ /\S/);

            # Indent continued lines, so LaTeX code is easier to read:
            $doc =~ s{\n}{\n                  }g;

            $text .= sprintf "  %-15s &amp; %s \\\\\n", "\\var{$module}", $doc;
            $module=''
        }

    }

    $text .= footer($args{selfcontained});

}

# ====================================================================== #

##
## Private utility subroutines:
##

sub get_docs_from_file {
#
# Extract documentation lines from one file and return list of array refs
# ( [var1, doc1], [var2, doc2], ... )
#
    my $module = shift;
    my $marker = shift;
    my $prefix = shift;
    my $debug  = shift || 0;
    my $verbose  = shift || 0;

    my @localdoc;
    my $file  = $module;
    my $count = 0;

    unless (open(MODULE, "&lt; $file")) {
        carp "Cannot open $file for reading: $!\n";
        return ();
    }
    print STDERR "$module:\n" if ($verbose);
    my $no_line_to_continue = 1;

    # Store prefix for processing with the next line to cover cases
    # like
    #   case ('cop')
    #   ! BCZ_DOC: copy value
    my $saved_prefix_line = '';
    LINE: while(defined(my $line = &lt;MODULE&gt;)) {
        print STDERR "----------- input line $. ----------\n" if ($debug);
        if ($line =~ /\s*($prefix)/) {
            $saved_prefix_line = $1;
            print STDERR "Saving prefix line #",
              $., " = &lt;", printable_substring($line), "&gt;\n"
                if ($debug);
        }
        unless ($line =~ /$marker/) {
            # Whatever comes next, cannot be a continuation line:
            $no_line_to_continue = 1;
            next;
        }

        print STDERR "\$line = &lt;", printable_substring($line), "&gt;\n"
          if ($debug);
        my ($var,$misc,$docstring) = ('', '', '');

        my ($decl, $latex)
          = ($line =~ /^\s*(.*?)\s*$marker\s*(.*?)\s*$/);
        warn "Weird... \$line=&lt;$line&gt;\n" unless defined($latex);
        print STDERR "\$decl=&lt;$decl&gt;, \$latex=&lt;$latex&gt;\n" if ($debug);

        # Get stored declaration line if there was no $prefix in the
        # actual line:
        if ($decl eq '') {
            print STDERR "\$decl &lt;-- &lt;",
              printable_substring($saved_prefix_line), "&gt;\n"
                if ($debug);
            $decl = $saved_prefix_line;
        }

        if ($decl =~ /$prefix/) {
            # there is a declaration part
            # -&gt; not a continuation line
            print STDERR "docstring at ${module}:$.\n" if ($debug);

            my ($var,$rest)
              = ($decl =~ /$prefix\s*(.*?)\s*/);
            print STDERR "## \$var=&lt;$var&gt;, \$rest=&lt;$rest&gt;\n" if ($debug);
            $misc
              = ($rest =~ /^(.*?)(?:\s*=\s*[-+0-9]+\s*)/i);
            print STDERR "\$var=&lt;$var&gt;, \$msc=&lt;$misc&gt;\n" if ($debug);
            if (defined($misc) &amp;&amp; $misc =~ /idiag_/i) {
                carp "In line $. of $file: "
                  . "multiple diagnostic variables in one line:\n";
                carp "  $var, $misc\n";
                next LINE;
            }
            unless (defined($var)) {
                carp "In line $. of $file: "
                  . "variable name not found:\n";
                next LINE;
            }
            print STDERR "    $var -&gt; $latex\n" if ($debug);
            push @localdoc, [$var, $latex];
            $no_line_to_continue = 0;
            $count++;
        } else {
            #  no declaration part --&gt; continuation line
            print STDERR "..continuation line at ${module}:$.\n" if ($debug);
            ## Append latex part to previous entry
            my ($var1,$latex1) = @{ pop @localdoc || [] }
                or next LINE; # nothing to append to
            push @localdoc, [$var1, "$latex1\n  $latex"];
        }
        $saved_prefix_line = '';
    }

    if ($count) {
        print STDERR "Found documentation for $count diagnostic variables\n"
          if ($debug);
    } else {
        print STDERR "No documentation found in $file\n"
          if ($debug);
    }

    return @localdoc;
}

# ---------------------------------------------------------------------- #

sub filter_doc {
# Remove (or not) items with empty documentation lines
    my $docref  = shift;
    my $verbose = shift || 0;

    my %newdoc;
    my $empty    = 0;
    my $nonempty = 0;
    foreach my $module (keys %$docref) {
        my @file_docs = @{$docref-&gt;{$module}}; # (['var1', 'doc1'],
                                               #  ['var2', 'doc2'], ...)
        foreach my $vardocref (@file_docs) {
            my ($var,$doc) = @$vardocref;
            if ($doc =~ /\S/) {
                push @{$newdoc{$module}}, [$var,$doc];
                $nonempty++;
            } else {
                $empty++;
            }
        }
    }

    # Give statistical feedback
    if ($verbose) {
        print STDERR "  (doc, undoc, tot) = ($nonempty, $empty, ",
          $nonempty+$empty, ")\n";
    }

    return \%newdoc;
}

# ---------------------------------------------------------------------- #

sub header {
#
# Print LaTeX longtable header
#
    my @files =  @{shift()};
    my $selfcontained = shift;
    my $descr_width = (shift || '0.7\textwidth');

    my $string =
        '%% $Id$' . "\n"
      . "%% This file was automatically generated by Pencil::DocExtractor,\n"
      . "%% so think twice before you modify it.\n"
      . "%%\n"
      . "%% Source files:\n%%   "
      . join("\n%%   ", @files) . "\n\n";

    if ($selfcontained) {
        $string .=
            "\n\\documentclass[12pt]{article}\n"
          . "\n"
          . "\\usepackage{longtable,booktabs}\n"
          . "\\usepackage{underscore}\n"
          . "\\usepackage{amsmath,newcent,helvet}\n"
          . "\\renewcommand{\\ttdefault}{cmtt} % Courier is too broad\n"
          . "\n"
          . "\\newcommand{\\file}[1]{`\\texttt{#1}'}\n"
          . "\\newcommand{\\var}[1]{\\textsl{#1}}\n"
          . "\n"
          . "\\newcommand{\\vekt}[1] {\\mathbf{#1}}\n"
          . "\n"
          . "\\newcommand{\\Av}{\\vekt{A}}\n"
          . "\\newcommand{\\Bv}{\\vekt{B}}\n"
          . "\\newcommand{\\cs}{c_{\rm s}}\n"
          . "\\newcommand{\\curl}{\\nabla\\times}\n"
          . "\\newcommand{\\jv}{\\vekt{j}}\n"
          . "\\newcommand{\\Strain}{\\boldsymbol{\\mathsf{S}}}\n"
          . "\\newcommand{\\uv}{\\vekt{u}}\n"
          . "\n"
          . "\\begin{document}\n\n"
    }

    $string .=
        "% ---------------------------------------------------------------- %\n"
      . "\\begin{longtable}{lp{$descr_width}}\n"
      . "\\toprule\n"
      . "  \\multicolumn{1}{c}{\\emph{Variable}} \&amp; {\\emph{Meaning}} \\\\\n";

    return $string;
}

# ---------------------------------------------------------------------- #
sub mod_header {
#
# Print LaTeX longtable header
#
    my @files =  @{shift()};
    my $selfcontained = shift;
    my $descr_width = (shift || '0.9\textwidth');

    my $string =
        '%% $Id$' . "\n"
      . "%% This file was automatically generated by Pencil::DocExtractor,\n"
      . "%% so think twice before you modify it.\n"
      . "%%\n"
      . "%% Source files:\n%%   "
      . join("\n%%   ", @files) . "\n\n";

    if ($selfcontained) {
        $string .=
            "\n\\documentclass[12pt]{article}\n"
          . "\n"
          . "\\usepackage{longtable,booktabs}\n"
          . "\\usepackage{underscore}\n"
          . "\\usepackage{amsmath,newcent,helvet}\n"
          . "\\renewcommand{\\ttdefault}{cmtt} % Courier is too broad\n"
          . "\n"
          . "\\newcommand{\\file}[1]{`\\texttt{#1}'}\n"
          . "\\newcommand{\\var}[1]{\\textsl{#1}}\n"
          . "\n"
          . "\\newcommand{\\vekt}[1] {\\mathbf{#1}}\n"
          . "\n"
          . "\\newcommand{\\Av}{\\vekt{A}}\n"
          . "\\newcommand{\\Bv}{\\vekt{B}}\n"
          . "\\newcommand{\\cs}{c_{\rm s}}\n"
          . "\\newcommand{\\curl}{\\nabla\\times}\n"
          . "\\newcommand{\\jv}{\\vekt{j}}\n"
          . "\\newcommand{\\Strain}{\\boldsymbol{\\mathsf{S}}}\n"
          . "\\newcommand{\\uv}{\\vekt{u}}\n"
          . "\n"
          . "\\begin{document}\n\n"
    }

    $string .=
        "% ---------------------------------------------------------------- %\n"
      . "\\begin{longtable}{lp{$descr_width}}\n"
      . "\\toprule\n"
      . "  \\multicolumn{1}{c}{\\emph{Module}} \&amp; {\\emph{Description}} \\\\\n";

    return $string;
}

# ---------------------------------------------------------------------- #

sub footer {
#
# Return LaTeX longtable footer
#
my $selfcontained = shift;
    my $string =
        "%\n"
      . "\\bottomrule\n"
      . "\\end{longtable}\n\n";

    if ($selfcontained) {
        $string .= "\n\\end{document}\n\n";
    }

    return $string;
}

# ---------------------------------------------------------------------- #

sub smart_compare {
#
# Comparison function that puts interesting modules first and sorts
# everybody else in alphabetic order.
#
    my ($a, $b) = @_;

    return
      compare_modulenames($a) &lt;=&gt; compare_modulenames($b)
        || $a cmp $b;
}

# ---------------------------------------------------------------------- #

sub compare_modulenames {
#
# Score interesting modules (as defined by the author of this script)
# higher than boring ones.
#
    my $module = shift;

    (my $short = $module) =~ s/\.f90$//; # remove suffix

    my %mapping =
      (
       'cdata'    =&gt; 1,
       'hydro'    =&gt; 2,
       'density'  =&gt; 3,
       'entropy'  =&gt; 4,
       'magnetic' =&gt; 5,
       'pscalar'  =&gt; 6,
       'equ'      =&gt; 7,
      );
    my $infty = 100000;         # or will we get more modules...?

    return $mapping{$short} || $infty;
}

# ---------------------------------------------------------------------- #

sub printable_substring {
# Extract substring and quote newlines for diagnostic printing
    my $string = shift;
    my $length = shift || 60;

    $string =~ s{\n}{\\n}g;      # quote newlines
    $ string =~ s{\s\s+}{\\s\+}; # compactify whitespace
    my $oldlen = length($string);
    $string = substr($string,0,$length);
    substr($string,-3,3) = '...' if ($length&lt;$oldlen);

    return $string;
}

# ---------------------------------------------------------------------- #

1;
__END__


=head1 NAME

Pencil::DocExtractor - Extract doc strings from F90 files and create LaTeX
longtable

=head1 SYNOPSIS

  use Pencil::DocExtractor;
  my $diag = Pencil::DocExtractor-&gt;new();
  my $count = $diag-&gt;parse('hydro.f90');
  my $count = $diag-&gt;parse('entropy.f90');
  print $diag-&gt;longtable();


=head1 DESCRIPTION

Pencil::DocExtractor extracts F90 comments of the form

  integer :: idiag_uxmz=0       ! DIAG_DOC: $\left&lt; u_x \right&gt;_{x,y}$
                                ! DIAG_DOC:   \quad(horiz. averaged $x$
                                ! DIAG_DOC:   velocity)
  integer :: idiag_uxmxz=0      ! DIAG_DOC:  $\left&lt; u_x \right&gt;_{y}$ \\

or

  case ('p')
    ! BCX_DOC: periodic
    call bc_per_x(f,topbot,j)
  case ('s')
    ! BCX_DOC: symmetry, $f_{N+i}=f_{N-i}$;
    ! BCX_DOC: implies $f'(x_N)=f'''(x_0)=0$
    call bc_sym_x(f,+1,topbot,j)

and creates a LaTeX {longtable} environment for inclusion into the manual:

  %% This file was automatically generated by extract-diag-doc
  %% from the src/*.f90 files.
  %% So think twice before you modify it.

  % ---------------------------------------------------------------- %
  \begin{longtable}{lp{0.7\textwidth}}
  \toprule
    \multicolumn{1}{c}{\emph{Variable}} &amp; {\emph{Meaning}} \\
  \midrule
    \multicolumn{2}{c}{Module \file{hydro.f90}} \\
  \midrule
    \var{uxmz}      &amp; $\left&lt; u_x \right&gt;_{x,y}$
                      \quad(horiz. averaged $x$
                      velocity) \\
    \var{uxmxz}     &amp; $\left&lt; u_x \right&gt;_{y}$ \\
  %
  \bottomrule
  \end{longtable}

or

  %% This file was automatically generated by extract-diag-doc
  %% from the src/*.f90 files.
  %% So think twice before you modify it.

  % ---------------------------------------------------------------- %
  \begin{longtable}{lp{0.7\textwidth}}
  \toprule
    \multicolumn{1}{c}{\emph{Variable}} &amp; {\emph{Meaning}} \\
  \midrule
    \multicolumn{2}{c}{Module \file{hydro.f90}} \\
  \midrule
    \var{p}       &amp; periodic \\
    \var{p}       &amp; symmetry, $f_{N+i}=f_{N-i}$;
                    implies $f'(x_N)=f'''(x_0)=0$ \\
  %
  \bottomrule
  \end{longtable}

=head2 Methods

=over 4


=item B&lt;$doc-E&lt;gt&gt;new&gt;()

Create a new object

=item B&lt;$doc-E&lt;gt&gt;parse&gt;(file)

Parse the file.

=item B&lt;$doc-E&lt;gt&gt;longtable&gt;()

=item B&lt;$doc-E&lt;gt&gt;longtable&gt;(%options)

=item B&lt;$doc-E&lt;gt&gt;longtable&gt;(\%options)

Return string containing the extracted documentation strings in a LaTeX
{longtable} environment.
Write this to a file and include it from a LaTeX document.

Additional I&lt;options&gt; are:

=over 8

=item B&lt;sort_files&gt;

If true (the default), sort file names, putting predefined important
modules first and sort remaining file names alphabetically.

=item B&lt;print_empty&gt;

If true, print lines for empty diagnostics, e.g. corresponding to

  integer :: idiag_dtd=0        ! DIAG_DOC:

etc.
If false (the default), skip such lines.

=back


=head1 BUGS AND LIMITATIONS

=over 4

=item *

None worth mentioning (so far).

=back


=head1 AUTHOR

Wolfgang Dobler &lt;wdobler [at] cpan.org&gt;


=head1 LICENSE AND COPYRIGHT

Copyright (c) 2007, Wolfgang Dobler &lt;wdobler [at] cpan.org&gt;.
All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same conditions as Perl or under the GNU General Public
License, version 3 or later.


=head1 DISCLAIMER OF WARRANTY

Use completely at your own risk.


=cut


# End of file
</pre></body></html>