File Coverage

blib/lib/Java/Doc.pm

Criterion	Covered	Total	%
statement	158	176	89.7
branch	30	54	55.5
condition	8	20	40.0
subroutine	16	16	100.0
pod	2	9	22.2
total	214	275	77.8

#!/usr/bin/perl
#-------------------------------------------------------------------------------
# Extract documentation from Java source code.
# Philip R Brenan at gmail dot com, Appa Apps Ltd, 2017
#-------------------------------------------------------------------------------
package Java::Doc;
require v5.16.0;
use warnings FATAL => qw(all);
use strict;
use Carp qw(confess);
use Data::Dump qw(dump);
use Data::Table::Text qw(:all);

our $VERSION = '20171011';

genLValueHashMethods(qw(parse));                                                # Combined parse tree of all the input files read
genLValueHashMethods(qw(classes));                                              # Classes encountered in all the input files read

my %veryWellKnownClassesHash = map {$_=>1} split /\n/, &veryWellKnownClasses;   # Urls describing some well known Java classes

sub urlIfKnown($$)                                                              # Replace a well known type with an informative url
 {my ($javaDoc, $type)  = @_;                                                   # Java doc builder, type to replace with an informative url
  for my $url(keys %veryWellKnownClassesHash, @{$javaDoc->wellKnownClasses})
   {my $i = index($url, "/$type.html");
    if ($i >= 0)
     {#say STDERR "AAAA $i  $type  $url", ;
      return qq($type);
     }
   }
  $type
 }

sub getAttributes($)                                                            # Get the attributes from a method type: public, private, final, static etc
  {my ($type) = @_;                                                             # Type as parsed out
   my $t = qq( $type );                                                         # Blank pad
   $t =~ s(\A\s*[\(\{]) ( )gs;                                                  # Replace leading open bracket with space
   my @attributes;                                                              # Method attributes
   for(qw(public private protected abstract final static))
    {push @attributes, $_ if $t =~ m($_)s;
     $t =~ s($_) ( )gs;
    }
   $t =~ s(\s+) ( )gs;                                                          # Remove excess white space
   (trim($t), @attributes)
  }
#say STDERR dump([getAttributes("  (final  public static  float  ")]);  exit;

sub parseJavaFile($$)                                                           # Parse java file for package, class, method, parameters
 {my ($javaDoc, $fileOrString)  = @_;                                           # Java doc builder, Parse tree, java file or string of java to process
  my $parse = $javaDoc->parse;                                                  # Parse tree

  my $s = $fileOrString =~ m(\n)s ? $fileOrString : readFile($fileOrString);

  my $package;                                                                  # Package we are in
  my @class;                                                                    # Containing classes as array
  my $class;                                                                    # Containing classes as a.b.c
  my $method;                                                                   # Method we are in
  my $state = 0;                                                                # 0 - outer, 1 - parameters to last method

  for(split /\n/, $s)
   {if ($state == 0)
     {if (m(\A\s*package\s+((\w+|\.)+)))                                        # 'package' package ;
       {#say STDERR "Package = $1";
        $package = $1;
       }
      elsif (m(\A.*?class\s+(\w+)\s*\{?\s*//C\s+(.*?)\s*\Z))                    # Class with optional '{' //C
       {push @class, $1;                                                        # Save containing class
        $class = join '.', @class;
        #say STDERR "Class $class = $1 = $2";
        $javaDoc->classes->{$class} = $parse->{$package}{$class}{comment} = $2; # Record the last encountered class as the class to link to - could be improved!
       }
      elsif (m(\A\s*}\s*//C\s+(\w+)))                                            # '}' '//C' className - close class className
       {#say STDERR "Class = $1 End";
        if (!@class)
         {warn "Closing class $1 but no class to close";
         }
        if ($1 ne $class[-1])
         {warn "Closing class $1 but in class $class ignored";
         }
        else
         {pop @class;
          $class = join '.', @class;
         }
       }
      elsif (m(\A\s*(.*?)\s+(\w+)\s*(\(\))?\s*\(?\s*//(M|c|O=\S+)\s+(.*?)\s*\Z))# Method with either '()' meaning no parameters or optional '(' followed by //M for method, //c for constructor, //O=package.method for override of the named method
       {my ($empty, $res, $comment) = ($3, $4, $5);
        $method = $2;

        my ($type, @attributes) = getAttributes($1);                            # Method attributes

        my $override;                                                           # Method is an override
        if ($res =~ m(\Ac\Z)s)                                                  # In summa it is a constructor
         {push @attributes, q(constructor);                                     # Constructor
          $type = qq($method);                                                      # Type for a constructor is the constructor name
         }
        elsif ($res =~ m(\AO=(.+?)\Z)s)                                         # Override
         {$override = $1;
          $comment  = qq(See $comment);
         }

        if ($package and $class)                                                # Save method details is possible
         {#say STDERR "Method = $method == $type == $comment ";

          push @{$parse->{$package}{$class}{methods}},
                {type=>$javaDoc->urlIfKnown($type), name=>$method,
                 comment=>$comment, attributes=>[@attributes]};
          $state = 1 if !$empty and !$override;                                 # Get parameters next if method has parameters and is not an override
         }
        else
         {my $m = qq(Ignoring method $method as no preceding);
          my $f = qq(in file:\n$fileOrString\nLine:\n$_);
          warn "$m package $f" unless $package;
          warn "$m class $f"   unless $class;
         }
       }
     }
    elsif ($state == 1)
     {if (m(\A.\s*(.+?)\s+(\w+)\s*[,\)\{]*\s*//P\s+(.*?)\s*\Z))                 # type name, optional ',){', //P
       {#say STDERR "Parameter =$1=$2=$3";
        my ($type, $parameter, $comment) = ($1, $2, $3);
        my ($t, @attributes) = getAttributes($type);
        push @{$parse->{$package}{$class}{methods}[-1]{parameters}},
             [$javaDoc->urlIfKnown($t), $parameter, $comment, [@attributes]];
       }
      else                                                                      # End of parameters if the line does not match
       {$state = 0;
        if ($package and $class and $method)
         {my $m = $parse->{$package}{$class}{methods}[-1];
          if (my $p = $m->{parameters})
           {if (my @p = @$p)
             {$m->{nameSig} = join ', ', map {$_->[1]} @p;
              $m->{typeSig} = join ', ', map {$_->[0]} @p;
             }
           }
         }
        else
         {warn "Ignoring method $method as no preceding package or class or ".
               "method in file:\n$fileOrString\nLine:\n$_";
         }
       }
     }
   }
  $parse
 }

sub parseJavaFiles($)                                                           # Parse all the input files into one parse tree
 {my ($javaDoc)  = @_;                                                          # Java doc processor
  for(@{$javaDoc->source})                                                      # Extend the parse tree with the parse of each source file
   {$javaDoc->parseJavaFile($_);
   }
 }

sub htmlJavaFiles($)                                                            # Create documentation using html for all java files from combined parse tree
 {my ($javaDoc)  = @_;                                                          # Java doc processor, combined parse tree
  my $parse = $javaDoc->parse;                                                  # Parse tree
  my $indent = $javaDoc->indent // 0;                                           # Indentation per level
  my @c = @{$javaDoc->colors};                                                  # Back ground colours
     @c = 'white' unless @c;
  my $d;                                                                        # Current background colour - start
  my $D = q();                                                            # Current background colour - end
  my $swapColours = sub                                                         # Swap background colour
   {my ($margin) = @_;
    my $m = $margin * $indent;
    push @c, my $c = shift @c;
    $d = qq();
   };
  &$swapColours(0);                                                             # Swap background colour

  my @h = <
$d




Packages
);  




176




 





 





 





 





 





 



 END 




177




1





 





 





 





 





4



   for my $package(sort keys %$parse) 




178




1





 





 





 





 





3



    {push @h, qq($package




179




 





 





 





 





 





 



    } 




180




1





 





 





 





 





3



   push @h, <




181
END
  for my $package(sort keys %$parse)
   {push @h, qq(
   }
  push @h, <

$D
END

  for my $package(sort keys %$parse)
   {my %package = %{$parse->{$package}};
    &$swapColours(1);
    push @h, <

$d
Classes in package: $package
 




193




 





 





 





 





 





 



 ClassDescription 




194




 





 





 





 





 





 



 END 




195




1





 





 





 





 





4



     for my $class(sort keys %package) 




196




2





 





 





 





 





2



      {my %class = %{$package{$class}}; 




 




2





 





 





 





 





9



   




197




2





 





 





 





 





3



       my $classComment = $class{comment}; 




198




2





 





 





 





 





10



       push @h, <<"END"; 




199




 





 





 





 





 





 



 $class 




200




 





 





 





 





 





 



     $classComment 




201




 





 





 





 





 





 



  




202




 





 





 





 





 





 



 END 




203




 





 





 





 





 





 



      } 




204




1





 





 





 





 





3



     push @h, <




205

END
    for my $class(sort keys %package)
     {my %class = %{$package{$class}};
      my $classComment = $class{comment};
      push @h, <<"END";



END
     }
    push @h, <

$D
END
    for my $class(sort keys %package)
     {my %class = %{$package{$class}};
      my $classComment = $class{comment};
      &$swapColours(2);
      push @h, <
$d

Methods in class: $class, package: $package
$classComment
 




218




 





 





 





 





 





 



 ReturnsMethodSignatureAttributesDescription 




219




 





 





 





 





 





 



 END 




220




2





 





 





 





 





3



       for my $method(@{$class{methods}}) 




 




2





 





 





 





 





4



   




221




3





 





 





 





 





4



        {my %method  = %{$method}; 




 




3





 





 





 





 





11



   




222




3





 




  
 50
  




 





 





5



         my $attr    = join ' ', @{$method{attributes}//[]}; 




 




3





 





 





 





 





8



   




223




3





 





 





 





 





4



         my $type    = $method{type}; 




224




3





 





 





 





 





4



         my $name    = $method{name}; 




225




3





 





 





 





 





3



         my $comment = $method{comment}; 




226




3





 




  
 50
  




 





 





7



         my $sig     = $method{typeSig} // 'void'; 




227




3





 





 





 





 





15



         push @h, <




228




 





 





 





 





 





 



 $type 




229




 





 





 





 





 





 



     $name 




230




 





 





 





 





 





 



     $sig 




231




 





 





 





 





 





 



     $attr 




232




 





 





 





 





 





 



     $comment 




233




 





 





 





 





 





 



  




234




 





 





 





 





 





 



 END 




235




 





 





 





 





 





 



        } 




236




2





 





 





 





 





6



       push @h, <




237

END
      for my $method(@{$class{methods}})
       {my %method  = %{$method};
        my $attr    = join ' ', @{$method{attributes}//[]};
        my $type    = $method{type};
        my $name    = $method{name};
        my $comment = $method{comment};
        my $sig     = $method{typeSig} // 'void';
        push @h, <






END
       }
      push @h, <

$D
END
      for my $method(@{$class{methods}})
       {my %method = %{$method};
        my $type = $method{type};
        my $name = $method{name};
        my $comment = $method{comment};
        &$swapColours(3);
        push @h, <
$d

$name : $type
$comment
END

        if (my $parameters = $method{parameters})
         {my @parameters = @$parameters;
          push @h, <
Parameters:
);  




258




 





 





 





 





 





 



 NameTypeAttributesDescription 




259




 





 





 





 





 





 



 END 




260




3





 





 





 





 





13



           for my $parameter(@parameters) 




261




9





 





 





 





 





15



            {my ($type, $name, $comment, $attributes) = @$parameter; 




262




9





 




  
 50
  




 





 





10



             my $attr    = join ' ', @{$attributes//[]}; 




 




9





 





 





 





 





17



   




263




9





 





 





 





 





28



             push @h, qq($name$type$attr$comment




264




 





 





 





 





 





 



            } 




265




3





 





 





 





 





5



           push @h, <




266

END
          for my $parameter(@parameters)
           {my ($type, $name, $comment, $attributes) = @$parameter;
            my $attr    = join ' ', @{$attributes//[]};
            push @h, qq(
           }
          push @h, <

END
         }
        push @h, <
$D

END
       }
     }
   }

  s(L<(.+?)>) ($1)gs for @h;

  @h
 }

sub veryWellKnownClasses {<<'END'}
https://developer.android.com/reference/android/app/Activity.html
https://developer.android.com/reference/android/content/Context.html
https://developer.android.com/reference/android/graphics/BitmapFactory.html
https://developer.android.com/reference/android/graphics/Bitmap.html
https://developer.android.com/reference/android/graphics/Canvas.html
https://developer.android.com/reference/android/graphics/drawable/BitmapDrawable.html
https://developer.android.com/reference/android/graphics/drawable/Drawable.html
https://developer.android.com/reference/android/graphics/Matrix.html
https://developer.android.com/reference/android/graphics/Paint.html
https://developer.android.com/reference/android/graphics/Path.html
https://developer.android.com/reference/android/graphics/PorterDuff.Mode.html
https://developer.android.com/reference/android/graphics/RectF.html
https://developer.android.com/reference/android/media/MediaPlayer.html
https://developer.android.com/reference/android/util/DisplayMetrics.html
https://developer.android.com/reference/java/io/ByteArrayOutputStream.html
https://developer.android.com/reference/java/io/DataInputStream.html
https://developer.android.com/reference/java/io/DataOutputStream.html
https://developer.android.com/reference/java/io/File.html
https://developer.android.com/reference/java/io/FileOutputStream.html
https://developer.android.com/reference/java/lang/String.html
https://developer.android.com/reference/java/lang/Thread.html
https://developer.android.com/reference/java/util/Stack.html
https://developer.android.com/reference/java/util/TreeMap.html
https://developer.android.com/reference/java/util/TreeSet.html
https://developer.android.com/studio/command-line/adb.html
END

#1 Attributes                                                                   # Attributes that can be set or retrieved by assignment

if (1) {                                                                        # Parameters that can be set by the caller
  genLValueArrayMethods(qw(source));                                            # A reference to an array of Java source files that contain documentation as well as java
  genLValueScalarMethods(qw(target));                                           # Name of the file to contain the generated documentation
  genLValueArrayMethods(qw(wellKnownClasses));                                  # A reference to an array of urls that contain the class name of well known Java classes such as: L which will be used in place of the class name to make it possible to locate definitions of these other classes.
  genLValueScalarMethods(qw(indent));                                           # Indentation for methods vs classes and classes vs packages - defaults to 0
  genLValueArrayMethods(qw(colors));                                            # A reference to an array of colours expressed in html format - defaults to B - the background applied to each output section is cycled through these colours to individuate each section.
 }

#1 Methods                                                                      # Methods available

sub new                                                                         # Create a new java doc processor
 {bless {};                                                                     # Java doc processor
 }

sub html($)                                                                     # Create documentation using html as the output format. Write the generated html to the file specified by L if any and return the generated html as an array of lines.
 {my ($javaDoc)  = @_;                                                          # Java doc processor

  $javaDoc->parseJavaFiles;                                                     # Parse the input files
  #say STDERR "AAAA ", dump($javaDoc->parse); exit;
  my @h = $javaDoc->htmlJavaFiles;                                              # Write as html

  if (my $file = $javaDoc->target)
   {my $h = @h;
    writeFile($file, join "\n", @h);
    say STDERR "$h lines of documentation written to:\n$file";
   }
  @h                                                                            # Return the generated html
 }

# podDocumentation

=encoding utf-8

=head1 Name

Java::Doc - Extract L
from L

=head1 Synopsis

  use Java::Doc;

  my $j = Java::Doc::new;                                # New document builder

  $j->source = [qw(~/java/layoutText/LayoutText.java)];  # Source files
  $j->target =  qq(~/java/documentation.html);           # Output html
  $j->indent = 20;                                       # Indentation
  $j->colors = [map {"#$_"} qw(ccFFFF FFccFF FFFFcc),    # Background colours
                            qw(CCccFF FFCCcc ccFFCC)];
  $j->html;                                              # Create html

Each source file is parsed for documentation information which is then
collated into a colorful cross referenced html file.

Documentation is extracted for L, L,
L.

=head2 Packages

Lines matching

  package packageName ;

are assumed to define packages.

=head2 Classes

Lines with comments B are assumed to define classes:

  class className    //C

with the text of the comment being the definition of the class.

Classes are terminated with:

 } //C className

which allows class document definitions to be nested.

=head2 Methods

Methods are specified by lines with comments matching B:

  methodName ()  //M

  methodName     //M

with the description of the method contained in the text of the comment
extending to the end of the line.

Constructors should be marked with comments matching B as in:

  methodName     //c

Methods that are overridden should be noted with a comment as in:

  methodName     //O=package.class.method

=head2 Parameters

Methods that are not overrides and that do have parameters should place the
parameters declarations one per line on succeeding lines marked with comments
B as in:

  parameterName //P

=head2 Example

The following fragment of java code provides an example of documentation held as
comments that can be processed by this module:

 package com.appaapps;

 public class Outer        //C Layout text on a canvas
  {public static void draw //M Draw text to fill a fractional area of the canvas
    (final Canvas canvas)  //P Canvas to draw on
    {}

   class Inner              //C Inner class
    {InnerText()            //c Constructor
      {}
    } //C Inner
  } //C Outer

=head1 Description

The following sections describe the methods in each functional area of this
module.  For an alphabetic listing of all methods by name see L.



=head1 Attributes

Attributes that can be set or retrieved by assignment

=head2 source :lvalue

A reference to an array of Java source files that contain documentation as well as java


=head2 target :lvalue

Name of the file to contain the generated documentation


=head2 wellKnownClasses :lvalue

A reference to an array of urls that contain the class name of well known Java classes such as: L which will be used in place of the class name to make it possible to locate definitions of these other classes.


=head2 indent :lvalue

Indentation for methods vs classes and classes vs packages - defaults to 0


=head2 colors :lvalue

A reference to an array of colours expressed in html format - defaults to B - the background applied to each output section is cycled through these colours to individuate each section.


=head1 Methods

Methods available

=head2 new()

Create a new java doc processor


=head2 html($)

Create documentation using html as the output format. Write the generated html to the file specified by L if any and return the generated html as an array of lines.

  1  $javaDoc  Java doc processor


=head1 Index


1 L

2 L

3 L

4 L

5 L

6 L

7 L

=head1 Installation

This module is written in 100% Pure Perl and, thus, it is easy to read, use,
modify and install.

Standard L process for building and installing modules:

  perl Build.PL
  ./Build
  ./Build test
  ./Build install

=head1 Author

L

L

=head1 Copyright

Copyright (c) 2016-2017 Philip R Brenan.

This module is free software. It may be used, redistributed and/or modified
under the same terms as Perl itself.

=cut



# Tests and documentation

sub test
 {my $p = __PACKAGE__;
  binmode($_, ":utf8") for *STDOUT, *STDERR;
  return if eval "eof(${p}::DATA)";
  my $s = eval "join('', <${p}::DATA>)";
  $@ and die $@;
  eval $s;
  $@ and die $@;
 }

test unless caller;

1;
# podDocumentation
__DATA__