View of /trunk/webwork2/lib/WeBWorK/DB/GDBM.pm

    1 package WeBWorK::DB::GDBM;
    2 
    3 use GDBM_File;
    4 
    5 # these should probably be in a constants file somewhere...
    6 use constant MAX_TIE_ATTEMPTS => 30;
    7 use constant TIE_RETRY_DELAY  => 2;
    8 use constant TIE_PERMISSION => 0660;
    9 
   10 sub new($$) {
   11   my $proto = shift;
   12   my $class = ref($proto) || $proto;
   13   my $self = {
   14     hashRef    => {},
   15     gdbm_file  => shift,
   16   };
   17   bless $self, $class;
   18   return $self;
   19 }
   20 
   21 sub connect($$) {
   22   my $self = shift;
   23   my $symbolicFlags = shift; # "ro" or "rw"
   24   return if tied %$self->{hashRef}; # already tied!
   25   my $flags = lc $symbolicFlags eq "rw" ? GDBM_WRCREAT() : GDBM_READER();
   26   foreach (1 .. MAX_TIE_ATTEMPTS) {
   27     return if tie %{$self->{hashRef}},
   28       "GDBM_File",        # class
   29       $self->{gdbm_file}, # file name
   30       $flags,             # I/O flags
   31       TIE_PERMISSION;     # access mode
   32     sleep TIE_RETRY_DELAY;
   33   }
   34   die "unable to tie ", $self->{gdbm_file}, ": $!";
   35 }
   36 
   37 sub hashRef($) {
   38   my $self = shift;
   39   return unless tied %{$self->{hashRef}}; # not tied!
   40   return $self->{hashRef};
   41 }
   42 
   43 sub disconnect($) {
   44   my $self = shift;
   45   return unless tied %{$self->{hashRef}}; # not tied!
   46   return 1 if untie %{$self->{hashRef}};
   47 }
   48 
   49 1;