package DADA::App::GenericDBFile;
use strict; 

use base qw(DADA::App::GenericDBFile::Backup);
use Fcntl qw(
O_WRONLY 
O_TRUNC 
O_CREAT 
O_CREAT 
O_RDWR
O_RDONLY
LOCK_EX
LOCK_SH 
LOCK_NB); 

use lib qw(./ ../../  ../../DADA ../../perllib); 
use DADA::Config; 

sub new { 
	my $class = shift;
	my $self = {@_};
	bless $self, $class;  
	return $self;
}




sub _list_name_check { 
	my ($self, $n) = @_; 
		$n = $self->_trim($n);
	return 0 if !$n; 
	return 0 if $self->_list_exists($n) == 0;  
	$self->{name} = $n;
	return 1; 
}




sub _list_exists { 
	my ($self, $n)  = @_; 
	return DADA::App::Guts::check_if_list_exists(-List => $n);
} 





sub _trim { 
	my ($self, $s) = @_;
	return DADA::App::Guts::strip($s);
}




sub _safe_path { 

	my ($self, $p) = @_; 
	$p =~ tr/\0-\037\177-\377//d;    # remove unprintables
	$p =~ s/(['\\])/\$1/g;           # escape quote, backslash
	$p =~ /(.*)/;
	return $1;

}




sub _open_db { 

	my $self      = shift; 
	my $exception = 0;
	
    $self->_lock_db;
	chmod($FILE_CHMOD, $self->_db_filename)
		if -e $self->_db_filename;
				   
	tie %{$self->{DB_HASH}}, "AnyDBM_File", $self->_db_filename,  O_RDWR|O_CREAT, $FILE_CHMOD  
		or $exception = 1; 
		
	if($exception == 1){ 
		if($self->{ignore_open_db_error} == 1){ 
			warn "$PROGRAM_NAME $VER warning! " . 
			'couldn\'t tie '. $self->_db_filename . ' for reading: ' . 
			$! . "Ignoring fatal error assuming you're (hopefully) resolving the issue by visiting: " . 
			$PROGRAM_URL . '?f=restore_lists ';
			$self->{DB_HASH} = {};
		}else{
			die 'couldn\'t tie '. $self->_db_filename . ' for reading: ' . 
			$! .  '; If your server recently upgraded software or moved 
			your lists to a different server, you may need to restore your list ' . 
			$self->{function} . '. Visit ' . $PROGRAM_URL . '?f=restore_lists '; 
		}
	}
}




sub _raw_db_hash { 

	my $self   = shift; 	
	my $as_ref = shift; 
	$self->_open_db; 
	my %RAW_DB_HASH = %{$self->{DB_HASH}};
	$self->{RAW_DB_HASH} = {%RAW_DB_HASH};
	$self->_close_db;
	$as_ref == 1 ? return \%RAW_DB_HASH : return %RAW_DB_HASH; 
}




sub _db_filename { 
	my $self = shift;
	my $fn = $self->{name}; 	
	   $fn =~ s/ /_/g; 
	   
	   my $dir = $FILES; 
	      $dir = $ARCHIVES if $self->{function} eq "archives"; 

	   $fn = $dir . '/mj-' . $self->{name}; 
	   $fn .= '-archive' if $self->{function} eq "archives"; # This isn't good, since this module 
	                                                         # has to know about the module that 
	                                                         # inherits it. 
	    
	   #untaint 
	   $fn = $self->_safe_path($fn); 
	   return $fn;
}




sub _close_db { 
	my $self = shift; 
	untie %{$self->{DB_HASH}} 
		or warn "untie didn't work: $!";
	delete $self->{DB_HASH}; 
	$self->_unlock_db; 
}




sub _lock_db { 
	my $self = shift; 
	sysopen(DB_SAFETYLOCK, $self->_lockfile_name,  O_RDWR|O_CREAT, $FILE_CHMOD) 
		or die "$PROGRAM_NAME $VER Error - Cannot open list lock file " . $self->_lockfile_name . " - $!";
	chmod($FILE_CHMOD, $self->_lockfile_name); 
	{
		my $sleep_count = 0; 
		{ 
			flock DB_SAFETYLOCK, LOCK_EX | LOCK_NB and last; 
			sleep 1;
			redo if ++$sleep_count < 11; 		
			die "$PROGRAM_NAME $VER Warning: Server is way too busy to open list db file," . $self->_lockfile_name . " -   $!\n";
		}
	}
}




sub _unlock_db { 
	my $self = shift; 
	close(DB_SAFETYLOCK);
	unlink($self->_lockfile_name) or warn "couldn't delete lock file: '" . $self->_lockfile_name . "' - $!";
}




sub _lockfile_name { 
	my $self = shift;
	return  $self->_safe_path("$TMP/".$self->{name}."_" . $self->{function} . "db.lock");	 
}



1;