package iDatabase;
use strict;

################################################################
#
# iDatabase v1.0 (May 2001)
#
# Developed for Ikonboard.
# Author: Matthew Mecham <matt@ikonboard.com>
#
# Accessor methods to databases
#
# CSV: Interface to text files.
#
################################################################

use vars qw($VERSION %DEBUG %GBL $INFO);
$INFO    = { FLOCK => 0, do_lock => 1 };
$VERSION = 1.0;

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


sub new {
    my $pkg = shift;

    # Collect the std. info, most is not needed for the CSV.

    my %args = (    "DATABASE" => "",
                    "IP"       => "",
                    "PORT"     => "",
                    "USERNAME" => "",
                    "PASSWORD" => "",
                    "DB_DIR"   => "",
                    @_,
               );
    my $obj = { 'error' => '', 'base_dir' => $args{'DB_DIR'} };
    bless $obj, $pkg;
    return $obj;
}

#+---------------------------------------------------------------------------------------------
#| Create Table: Creates a table, all errors to $obj->{'error'}, returns 1 on success.
#+---------------------------------------------------------------------------------------------

sub create_table {
    my $obj = shift;
       $obj->{'error'} = undef;
    my $IN = {  
                "TABLE"   => "",
                "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;
        }
    }

    if ($IN->{'DBID'}) {
        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;
        }
        open NEW, ">" . $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'/file.cgi';
        close NEW;
        
    } else {
        if (-e $obj->{'base_dir'} . $IN->{'TABLE'}.'/file.cgi') {
            $obj->{'error'} = "Database Table ( $IN->{'TABLE'}/file.cgi ) already exists!";
            return;
        }
        open NEW, ">" . $obj->{'base_dir'} . $IN->{'TABLE'}.'/file.cgi';
        close NEW;
    }      

    return 1;

}


#+---------------------------------------------------------------------------------------------
#| SELECT: Returns a single record based on criteria
#+---------------------------------------------------------------------------------------------


sub select  {
    my $obj = shift;
       $obj->{'error'} = undef;
    my $IN = {  
                "TABLE"   => "",
                "COLUMNS" => [],
                "KEY"     => "",
                "DBID"    => "",
                "ID"      => "",
                @_
              };
    my ($data, $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'}.'/' : '';
    $IN->{'ID'}   =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';

    my $cur_columns = scalar @{$IN->{'COLUMNS'}} > 0 ? \@{$IN->{'COLUMNS'}} : \@{$obj->{'col_name'}};
    
    if ($obj->{'cur_method'} eq 'multiple') {
        $data = $obj->my_load_table_entry($IN);
        $found = 1;
    } else {
        my $file = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi';
        return unless (-e $file);

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

        sysopen (FILE, $file, O_RDONLY) or die " Cannot open $file ($!)";
        if ($INFO->{'FLOCK'}) {
            flock (FILE, LOCK_SH) or die "Couldn't obtain a shared lock on $file ($!)";
        }
        while (<FILE>) {
            next unless m#^$IN->{'KEY'}\|\^\|#;
            $data = $obj->decode_record($_);
            $found = 1;
            last;
        }
        close (FILE) or die $!;

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

    }

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

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


#+---------------------------------------------------------------------------------------------
#| QUERY: Returns records based on criteria(s)
#+---------------------------------------------------------------------------------------------


sub query  {
    my $obj = shift;
       $obj->{'error'} = undef;
    my $IN = {  
                "TABLE"     => "",
                "COLUMNS"   => [],
                "SORT_KEY"  => "",
                "SORT_BY"   => "",
                "WHERE"     => "",
                "MATCH"     => "",
                "RANGE"     => "",
                "DBID"      => "",
                "ID"        => "",
                "COUNT"     => "",
                "POP"       => "",
                @_,
              };
    my ($data, $found, $statement_string, $returned_records, @return, @found, $return_single, @popped);

    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'}.'/' : '';
    $IN->{'ID'}   =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';

    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#/([\w\d\s]+)/#/\\b$1\\b/i#g;
        #> Perl won't need the SQL % wildcard character
        $statement_string =~ s#%##g;
    } else {
		$statement_string = qq~(\$data->{ \$obj->{'cur_p_key'} } ne '')~;
	}


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

    my $eval = qq~sub Check {  my (\$obj, \$data) = \@_; return 1 if $statement_string; }~;
    
    eval $eval; die "eval error" . $@ if $@;

    if ($obj->{'cur_method'} eq 'multiple') {

        # Really not recommended!!
        # Huge resource drain on large databases.
        # Only added to allow mySQL intergration.

        opendir DIR, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'} or die "Cannot Open the Directory!";
        my @files =  grep  {   !/^\./   } readdir DIR;
        closedir DIR;
        for my $file (@files) {
            $IN->{'ID'} = $file;
            $IN->{'ID'} =~ s!file(.+?)\.cgi!$1!g;
            my $data = $obj->my_load_table_entry($IN);
            if ($obj->Check($data)) {
                $found_records->{$data->{$obj->{'cur_p_key'}}} = $data;
                ++$returned_records;
                if ($returned_records == 1 and $IN->{'MATCH'} eq 'ONE') {
                    $found = $data;
                    last;
                }
            }
        }
    } else {
        my $file = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi';
        return my $empty_array = [] unless (-e $file);

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

        sysopen (FILE, $file, O_RDONLY) or die "$!: File: $obj->{'base_dir'}" . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi';
        if ($INFO->{'FLOCK'}) {   
            flock (FILE, LOCK_SH) or die "Could not obtain a shared lock on $file ($!)";
        }
        while (<FILE>) {
            my $data = $obj->decode_record($_);
            if ($obj->Check($data)) {
                $found_records->{$data->{$obj->{'cur_p_key'}}} = $data;
                ++$returned_records;
                if ($returned_records == 1 and $IN->{'MATCH'} eq 'ONE') {
                    $found = $data;
                    last;
                }
            }
        }
        close (FILE) or die $!;

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

    }


    if ($IN->{'MATCH'} ne 'ONE') {

        goto RANGE if $IN->{'COUNT'};

        if ($obj->{'all_cols'}->{ $IN->{'SORT_KEY'} }[1] eq 'string') {
            if ($IN->{'SORT_BY'} eq 'Z-A') {
                for (sort { $found_records->{$b}->{ $IN->{'SORT_KEY'} } cmp $found_records->{$a}->{ $IN->{'SORT_KEY'} } } keys %{$found_records}) {
                    if ($IN->{'POP'} and $obj->POP($found_records->{$_})) { push @popped, $found_records->{$_} } else { push @return, $found_records->{$_}; }
                }
            } else {
                for (sort { $found_records->{$a}->{ $IN->{'SORT_KEY'} } cmp $found_records->{$b}->{ $IN->{'SORT_KEY'} } } keys %{$found_records}) {
                    if ($IN->{'POP'} and $obj->POP($found_records->{$_})) { push @popped, $found_records->{$_} } else { push @return, $found_records->{$_}; }
                }
            }
        } else {
            if ($IN->{'SORT_BY'} eq 'Z-A') {
                for (sort { $found_records->{$b}->{ $IN->{'SORT_KEY'} } <=> $found_records->{$a}->{ $IN->{'SORT_KEY'} } } keys %{$found_records}) {
                    if ($IN->{'POP'} and $obj->POP($found_records->{$_})) { push @popped, $found_records->{$_} } else { push @return, $found_records->{$_}; }
                }
            } else {
			    for (sort { $found_records->{$a}->{ $IN->{'SORT_KEY'} } <=> $found_records->{$b}->{ $IN->{'SORT_KEY'} } } keys %{$found_records}) {
                    if ($IN->{'POP'} and $obj->POP($found_records->{$_})) { push @popped, $found_records->{$_} } else { push @return, $found_records->{$_}; }
                }
            }
        }
        
        if (@popped > 0) {
            @return = (@popped, @return);
        }

        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 \@return;
        }
    }

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


#+---------------------------------------------------------------------------------------------
#| INSERT: Inserts a record into the table
#+---------------------------------------------------------------------------------------------


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


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

    if ($IN->{'DBID'}) {
        unless (-e $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}) {
            unless ( mkdir ($obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}, 0777) ) {
                $obj->{'error'} = "DB Error: Cannot Create Sub directory, please check the permissions for that tables directory";
                return;
            }
            chmod (0777, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'});
        }
    }


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

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

    my $counter;
    

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

        ++$counter;

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

    if ($obj->{'cur_method'} eq 'multiple') {
        $obj->my_insert_table_entry($IN);
    } else {
        my $entry = $obj->encode_record($IN->{'VALUES'});
        my $old   = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi';
        my $new   = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.tmp.cgi';

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

        #+--------------------------------------------------
        sysopen (OLD, $old, O_RDONLY);
        if ($INFO->{'FLOCK'}) {
            flock (OLD, LOCK_SH);
        }
        #+--------------------------------------------------
        sysopen (NEW, $new, O_WRONLY|O_CREAT, 0666) or die $!;
        if ($INFO->{'FLOCK'}) {
            flock (NEW, LOCK_EX);
        }
        #+--------------------------------------------------
        select (NEW);
        #+--------------------------------------------------
        print NEW $entry."\n" if $obj->{'cur_update'} eq 'top';
        while (<OLD>) { print NEW $_; }
        print NEW $entry."\n" if $obj->{'cur_update'} eq 'bottom';
        #+--------------------------------------------------
        close (OLD);
        close (NEW) or die $!;
        #+--------------------------------------------------
        rename($old, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.bak.cgi');
        rename($new, $old);
        #+--------------------------------------------------
        select STDOUT; #Reselect screen for default outputting.
        #+--------------------------------------------------

        $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'}.'file'.$IN->{'ID'}.'.cnt.cgi') or die $!;
        flock (CNT, LOCK_EX) or die $! if $INFO->{'FLOCK'};
        print CNT $counter;
        close (CNT) or die $!;

        return $counter;
    }
}



#+---------------------------------------------------------------------------------------------
#| DELETE: Deletes a record(s) based on the Primary Key
#+---------------------------------------------------------------------------------------------

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

    my ($data, $found);

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

    unless ( $obj->ping(TABLE=>$IN->{'TABLE'},DBID=>$IN->{'DBID'},ID=>$IN->{'ID'}) ) {
        $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 @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, $_;
			}
		}
	}

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

    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;
        $IN->{'KEY'} = [];
        for (@{$ids}) {
            push @{ $IN->{'KEY'} }, $_->{$obj->{'cur_p_key'}};
        }
    }


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

    if (ref($IN->{'KEY'}) eq 'ARRAY') {
        my $line = join ('|', @{$IN->{'KEY'}});
        $IN->{'KEY'} = "(" . $line . ")";
    }
    
    if ($obj->{'cur_method'} eq 'multiple') {
        $obj->my_delete_table_entry($IN);
    } else {
        return unless (-e $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi');
        my $old   = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi';
        my $new   = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.tmp.cgi';

        $obj->lock_table($IN->{'TABLE'});
 
        #+--------------------------------------------------
        sysopen (OLD, $old, O_RDONLY);
        if ($INFO->{'FLOCK'}) {
            flock (OLD, LOCK_SH);
        }
        #+--------------------------------------------------
        sysopen (NEW, $new, O_WRONLY|O_CREAT, 0666) or die $!;
        if ($INFO->{'FLOCK'}) {
            flock (NEW, LOCK_EX);
        }
        #+--------------------------------------------------
        select (NEW);
        #+--------------------------------------------------
        while (<OLD>) {
            unless (m#^$IN->{'KEY'}\|\^\|#) {
                print NEW $_;
                $found = 1;
            }
        }
        #+--------------------------------------------------
        close (OLD);
        close (NEW) or die $!;
        #+--------------------------------------------------
        rename($old, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.bak.cgi');
        rename($new, $old);
        #+--------------------------------------------------
        select STDOUT; #Reselect screen for default outputting.
        #+--------------------------------------------------

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

    }

    unless ($found == 1) { $obj->{'error'} = "DB Error: Cannot locate the primary key whilst attempting to delete in table $IN->{'TABLE'}"; return; }

    return 1;
}

#+---------------------------------------------------------------------------------------------
#| UPDATE: Updates a record(s) based on the Primary Key
#+---------------------------------------------------------------------------------------------

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

    my ($data, $found);

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

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

    my @keys;

    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;
        $IN->{'KEY'} = [];
        for (@${ids}) {
            push @{ $IN->{'KEY'} }, $_->{$obj->{'cur_p_key'}};
        }
    }

    $IN->{'DBID'} =  $IN->{'DBID'} ne '' ? $IN->{'DBID'}.'/' : '';
    $IN->{'ID'}   =  $IN->{'ID'}   ne '' ? '-'.$IN->{'ID'}   : '';
    
    if ($obj->{'cur_method'} eq 'multiple') {
        $obj->my_update_table_entry($IN);
        $found = 1;
    } else {

        if (ref($IN->{'KEY'}) eq 'ARRAY') {
            my $line = join ('|', @{$IN->{'KEY'}});
            $IN->{'KEY'} = "(" . $line . ")";
        }

        my $old   = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi';
        my $new   = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.tmp.cgi';
        return unless (-e $old);

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

        #+--------------------------------------------------
        sysopen (OLD, $old, O_RDONLY) or die "Cannot open $old for reading ($!)";
        if ($INFO->{'FLOCK'}) {
            flock (OLD, LOCK_SH);
        }
        #+--------------------------------------------------
        sysopen (NEW, $new, O_WRONLY|O_CREAT, 0666) or die "Cannot open $new for writing ($!)";
        if ($INFO->{'FLOCK'}) {
            flock (NEW, LOCK_EX);
        }
        #+--------------------------------------------------
        select (NEW);
        #+--------------------------------------------------
        while (my $i = <OLD>) {
            if ($i =~ m#^$IN->{'KEY'}\|\^\|#) {
                my $data = $obj->decode_record($i);
                for my $k (keys %{$IN->{'VALUES'}}) {
                    $data->{$k} = $IN->{'VALUES'}->{$k};
                }
                my $entry = $obj->encode_record($data);
                print NEW $entry."\n";
                $found = 1;
            } else {
                print NEW $i;
            }
        }
        #+--------------------------------------------------
        close (OLD);
        close (NEW) or die $!;
        #+--------------------------------------------------
        rename($old, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.bak.cgi');
        rename($new, $old);
        #+--------------------------------------------------
        select STDOUT; #Reselect screen for default outputting.
        #+--------------------------------------------------
    
        $obj->release_lock($IN->{'TABLE'});

    }

    unless ($found == 1) { $obj->{'error'} = 'Cannot locate the primary key'; return; }

    return 1;
}


#+---------------------------------------------------------------------------------------------
#| ROLLBACK: Undoes the last database change.
#+---------------------------------------------------------------------------------------------

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

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

    unless (-e $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.bak.cgi') {
        $obj->{'error'} = 'Back-up not found!';
        return;
    }        

    my $old   = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.bak.cgi';
    my $new   = $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi'; 

    rename($old, $new);

    return 1;

}

#+---------------------------------------------------------------------------------------------
#| 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 export {
    my $obj = shift;

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

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

    my $export;

    if ($obj->{'cur_method'} eq 'single') {
        local $/ = undef;
        open EXP, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi' or $obj->{'error'} = "Could not access that table ($IN->{'TABLE'})";
        $export = <EXP>;
        close EXP;
    } else {

        # Push all entries into one table.
        # Remove Trailing slash if a DBID is defined.

        $IN->{'DBID'} =~ s!/+\Z!!;

        opendir DIR, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'} or die "Cannot Open the Directory!";
        my @files =  grep  {   !/^\./   } readdir DIR;
        closedir DIR;
        my @all_files;
        for my $file (@files) {
            next if $file =~ /\.bak\.cgi\Z/;
            next if $file =~ /\.cnt\.cgi\Z/;
            $IN->{'ID'} = $file;
            $IN->{'ID'} =~ s!file(.+?)\.cgi!$1!g;
            my $data = $obj->my_load_table_entry($IN);
            $data    = $obj->encode_record($data);
            push @all_files, "|*|$file|*|".$data;
        }
        $export = join "\n", @all_files;
    }

    if (-e $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cnt.cgi') {
        open CNT, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cnt.cgi';
        my $cnt = <CNT>;
        close CNT;
        chomp $cnt;

        $export .= "#".$cnt;
    }

    # return table

    return $export;
}



sub lock_table {
    my ($obj, $table_name) = @_;
    return unless $INFO->{'do_lock'};
    my $EndTime = 30 + 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) = @_;
    return unless $INFO->{'do_lock'};
    my $file = $table_name . '.lck';
    close(LOCK);
    unlink($obj->{'base_dir'}.'Temp/'.$file);
}







sub DESTROY { return undef; }

#+---------------------------------------------------------------------------------------------
#| DECODE_RECORD: Decode a record entry
#+---------------------------------------------------------------------------------------------

sub decode_record {
    my ($obj, $record) = @_;
    my $return = {};
    chomp $record;
    my @Tmp = split (/\Q|^|\E/, $record);
    for my $i (0 .. $obj->{'total_cols'}) {
        $Tmp[$i] =~ s!^\s+!!g;
        $Tmp[$i] =~ s!\s+$!!g;
        $Tmp[$i] =~ s!\$!&#36!g;
        $Tmp[$i] =~ s!\\n!\n!g;
        $return->{ $obj->{'col_name'}->[$i] } = $Tmp[$i];
    }

    return $return;
}
 
#+---------------------------------------------------------------------------------------------
#| ENCODE_RECORD: Encode a record entry
#+---------------------------------------------------------------------------------------------


sub encode_record {
    my ($obj, $values) = @_;
    my $return;
    for my $i (0 .. $obj->{'total_cols'}) {
        $values->{$obj->{'col_name'}->[$i]}  =~ s!^\s+!!g;
        $values->{$obj->{'col_name'}->[$i]}  =~ s!\s+$!!g;
        $values->{$obj->{'col_name'}->[$i]}  =~ s!\r!!g;
        $values->{$obj->{'col_name'}->[$i]}  =~ s!\n!\\n!g;
        $return .= $values->{$obj->{'col_name'}->[$i]}."|^|";
    }
  return $return;
}


#+---------------------------------------------------------------------------------------------
#| LOAD_CFG: Load and set up the configuration file.
#+---------------------------------------------------------------------------------------------

sub load_cfg ($$) {
    my ($obj, $cfg) = @_;
    die "Invalid Number of ARGVS" unless @_ == 2;
    do $obj->{'base_dir'}.'config/'.$cfg.'.cfg' or die "Cannot open file : $cfg.cfg ($!)";

    $obj->{'cur_table'}  = $IMPORT::STRING->{'TABLE'};
    $obj->{'cur_p_key'}  = $IMPORT::STRING->{'P_KEY'};
    $obj->{'cur_method'} = $IMPORT::STRING->{'MTD'};
    $obj->{'cur_update'} = $IMPORT::STRING->{'UPDATE'} || 'bottom';
    $obj->{'all_cols'}   = $IMPORT::COLS;
    $obj->{'total_cols'} = 0;
    $obj->{'col_name'}   = [];
    foreach (sort { $obj->{'all_cols'}->{$a}[0] <=> $obj->{'all_cols'}->{$b}[0] } keys %{$obj->{'all_cols'}} ) {
        push @{$obj->{'col_name'}}, $_;
        ++$obj->{'total_cols'};
    }
    --$obj->{'total_cols'};
    
}


#+---------------------------------------------------------------------------------------------
#| Single Entry Data Types: File require's, private use only
#+---------------------------------------------------------------------------------------------


sub my_load_table_entry {
    my ($obj, $IN) = @_;
    return unless (-e $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi');
    do $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi' or die $!;
    return eval { $IN->{'TABLE'}->new() };
}


sub my_update_table_entry {
    my ($obj, $IN) = @_;

    if (ref($IN->{'KEY'}) eq 'ARRAY') {

        opendir DIR, $obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'} or die "Cannot Open the Directory!";
        my @files =  grep  {   !/^\./   } readdir DIR;
        closedir DIR;
        for my $file (@files) {
            $IN->{'ID'} = $file;
            $IN->{'ID'} =~ s!file(.+?)\.cgi!$1!g;
            my $data = $obj->my_load_table_entry($IN);
            for my $key (@{$IN->{'KEY'}}) {
                if ($key eq $data->{ $obj->{'cur_p_key'} }) {
                    for (keys %{ $IN->{'VALUES'} }) {
                        $data->{$_} = $IN->{'VALUES'}->{$_};
                    }
                    $IN->{'VALUES'} = $data;
                    $obj->_do_table_entry($IN);
                }
            }
        }
    } else {
        my $data = $obj->my_load_table_entry($IN);
        for (keys %{ $IN->{'VALUES'} }) {
            $data->{$_} = $IN->{'VALUES'}->{$_};
        }
        $IN->{'VALUES'} = $data;
        $obj->_do_table_entry($IN);
    }
}


sub my_insert_table_entry {
    my ($obj, $IN) = @_;
    $obj->_do_table_entry($IN);
}


sub my_delete_table_entry {
    my ($obj, $IN) = @_;
    unlink ($obj->{'base_dir'} . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi');
    return 1;
}


sub _do_table_entry {
    my ($obj, $IN) = @_;
    my $data = $IN->{'VALUES'};
    open  (FH, ">$obj->{'base_dir'}" . $IN->{'TABLE'}.'/'.$IN->{'DBID'}.'file'.$IN->{'ID'}.'.cgi') or die $!;
    flock (FH, LOCK_EX) or die $! if $INFO->{'FLOCK'};

    print FH qq|package $IN->{'TABLE'};
                sub new {
                my \$pkg = shift;
                my \$obj = {
               |;
    
    foreach (keys %{$data}) {
        my $space = " " x (20 - (length($_)));
        if (ref($data->{$_}) eq 'ARRAY') {
            my $line = qq|        '$_' $space => [|;
            for my $i (@{ $data->{$_} }) { $line .= qq| "$i",|; }
            $line .= "]";
            $line =~ s!,\]!\]!;
            print FH $line.",\n";
        } else {
        print FH qq|        '$_' $space => q!$data->{$_}!,\n|;
        }
    }
    print FH qq|};
                bless \$obj, \$pkg;
                return \$obj;
                }
                1;|;
    close (FH) or die $!;
    return 1;
 }


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

__END__


=pod

=head1 NAME

iDatabase: Universal Interface to database access

=head1 SYNOPSIS

    use iDatabase::CSV;

    my $db = iDatabase->new();

    my $key = $record_id;

    my $array_fef = $db->select( TABLE   => 'accounts',
                                 COLUMNS => ['ID', 'PRICE', 'COLOR'],
                                 KEY     => $key
                               );

    for $rv (@{$array_ref}) {
        print "Id Numer: $rv->{'ID'}, Price: $rv->{'PRICE'}, Color: $rv->{'COLOR'}\n";
    }

    $db->update( TABLE  => 'accounts',
                 KEY    => $key,
                 VALUES => { PRICE => '3.00' }
               );

=head1 DESCRIPTION

iDatabase is an independant interface for database access. From text files, to DBM hashes to SQL RDMS

It allows a script author to change database types on a whim.
<More later>

=cut






