# ===================================
# RDB.pm
#
# Parse data into a hash:
#
#
# $tbl{headers_name} = @ of the column header name.
# $tbl{headers_spec} = @ of the specs for the columns.
# $tbl{comments}     = @ of the comments.
# $tbl{data}         = % (indexed by header names) of the @ of the data.
#
#

# This only provides read services, not writing.

package RDB;

use strict;
use vars qw($VERSION @ISA @EXPORT_OK);

require Exporter;

$VERSION = "0.1";
@ISA = qw(Exporter);
@EXPORT_OK = qw(RDB_parse_string RDB_parse_array RDB_splice_data);


# Params:
#  $tbl = Main hash, see top.
sub RDB_parse_init
  {
    my ($tbl) = @_;

    $tbl->{headers_name} = ();
    $tbl->{headers_spec} = ();
    $tbl->{comments} = ();
    $tbl->{data} = ();
  }


# Params:
#  $line = String of the next line to add to the hash.
#  $tbl  = Main hash, see top.
sub RDB_parse_comment
  {
    my ($line, $tbl) = @_;

    if ($line !~ /^\#/)
      {
	return (0);
      }

    push (@{$tbl->{comments}}, $line);
  }

# Params:
#  $line = String of the next line to add to the hash.
#  $tbl  = Main hash, see top.
sub RDB_parse_headers_name
  {
    my ($line, $tbl) = @_;

    my @cells = split ("\t", $line, -1);

    @{$tbl->{headers_name}} = @cells;

    my $i = undef;
    for $i (@cells)
      {
	$tbl->{data}->{$i} = ();
      }

    return (1);
  }

# Params:
#  $line = String of the next line to add to the hash.
#  $tbl  = Main hash, see top.
sub RDB_parse_headers_spec
  {
    my ($line, $tbl) = @_;


    my @cells = split ("\t", $line, -1);

    if (scalar (@cells) != scalar(@{$tbl->{headers_name}}))
      { return (0); }

    @{$tbl->{headers_spec}} = @cells;

    return (1);
  }

# Params:
#  $line = String of the next line to add to the hash.
#  $tbl  = Main hash, see top.
sub RDB_parse_entry
  {
    my ($line, $tbl) = @_;

    my @cells = split ("\t", $line, -1);

    if (scalar (@cells) != scalar(@{$tbl->{headers_name}}))
      { return (0); }

    my @cell_names = @{$tbl->{headers_name}};

    my $i = undef;
    for $i (@cells)
      {
	my $header = shift (@cell_names);
	push (@{$tbl->{data}->{$header}}, $i);
      }

    ++$tbl->{entries};

    return (1);
  }

# Params:
#  @lines = Array of strings (lines of a "file" to parse).
sub RDB_parse_array
  {
    my @lines = @_;

    my $table = {};

    RDB_parse_init($table);

    while ((scalar(@lines) > 2) &&
	   RDB_parse_comment($lines[0], $table))
      { shift (@lines); }

    if (scalar(@lines) < 3)
      { return (undef); }
    if (!RDB_parse_headers_name($lines[0], $table))
      { return (undef); }

    shift (@lines);

    if (!RDB_parse_headers_spec($lines[0], $table))
      { return (undef); }

    shift (@lines);

    my $i = undef;
    for $i (@lines)
      {
	if (!RDB_parse_entry($i, $table))
	  { return (undef); }
      }
    
    return ($table);
  }

# Params:
#  $content = Multiline string of the "file" to parse.
sub RDB_parse_string
  {
    my ($content) = @_;

    my @lines = split ('\n', $content);

    return (RDB_parse_array(@lines));
  }

# Params:
#  $tbl    = An object from RDB_parse_array etc.
#  $entry  = The number of the entry to delete.
#  $number = The number of entries to delete (can be undef).
# Returns: a hash of the entry(s) removed.
sub RDB_splice_data
  {
    my ($tbl, $entry, $num) = @_;
    my ($ret) = {};

    if (!defined($num))
      {	$num = 1; }

    if ($entry < 0)
      {
	return (undef);
      }
    
    for my $i (keys %{$tbl->{data}})
      {
	if ($entry > $#{$tbl->{data}->{$i}})
	  {
	    return (undef);
	  }

	@{$ret->{$i}} = splice (@{$tbl->{data}->{$i}}, $entry, $num);
      }

    return ($ret);
  }

1;