#!/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 = "    ";
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=>$display_module_tree, href=>"#child"."$display_module_tree"},"  $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 = $display_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 would be called in following way, $display_module_tree_for_module_description, 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_module_name";
                        $html_buffer .= a({name=>"child"."$display_module_tree\:\:$child_module_name",href=>"#$display_module_tree\:\:$child_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_name";
                  $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;&nbsp;&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>".$modules_to_be_used[$i][$j]."<\/b><\/img>";
				}
				else

				{
					$create_image .= "<img\ src\=\"sub\.gif\"><b>".$modules_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;&nbsp;<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;

##</code><code>##

#!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 :  $filepath";
     print FOUT $filebuf;
     close(FOUT);
 }
1