# $Id: SystemInfoDB.pm,v 1.8 1999/10/04 17:26:28 v2kea318 Exp $
# $Log: SystemInfoDB.pm,v $
# Revision 1.8  1999/10/04  17:26:28  v2kea318
# Added an optional constructor parameter that will specify that the
# data base will have unique key values.  If this flag is true and a duplicate
# key is found while building the index, an exception will be thrown.
#
# Revision 1.7  1999/06/10  20:59:49  v2kea318
# Fixed the error string in the read() method to use the data base name
# stored in the object rather than the optional $fname parameter.
#
# Revision 1.6  1999/04/07  20:23:27  v2kea318
# Provide POD format documentation.
#
# Revision 1.5  1999/02/25  21:47:37  v2kea318
# Fixed the removal of blank lines in the read() method.
#
# Revision 1.4  1999/02/08  22:07:42  v2kea318
# *** empty log message ***
#
# Revision 1.3  1999/02/08  22:07:13  v2kea318
# Instead of storing an array of lines from the data file, and forcing each
# retrieval to do a split to convert the record into the fields, store a
# reference to an array of field values.  This way, each line is only split
# once.
#
# Revision 1.2  1999/02/08  18:53:08  v2kea318
# Redesigned the class to be completely general.  The DB is read into an
# array of lines, stored internally.  A map is built of key fields to an
# index into this array, which is used for retrieval.  Derived object will
# specify comment and field delimiter strings.
#
# Revision 1.1  1999/02/06  18:57:41  v2kea318
# Initial revision
#
#***************************************************************************

=head1 NAME

SystemInfoDB - a generic interface to a text-based information database.

=head1 DESCRIPTION

This class provides an interface to a text-based information database 
on disk.  A single record in the DB is assumed to lie on a single line.
The user will supply the field delimiter string to extract information
from the record.  The DB will be read from disk, each record being
split into an array fields.  The user will supply the index for this
array, designating the key field.  Data are obtained from this 
interface only after an key field is defined.  A "null string" is 
provided to indicate unprovided data; the data base on disk must use
this string for any field that is not provided.

This class is to be considered abstract.

=head1 METHODS

=head2 Public

  size()                 how big is the DB?
  db_name()              what is the file name of the DB?
  setkey($;$)            set the key index.  The second argument 
                         is a boolean, defaulting to true, to 
                         specify if the internal map of index to 
                         data is to be rebuilt.
  keylst()               returns the full list (references) of keys.
  set_comm($)            Set the comment marker string
  set_flddelim($)        set the field delimiter string.
  set_dbfile($)          set the DB file name.

=head2 Protected

  getData($)             get the data array (ref) corresponding to 
                         the key
  getIndex($$)           get the data at a given index in the array.
                         Return undef if not found or the null string
                         is found.
  build()                builds the internal map of the data base.
  read(;$)               read the data base from disk. The file name
                         is optionally passed.  This method will die
                         if the file does not exist.

=cut

#***************************************************************************

# Package name.
package SystemInfoDB;

# Library inclusion.
use FileHandle; use exceptions_enabled;

# Internal parameters.
my $null_string = '---';                      # the null string.

#***************************************************************************
# Constructor.  Optionally may take the file name, the comment marker, 
# the field delimiter, and a flag to specify that the data base must have
# unique key values.  This will not build the data base.
#***************************************************************************

use constant UNIQUE => 1;

sub new {
  my ($pkg, $dbfile, $commmark, $flddelim, $unique) = @_;
  $dbfile ||= undef;
  $commmark ||= '#';
  $flddelim ||= '\s+';
  $unique ||= 0;

  # Initialize the object.
  my $obj = {
	     dbname   => $dbfile,   # the disk name for the DB
	     dmap     => {},        # a map from keys to array indices
	     keyfld   => undef,     # the key field index
	     arr      => [],        # an array of lines from the DB file.
	     comm     => $commmark, # the comment marker
	     flddelim => $flddelim, # the field delimiter.
	     attrs    => 0,         # data base attributes
	    };

  # set up the attributes.
  $obj->{attrs} |= UNIQUE if $unique;

  # bless everything.
  bless $obj, $pkg;
}

#***************************************************************************
# Protected methods.
#***************************************************************************

sub is_unique() {
  return shift()->{attrs} & UNIQUE;
}

sub read(;$) {
  my ($obj, $fname) = @_;
  
  # cleanup whatever is there.
  $obj->{arr} = [];
  $obj->{dmap} = {};

  # insert the new filename.
  $obj->{dbname} = $fname if (defined($fname));

  # Read the file into a single string.
  my $db = new FileHandle($obj->db_name(), O_RDONLY) || 
    die "Unable to open DB " . $obj->db_name() . " for input.\n";
  my $text = join('', $db->getlines());

  # Remove comments and blank lines.
  my $commstr = $obj->{comm};
  $text =~ s/$commstr.*?$//gm;
  $text =~ s/\n(\s*\n)+/\n/g;

  # handle the special case of blank lines at the beginning and end of
  # the string.
  $text =~ s/^\n+//; $text =~ s/\n+$//;

  # Fill in the array.  Split each line of text into an array of fields
  # and save a reference to this array in the internal array.
  my $aref = $obj->{arr};
  foreach my $line ( split("\n", $text) ) {
    # split into an array of fields.
    my @fldarr = split($obj->{flddelim}, $line);
    
    # insert this into the array.
    push(@$aref, \@fldarr);
  }
}

#***************************************************************************

sub build() {
  my ($obj) = @_;

  # ensure certain things are specified.  
  die "No key field specified\n" unless (defined($obj->{keyfld}));
  my $keyfld = $obj->{keyfld};

  # Clean up whatever is there.
  $obj->{dmap} = {};

  # Build the map of key field to index.
  my $aref = $obj->{arr}; my $href = $obj->{dmap};
  for (my $cnt = 0; $cnt < $obj->size(); $cnt++) {
    # get the key value.
    my $key = $aref->[$cnt][$keyfld];
    throw "SystemInfoDB:  duplicate key error for $key\n"
      if ($obj->is_unique() && exists $href->{$key});

    # insert
    $href->{$key} = $cnt;
  }
}

#***************************************************************************

sub getData($) {  # look the key up and return the data.  Return
                  # undef if not found.
  my ($obj, $key) = @_;
  my $index = $obj->{dmap}->{$key};
  return undef unless (defined($index));
  return $obj->{arr}->[$index] || undef;
}

#***************************************************************************

sub getIndex($$) { # get the data from the given index.  If the null
                   # string is found, return undef.
  my ($obj, $key, $index) = @_;
  my $data = $obj->getData($key);
  return undef if (!defined($data));
  my $fld = $data->[$index] || $null_string;
  return undef if ($fld eq $null_string);
  return $fld;
}

#***************************************************************************
# Public methods.
#***************************************************************************

sub db_name() {
  return shift()->{'dbname'};
}

#***************************************************************************

sub size() {
  my $obj = shift();
  my $arrref = $obj->{arr};
  return $#{@$arrref} + 1;
}

#***************************************************************************

sub keylst() {
  my $obj = shift();
  my $href = $obj->{dmap};
  my @keylst = keys %$href;
  return \@keylst;
}

#***************************************************************************

sub setkey($;$) {
  my $obj = shift(); my $keyfld = shift(); 
  my $do_build = shift() || 1;

  # if the desired key field is the current key field, do nothing.
  return if (defined($obj->{keyfld}) && $obj->{keyfld} == $keyfld);

  # Mark the key field in the object.
  $obj->{keyfld} = $keyfld;

  # build the map, if requested.
  $obj->build() if ($do_build);
}

#***************************************************************************

sub set_comm($) {
  my ($obj, $commstr) = @_;
  $obj->{comm} = $commstr;
}

#***************************************************************************

sub set_flddelim($) {
  my ($obj, $delim) = @_;
  $obj->{flddelim} = $delim;
}

#***************************************************************************

sub set_dbfile($) {
  my ($obj, $fname) = @_;
  $obj->{dbfile} = $fname;
}

#***************************************************************************

1;
