package RasDB;
use System;

use GDBM_File;
use MLDBM::Sync;
use Storable qw(retrieve dclone store);
use MLDBM qw(GDBM_File Storable);
use strict;
use vars qw(%DBS $DBC);
use Debug;

sub close {
  my($class) = @_;
}

sub cache {
  my($class) = @_;
  my $DBC = $class->new("CACHE") if (!$DBC);
  return $DBC->{hash};
}


sub reset {
  my($class, $file) = @_;
  delete $DBS{$file};
}

#  $db = RasDB->new("state/state");

sub new {
  my($class, $file, $no_cache) = @_;

  if (!$no_cache) {
    return $DBS{$file} if (exists $DBS{$file});
  }

  my(%ST2);
  my $NEW = System->get_home() . "/DATA/$file.db";

  my $ST2_db =  tie %ST2,  'MLDBM::Sync', $NEW , GDBM_WRCREAT,GDBM_READER, 0664;

  my $obj = {handle => $ST2_db, hash => \%ST2};
  bless($obj, $class);

  if (!-f $NEW) {
    eval {
      delete $ST2{""};
    };
    if ($@) {
      Debug->logLine("RasDB: $@");
    }
    chmod 0664, $NEW;
    chmod 0664, "$NEW.lock";
    chown 0,1, $NEW, "$NEW.lock";

  } elsif (!-w $NEW) {  # RETURN NO OBJECT IF THE FILE cannot be WRITTEN
    Debug->print0("RasDB: cannot write to $NEW, check file permissions!");
    return 0;
  }
  $DBS{$file} = $obj;

  return $obj;
}

# REORGANIZE THE DATABASE, 
# $obj->Lock();
# $obj->reorganize();
#
sub reorganize {
  my($obj) = @_;
  if (exists $obj->{handle}{dbm}{DB}) {
      my $gdbm = $obj->{handle}{dbm}{DB};
      $gdbm->reorganize();
  }
}

#
# REORGANIZE THE USUAL SUSPECTS ABOVE 5 Meg
#
sub REORG {
  my($class) = @_;
  require EventDB;

  EventDB->clean(10); # keep 10 days;

  foreach my $f ('SEQUENCER','EDOCS', 'EVENTS') {
     my $name = System->get_home() . "/DATA/$f.db";
     my $size = Util->fileSize($name);
     if ($size > 5000 * 1000) {
        my $DB = $class->new($f);
        $DB->Lock();
        $DB->reorganize();
        $DB->UnLock();
     }
  }
}



sub clear {
  my($obj,  $file) = @_;

  my $handle = $obj->{handle};
  my $hash   = $obj->{hash};
  $handle->Lock();
  foreach my $k (keys %$hash) {
     delete $hash->{$k};
  }
  $handle->UnLock();
}


sub ReadLock {
  my($obj) = @_;
  my $handle = $obj->{handle};
  $handle->ReadLock();
}

sub Lock {
  my($obj) = @_;
  my $handle = $obj->{handle};
  $handle->Lock();
}

sub UnLock {
  my($obj) = @_;
  my $handle = $obj->{handle};
  $handle->UnLock();
}

sub dump {
  my($obj) = @_;
  require Data::Dumper;

  my $handle = $obj->{handle};
  my $hash   = $obj->{hash};
  $obj->ReadLock();
  foreach my $k (keys %$hash) {
     my $v = $hash->{$k};
     print "$k: " . Data::Dumper::Dumper($v) . "\n";
  }
  $obj->UnLock();
}

sub hash {
  my($class) = @_;
  return $class->{hash};
}

1;


__END__

=head1 NAME

RasDB.pm - Hash Database based on MLDBM, GDBM and Storable.
           Support complex Perl objects and locking.


=head1 SYNOPSIS

 use RasDB;
 
 $DB = RasDB->new("TESTDB"); 
 $DB->Lock();
 $DB->ReadLock();
 $DB->clear();
 $DB->reorganize();
 $DB->dump();

 $hash = $DB->hash();
 ..
 $hash->{entry1} = "value1";
 delete $hash->{entry};
 $DB->UnLock();



=head1 DESCRIPTION

This module is used to maintain object database in a GDBM files.
It support locking and can store deep objects.


=head1 CONSTRUCTOR

=over 4

=item new()

Example:
   my $db = RasDB->new(<DB_NAME>);

=back 4

=head1 METHODS

=over 4

=item Lock()

Exclusive lock of the database for reading/writing.

=item ReadLock()

Exclusive lock of the database for reading.

=item clear();

Remove all entries of the database one by one.

=item reorganize()
  
Recover unused space in the database.

=item dump()

Print all entries in the database.

=back 4

=head1 USAGE

=over 4

 $DB = RasDB->new("TESTDB");
 my $hash = $DB->hash();
 $DB->Lock();
 $hash->{"key1"} = $object1;
 $DB->UnLock();

 See RasDB.utest for more examples.

=back 4


=head1 COPYRIGHT

Copyright (c) 2004 Sun Microsystems

=cut
