Auto documentation

Dear Gurus,
Here is my first attempt to share my code for auto documentation. It all started with old code maintenance, which my company opted to go for. In order to full-fill the understand the requirement I had to write 'Code-Description' or 'Design' (I know... it is a Bad habit to create Design document after the code is written) documents for all the Perl scripts, which I/somebody else had written. I have developed a script to scan Perl script and create a 'Design report' out of it. This could be modified manually later (It does not give complete description). I have created the Design document the way as per my requirement, however anybody can modify the words. The command line argument would be the 'Name of the script you would like to scan'
Few efforts are required from programmer's side
1) You should write subroutine's description between the word 'sub' and '{'.
2) You should write purpose of the Code, Module in the beginning as (e.g.)
#Purpose:- This code is used to count the number of 'A's
3) Create 3 gifs as per your choice and put those in the same folder.
4) This code will create 3 outputs a) Design report b) Pictorial view of code c) Tree of modules.
I know I am too young to put my code in this section, but your comments would improve my knowledge.
The code goes as follows

#!/usr/bin/perl
use strict;
use fileoprn;
use CGI qw/:standard/;

start_html(),
my ($script_name) = @ARGV;
my @perl_lib_or_used_modules;
##########################
push @perl_lib_or_used_modules, "strict";
push @perl_lib_or_used_modules, "Tk";
push @perl_lib_or_used_modules, "Exporter";
##########################
#print "\n############\nProgram Name:-$script_name\n############\n";

my @module_tree;
my @used_modules;
my @perl_subroutines;
my @all_design;
my $html_buffer = h1(u("APPROVED DESIGN OF $script_name"));
my $tree_structure;
my $tab = "&nbsp;&nbsp;&nbsp;&nbsp;";
push @module_tree, $script_name;
foreach my $module_name_tree (@module_tree)
{
        my $lib_module_switch=0;
        my ($pre_modules,$module_name) = $module_name_tree=~ m/(^.*\:\
+:)?(.*?)\z/s;
        #print "$module_name_tree#$module_name\n";
        my $display_module_tree = $module_name_tree;
        $html_buffer .= br("==========================================
+==========================================");
        $html_buffer .= h3("There would be a Module Named",a({name=>$d
+isplay_module_tree, href=>"#child"."$display_module_tree"},"&nbsp;&nb
+sp;$module_name"));
        foreach my $x (@perl_lib_or_used_modules)
    {
            if ("$x.pm" eq "$module_name.pm")
            {
               $lib_module_switch=1;
               #print "\n$module_name Is a library/Used module\n";
                }
    }
    if ($lib_module_switch eq 0)
        {
        my $module_code;
        my ($sub_name, $sub_comments);
        my $purpose;
                if ($module_name =~ m/\.pl\z/s)
        {
                 $module_code = fileoprn::fileread("$module_name");
                }
                else
                {
                 $module_code = fileoprn::fileread("$module_name.pm");
                }
                ### V V V Imp, Deleting all the code in Begin & Cut
                $module_code =~ s/(\n)(\=begin.*?\n\=cut)/$1/gs;
                #####################################################
                ($purpose) = $module_code =~ m/\#\s*Purpose(?:\s|\:)*(
+.*?)(?=\n)/s;
                my $display_module_tree_for_module_description = $disp
+lay_module_tree;
        if ($display_module_tree_for_module_description =~ m/\:\:/s)
        {
                    $display_module_tree_for_module_description =~ s/\
+:\:/ calls /s;
                    $display_module_tree_for_module_description =~ s/\
+:\:/ which calls /gs;
            }

        $html_buffer .= "<u>Design Description</u><br> This Module wou
+ld be called in following way, $display_module_tree_for_module_descri
+ption, this one $purpose<br>";
                #print "$module_name:-$purpose\n";
            ###########################
        #print "scanning $module_name\n";
                ### Scanning Module Name.
        my $ctr=0;
            $module_code =~ s{((?:\n|^)\s*)(?:use|require)\s+(.*?)(?=\
+;|\s*qw|\s*\()}
            {
                my ($start_new_line, $child_module_name) =($1,$2);
                $ctr++;
                $html_buffer .= "This one should call " if ($ctr == 1)
+;
                    push @module_tree, "$module_name_tree\:\:$child_mo
+dule_name";
                        $html_buffer .= a({name=>"child"."$display_mod
+ule_tree\:\:$child_module_name",href=>"#$display_module_tree\:\:$chil
+d_module_name"},"&nbsp;&nbsp;$child_module_name\,")."&nbsp;&nbsp;";

            }exgs;
            $html_buffer .= "module" if ($ctr > 0);
            $html_buffer .= "s" if ($ctr > 1);
        ### Scanning Subroutine
        $ctr=0;
                $module_code =~ s{(?:(?:\n|^)\s*)sub\s+([^\;]*?)(?=\{)
+}
                {
          my $sub_name_comments=($1);
          $ctr++;
          $html_buffer .= "<br><br>It should use following Subroutines
+ <br>" if ($ctr == 1);
          ($sub_name, $sub_comments)=$sub_name_comments =~ m/(^.*?)\n(
+.*?)\z/gs;
          if ($sub_comments)
          {
              $sub_comments =~ s/(^|\n)\#?/\./gs;
              $sub_comments =~ s/\.+/\./gs;
              $sub_comments =~ s/\./\:-/s;

          }
                  push @perl_subroutines, "$module_name_tree\:\:$sub_n
+ame";
                  $html_buffer .= ("<br><u>$ctr\)&nbsp;&nbsp;$sub_name
+<\/u>");
                  if ($sub_comments =~ m/\w/s)
                  {
                      $html_buffer .= ("$sub_comments") ;
              }
                }exgs;
                #print "\n\t$sub_name#$sub_comments\n";
                push @perl_lib_or_used_modules, $module_name;
        #print "USED $module_name\n";
    }
        ###########################
}
#print "\n######################\n";
fileoprn::filewrite("$script_name\.html",$html_buffer);

foreach my $y (@module_tree)
{
    $y =~ s/\:\:/\.pm=> /gs;
        $y = "$y"."\.pm";
        $y =~ s/(\.pl)\.pm/$1/gs;
        $y =~ s/-/&dash;/gs;
        push @all_design, $y;
#    print "$y\n";

}
#print "\n#####################\n";
foreach my $y (@perl_subroutines)
{
    $y =~ s/\:\:/\.pm=> /gs;
        $y =~ s/(\.pl)\.pm/$1/gs;
        push @all_design, $y;
}

@all_design= sort(@all_design);
my @modules_to_be_used;
my $row=0;
my $max_col=0;
foreach my $y (@all_design)
{

    my $dup_y = $y;
    my $col=0;
    $dup_y =~ s{(?:^|=>)\s*(.*?)\s*(?==>|\z)}
    {
        my ($x) = ($1);
        $modules_to_be_used[$row][$col]=$1;
        #print "$row"."$col".$x."\n";
        $col++;
        $max_col = $col if ($col > $max_col);
        ""
    }exgs;
    $tree_structure.= "$y\n";
    $row++;
}
#print "max_row $row
#max_col $max_col
#";
my $prev_module_in_list;
for (my $j=0;$j<=$max_col;$j++)
{
    for (my $i=0;$i<=$row;$i++)
    {

        if ($prev_module_in_list eq $modules_to_be_used[$i][$j])
        {
            $modules_to_be_used[$i][$j]="U" if ($modules_to_be_used[$i
+][$j]);
        }
        else
        {
            $prev_module_in_list = $modules_to_be_used[$i][$j]
        }

        #print $i."#".$j."#".$modules_to_be_used[$i][$j]."\n";
    }
}
#### Creating the images
my $create_image;
my $iterations=0;
for (my $i=0;$i<=$row;$i++)
{
    for (my $j=0;$j<=$max_col;$j++)
    {
        $iterations++;
        #print $modules_to_be_used[$i][$j]."=>";
        if ($modules_to_be_used[$i][$j])
        {
            if ($modules_to_be_used[$i][$j] ne "U")
            {
                if ($iterations > 1)
                {
                    $create_image .= "=======>" ;
                }
                else
                {
                    $create_image .= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&n
+bsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp
+;&nbsp;" ;
                }
                if ($modules_to_be_used[$i][$j] =~ m/\.pm/s)

                {
                    $create_image .= "<img\ src\=\"bin\.gif\"><b>".$mo
+dules_to_be_used[$i][$j]."<\/b><\/img>";
                }
                else

                {
                    $create_image .= "<img\ src\=\"sub\.gif\"><b>".$mo
+dules_to_be_used[$i][$j]."<\/b><\/img>";
                }

                #$create_image .= "<b>".$modules_to_be_used[$i][$j]."<
+\/b>";
            }
            else
            {
                #$create_image .= "=======><img\ src\=\"abc\.gif\"><\/
+img>";
                $create_image .= "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
+&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nb
+sp;<img\ src\=\"abc\.gif\"><\/img>";
            }
        }
    }
    $create_image .= "<br>\n";
}

#print $create_image;
my $heading = h1(b(u("PICTORICAL VIEW OF $script_name")));
$heading .= b(u("Image Codes")."<br><br>");
$heading .= b("<img\ src\=\"bin\.gif\">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&
+nbsp;&nbsp;&nbsp;Module/Script<br>");
$heading .= b("<img\ src\=\"abc\.gif\">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&
+nbsp;&nbsp;&nbsp;Module/Script column Extended<br>");

$heading .= b("<img\ src\=\"sub\.gif\">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&
+nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Subroutine<br>");
$heading .= "=========================================================
+===============================<br>";

$create_image = "<html><body>$heading".$create_image."<\/html><\/body>
+";
fileoprn::filewrite("$script_name"."_pict\.htm",$create_image);
end_html;
fileoprn::filewrite("$script_name"."_tree\.txt",$tree_structure);
end_html;
[download]

The fileoprn.pm is as follows

#!usr/bin/perl
#*******************************************************************

package fileoprn ;

=FUNCTION
======================================================================
+==
FILEREAD
=================
-----------------------------------------------------------------
Parameter       :  File path
Return Value    : The file buffer
====================================================================
=cut

sub fileread($)
 {
    my($filepath)  = @_;
    my $filebuf;
    chomp($filepath);
    open(FIN,"< $filepath") || open(FIN,"< $filepath") || warn "Unable
+ to open file :  $filepath";
    $filebuf = join '', <FIN>;
    close(FIN);
    return $filebuf;
 }

=FUNCTION
======================================================================
+==
FILEWRITE
=================
-----------------------------------------------------------------
Parameter       :  File path, buffer
Return Value    :
====================================================================
=cut

 sub filewrite($$)
 {
     my($filepath,$filebuf)  = @_;
     chomp($filepath);
     open(FOUT,"> $filepath") || die "Unable to open file :  $filepath
+";
     print FOUT $filebuf;
     close(FOUT);
 }

=FUNCTION
======================================================================
+==
FILEAPPEND
=================
-----------------------------------------------------------------
Parameter       :  File path, buffer
Return Value    :
====================================================================
=cut

 sub fileappend($$)
 {
     my($filepath,$filebuf)  = @_;
     chomp($filepath);
     open(FOUT,">> $filepath") || die "Unable to open file :  $filepat
+h";
     print FOUT $filebuf;
     close(FOUT);
 }
1
[download]

Comment on Auto documentation Select or Download Code

Replies are listed 'Best First'.
Re: Auto documentation by QM (Parson) on Nov 28, 2005 at 16:50 UTC
OK, but why not use POD for some of that? And surely someone has come up with a basic XREF utility? (Though a profiler might be needed to generate a typical tree.) -QM -- Quantum Mechanics: The dreams stuff is made of	[reply]
Re^2: Auto documentation by planetscape (Chancellor) on Dec 02, 2005 at 02:19 UTC
I think you are thinking of B::Xref. xref.pl, part of GraphViz-2.02, can use the output from B::Xref to generate a nice call graph. The reader interested in doing profiling with graphical output would also benefit from reading Creating Perl Code Graphs by brian_d_foy. HTH, planetscape	[reply]
Re: Auto documentation by planetscape (Chancellor) on Nov 30, 2005 at 01:59 UTC
I've re-invented a few wheels myself, so I won't be too hard on you, but I think you would benefit from looking at ~~DoxyFilt~~* (Doxygen for Perl) (You can see some samples here). Also: Analyzing large Perl code base. Becoming familiar with a too-big codebase? HTH, * Update: 2005-12-28 Kudos to both john_oshea and tfrayner for alerting me to the fact that my link above has been rendered usless by the foul creatures known as spammers... I have found what appears to be a good link to obtain DoxyFilt; the most recent version seems to be from August 24, 2005: Doxygen-0.84.tar.gz. Thanks again, guys! planetscape	[reply]
Re^2: Auto documentation by sanPerl (Friar) on Nov 30, 2005 at 05:39 UTC
Dear planetscape, Thanks for your suggestion. Regards, SanPerl	[reply]

Back to Cool Uses for Perl