#!/usr/bin/perl

use strict;
use CGI qw(:standard);

# instantiate a new CGI object
my $cgi = new CGI;

# perform a single print statement, with liberal use of the perl
# string concatenator "." and some CGI methods
print $cgi->header."\n";

# Testing document write
print $cgi->start_html(-title=>"Test Script",
                       -description=>"cgi-bin test script for windows")."\n";
print $cgi->h1("Tests result")."\n";
print $cgi->br."\n";

my $test_file = "test_file2.txt";
my $good_color = "#009933";
my $bad_color = "#FF0000";
my @results = ();
my $current_message = "";
my $test_content = "The lazy brown fox jumped over the white fence";
my @file_contents = ();
my $error = 0; #0 = no error, 1 = error


# -------------- test 1 begin -----------------
# test 1 checks whether the dummy file can be created
# or not.
#create a test file

if ( !open(TESTFILE, ">$test_file") ){
  $current_message = $cgi->td({-width=>"25%",-valign=>"top"},$cgi->span({-style=>"color:$bad_color;font-size:14pt;"},"File creation failed"));
  $current_message .= $cgi->br;
  $current_message .= $cgi->td({-valign=>"top"},"The cgi-bin directory does not have write permission");
  push (@results, $current_message);
  $error = 1;
}

# --------------- test 1 end -------------------

# --------------- test 2 begin -----------------
# test 2 checks whether the created file has write access

if ( $error ne 1 ){
  if ( !print TESTFILE $test_content ){
    $current_message = $cgi->td({-width=>"25%",-valign=>"top"}, $cgi->span({-style=>"color:$bad_color;font-size:14pt;"},"File does not have write access"));
    $current_message .= $cgi->br;
    $current_message .= $cgi->td({-valign=>"top"},"1.  The test file may be inheriting no write permissions" .
                                                  $cgi->br . 
                                                  "2.  The hard drive may be running out of space" . 
                                                  $cgi->br . 
                                                  "3.  The system may be experiencing some I/O error");
    push (@results, $current_message);
    $error = 1;
  }
}
# --------------- test 2 end -------------------

# --------------- test 3 begin -----------------
#test 3 checks if we can read the created file
if ( $error ne 1 ){
  if ( !open(TESTFILE, "<$test_file") ){
    $current_message = $cgi->td({-width=>"25%",-valign=>"top"},$cgi->span({-style=>"color:$bad_color;font-size:14pt;"},"File does not have read access"));
    $current_message .= $cgi->br;
    $current_message .= $cgi->td({-valign=>"top"},"1. &nbsp; Check script permissions in IIS" . 
                                                 $cgi->br . 
                                                 "2. &nbsp;" . $cgi->b("No Read Permissions") . " are being inherited from some setting");
    push (@results, $current_message);
    $error = 1;
  }
  else{
    #push (@results, $cgi->span({-style=>"color:$good_color;font-size:14pt;"},"File has read access"));
    #read the file contents
    @file_contents = <TESTFILE>;
    close(TESTFILE);
  }
}
# --------------- test 3 end -------------------

# --------------- test 4 begin -----------------
# test 4 checks the contents of the file and whether
# the content is what we expect from $test_content
if ( $error ne 1 ){
  my $array_size = $#file_contents + 1;
  if ( $array_size == 1 ){
    #we succeeded in reading the written line

    #verify the line read is the same as the line written
    chomp($file_contents[0]);
    if ( $file_contents[0] ne $test_content ){
      $current_message = $cgi->td({-width=>"25%",-valign=>"top"},$cgi->span({-style=>"color:$bad_color;font-size:14pt;"},"File content does not match"));
      $current_message .= $cgi->br;
      $current_message .= $cgi->td({-valign=>"top"},"Somehow the file content written previously did not match." .
                                                    "Verify the content of $test_file matches " .
                                                    $cgi->b($test_content) .
                                                    ". &nbsp;If the content matches, then there is a bug on the script " .
                                                    "Otherwise something is corrupting the test file. Check your disk for errors");
      push (@results, $current_message);
      $error = 1;
    }
  }
  else{
	$current_message = $cgi->td({-width=>"25%",-valign=>"top"}, $cgi->span({-style=>"color:$bad_color;font-size:14pt;"},"File line count does not match"));
      $current_message .= $cgi->br;
      $current_message .= $cgi->td({-valign=>"top"}, "1. &nbsp;The script is reading the wrong file which happenes to have the name $test_file" .
                                                    $cgi->br .
                                                    "2. &nbsp;The script has a bug");
      push (@results, $current_message);
      $error = 1;
  }
}
# --------------- test 4 end -------------------

########
##  MARKER => #1@34
##  The next script segment was removed because the 
##  end-user testing with this script may already have
##  a website set.  Thus, if we allow to overwrite the
##  index.html file, then the current web site will 
##  loose its index
#########
##--------------- create index.html begin -------------
#if ( $error ne 1 ){
#  #create the index.html file
#  if (! open(INDEX,">../index.html")){
#    #test index.html creation failed
#    $current_message = $cgi->td({-width=>"25%",-valign=>"top"}, $cgi->span({-style=>"color:$bad_color;font-size:14pt;"}, "Failed to create test index.html"));
#    $current_message .= $cgi->br;
#    $current_message .= $cgi->td({-valign=>"top"}, "Failed to create the test index.html file at the root level of the website" .
#                                                   "Mostlikely, website's root directory does not allow write permissions." .
#                                                   "Please verify your permissions");
#    push(@results, $current_message);
#    $error = 1;
#  }
#  else{
#    #create the contents of the test index.html file
#    print INDEX $cgi->start_html(-title=>"HTML Test",
#                                 -description=>"HTML test file")."\n";
#    print INDEX $cgi->div({-style=>"color:$good_color;font-size:14pt;", -align=>"center"},"HTML READY");
#    print INDEX $cgi->end_html();
#    close(INDEX);
#  }
#  #--------------- create index.html end ---------------
#}

##### Print Results #####

print $cgi->br;
print $cgi->hr;

if ( $error eq 1 ){

  print $cgi->center($cgi->span({-style=>"font-size:24pt;color:$bad_color"},"Failure"));
  print $cgi->table({-border=>"1"});
  print $cgi->Tr($cgi->th("Failed Test").$cgi->th("Possible Cause")) . "\n";
  my $result_item = "";
  foreach $result_item (@results){
   print $cgi->Tr($result_item) . "\n";
  }
  print "</table>";
}
else{
  #no errors in any of the tests
  print $cgi->div({-align=>"center",-style=>"font-size:24pt;color:$good_color"}, "Success");
  # search for marker #1@34 in this script for
  # explanation why the next 2 lines were commented out
  #print $cgi->br;
  #print $cgi->a({-href=>"../index.html"},"test html");
}

print $cgi->hr;
print $cgi->br;

# print end of html
print $cgi->end_html;


#--------------- clean up begin -------------
#delete test file
unlink $test_file;
#--------------- clean up end ---------------

# Tell the webserver everything is fine
exit (0);