Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Auto documentation

by sanPerl (Friar)
on Nov 28, 2005 at 12:00 UTC ( #512146=CUFP: print w/ replies, xml ) Need Help??

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;

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

Comment on Auto documentation
Select or Download Code
Re: Auto documentation
by QM (Vicar) 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

Re: Auto documentation
by planetscape (Canon) on Nov 30, 2005 at 01:59 UTC
      Dear planetscape,
      Thanks for your suggestion.

      Regards,
      SanPerl

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://512146]
Approved by valdez
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (6)
As of 2014-12-18 02:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (41 votes), past polls