# $Id: dbase.pm,v 1.21 2002/10/28 22:24:12 tomj Exp $

# Database interface functions using SQL interfaces.

#
# Copyright (date) State of Oregon, by and for the State Board of
# Higher Education, on behalf of the Network Startup Resource Center at
# the University of Oregon. All rights reserved.
#
# No part of this publication may be used or reproduced, stored in a
# retrieval system, or transmitted in any form without the prior written
# consent of the authors. Requests for permission should be addressed to:
#
#     The Network Startup Resource Center (NSRC)
#     1225 Kincaid Street
#     1212 University of Oregon
#     Eugene, Oregon 97403-1212 USA
#
#     Telephone: +1 541 346-3547 	Email: nsrc@nsrc.org
#     Fax: +1 541-346-4397 		http://www.nsrc.org/
#
# This material is based upon work supported by the National Science
# Foundation under Grant No. NCR-9981821. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those of
# the author(s) and do not necessarily reflect the views of the National
# Science Foundation.
#
use Header;				# common to all modules
use Exporter;
#@ISA= qw(Exporter);
#@EXPORT= qw(db_cache);

my %db_cache= ();			# where we cache DB record,
my $db_dirty= 0;			# cache needs writing to disk
my $dbh;				# DB object
my $sth;				# most-recent execute object
my %DFI = ();				# cache DB field info here

#############################################################
#
# Open (connect to) the database. CSV for now.
#
sub db_open {

	$dbh= DBI-> connect ("DBI:CSV:f_dir=$Conf::dbpath") 
	    or croak "db_open says: " . $DBI::errstr;

	$dbh-> {RaiseError}= 0;
#	$dbh-> {AutoCommit}= 0;
	$db_dirty= 0;
	return $dbh;
}


#############################################################
#
# Purge dead records from the database. Dead records have
# ID="OLD".
#
sub db_purge {

	&db_put if $db_dirty;				# write out changes
	&db_sel ("state=$Conf::TIMEDOUT");
	while (&db_nextrow) {				# for all found...
		my $prep=
		    "DELETE FROM $Conf::dbfn WHERE ID="
		    . $dbh-> quote (&db_param ('ID'));

# Make delete string:
#
# DELETE FROM $dbfn WHERE ID=ID

		$sth= $dbh-> prepare ($prep) 		# prepare,
		    or croak "db_purge1: " . $dbh-> errstr;
		$sth-> execute	 			# execute
		    or croak "db_purge2: " . $dbh-> errstr;

		croak "db_purge3: " . $sth-> err if $sth-> err;
	}
}

#############################################################
#
# Close (disconnect) the database.
#
sub db_close {

	&db_put if $db_dirty;			# write out changes first,
	$dbh-> disconnect or croak "db_disconnect says: " . $DBI::errstr;
}


#############################################################
#
# db_get (ID)
#
# Locate the record ID=(id) and loads the first row into the
# cache (even if there are other rows). Returns 0 if not found.
# Croaks on error.
#
sub db_get {
my $ID= shift;

	&db_put if $db_dirty;			# write out changes first,
	$sth= &db_sel ("ID=$ID");		# attempt the select,
	return 0 if ! $sth;			# nothing matches
	return &db_nextrow;			# return all the data.
}

#############################################################
#
# db_nextrow
#
# Returns an array containing the next row of data
# from the most recent db_sel. sth better be valid!
# Returns 0 if no data found (usually because previous 
# select failed).
#
sub db_nextrow {

	my @L= &db_param();			# make list of field names
	my $i= 0;				# name index and return code

# Fetchrow_* returns data as tainted. We can however
# most reasonably assume that the database is untainted.

	foreach $_ ($sth-> fetchrow_array) {	# fields in data,
		($_)= $_ =~ /^(.*)$/;		# untaint
		&db_param ($L[$i++], $_);	# hash 'em
	}
	return $i;
}


#############################################################
#
# db_exists ("field=contents", "field=contents", ..)
#
# Return true if a record with all of the specified field contents
# exists. Doesn't modify the cache.
#
sub db_exists {
my @F= @_;

	$sth= &db_sel (@F);			# attempt the select,
	return 0 if ! $sth;			# nothing matches
	my @L= $sth-> fetchrow_array;
	return @L > 0;
}

#############################################################
#
# db_sel ("field=contents", "field=contents...")
#
# Locate record(s) with field contents indicated (AND of all
# patterns). 
#
sub db_sel {
my ($f, $c, $w);
my @L;
my $l;
my $n;

	&db_put if $db_dirty;			# write out changes first,
	@L= &db_param();
	$l= join ' ', @L;			# for error-checking

# Make select string:
# SELECT field,field,...field FROM $dbfn WHERE $field="contents"

	my $prep=
	    "SELECT "
	    . join (',', @L)
	    . " FROM $Conf::dbfn"
	    . " WHERE ";

	$n= 0;
	foreach (@_) {				# add criteria
		($f, $c)= split '=', $_;
		croak ("db_sel non-existent field /$f=$c/")
	    	    if not $l =~ /\b$f\b/;	# field name must exist!
		$c= $dbh-> quote ($c) if $c ne "?";
		$prep .= ' AND ' if $n++;
		$prep .= "$f=$c";
	}

	$sth= $dbh-> prepare ($prep) 		# prepare,
	    or croak "db_sel1: " . $dbh-> errstr;
	$sth-> execute	 			# execute
	    or croak "db_sel2: " . $dbh-> errstr;

	croak "db_sel3: " . $sth-> err if $sth-> err;

	return $sth;
}



#############################################################
#
# Write out the cached record to the database. Dies on error.
#
sub db_put {

	return if ! $db_dirty;			# nothing to do

	&db_param ('timestamp', time);		# update timestamp
	my $prep= "UPDATE $Conf::dbfn SET "
	    . join (', ', 
	        map { "$_=" . $dbh-> quote (&db_param ($_)); } &db_param())
	    . " WHERE ID="
	    . $dbh-> quote ($db_cache{'ID'});

	$sth= $dbh-> prepare ($prep) 
		or croak ("db_put1: using /$prep/:<p>\n\n" . $dbh-> errstr);
	$sth-> execute or croak ("db_put2: " . $dbh-> errstr);

	$db_dirty= 0;				# has been written.
}

#############################################################
#
# Insert a new record into the database.
#
sub db_insert {

	&db_put if $db_dirty;			# write out changes first,
	my $prep=
	    "INSERT INTO $Conf::dbfn ("
	    . join (', ', &db_param)
	    . ") values ("
	    . join (', ', map { $dbh-> quote (&db_param ($_)) } &db_param)
	    . ")";

	$sth= $dbh-> prepare ($prep)
	    or croak ("db_insert1: using /$prep/:<p>\n\n" . $dbh-> errstr);
	$sth-> execute 
	    or ("db_insert2: using /$prep/:<p>\n\n" . $dbh-> errstr);
}

#############################################################
#
# Rollback changes to the database.
#
sub db_rollback {

	return if $dbh-> {AutoCommit};		# won't work if true

	$dbh-> rollback or croak "db_rollback says: " . $DBI::errstr;
}



#############################################################
#
# Commit changes to the database.
#
sub db_commit {

	return if $dbh-> {AutoCommit};		# no point if true

	&db_put if $db_dirty;			# write out changes first,
	$dbh-> commit or croak "db_commit says: " . $DBI::errstr;
}


#############################################################
#
# Basic access to db_cache contents:
#   1. set {name}= value if value defined;
#   2. return current value of {name}, if defined;
#   3. else return a list of keys, if no parameters given
#
# #3 is slightly tricky, in that the FIELDS table contains
# special fields, duplicated fields, etc that we have to
# ignore. The logic is in config.pm, but essentially we
# ignore query fields (*name) COMMENTs and duplicates.
#
# We set the dirty bit if the cache is modified and needs
# flushing.
#
sub db_param {
my $n= shift;		# name of parameter,
my $v= shift;		# optional value,
my @L;
my  ($format, $name, $foo);

	if (defined $v) {
		$db_cache{$n}= $v;			# write datum,
		$db_dirty= 1;				# needs flushing
	}
	return $db_cache{$n} if defined $n;		# one or two args

# No args, return list of fieldnames. 

	$n= "";
	foreach (sort alphanumerically keys %Conf::FIELDS) {
		next if $_ !~ /^\d/;			# only numeric keys
		($format, $foo, $foo, $name, $foo, $foo)= 
		    split(/:/, $Conf::FIELDS{$_});
		next if $format =~ /COMMENT/;		# is a comment
		next if $name =~ /^\*/;			# is a query field only
		next if $name eq $n;			# is duplicate
		push @L, $name;				# add to the list
		$n= $name;				# remember last name
	}
	return @L;
}

############################################################
#
# &db_parm_info (fieldname)
#
# Returns (format, size) for the given field name or undef if
# it doesn't exist. Since it involves iteration over the big
# FIELDS table do it once and cache the results.

sub db_param_info {
my $field= shift;		# DB field name
my ($format, $size, $name, $foo);

	if (! keys %DFI) {				# first time,
		foreach (keys %Conf::FIELDS) {		# populate a hash
			($format, $size, $foo, $name)= 	# of field::data
			    split (/:/, $Conf::FIELDS{$_});
			$DFI{$name}= "$format:$size";	#
		}
	}
	return split $DFI{$field};
}

		

sub db_dump {

	print "<ul>";
	map { print "<li>$_=", $db_cache{$_}, "</li>\n" } keys %db_cache;
	print "</ul>";
}

	return 1;