package DBIx::TableHash;

# AUTHOR: Vladimir Bogdanov
#
# $Date: 2002/04/24 03:38:21 $
#
# $Id: TableHash.pm,v 1.11 2002/04/24 03:38:21 vlad Exp $         
#
# $Revision: 1.11 $  
#
# $Log: TableHash.pm,v $
# Revision 1.11  2002/04/24 03:38:21  vlad
# *** empty log message ***
#
# Revision 1.10  2002/04/23 20:37:32  vlad
#
# fixed serious flaw in get_hashref whereby hash keys would not be assigned
# correct values.
#
# Revision 1.9  2002/04/22 22:38:03  vlad
#
# release
#
# Revision 1.8  2002/04/22 20:00:12  vlad
#
# with add_key_mapping() existing keys may be mapped to existing records
# via additional/alternative key values.  For example, in my weather
# city analyzer script, I had to add this line:
#
# $lookup{countryname_code}->add_key_mapping(countryname => 'England', 'UNITED KINGDOM');
#
# to also make 'UNITED KINGDOM' (country name used by our vendor) point to
# all records that 'England' (our name for the same country) key points to.
#
# Revision 1.7  2002/04/22 19:40:57  vlad
#
# new subroutine add_record() may now be used to add a record to the table.
#
# Revision 1.6  2002/04/22 19:17:21  vlad
#
# added get_hashref to return records as hashes with keys being column
# names and values.. err.. their respective values ;).  Also, it is
# now possible to look for multiple key values (not multiple keys just
# yet).
#
# Revision 1.5  2002/04/19 22:28:34  vlad
#
# minor
#
# Revision 1.4  2002/04/19 22:13:09  vlad
#
# First working release.
#
# Revision 1.3  2002/04/19 20:51:21  vlad
#
# fixed a few bugs. Rearranged code flow.
#
# Revision 1.2  2002/04/19 20:45:56  vlad
#
# beta.
#
# Revision 1.1  2002/04/19 17:46:52  vlad
#
# a simple module to store table data into a hash (for quicker access).
# The hash also could be dumped into a static file (using Data::Dumper)
# for use on consequent runs of the same script.
#
#
# DESCRIPTION: 
#  somewhat similar to DBIx::Cache but is very simpler and
#  serves narrower purpose.  
#
# TODO: 
# 0. Enable lookup by multiple keys so that only records
#    containing both matching keys will get returned.
#    Also, could implement support for complex look up
#    rules (near to what you'd get with SQL WHERE clause).
#
# 1. Add set(field => value) method to allow user to set
#    a record field to a new value.
#
# 2. Add commit() ? to save data back into the database.
#    Note: may have to deal with original SQL statement
#          in odrer to build a proper UPDATE SQL command.
#

use strict;

#
# Instantiates an object that will store database data
# from a single table (or multiple for that matter, depending
# on the kind of SQL statement used to grab that data)
# in an internal specially arranged structure to facilitate
# quick key value lookup machanism.
# 
# example:
# statement = "select col1, col2, col3 from table foobar"
# fields = qw(col1 col2 col3)
# keys = qw(col2)
#
# if return data is:
# 
# col1_val1, col2_val1, col3_val1 # record 1
# col1_val2, col2_val2, col3_val2 # record 2
# col1_val3, col2_val3, col3_val3 # record 3
#
# Data will be structured as follows:
# %table = 
# (
#  fields => {
#            'col1' => 0,
#            'col2' => 1,
#            'col3' => 2,
#            }
#  records => [
#              ['col1_val1','col2_val1','col3_val1'], # record 1 
#              ['col1_val2','col2_val2','col3_val2'], # record 2
#              ['col1_val3','col2_val3','col3_val3'], # record 3
#             ]
#  record_keys => {
#           # col1 serves as key
#           col1 => {
#                    # key field value => list of matching records
#                    col2_val1 => [0],
#                    col2_val2 => [1],
#                    col2_val3 => [2],
#                   },
#  } 
# )
#
# So, to find a record by a value of col1, you'd have to do this:
#                     name of a key field --\
# $table{records}[$table_data{record_keys}{col1}{'col2_val2'}][$table_data{fields}{col3}]
#
# Which is equivalent to this SQL:
#
# select col3 from table foobar where col1 = 'col2_val2';
#
sub new {
  my $pkg = shift;
  my $self; { my %hash; $self = bless(\%hash, $pkg); }
  
  my (%vars) = @_;
  
  my $ar_keys;
  if (exists $vars{keys}) {
    if (ref $vars{keys} eq "ARRAY") {
      @{$ar_keys} = map {uc($_)} @{$vars{keys}};
    } 
    elsif (ref $vars{keys} eq "SCALAR") {
      $ar_keys = $vars{keys};
    }
  }

  my $statement= $vars{statement};
  my $params_aref = $vars{params};

  my $dbh = $vars{dbh};
  my $sth = $dbh->prepare($statement);
  $sth->execute(@$params_aref) or die $sth->errstr;

  # key field(s) (will allow easy hash key lookup).
  # use the first field by default.
  my $ar_fields = $sth->{NAME};

  $ar_keys ||= [$ar_fields->[0]]; # first field as key by default.

  my $i = 0;
  %{$self->{table}{fields}} = map {$_ => $i++} @$ar_fields;  

  while (my @row = $sth->fetchrow_array()) {
      $self->add_record($ar_keys, [@row]);        
  }
  
  return $self;
}

#
# add a record
#
# $rec : reference to record array (all field values)
#        Care should be taken to make sure that
#        field values are arranged in proper order
#        here to match the original order in SQL
#        that was used to build data view (table data).
#
sub add_record {
    my ($self, $ar_keys, $ar_rec) = @_;
    
    # store in records hash
    push @{$self->{table}{records}}, $ar_rec;
    my $record_indx = scalar(@{$self->{table}{records}}) - 1;

    foreach my $key_field (@$ar_keys) {
    my $key_val = $ar_rec->[$self->{table}{fields}{$key_field}];
    # create key field mapping 
    push @{$self->{table}{record_keys}{$key_field}{$key_val}}, $record_indx;
    }
}

#
# maps given key to a record.
# Usually done to add new keys that would
# link to existing records.
#
# $key_field : key field name to map
# $key_value : new key value
# $map_to_value : existing key value
#
# returns: undef if mapping failed (e.g. no record to map to).
sub add_key_mapping {
    my ($self, $key_field, $key_value, $map_to_value) = @_;

    $key_field = uc($key_field);

#    $DB::single = 1;
    # retrieve matched record indexes
    my $rec_indxs = $self->_find_record_indxs($key_field, $key_value);    

    return unless ($rec_indxs);

    for my $rec_indx (@$rec_indxs) {
    # add mapping..
    push @{$self->{table}{record_keys}{$key_field}{$map_to_value}}, $rec_indx;
    }
}

#
# returns list of records in the table that
# matched key value. Each record is represented
# by an array of values.
# 
# Note: actual records are not being copied here.
#       Therefore, if user chooses to update
#       a record field value, he/she will be 
#       modifying a record field value stored
#       in this object's table.
#
sub get {
  my ($self, $key_field, $key_value) = @_;
  my $rec_num = $self->_find_record_indxs($key_field, $key_value);
  return ($rec_num) ? @{$self->{table}{records}}[@$rec_num] : ();
}

#
# get list of references to matched records represented
# as hashes. 
#
sub get_hashref {
  my ($self, $key_field, $key_value) = @_;
  my $rec_num = $self->_find_record_indxs($key_field, $key_value);

  return unless ($rec_num);

  # note: $self->{table}{records} is array ref therefore,
  # @{$self->{table}{records}}[@$rec_num] returns one or
  # more of such array refs (say, if 1 key matched a few 
  # records). 
  my @records_arrayrefs = @{$self->{table}{records}}[@$rec_num];

  my @found_records;
  for my $rec (@records_arrayrefs) {
      # build table record hash (keys -> column names)
      my %rec_hash;
      $rec_hash{$_} = $rec->[$self->{table}{fields}{$_}] for (keys %{$self->{table}{fields
+}});
      push(@found_records, \%rec_hash);
  }

  # return reference to the new hash struct.
  return \@found_records;
}

# returns reference to list of 
# record indexes which contain the key(s)
# $key_value may be an array ref containing
# possible keys to compare against.
sub _find_record_indxs {
  my ($self, $key_field, $key_value) = @_;

  # return if either of the two required parameters are
  # not specified.
  return unless (defined $key_field && defined $key_value);

  my $table = $self->{table};    
  $key_field = uc($key_field);
  return unless exists $table->{record_keys}{$key_field};

  my $keys = (ref $key_value eq "ARRAY") ? $key_value : [$key_value];

  my $rec_num;  
  foreach (@$keys) {
      if (exists $table->{record_keys}{$key_field}{$_}) {
      return $table->{record_keys}{$key_field}{$_}; # ok, found!
      }      
  }
  
  return; # return undef (ak'a 'empty array' or undef based on context)
}

1;

=head1 NAME

DBIx::TableHash - Perl module to build database table view hash for quick lookup later in your code.

=head1 SYNOPSIS

1. Create a DBIx::TableHash object:

my $country_table = new DBIx::TableHash(
                    dbh => $dbh,
                                        statement => qq/ select countrycode, countryname f
+rom countries /,
                    );

2. Lookup records with matching 'countrycode' field:

my $country_rec = $country_table->get_hashref(countrycode => 'USA');
print "Country name: " . $country_rec->[0]{COUNTRYNAME} . "\n";


Similarly, you may create TableHash objects to allow you lookup records by multiple keys.
Here's an example of just how you could do this:

1. Again, create a DBIx::TableHash object, but a little more complex than the one before:

#
# Note:  '. . .' denotes SQL expression of any complexity you wish.
#
my $country_table = new DBIx::TableHash(
                    dbh => $dbh,
                                        statement => qq/ select provname, provcode, countryname, countrycode
                                                         from . . .
                                                         where . . . /,
                                        keys => [qw(provcode countrycode)], # lookup keys
                    );

2.a Lookup records with matching provcode (Province code):

my $prov_rec = $country_table->get_hashref(provcode => 'BC');
print "First province name: " . $prov_rec->[0]{PROVNAME} . "\n";

2.b Find all provinces (or states) that belong to specified country:

my $prov_rec = $country_table->get_hashref(countrycode => 'USA');

$prov_rec is an AoH (array of hashes) structure, where each hash represents a record
in the database table/view.  This is very similar to what you’d get with a conventional
DBI select_hashref call.