package Table;
use strict;

#############################################################
#
#   Table - a Textfile-based Database
#
#   Definitions:
#
#      a ROW is a string of tab-delimited fields.
#      FIELDS is a row containing column names.
#      
#
#   Usage:
#
#   my $table = new Table( "tablename" );      
#
#      $table->read( "filename" );
#      $table->write( "filename" );
#
#      $table->name  ( $tablename );
#      $table->fields( $colNames  );
#      $table->rows  ( @rows      );
#
#      $table->addRow( @rows      );
#      $table->row   ( @rowNums   );
#
#      $table->column           ( @colNames          );
#      $table->insertColumnAfter( $newCol, $afterCol );
#      $table->putColumn        ( $colName, @colData );
#      $table->rmColumn         ( $colName           );
#
#      $table->sumColumn        ( $colName           );
#
#      $table->select( [colname, pattern], [colname, pattern] ... );
#
#   Not Implemented:
#
#   #  $table->join( $myColumn, $otherTable, $otherColumn );
#
#
#
#   EXAMPLE:
#
# !/usr/bin/perl
# use strict;
# use Table;
#
# my $tab = new Table();
#
#    $tab->fields( "One", "Two", "Three" );
#    $tab->rows( "a\tb\tc", "d\te\tf", "g\th\ti" );
#
# print $tab->toString(), "\n";
#
#    $tab->write( "db2.txt" );
#
# my $tab2 = new Table();
#    $tab2->read( "db2.txt" );
#
# print $tab2->toString(), "\n";
#
# print join( "\n", $tab->select( [ 'Two', 'e' ], [ 'One', 'd' ] ) ), "\n"; 
# print join( "\n", $tab->select( [ 'Two', 'e' ], [ 'One', 'f' ] ) ), "\n";
#
#
#
#
#
#
#############################################################

#########################################
#
#   Table constructor
#
#########################################
sub new
{
   my $proto = shift;
   my $class = ref($proto) || $proto;
   my $self  = {};

   $self->{NAME}       = '';
   $self->{FIELDS}     = [];
   $self->{FIELDINDEX} = {};
   $self->{ROWS}       = [];

   bless ($self, $class);
   return $self;
}

#########################################
#
#   Read in table data from a file.
#
#########################################
sub read
{
   my $self = shift;
   my $file = shift;

   #
   #  Open and read in the specified file.
   #
   open( IN, $file );
   my ($name, $fields, @rows) = <IN>;
   close IN;

   chomp ($name, $fields, @rows ); 

   $self->name(   $name   );   # set the table name
   $self->fields( $fields );   # set the field names
   $self->rows(   @rows   );   # set the row data
   return @rows;               # return the row data
}

#########################################
#
#   Write out table data to a file.
#
#########################################
sub write
{
   my $self = shift;
   my $file = shift;

   open( OUT, ">$file" );
   print OUT $self->name(), "\n";
   print OUT join( "\t", @{$self->{FIELDS}} ), "\n";
   print OUT join( "\n", $self->rows() ), "\n";
   close OUT;
}


#########################################
#
#   toString method
#
#########################################
sub toString
{
   my $self = shift;
   return $self->name(). "\n"
        . join( "\t", $self->fields() ) . "\n"
        . join( "\n", $self->rows()   ) . "\n";
}

#########################################
#
#   Name accessor
#
#########################################
sub name
{
   my $self = shift;
   $self->{NAME} = shift if @_;
   return $self->{NAME};
}

###########################
#
#   Field hash refresh.  
#   Called by fields().
#
###########################
sub refreshFieldData
{
   my $self   = shift;
   my $i      = 0;

   %{$self->{FIELDINDEX}} = map
   {
      ($_, $i++);
   } @{$self->{FIELDS}};
}

#########################################
#
#   Fields accessor
#
#########################################
sub fields
{
   my $self = shift;
   if (@_) 
   { 
      @{ $self->{FIELDS} } = split( "\t", $_[0] ); # or just @_
      $self->refreshFieldData();
   }
   return @{ $self->{FIELDS} };
}

#########################################
#
#   Return the position of a column.
#
#########################################
sub indexOf
{
   my $self  = shift;
   my $name  = shift; 
   return @{$self->{FIELDINDEX}}{$name};
}

#########################################
#
#   Rows accessor
#   Destructively assigns rows to table.
#
#########################################
sub rows
{
   my $self = shift;
   if (@_) { @{ $self->{ROWS} } = @_ }
   return @{ $self->{ROWS} };
}


#########################################
#
#   Add rows
#
#########################################
sub addRow
{
   my $self = shift;
   push( @{ $self->{ROWS} }, @_ );
}


#########################################
#
#   Fetch rows by row numbers
#
#########################################
sub row
{
   my $self  = shift;
   return ${ $self->{ROWS} }[ @_ ];
}


#########################################
#
#   Fetch columns by column names
#
#########################################
sub column
{
   my $self    = shift;
   my @names   = @_;
   my @indices = map { ${$self->{FIELDINDEX}}{$_} } @names;
   my @response;
 
   foreach ($self->rows())
   {
      push( @response, join( "\t", (split "\t")[@indices] ) );
   }
   return @response;
}

#########################################
#
#   Insert a new empty column.
#
#########################################
sub insertColumnAfter
{
   my $self   = shift;
   my $newCol = shift;
   my $index  = $self->indexOf( shift ) + 1;
   my @fields = $self->fields();

   splice @fields, $index, 0, $newCol;
   $self->fields( join( "\t", @fields ) );
   
   my @newRows = ();
   foreach ($self->rows())
   {
      my @row = split( "\t" );
      splice @row, $index, 0, ' ';
      $_ = join( "\t", @row );
      push @newRows, $_;
   }
   $self->rows( @newRows );
}

#########################################
#
#   Remove column by column name
#
#########################################
sub rmColumn
{
   my $self    = shift;
   my $name    = shift;
   my $index   = $self->indexOf( $name );
   my @fields  = $self->fields();

   splice @fields, $index, 1;
   $self->fields( join( "\t", @fields ) );

   my @newRows = ();
   foreach ($self->rows())
   {
      my @row = split( "\t" );
      splice @row, $index, 1;
      $_ = join( "\t", @row );
      push @newRows, $_;
   }
   $self->rows( @newRows );
}

#########################################
#
#   Replace column data by column name
#
#########################################
sub putColumn
{
   my $self    = shift;
   my $index   = $self->indexOf( shift );
   my @col     = @_;

   my @newRows = ();
   foreach ($self->rows())
   {
      my $value = shift @col;
      my @row   = split( "\t" );
      $row[$index] = $value;
      push @newRows, join( "\t", @row );
   }   
   $self->rows( @newRows );
}

#########################################
#
#   Return the sum of the column values.
#
#########################################
sub sumColumn
{
   my $self = shift;
   my @col  = $self->column( shift );
   my $val  = 0;
   
   $val += $_ for @col;

   return $val;
}


#########################################
#
#   Implementation of the select 
#   statement: basically, do a multiple-
#   column pattern match on the database
#   and return any resulting matches.
#
#   WARNING: this only performs an 
#   intersection select().
#
#########################################
sub select
{
   my $self    = shift;
   my @selects = @_;    # an array of references

   my @patterns = ( '.*' ) x $self->rows();

#   print "patterns=", @patterns, "\n";

   #
   #  First, copy the patterns into the
   #  patterns array at the index corresponding
   #  to the given column name.
   #
   foreach (@selects)
   { 
      # each member is a 2-element array
      my ($column, $pattern) = @{$_};
      $column = $self->indexOf( $column );
#      print "Inserting $pattern in column $column\n";
      $patterns[$column] = $pattern;
   }
   
#   print "patterns=@patterns\n";

   #
   #  Now, turn the patterns array into something
   #  that looks like a real row in our table.
   #
   my $select = join( "\t", @patterns );

#   print "select=$select\n";

   #
   #   Now do a grep.
   #
   return grep( /$select/, $self->rows() );
}

#########################################
#
#   Implementation of the join statement:
#   create a new table made up of the 
#   union of rows based around the specified
#   column names.
#
#########################################
#sub join
#{
#   my $self  = shift;
#   my $col   = shift;
#   my $coli  = $self->indexOf( $col );
#
#   my $other = shift;
#   my $ocol  = shift;
#   my $ocoli = $other->indexOf( $ocol );
#    
#   my @rows  = $self->rows();
#   my @orows = $other->rows();
#}


1; # end of package