#########################################################
# PRE-RELEASE MODULE
# Module: LADY /TM.pm LADY Table Methods
# Version BETA 1.0 r 3  2-06-2001
# Author: C. Prichard
# COPYRIGHT: GREENTV¬ Charles Prichard -1999-
# This module is a collection of methods needed
# to access and set EZDB compatible hash table data
# stored in a persistent index file on the server.
#
# Using the hashing table indexing system for data allows
# for improvement in efficiency over use of simple flat files
# if the index values are created with sortable features.
# The keys may be extracted from the table and sorted,
# then filtered using the remaining keys to access values
# in the hash table.The methods are practical only for
# small to medium sized datafiles because the entire data
# array is created in the server's memory.
#
# When the table is initialized, a multitasking system will do
# other processes while configuring the data in memory
#
# Systems that benefit are those that intensively require
# special sorting and processing of returned data.
package Lady_TM;

use strict;

#################################################
#  Sub new                          		#
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub new ($;$){

	my $class = shift;

	my $self = {};
	
	bless $self, ref $class || $class;
	
	$self->{index_path} = undef;
	$self->{lady_time} = undef;
	$self->{sep} = undef;
	
	$self->{TABLE} = {};
	$self->{TABLE_ARRAY} = [];
	
	$self->init(@_);
	
	
    return $self;

}
sub init($;$){
	
	my $self = shift;

	$self->{index_path} = shift;
	
	if ($_[0]){$self->{sep}= shift;}else{$self->{sep}="Ö";}
	
	use Lady::Lady_DATE;

	my $TIME = new Lady_DATE;

	$self->{lady_time} = $TIME->lady_time();

return;
}
#################################################
#       Sub set_specified_value_in_index_table  #
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub set_specified_value_in_index_table ($$){

	my $self = shift;

        my ($index_key,$index_value) = @_;

        if (defined $self->{index_path}) {

        	$self->get_index_table();

        	$self->{TABLE}{$_[0]} = $_[1];
        	$self->update_index_table ($self->{TABLE});
        }

        return;
}
#################################################
#       Sub increment_specified_value_in_index_table  #
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub increment_specified_value_in_table ($){

	my $self = shift;

	my ($key) = @_;

	$self->initialize_table();

	$self->{TABLE}{$key}++;

	$self->update_index_table($self->{TABLE});

	return $self->{TABLE}{$key};

}
#################################################
#       Sub decrement_specified_value_in_index_table  #
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub decrement_specified_value_in_table ($){

	my $self = shift;

	my ($key) = @_;

	$self->initialize_table();

	$self->{TABLE}{$key}--;

	$self->update_index_table($self->{TABLE});

	return $self->{TABLE}{$key};

}
#################################################
#       Sub add_specified_amount_to_value_in_table #
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub add_specified_amount_to_value_in_table ($$){

	my $self = shift;

	my ($key,$value) = @_;

	$self->initialize_table();

        $self->{TABLE}{$key} = $self->{TABLE}{$key} + $value;

	$self->update_index_table($self->{TABLE});

	return $self->{TABLE}{$key};

}
#################################################
#       Sub get_specified_value_in_index_table  #
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub get_specified_value_in_table ($){

	my $self = shift;

        my $key = shift;

        $self->get_index_table();

        return $self->{TABLE}{$key};

}
#################################################
#       Sub get_random_option                   #
#################################################
#################################################
#   	PRIVATE Subroutine                      #
#################################################
sub random_option ($){

	my $self = shift;

        return int(rand($_[0]));
}
#################################################
#       Sub get_random_value_in_index_table     #
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub get_random_value_in_index_table () {

	my $self = shift;

	my ($lines,$random_selection,$random_line);

        $self->get_index_table ();
        
        my (%TEMP) = $self->{TABLE};

        my $self->{TABLE_ARRAY} = values (%TEMP);
        $lines = scalar ($self->{TABLE_ARRAY}) - 1;
        $random_selection= $self->random_option ($lines);
        $random_line = $self->{TABLE_ARRAY}[$random_selection];

        return ($random_line);
}
#################################################
#       Sub get_index_table             	#
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub get_index_table (){

  	my $self = shift;

  	# flock (INDEXFILE, $LOCK_SH); #Commented for Personal Webserver Perl implementation.
  	open(INDEXFILE, "$self->{index_path}") || &file_open_error("$self->{index_path}","Read Index",__FILE__,__LINE__);

  	$_ = <INDEXFILE>; #READ first line.

  	if ($_ =~ /(.+)/){$_ = $1;}
  	else {die "Bad data in index $self->{index_path}.";}
 	# print "$_<br>";
	# my @db_definition = split(/\|/,$_);

  	$self->{TABLE} = ();

  	while (!eof(INDEXFILE)){

      		$_ = <INDEXFILE>;

      		if ($_ =~ /(.+)/){$_ = $1;}
      		else {die "Bad data in index $self->{index_path}.";}

      		my @db_row = split(/\|/,$_);

      		$self->{TABLE}{$db_row[1]} = $db_row[2];

 		# print  "$db_row[1],$db_row[2]<br>";
	}

  	close(INDEXFILE);

  	return $self->{TABLE};
} #end of get_index_table subroutine
#################################################
#        Sub update_index_table                 #
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub update_index_table (%){

  	my $self = shift;

  	$self->{TABLE} = @_;

  	#flock (INDEXFILE, $LOCK_SH);
  	open (INDEXFILE, "<$self->{index_path}") || &file_open_error("$self->{index_path}","Reading Index",__FILE__,__LINE__);

  	my $newline = <INDEXFILE>;

  	if ($newline =~ /(.+)/){$newline = $1;} # passes all chars
  	else {die "Bad data in index $self->{index_path}.";}
  	# $newline = $newline;

  	$newline .= "\n";

  	my @db_row = ();

  	while (<INDEXFILE>){

      		if ($_ =~ /(.+)/){$_ = $1;}
      		else {die "Bad data in index $self->{index_path}.";}

      		@db_row = split(/\|/,$_);

      		# print "@db_row"."<br>";

      		if (defined $self->{TABLE}{$db_row[1]}){

      			$db_row[2] = $self->{TABLE}{$db_row[1]};
      			$newline .= join "|",@db_row;
      			$newline .= "\n";

      			# print "<br>$newline";

		}

  	}

  	close INDEXFILE;

  	# flock (INDEXFILE, $LOCK_EX);
  	open (INDEXFILE, ">$self->{index_path}") || &file_open_error(">$self->{index_path}","Writing Index",__FILE__,__LINE__);
  	# if ($newline =~ /(.+)/){$newline = $1;}
  	# else {die "Bad data in index $self->{index_path}.";}
  	syswrite INDEXFILE, $newline, length $newline;
  	close INDEXFILE;

  	return;

} #end of update_index_counters subroutine
#################################################
#       Sub get_keyed_value_array            	#
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
#
# There is a problem here returning an array, splitting on sep
#
sub get_keyed_value_array ($){

	my $self = shift;

  	$self->get_index_table();
  	
  	#print "STRING:$self->{TABLE}{$_[0]}<br>";
  	
  	#print "SEP:\"$self->{sep}\"<br>";
  	
  	my (@ARRAY) = split ("$self->{sep}",$self->{TABLE}{$_[0]});
  	
  	#print "ARRAY:$ARRAY[0],$ARRAY[1],$ARRAY[2]<br>";
  	
  	return (\@ARRAY);

}

#################################################
#       Sub set_keyed_value_array            	#
#################################################
sub set_keyed_value_array ($@){

	my $self = shift;

  	my ($key) = shift;
  	
  	$self->{TABLE_ARRAY} = shift;
  	
  	#print "KEY:$key, TABLE: $self->{TABLE_ARRAY}[0]<br>";
  	
  	$self->get_index_table();

  	if (defined $self->{TABLE}{$key}){

  		$self->{TABLE}{$key} = join "$self->{sep}",$self->{TABLE_ARRAY};
  		$self->update_index_table($self->{TABLE});
  	}
  	else{
  		$self->add_new_table_row($key,$self->{TABLE_ARRAY});
  	}

  	return;
}
#################################################
#     Sub get_nth_element_in_keyed_array      #
#################################################
#################################################
#       PUBLIC Subroutine                       #
#################################################
sub get_nth_element_in_keyed_value_array($$){
    
    my $self = shift;
    
    my ($key,$place) = @_;
    
    my @List = @{$self->get_keyed_value_array($key)};
    return $List[$place];

}
#################################################
#       Sub delete_key_value_pair            	#
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub delete_key_value_pair ($%){

	my $self = shift;

	my ($key) = shift;
	
	$self->{TABLE} = shift;

	my %deleted_pair = ();

  	$deleted_pair{$key} = $self->{TABLE}{$key};

  	delete ($self->{TABLE}{$key});

  	$self->update_index_table($self->{TABLE});

  	return (\%deleted_pair);
}
#####################################################
# 	Sub get_table_keys_by_specified_first_characters  #
#####################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub get_table_keys_by_specified_first_characters($%){

	my $self = shift;

	my ($char) = shift;
	
	my (%TEMP) = shift;

	my (@temp) = grep{[/($_[0]+)/,$_]} keys (%TEMP);

	return (\@temp);
}
#################################################
# 	Sub get_numeric_keys_greater_than_passed_value#
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub get_numeric_keys_greater_than_passed_value($;%){

	my $self = shift;

	my ($val) = shift;
	
	my (%TEMP) = shift;
	
	my (@temp) = grep{($_ > $val)} keys (%TEMP);

	return (\@temp);
}
#################################################
# 	Sub get_numeric_keys_less_than_passed_value  	#
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub get_numeric_keys_less_than_passed_value($;%){

	my $self = shift;
	
	my ($val) = shift;
	
	my (%TEMP) = shift;

	my (@temp) = grep{($_ < $val)} keys (%TEMP);

	return (\@temp);
}
#################################################
# 	Sub get_numeric_keys_in_passed_range  	#
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub get_numeric_keys_in_passed_range($$%){

	my $self = shift;

	my $lower = shift;
	
	my $upper = shift;
	
	my (%TEMP) = shift;
	
	my (@temp) = grep{[($_ ge $lower) && ($_ le $upper)]} keys (%TEMP);

	return (\@temp);
}
#################################################
#       Sub initialize_table                 	#
#################################################
#################################################
#   	PRIVATE Subroutine                       #
#################################################
sub initialize_table (){
	
	my $self = shift;

  	return $self->get_index_table();

}
#################################################
#	Sub create_table       			#
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub create_table($){

	my $self = shift;

	my ($table_line) = @_;

	#TODO: Test for existence of table and cancel operation if test fails.

  	open(INDEXFILE, ">$self->{index_path}") || &file_open_error("$self->{index_path}","Creating Table",__FILE__,__LINE__);
  	print INDEXFILE "$table_line";
  	close INDEXFILE;
}
#################################################
#	Sub add_new_table_row       		#
#################################################
#################################################
#   	PUBLIC Subroutine                       #
#################################################
sub add_new_table_row ($@){

	my $self = shift;

	my $key = shift;
	
	$self->{TABLE_ARRAY} = shift;
	
	#print "TABLE_ROW: $self->{TABLE_ARRAY}[0]<br>";

  	#flock (INDEXFILE, $LOCK_SH);
  	open (INDEXFILE, "<$self->{index_path}") || &file_open_error("$self->{index_path}","Reading Index",__FILE__,__LINE__);

  	my $newline = <INDEXFILE>;

  	if ($newline =~ /(.+)/){$newline = $1;} # passes all chars
  	else {die "Bad data in index $self->{index_path}.";}

  	my @row = ();

  	$newline .= "\n";

  	my $i=90000;
  	my $line;
  	while (<INDEXFILE>){

      		if ($_ =~ /(.+)/){$_ = $1;}
      		else {die "Bad data in index $self->{index_path}.";}
      		my @db_row = ();
      		@db_row = split(/\|/,$_);
      		if ($i == 90000){@row = @db_row;}
      		my @values = split(/\ /,$db_row[2]);
      		#if ($lady_time < $values[3]){ #TO add something for purging
      			$db_row[0] = $i;
      			$line = join "|",@db_row;
      			$newline .= $line."\n";
      			# print "<br>$newline";
  			$i++;
  		#}
  	}

  	close INDEXFILE;

  	$row[0] = $i;
  	$row[1] = $key;
  	$row[2] = join "$self->{sep}",$self->{TABLE_ARRAY};

  	$newline .= join "|",@row;
  	$newline .= "\n";

  	# flock (INDEXFILE, $LOCK_EX);
  	open (INDEXFILE, ">$self->{index_path}") || &file_open_error(">$self->{index_path}","Writing Index",__FILE__,__LINE__);
  	# if ($newline =~ /(.+)/){$newline = $1;}
  	# else {die "Bad data in index $self->{index_path}.";}
  	syswrite INDEXFILE, $newline, length $newline;
  	close INDEXFILE;

  	return;

}#end of add_new_table_row subroutine

#################################################
#	Sub get_and_increment_page_counter	#
#################################################
# This method reads an EZ DB compatible flatfile and indexes a counter
# value using the passed page tag in $counter. When a matching tag is found
# the associated value is incremented and concatenated to the new file string.
# The index tags and counter values are placed in the %index_table array 
# and when the method returns, it indexes the tag counter value and places it
# in the returned value.
# If a matching tag value in counter is not found, then a new line is 
# automatically appended to the counter file using the tag, the accrued row 
# count and the optional passed html page path value.
#
# EXAMPLE: (From input parsing method.)
# if ($page){
#		$page_name = $page;
#		$page = &get_page($page);	# TO DO: ADD OTHER PARSING METHODS HERE        	
#        	$DISPLAY_TABLE{'page_counter'} = &get_and_increment_page_counter($page_name,$page);
#        	
#        	&display_page("$page","$page_name", __FILE__,__LINE__,\%DISPLAY_TABLE);
#        	exit 0;
#	} 
#
# Where:The display_page method will search for a %%page_counter%% tag and if found, make the 
# replacement.(NOT SHOWN)
#
# The $lady_site_page_counter_path variable must be initialized properly.to
# locate the counter file.
# The file is a common flatfile with the following structure:
# pkey|page|count|path||blank
# 1000|opener|0|./html/NTTC/NTTC_opener.html||
# 1001|general_information|0|./html/NTTC/general_information.html||
# 1002|contacts|0|./html/NTTC/contacts.html||
# 1003|links|0|./html/NTTC/links.html||
# 1004|index|0|./html/NTTC/NTTC_index.html||
#
# The path is not used by the counter, but future modifications to the script
# could consolidate the page path index and the counter index to improve 
# performance.

sub get_and_increment_page_counter($;$){

	my $self = shift; 
	
	my $counter = shift;
	
	my $path = shift;
	
	$self->{TABLE} = ();
		
	my $found = 0;
	open(INDEXFILE, "<$self->{index_path}") || &file_open_error($self->{index_path},"Reading Counter Index",__FILE__,__LINE__);
	# flock INDEXFILE, 2; 	# SET EXCLUSIVE MODE
  	my $line = <INDEXFILE>;
  	my $newline = $line;
  	my $x=999;			# Initial Value - 1
  	my @db_row = ();
  	
	while (!eof(INDEXFILE)){
		
      		$line = <INDEXFILE>;		
      		@db_row = split(/\|/,$line); 
      		if($counter eq $db_row[1]){$db_row[2]++;$found=1}
      		$self->{TABLE}{$db_row[1]} = $db_row[2];
	        my $nextline = join "|",@db_row;
      		$newline .= $nextline;
      		$x++;
        } 
        if ($found == 0){
        	$x++;
        	my $newstring = $x."|".$counter."|1|".$path."||\r\n";
        	$newline .= $newstring;
        	$self->{TABLE}{$counter} = 1;
        }
	close INDEXFILE;
	open (INDEXFILE, ">$self->{index_path}") || &file_open_error("$self->{index_path}","Writing Counter Index",__FILE__,__LINE__);
	# flock INDEXFILE, 2; 	# SET EXCLUSIVE MODE
	print INDEXFILE $newline;
	close INDEXFILE;
		
	return $self->{TABLE}{$counter};
}

sub file_open_error{

                # The subroutine simply uses the update_error_log
                # subroutine discussed later to modify the error log and
                # then uses CgiDie in cgi-lib.pl to gracefully exit the
                # application with a useful debugging error message sent
                # to the browser window.

  my ($bad_file, $script_section, $this_file, $line_number) = @_;

  # &update_error_log("FILE OPEN ERROR-$bad_file", $this_file, $line_number);
  use CGI_lib;

  my $CGI = new CGI_lib();

  $CGI->CgiDie ("I am sorry, but I was not able to access $bad_file in the
        $script_section routine of $this_file at line number $line_number.
        Would you please make sure the path is correctly defined in
        lady_site.setup and that the permissions are correct. $!")
  } # End of Sub "file_open_error"


1;