#################################################################
#
# iDatabase::Driver::DBM
#
# A driver class for DBM files
#
# Driver Author: Matthew Mecham <matt@ikonboard.com>
#
#################################################################
package iDatabase::Driver::DBM;
use strict;

use vars qw(@ISA $VERSION $CONN $TYPE $error %DEBUG %GBL $INFO @r_IGNORE);

# Import AnyDBM_File
BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File SDBM_File) }
use AnyDBM_File;

#Inherit from the base class
require iDatabase::Driver::Base;
@ISA = qw(iDatabase::Driver::Base);

# Set up the flock settings
if ($^O ne 'MacOS' && ($^O ne 'MSWin32' || !Win32::IsWin95())) {
    use Fcntl qw(:DEFAULT :flock);
    $INFO->{'FLOCK'} = 1;
}

$VERSION = 1.0;
$INFO->{'do_lock'} = 1;

# Set the type
$TYPE = 'DBM';

# Some userdefinable stuff to set up:
# Do you want your notice log appended on every key delete? (Handy for de-bugging)
$GBL{'NOTICE'} = 1;

# Which tables do you want to ignore from warns/notices?
@r_IGNORE = ( 'active_sessions' );

#--------------------------------------
#
# Create a DB connection
#
#--------------------------------------

sub newSQL {
    my ($pkg, $args)  = @_;
    my $rPkg = ref $pkg || $pkg;
    
    my $obj = { 'error'    => '',
                'query'    => '',
                'query_c'  => 0,
                'PREFIX'   => $args->{'DB_PREFIX'},
                'base_dir' => $args->{'DB_DIR'}
              };

    # Create the mySQL class.
    bless $obj, $rPkg;
    
    # Connect, if we don't already have a live connection or
    # DB Handle
    
    # No connection methods needed
    
    # Set the permissions for creating / dropping tables
    $obj->{_can_drop}   = $args->{ATTR}->{allow_drop}   || 0;
    $obj->{_can_create} = $args->{ATTR}->{allow_create} || 0;
    
    return $obj;
}










#----------------------------------------------------------------
# select, overrides base class method
#----------------------------------------------------------------


sub select  {
    my $obj = shift;
       $obj->{'error'} = undef;
    my $IN = {  
                "TABLE"   => "",
                "COLUMNS" => [],
                "KEY"     => "",
                "DBID"    => "",
                "ID"      => "", # DEPRECIATED IN DBM
                @_
              };
    my $found;

    unless ( $obj->ping(TABLE=>$IN->{'TABLE'},DBID=>$IN->{'DBID'},ID=>$IN->{'ID'}) ) {
        $obj->{'error'} = 'Table Not Found!';
        return;
    }

    $obj->load_cfg($IN->{'TABLE'});


    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

    my $cur_columns = scalar @{$IN->{'COLUMNS'}} > 0 ? \@{$IN->{'COLUMNS'}} : \@{$obj->{'col_name'}};

	my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.db";
    return unless ((-e $file) || (-e "$file.pag"));

	$obj->lock_table($IN->{'TABLE'});

	tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) or die "Can't open file ($file) for reading. $!";

	if ( $DB{ $IN->{'KEY'} } eq '') {
    	$obj->{'error'} = "DB Error: Cannot locate the primary key whilst selecting $IN->{'KEY'} in table $IN->{'TABLE'}";
    	return;
  	}

	my $data = $obj->decode_record( $DB{ $IN->{'KEY'} });

	untie (%DB);

	$obj->release_lock($IN->{'TABLE'});
    
    my $return = {};
    if (scalar @{$IN->{'COLUMNS'}} != $obj->{'total_cols'}) {
        for (@{$cur_columns}) {
            $return->{$_} = $data->{$_};
        }
    } else {
        $return = $data;
    }
    
    return $return ? $return : 0;
}


#----------------------------------------------------------------
# query, overrides base class method
#----------------------------------------------------------------


sub query  {
    my $obj = shift;
       $obj->{'error'} = undef;
    my $IN = {  
                "TABLE"     => "",
                "COLUMNS"   => [],
                "SORT_KEY"  => "",
                "SORT_BY"   => "",
                "WHERE"     => "",
                "MATCH"     => "",
                "RANGE"     => "",
                "DBID"      => "",
                "ID"        => "", #DEPRECIATED IN DBM
                "COUNT"     => "",
                "INDEX"     => "",
                @_,
              };

    if ($IN->{'INDEX'}) {

        my $data = $obj->query_index( TABLE     => $IN->{'TABLE'},
                                      DBID      => $IN->{'DBID'},
                                      ID        => $IN->{'ID'},
                                      INDEX_KEY => $IN->{'INDEX'}->{'KEY'},
                                      S_KEY     => $IN->{'INDEX'}->{'VALUE'},
                                      CASE      => $IN->{'INDEX'}->{'CASE'}
                                    );

        return {} unless defined $data;

        my $return = $obj->select( TABLE     => $IN->{'TABLE'},
                                   DBID      => $IN->{'DBID'},
                                   ID        => $IN->{'ID'},
                                   KEY       => $data
                                 );

        return $return;
    }


    my ($data, $found, $statement_string, $returned_records, @return, @to_sort);

    $obj->load_cfg($IN->{'TABLE'});

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }
    
    my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.db";
	return my $empty_array = $IN->{'MATCH'} eq 'ONE' ? {} : [] unless ((-e $file) || (-e "$file.pag"));

    my $cur_columns = scalar @{$IN->{'COLUMNS'}} > 0 ? \@{$IN->{'COLUMNS'}} : \@{$obj->{'col_name'}};

    #Build the search query
    
    if ($IN->{'WHERE'}) {
        $statement_string = "(".$IN->{'WHERE'}.")";
        for my $i (0 .. $obj->{'total_cols'}) {
            $statement_string =~ s!(^|[\s\b\(])($obj->{'col_name'}->[$i])([\b\s\)]|$)!$1\$data->{'$2'}$3!g;
        }
        #> Swop SQL LIKE to perl regexp
        $statement_string =~ s#\s{1}NOT LIKE\s{1}# !~ #g;
        $statement_string =~ s#\s{1}LIKE\s{1}# =~ #g;
        #> We assume that /$word/ is looking for a word boundry
        #> and /%$word%/ is looking for any match
        $statement_string =~ s#/(.+?)/#/\\b$1\\b/i#g;
        $statement_string =~ s#/\\b%#/#g;
        $statement_string =~ s#%\\b/#/#g;
        #> Perl won't need the SQL % wildcard character
        #$statement_string =~ s#%#\\b#g;
    } else {
		$statement_string = qq~(\$data->{ \$obj->{'cur_p_key'} } ne '')~;
	}


    $obj->{'query'} = $statement_string;
    my $found_records = {};

    my $eval = qq~sub Check {  my (\$obj, \$data) = \@_; return 1 if $statement_string; }~;
    
    {
        local $@;
        eval $eval; die "Eval Error while parsing:: $statement_string" . $@ if $@;
    }

	$obj->lock_table($IN->{'TABLE'});

	tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";
    my ($k, $v);
	while (($k, $v) = each(%DB)) {
		my $data = $obj->decode_record($v);
		if ($obj->Check($data)) {
    		push @to_sort, $data;
    		++$returned_records;
    		if ($returned_records == 1 and $IN->{'MATCH'} eq 'ONE') {
        		$found = $data;
       			last;
			}
		}
	}

	untie (%DB);

	$obj->release_lock($IN->{'TABLE'});

    if ($IN->{'MATCH'} eq 'WITH COUNT') {
        $obj->{'matched_records'} = $returned_records;
    }

    if ($IN->{'MATCH'} ne 'ONE') {
        local $^W = undef;
        goto RANGE if $IN->{'COUNT'};

        if ($obj->{'all_cols'}->{ $IN->{'SORT_KEY'} }[1] eq 'string') {
            if ($IN->{'SORT_BY'} eq 'Z-A') {
                @return = sort { $b->{ $IN->{'SORT_KEY'} }
                                                  cmp
                                 $a->{ $IN->{'SORT_KEY'} } } @to_sort;
            } else {
                @return = sort { $a->{ $IN->{'SORT_KEY'} }
                                                  cmp
                                 $b->{ $IN->{'SORT_KEY'} } } @to_sort;
            }
        } else {
            if ($IN->{'SORT_BY'} eq 'Z-A') {
                @return = sort { $b->{ $IN->{'SORT_KEY'} }
                                                  <=>
                                 $a->{ $IN->{'SORT_KEY'} } } @to_sort;
            } else {
                @return = sort { $a->{ $IN->{'SORT_KEY'} }
                                                  <=>
                                 $b->{ $IN->{'SORT_KEY'} } } @to_sort;
            }
        }
        
        RANGE:

        if ($IN->{'RANGE'}) {
            my ($from, $to) = split " to ", $IN->{'RANGE'};
            $from = 0 unless $from;
            $to   = $#return if ((!$to) or ($to > $#return));
            @return = @return[$from .. $to];
        }

        @return = () unless scalar @return > 0;
        if ($IN->{'COUNT'}) {
            return $returned_records;
        } else {
            return wantarray ? @return : \@return;
        }
    }

    return $returned_records == 1 ? $found : {};
}


#----------------------------------------------------------------
# insert, overrides base class method
#----------------------------------------------------------------


sub insert {
    my $obj = shift;
       $obj->{'error'} = undef;
    my $IN = {  
                "TABLE"    => "",
                "VALUES"   => "",
                "DBID"     => "",
                "ID"       => "", #DEPRECIATED IN DBM
                @_
              };  


    unless ( $obj->ping(TABLE=>$IN->{'TABLE'},DBID=>$IN->{'DBID'}) ) {
        $obj->{'error'} = 'Table Not Found!';
        return;
    }

    $obj->load_cfg($IN->{'TABLE'});

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

    my $counter;
    
    if ($obj->{'all_cols'}->{ $obj->{'cur_p_key'} }[1] eq 'update') {
        open (CNT, $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.cnt.db");
        flock (CNT, LOCK_SH) if $INFO->{'FLOCK'};
        $counter = <CNT> || 0;
        close (CNT);

        ++$counter;

        $IN->{'VALUES'}->{ $obj->{'cur_p_key'} } = $counter;
    } 


	my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.db";
	#return unless (-e $file);

	my $entry = $obj->encode_record($IN->{'VALUES'});

	$obj->lock_table($IN->{'TABLE'});

	tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) or $obj->{'error'} =  "Can't open file ($file) for reading. $!";

    $DB{ $IN->{'VALUES'}->{ $obj->{'cur_p_key'} } } = $entry;

	untie (%DB);
        
	$obj->release_lock($IN->{'TABLE'});

  
    if ($obj->{'all_cols'}->{ $obj->{'cur_p_key'} }[1] eq 'update') {
        open (CNT, ">$obj->{'base_dir'}" . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.cnt.db") or die "File:$obj->{'base_dir'}" . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.cnt.db Reason:$!";
        flock (CNT, LOCK_EX) or die $! if $INFO->{'FLOCK'};
        print CNT $counter;
        close (CNT) or die $!;

        return $counter;
    }
    return "0 but true";
}



#----------------------------------------------------------------
# delete, overrides base class method
#----------------------------------------------------------------

sub delete  {
    my $obj = shift;
       $obj->{'error'} = undef;
    my $IN = {  
                "TABLE"   => "",
                "KEY"     => "",
                "DBID"    => "",
                "ID"      => "", #DEPRECIATED IN DBM
                "WHERE"   => "",
                @_
              };

    my @keys;

    $obj->load_cfg($IN->{'TABLE'});

    if ($IN->{'KEY'} eq '') {
        return $obj->{error} = 'no keys to delete!' unless $IN->{'WHERE'} ne '';
    }

    unless ( $obj->ping(TABLE=>$IN->{'TABLE'},DBID=>$IN->{'DBID'}) ) {
        $obj->{'error'} = 'Table Not Found!';
        return;
    }

    if ($IN->{'WHERE'} ne '') {
        my $ids = $obj->query( TABLE   => $IN->{'TABLE'},
                               ID      => $IN->{'ID'},
                               COLUMNS => [$obj->{'cur_p_key'}],
                               WHERE   => $IN->{'WHERE'},
                               DBID    => $IN->{'DBID'},
                              );
        return unless scalar @{$ids} > 0;
        for (@{$ids}) {
            push @keys, $_->{ $obj->{'cur_p_key'} };
        }
    } else {
		if (ref($IN->{'KEY'}) ne 'ARRAY') {
			push @keys, $IN->{'KEY'};
		} else {
			for (@{$IN->{'KEY'}}) {
				push @keys, $_;
			}
		}
	}

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

	my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.db";
    return unless ((-e $file) || (-e "$file.pag"));

	$obj->lock_table($IN->{'TABLE'});

    # Set the delete flag
    my $count  = 0;
    my ($k, $v);
	tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";

	for my $key (@keys) {
	    next if $DB{ $key } eq '';
    	delete $DB{ $key };
    	if ($GBL{'NOTICE'}) {
            $obj->_error(    P_KEY  => $obj->{'cur_p_key'},
                             ERROR  => "Deleted Key",
                             TABLE  => $IN->{'TABLE'},
                             DBID   => $IN->{'DBID'},
                             ID     => $IN->{'ID'},
                             KEY    => $key,
                             TYPE   => "Notice",
                        );
        }
	}
	
	# Test to see if we have any valid keys left.
	while (($k, $v) = each(%DB)) {
        if (defined $k and defined $v ) {
            $count++;
            last;
        }
    }

	untie (%DB);
        
	$obj->release_lock($IN->{'TABLE'});
	
	# If there are no keys left, delete the file
	unless ($count) {
	    unlink ($file);
	    # remove the counter file... 
	    unlink ($obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.cnt.db");
	}

    return 1;
}

#----------------------------------------------------------------
# update, overrides base class method
#----------------------------------------------------------------

sub update  {
    my $obj = shift;
       $obj->{'error'} = undef;
    my $IN = {  
                "TABLE"   => "",
                "VALUES"  => "",
                "KEY"     => "",
                "WHERE"   => "",
                "DBID"    => "",
                "ID"      => "", #DEPRECIATED IN DBM
                @_
              };

    my ($data, $found);

    unless ( $obj->ping(TABLE=>$IN->{'TABLE'},DBID=>$IN->{'DBID'}) ) {
        $obj->{'error'} = 'Table Not Found!';
        return;
    }

    my @keys;

    $obj->load_cfg($IN->{'TABLE'});

    #$IN->{'VALUES'}->{ $obj->{'cur_p_key'} } = $IN->{'KEY'};

    if ($IN->{'WHERE'} ne '') {
        my $ids = $obj->query( TABLE   => $IN->{'TABLE'},
                               ID      => $IN->{'ID'},
                               COLUMNS => [$obj->{'cur_p_key'}],
                               WHERE   => $IN->{'WHERE'},
                               DBID    => $IN->{'DBID'},
                              );
        return unless scalar @{$ids} > 0;
        @keys = map {   $_->{ $obj->{'cur_p_key'} }   } @{$ids};
    } else {
		if (ref($IN->{'KEY'}) ne 'ARRAY') {
			push @keys, $IN->{'KEY'};
		} else {
			for (@{$IN->{'KEY'}}) {
				push @keys, $_;
			}
		}
	}
    
    return unless @keys > 0;

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

	my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.db";
    return unless ((-e $file) || (-e "$file.pag"));

	$obj->lock_table($IN->{'TABLE'});

	tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";

    for my $key (@keys) {

	    my $data = $obj->decode_record( $DB{ $key });

	    for my $k (keys %{$IN->{'VALUES'}}) {
    	    $data->{$k} = $IN->{'VALUES'}->{$k};
	    }
	    
	    # Do we have a primary key to save back?
	    unless (defined $data->{ $obj->{'cur_p_key'} } ) {
	        $obj->_error( P_KEY  => $data->{ $obj->{'cur_p_key'} },
	                      ERROR  => "Could not update table (Missing primary key when updating)",
	                      TABLE  => $IN->{'TABLE'},
	                      DBID   => $IN->{'DBID'},
	                      ID     => $IN->{'ID'},
	                      KEY    => $key,
	                      TYPE   => "Error",
	                    );
	        $obj->{'error'} = "Cannot update! No primary key found";
	        untie (%DB);
	        $obj->release_lock($IN->{'TABLE'});
	        return;
	    }
	    
	    my $entry = $obj->encode_record($data);

	    $DB{ $key } = $entry;
    }

	untie (%DB);
        
	$obj->release_lock($IN->{'TABLE'});

    return 1;
}

##############################################################################

sub _error {
    my $obj = shift;
    my %IN = ( P_KEY => "",
               ERROR => "",
               TABLE => "",
               ID    => "",
               DBID  => "",
               KEY   => "",
               TYPE  => "",
               @_,
             );
             
    return if grep { $_ eq $IN{'TABLE'} } @r_IGNORE;
             
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
    my @months = ('Jan.','Feb.','Mar.','April','May','June','July','Aug.','Sep.','Oct.','Nov.','Dec.');
    $mon = $months[$mon];
    my $ampm = "am";
    if ($hour > 11) {  $ampm = "pm"; }
    if ($hour > 12) { $hour = $hour - 12; }
    if ($hour == 0) { $hour = 12; }
    if ($min < 10) { $min = "0$min"; }
    if ($sec < 10) { $sec = "0$sec"; }
    $year = $year + 1900;
    
    my $file = $IN{'TYPE'} eq 'Notice' ? 'Notice-Log' : 'Error-Log';
    
    open LOGS, ">>".$obj->{'base_dir'}."/$file" or die $!;
    print LOGS "[$IN{'TYPE'}] $hour:$min $sec $ampm on $mon $mday, $year $IN{'ERROR'} (Table: $IN{'TABLE'}, DBID:$IN{'DBID'}, ID:$IN{'ID'}) Primary Key: $obj->{'cur_p_key'}. DBM Key: $IN{'KEY'}\n";
    close LOGS;
}



sub count {
    my $obj = shift;
    my $IN = {  
                "TABLE"    => "",
                "DBID"     => "",
                "ID"       => "",
                @_,
              };

    my $count = 0;

    $obj->load_cfg($IN->{'TABLE'});

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

    if ($IN->{'ID'}) {
        my ($k, $v);
	    my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.db";
        return 0 unless ((-e $file) || (-e "$file.pag"));
	    $obj->lock_table($IN->{'TABLE'});
	    tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";
        $count = scalar( keys %DB );
	    untie (%DB);
	    $obj->release_lock($IN->{'TABLE'});
        return $count;

    } else {
        my $r_count;
        opendir CNT, $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}" or die "Cannot open directory for reading";
        my @files = grep { /^$IN->{'TABLE'}\-([\w\d-]+)\.db(\.pag)?/ } readdir CNT;
        closedir CNT;
        if (scalar @files > 1) {
            $IN->{'DBID'} =~ s![\\/]+$!!;
            for my $f (@files) {
                $f =~ s/$IN->{'TABLE'}\-([\w\d-]+)\.db(\.pag)?/$1/;
                my $t_count = $obj->count( TABLE    => $IN->{'TABLE'},
                                           DBID     => $IN->{'DBID'},
                                           ID       => $f,
                                         );
                $r_count += $t_count;
            }
            return $r_count;
        } else {
            my ($k, $v);
	        my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}.db";
            return 0 unless ((-e $file) || (-e "$file.pag"));
	        $obj->lock_table($IN->{'TABLE'});
	        tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";
            while (($k, $v) = each(%DB)) {
                $count++;
            }
	        untie (%DB);
	        $obj->release_lock($IN->{'TABLE'});
            return $count;
        }
    }
}
        
        

#+---------------------------------------------------------------------------------------------
#| PING: Test to see if the table exists.
#+---------------------------------------------------------------------------------------------

sub ping {
	my $obj = shift;
    my $IN = {  
                "TABLE"   => "",
                "DBID"    => "",
                "ID"      => "",
                @_
              };
	
    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';
    $IN->{'ID'}   =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';

	return 1 if (-e $obj->{'base_dir'} . $IN->{'TABLE'});
}


sub table_import {
	my $obj = shift;

    my $IN = {  
                "TABLE"   => "",
                "SOURCE"  => "",
                "DBID"    => "",
                "ID"      => "",
                @_
             };
    $obj->load_cfg($IN->{'TABLE'});

    # Ok, we A.S.S.U.ME that these files may be potentially large.
    # So, the first step is to identify which entries we're going to need.
    # Then, copy these entries into a text file to work with.
    # If we are not fussed on ID's and DBIDs, then we just suck it all up.
    
    # Open up the source file..
    open SOURCE, "$IN->{'SOURCE'}/$IN->{'TABLE'}.txt" or die "Cannot find $IN->{'SOURCE'}/$IN->{'TABLE'}.txt to open";
    
    # Open up the temp file...
    open TEMP, ">$IN->{'SOURCE'}/$IN->{'TABLE'}.tmp" or die "Cannot create $IN->{'SOURCE'}/$IN->{'TABLE'}.tmp";

    # Start the loop..
    while (<SOURCE>) {
        if ($IN->{DBID}) {
            next unless m#^$IN->{'DBID'}-#;
        }
        if ($IN->{ID}) {
            next unless m#^(.+?)-$IN->{ID}\|\*\|#;
        }
        #chomp;
        /^(.+?)\|\*\|(.*)$/;
        my $data = $2;
        print TEMP $data."\n";
    }
    close SOURCE;
    close TEMP;

    # Now we have our needed file to import, lets do so...
    
    if ($IN->{'DBID'}) {
        unless (-e $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}) {
            unless (mkdir ($obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}, 0777) ) {
                $obj->{'error'} = "Could not create table $IN->{'TABLE'}/$IN->{'DBID'}! Please allow the Database dir to have write to permission";
            }
        }
    }
    
    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';
    $IN->{'ID'}   =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';

    # Open the DB handle
	my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.db";
	tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) or die  "Can't open file ($file) for writing. $!";
    my $counter;
    # Open the text file..
    open TEMP2, "$IN->{'SOURCE'}/$IN->{'TABLE'}.tmp" or die "Cannot find the $IN->{'TABLE'} temp file $!";
    while (<TEMP2>) {
        chomp;
        next unless $_;
        # Get the key...
        /^([\d\w\-\+]+)\|\^\|/;
        my $key = $1;
        $DB{ $key } = $_;
        ++$counter;
    }
	untie (%DB);
    close TEMP2;

    # Remove the work file...
    unlink ("$IN->{'SOURCE'}/$IN->{'TABLE'}.tmp");

    ++$counter;
    
    if ($obj->{'all_cols'}->{ $obj->{'cur_p_key'} }[1] eq 'update') {
        open (CNT, ">$obj->{'base_dir'}" . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.cnt.db");
        print CNT $counter;
        close (CNT) or die $!;
    }
    
    # Do we have an index file to create?
    
    if ($obj->{'cur_INDEX'}) {
        for my $key ( keys %{ $obj->{'cur_INDEX'} } ) {
            my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$key$IN->{'ID'}.idx";
            tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) or die "Cannot open $file for writing $!";
            # Open the index file..
            open IND, "$IN->{'SOURCE'}/$IN->{'TABLE'}-$key.index";
            while (<IND>) {
                chomp;
                my ($key, $value);
                /^(.+?)\|\*\|(.+?)$/;
                $key   = $1;
                $value = $2;
                $DB{ $key } = $value;
            }
            close IND;
            untie %DB;
        }
    }
    
    return $counter;
}



sub back_up {
    my $obj = shift;
    
    # EXPORTING DATABASE
    #
    # This will export all the information to a single text file per table
    # Each entry is like so; DBID-ID|*|values


    my $IN = {  
                "TABLE"          => "",   #Provide table name
                "DESTINATION"    => "",   #Root directory for destination
                @_
              };

    #Ensure the destination directory is trailing slash free.

    $IN->{'DESTINATION'} =~ s!/$!!;

    unless (-e $IN->{'DESTINATION'}) {
        $obj->{'error'} = "Could not find the destination directory to back-up into";
        return;
    }
    unless (-w $IN->{'DESTINATION'}) {
        $obj->{'error'} = "Permission Denied: Cannot write into the destination directory.";
    }

    my $destination = "$IN->{'DESTINATION'}/$IN->{'TABLE'}.txt";
    
    # Create a new file
    
    open T, ">$IN->{'DESTINATION'}/$IN->{'TABLE'}.txt";
    close T;
    
    opendir (DIR, $obj->{'base_dir'}.$IN->{'TABLE'}) or $obj->{'error'} =  "Cannot Open the Directory!";
    my @files =  grep  {   !/^\./ && !/\.idx/ && !/\.cnt/ && !/\+/ } readdir DIR;
    closedir DIR;

    #Make the table directory

    for my $f (@files) {
        
        # Skip non DB files
        
        next if $f =~ /\.(htm|html|htaccess|php|shtml|idx|cnt|cgi|tar|gz|Icon\+)\.?/i;
        
        #Is it a directory?
        if (-d $obj->{'base_dir'}.$IN->{'TABLE'}."/$f") {
            #Open the directory
            opendir DIR, $obj->{'base_dir'} . $IN->{'TABLE'}."/$f";
            my @sub_files =  grep  {   !/^\./   } readdir DIR;
            closedir DIR;

            for my $s_f (@sub_files) {
            
                next if $s_f =~ /\.(htm|html|htaccsss|php|shtml|idx|cnt)\.?/i;
                my $source      = $obj->{'base_dir'}  .$IN->{'TABLE'}."/$f/$s_f";
                
                # Figure out if this is an ID assigned file.
                my $poss_id = $s_f;
                $poss_id =~ /^$IN->{'TABLE'}-([\d\w]+)\./i;
                $poss_id = $1 || '';
                # Get the DBID
                my $poss_dbid = $f;
                $poss_dbid =~ /^(\D+)(\d+)$/;
                $poss_dbid = $2 || '';
                
                my ($k, $v);
                # Open up the DBM file...
                tie (my %DB, $AnyDBM_File::ISA[0], $source, O_RDWR|O_CREAT, 0777) || die "Can't open file ($source) for reading. $!";
                # Append to the text file
                open F, ">>".$destination;
                # Iterate through the DBM file...
                while (($k, $v) = each(%DB)) {
                    print F "$poss_dbid-$poss_id|*|".$v."\n";
                }
                # Close the DBM file.
                untie %DB;
                # Close the text file
                close F;
            }
        } else {
            #We assume it's a normal file
            my $source      = $obj->{'base_dir'}  .$IN->{'TABLE'}."/$f";
            
            # Figure out if this is an ID assigned file.
            my $poss_id = $f;
            $poss_id =~ /^$IN->{'TABLE'}-([\d\w]+)\./i;
            $poss_id = $1 || '';
                
            my ($k, $v);
            # Open up the DBM file...
            tie (my %DB, $AnyDBM_File::ISA[0], $source, O_RDWR|O_CREAT, 0777) || die "Can't open file ($source) for reading. $!";
            # Append to the text file
            open F, ">>".$destination;
            # Iterate through the DBM file...
            while (($k, $v) = each(%DB)) {
                print F "-$poss_id|*|".$v."\n";
            }
            # Close the DBM file.
            untie %DB;
            # Close the text file
            close F;
        }
    } 
    
    
    # Export the index if needed
    if ($obj->{'cur_INDEX'}) {
        my ($k, $v);
        for my $key ( keys %{ $obj->{'cur_INDEX'} } ) {
            my $source      = $obj->{'base_dir'}  .$IN->{'TABLE'}."-$key.idx";
            tie (my %DB, $AnyDBM_File::ISA[0], $source, O_RDWR|O_CREAT, 0777) || die "Can't open file ($source) for reading. $!";
            open IND, ">$IN->{'DESTINATION'}/$IN->{'TABLE'}-$key.index";
            while (($k, $v) = each(%DB)) {
                print F "$k|*|$v\n";
            }
            close IND;
        }
    }

    return "0 but true";
}



sub lock_table {
    my ($obj, $table_name) = @_;
    my $EndTime = 10 + time;
    my $file = $table_name . '.lck';  
    while ((-e $file) && (time < $EndTime)) {
        sleep(1);
    }

    #chmod (0777, $obj->{'base_dir'}.'Temp');
    open(LOCK, ">".$obj->{'base_dir'}.'Temp/'.$file) or $obj->{'error'} = "Can't open the lock file ($!)";
    chmod (0777, $obj->{'base_dir'}.'Temp/'.$file);
}


sub release_lock {
    my ($obj, $table_name) = @_;
    my $file = $table_name . '.lck';
    close(LOCK);
    unlink($obj->{'base_dir'}.'Temp/'.$file);
}



sub create_index {
    my $obj = shift;
    my $IN = { TABLE       => "",
               DBID        => "",
               ID          => "", # DEPRECIATED IN DBM
               INDEX_KEY   => "",  #Column Name to use as an index key
               FOREIGN_KEY => "",  #Foreign Key to return
               @_,
             };

    $obj->load_cfg($IN->{'TABLE'});

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

    my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'INDEX_KEY'}$IN->{'ID'}.idx";

    $obj->lock_table($IN->{'TABLE'});

    tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";

    untie (%DB);

    $obj->release_lock($IN->{'TABLE'});
    
    return 1;
}


sub drop_index {
    my $obj = shift;
    my $IN = { TABLE       => "",
               DBID        => "",
               ID          => "", # DEPRECIATED IN DBM
               INDEX_KEY   => "",
               @_,
             };

    $obj->load_cfg($IN->{'TABLE'});

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

    my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'INDEX_KEY'}$IN->{'ID'}.idx";

    if (-e $file) {
        unlink $file;
        return 1;
    } elsif (-e $file.'.pag') {
        unlink "$file.pag";
        return 1;
    } else {
        return 0;
    }
}


sub update_index {
    my $obj = shift;
    my $IN = { TABLE       => "",
               DBID        => "",
               ID          => "", # DEPRECIATED IN DBM
               INDEX_KEY   => "",
               R_KEY       => "",
               R_VALUE     => "",
               REMOVE      => "",
               @_,
             };

    $obj->load_cfg($IN->{'TABLE'});

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

    my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'INDEX_KEY'}$IN->{'ID'}.idx";

    #return unless ((-e $file) || (-e "$file.pag"));

    $obj->lock_table($IN->{'TABLE'});

    tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";
    if ($IN->{'REMOVE'}) {
        delete ( $DB{ $IN->{'R_KEY'} } );
    } else {
        $DB{ $IN->{'R_KEY'} } = $IN->{'R_VALUE'};
    }
    untie (%DB);

    $obj->release_lock($IN->{'TABLE'});
    
    return 1;
}


sub query_index {
    my $obj = shift;
    my $IN = { TABLE     => "",
               DBID      => "",
               ID        => "", # DEPRECIATED IN DBM
               INDEX_KEY => "",
               S_KEY     => "",
               CASE      => "",
               @_,
             };

    my $return;

    $obj->load_cfg($IN->{'TABLE'});

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

    my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'INDEX_KEY'}$IN->{'ID'}.idx";

    return unless ((-e $file) || (-e "$file.pag"));

    $obj->lock_table($IN->{'TABLE'});

    tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";

    if ($IN->{'CASE'}) {
        for my $k (keys %DB) {
            if ( lc($k) eq lc($IN->{'S_KEY'}) ) {
                $return = $DB{$k};
                last;
            }
        }
    } else {
        $return = $DB{ $IN->{'S_KEY'} };
    }

    untie (%DB);

    $obj->release_lock($IN->{'TABLE'});

    return $return;

}

sub create_table {
    my $obj = shift;
       $obj->{'error'} = undef;
    my $IN = {  
                "TABLE"   => "",
                "DBID"    => "",
                "ID"      => "",
                @_,
              };



    $obj->load_cfg($IN->{'TABLE'});

    if ($obj->{'cur_method'} eq 'single') {
        $IN->{'ID'} =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    } else {
        $IN->{'ID'} = undef;
    }

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';

    # DBID is the table sub dir. (Table_name/dbid/)
    
    # iB3 has DBIDs for forum_posts and forum_polls  (forum_posts/f0 would be the table/dbid for the forum posts)
    # As a point of reference, the SQL version won't bother with that, it'll merely use "f0_forum_posts" as a table name

    unless (-e $obj->{'base_dir'} . $IN->{'TABLE'} ) {
        unless (mkdir ($obj->{'base_dir'} . $IN->{'TABLE'}, 0777) ) {
            $obj->{'error'} = "Could not create table $IN->{'TABLE'}! Please allow the Database dir to have write to permission";
            return;
        }
        chmod (0777, $obj->{'base_dir'} . $IN->{'TABLE'});
    }

    if ($IN->{'DBID'}) {
        # Remove the trailing slash from the DBID element
        $IN->{DBID} =~ s!/$!!;
        if (-e $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}) {
            $obj->{'error'} = "Database Table ( $IN->{'TABLE'}/$IN->{'DBID'} ) already exists!";
            return;
        }
        unless (mkdir ($obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}, 0777) ) {
            $obj->{'error'} = "Could not create table $IN->{'TABLE'}/$IN->{'DBID'}! Please allow the Database dir to have write to permission";
            return;
        }
        chmod (0777, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'});
        my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.db";
        tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";
        untie (%DB);
        
    } else {
        if (-e $obj->{'base_dir'} . $IN->{'TABLE'}."/$IN->{'TABLE'}$IN->{'ID'}.db") {
            $obj->{'error'} = "Database Table ( $IN->{'TABLE'}/$IN->{'TABLE'}$IN->{'ID'}.db ) already exists!";
            return;
        }
        my $file = $obj->{'base_dir'} . "$IN->{'TABLE'}/$IN->{'DBID'}$IN->{'TABLE'}$IN->{'ID'}.db";
        tie (my %DB, $AnyDBM_File::ISA[0], $file, O_RDWR|O_CREAT, 0777) || die "Can't open file ($file) for reading. $!";
        untie (%DB);
    }      

    return 1;

}


sub drop_table {
    my $obj = shift;

    my %IN = ( TABLE    => "",
               DBID     => "",
               @_,
             );

    my $path = $IN{'DBID'} ? $obj->{'base_dir'}."$IN{'TABLE'}/$IN{'DBID'}" : $obj->{'base_dir'}.$IN{'TABLE'};

    opendir (DB, $path);
    my @files = grep { !/^\./ } readdir(DB);
    closedir(DB);

    for my $file (@files) {
        unless (-d $path.'/'.$file) {
            unlink $path.'/'.$file;
        }
    }

    if ($IN{'DBID'}) {
        rmdir $path;
    }

    return 1;
}


sub drop_tables {
    my $obj = shift;
    
    my %IN = ( TABLES => [],
               @_,
             );

    foreach my $table (@{$IN{'TABLES'}}) {
        $obj->drop_table( TABLE => $table->{'TABLE'},
                          DBID  => $table->{'DBID'},
                        );
    }
    return 1;
}

# Drops a complete database, using the config files as
# the name for the tables.

sub drop_database {
    my $obj = shift;

    # Makes life so much easier..
    use File::Path;
    
    # Grab the table names.
    opendir DIR, $obj->{'base_dir'}.'config';
    my @files = grep { !/^\./ && !/^\.html/ } readdir DIR;
    closedir DIR;
    
    for (@files) {
        s/\.cfg//i;
        rmtree $obj->{'base_dir'}.$_;
        # Remake the directory.
        mkdir ( $obj->{'base_dir'}.$_, 0777 );
        # Ensure the chmod is correct
        chmod( 0777, $obj->{'base_dir'}.$_);
    }
}   


#+---------------------------------------------------------------------------------------------
1;       # End of Module
#+---------------------------------------------------------------------------------------------
