root/honeyclient/tags/exp/UP2-kindlund-dynamic_updates/lib/HoneyClient/DB.pm

#######################################################################
# Created on:  February 17, 2007
# Package:     HoneyClient::DB
# File:        DB.pm
# Description: Abstract class for controlling storage of HoneyClient
#              data into a database.
#
# CVS: $Id$
#
# @author mbriggs, kindlund
#
# Copyright (C) 2007 The MITRE Corporation.  All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation, using version 2
# of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.
#
#######################################################################

=pod

=head1 NAME

HoneyClient::DB - Perl extension to provide an abstract interface for
storing HoneyClient data into a database.

=head1 VERSION

This documentation refers to HoneyClient::DB version 0.99.

=head1 SYNOPSIS

As a generic example, let's store data about superheroes.

=head2 DEFINE SCHEMAS

  # First, we define a schema for each superhero ability (child object).
  use HoneyClient::DB;
  package HoneyClient::DB::SuperHero::Ability;
  use base("HoneyClient::DB");

  # Define Ability Schema
  our %fields = (
      string => {
          # Each ability should have a name. 
          name => {
              # This name should be required.
              required => 1, # Must exist and is not null
          },
      },

      # Each ability may have an optional description.
      text => [ 'description' ],

      # Each ability may have an optional recharge time.
      int  => [ 'recharge_time' ],
  );
  
  # Next, we define a schema for each superhero (parent object).
  package HoneyClient::DB::SuperHero;
  use base("HoneyClient::DB");
  
  # Define SuperHero Schema 
  our %fields = (
      string => {
          # Each superhero should have a name.
          name => {
              # This name should be required.
              required => 1,
              key => $HoneyClient::DB::KEY_UNIQUE_MULT,
          },
          # Each superhero may have an optional real name.
          real_name => {
              key => $HoneyClient::DB::KEY_UNIQUE_MULT,
          },
          # If 2 SuperHero Objects have the same 'name' and 'real_name'
          # fields, then only the first object will be inserted succesfully
      },
      
      # Each superhero may have optional height and weight stats. 
      int => [ 'height', 'weight' ],

      # Each superhero must have a primary ability.
      ref => {
          primary_ability => {
              # Reference child object type.
              objclass=> "HoneyClient::DB::SuperHero::Ability",

              # This should be required.
              required => 1,
          },
      },

      # Each superhero may have optional abilities.
      array => {
          abilities => {
              # Reference child object type.
              objclass=> "HoneyClient::DB::SuperHero::Ability",
          },
      },

      # Each superhero should have a birth date.
      timestamp => {
          birth_date => {
              required => 1,
          },
      },
  );
  
  1;

=head2 USE SCHEMAS

  # Now, we start generating data to insert into our database.

  use HoneyClient::DB::SuperHero;
  use Data::Dumper;

  # Create a new superhero.
  my $hero = {
      name       => 'Superman',
      real_name  => 'Clark Kent',
      weight     => 225,
      height     => 75,
      birth_date => '1998-06-01 12:34:56', # YYYY-MM-DD HH:MM:SS
      primary_ability => {
          name              => 'Super Strength',
          description       => 'More powerful than a locomotive.',
      },
      abilities  => [
          {
              name          => 'Flight',
              description   => "It's a bird, it's a plane.",
          },
          {
              name          => 'Heat Vision',
              recharge_time => 5, # in seconds
          },
      ],
  };
    
  # Instantiate a new SuperHero object.
  # Upon creation, the data will be checked against the schema.
  # This call will croak if any errors occur. 
  $hero = HoneyClient::DB::SuperHero->new($hero);

  # Insert the data into the database.
  $hero->insert();
  
  # Retrieve the superhero.
  my $filter = {
      name => 'Superman',
  };
    
  # Retrieves rows in the SuperHero table where name is 'Superman'.
  # NOTE: At this time, the returned data is NOT identical to
  # the object inserted.
  my $inserted_hero = HoneyClient::DB::SuperHero->select($filter);

  # Printing the contents of the returned content should clarify
  # how the data looks.
  $Data::Dumper::Indent = 1;
  $Data::Dumper::Terse = 0;
  print Dumper($inserted_hero) . "\n";

=head1 DESCRIPTION

This library is an abstract class used to access and store HoneyClient
within a database. The class is not to be used directly, but can be inherited
by sub-classes, in order to indirectly store specific types of data into a
database.

B<Note>: Any calls made to this library will fail, if a database is not properly
described in the <HoneyClient/><DB/> section of the etc/honeyclient.xml
configuration file or if the library cannot establish a connection to the
database.

=head2 SCHEMA DEFINITION

The schema for a HoneyClient::DB subclass is created from the B<%fields>
variable, a multi-level hash table.

=head3 FIRST LEVEL: DATA TYPE

The keys at the first level of B<%fields> define the data types to be used
for each column, which are named as keys in the second level.  The following
is a list of acceptable data types:

=over 4

=item * B<'int'>

An integer.

=item * B<'string'>

A string no longer than 255 characters.

=item * B<'text'>

A string no longer than 65,535 characters.

=item * B<'timestamp'>

An ISO8601 compliant timestamp (i.e., 'MMDDYYYY HH:MM:SS').

=item * B<'array'>

An array.  Used to represent one-to-many relationships.

B<Note>: If this type is specified, then the L<'objclass'> option
must be set within each column name.

=item * B<'ref'>

A reference.  Used to represent one-to-one relationships.

B<Note>: If this type is specified, then the L<'objclass'> option
must be set within each column name.

=back

=head3 SECOND LEVEL: COLUMN NAMES

Column names are defined as keys in the second level of B<%fields>.  If
each column does not need any special options (e.g., making the column
required), then an array reference can hold all the column names. 
For example, the following schema defines 3 default integer fields:

  %our fields = {
      int => [
          'col_a',
          'col_b',
          'col_c',
      ],
  };

However, if some of the columns need special options set (e.g., making 'col_b'
required), then a sub-hash table should be defined instead, as follows:

  %our fields = {
      int => { 
          'col_a' => {},
          'col_b' => {
              'required' => 1,
          },
          'col_c' => {},
      },
  };

=head3 THIRD LEVEL: OPTIONS

If needed, options are defined in the third level of B<%fields>.  These
options are described as follows:

=over 4

=item * B<'check_func'>

If defined, then this contains a reference to a subroutine that will
verify the actual column data is in a proper format.  This overrides the
default internal check function for the data type of that column.

=item * B<'init_val'>

If defined, then this value will be the default value that the database
will assign to the column, if empty data is inserted into this column.

=item * B<'key'>

If defined, then this value creates an index for the column.
Possible values are:

=over 4

=item * B<$HoneyClient::DB::KEY_INDEX>

If set, an index will be created in the database to improve the search
time of this column.  This option is only recommended for very frequently
searched columns.

=item * B<$HoneyClient:DB::KEY_UNIQUE>

If set, a UNIQUE index is created for the column. If a record is inserted that
has a match with this column in a previously existing record, the insert will
fail on the database side, but the 'id' of that existing record will be
returned.

=item * B<$HoneyClient:DB::KEY_UNIQUE_MULT>

If set, the column is added to a UNIQUE index comprised of all other columns
with the KEY_UNIQUE_MULT key option. This index is used to ensure ALL VALUES for
the columns in the index are distinct. An insert of a record matching an
existing record will return the ID of that record.

=back

=item * B<'objclass'>

This option is required and only used by the L<'array'> and L<'ref'>
data types.  The value should be a string which contains the package name of
the schema to include as a child.

=item * B<'required'> 

If defined and set to 1, then this option will cause all subsequent
B<HoneyClient::DB::*-E<gt>L<new>($data)> operations to fail, if the B<$data>
does not contain the required field.

=back

=head1 DATABASE CONFIGURATION

This library expects to connect to a MySQL v5.0 or greater database.
To specify which database this library should use, see the
<HoneyClient/><DB/> section of the etc/honeyclient.xml configuration file
for further details.

=cut

package HoneyClient::DB;

use Data::Dumper qw(Dumper);
use strict 'vars', 'subs';
use warnings;

BEGIN {

    #Dependencies
    use DBI;
    use Carp ();
    use HoneyClient::Util::Config;
    use DateTime::Format::ISO8601;
    use Math::BigInt;
    use Log::Log4perl qw(:easy);

    require Exporter;

    # Traps signals, allowing END: blocks to perform cleanup.
    use sigtrap qw(die untrapped normal-signals error-signals);
    $SIG{PIPE} = 'IGNORE';    # Do not exit on broken pipes.

    #Globals
    our @ISA    = qw(Exporter);
    our @EXPORT = qw();
    our @EXPORT_OK;
    our $VERSION = 0.99;

    my $database_version;     #  = $dbh->get_info(  18 ); # SQL_DBMS_VER
}

# The global logging object.
our $LOG = get_logger();

our $dbhandle;

# To be used ONLY INTERNALLY!
our ( %_types, %_check, %_required, %_init_val, %_keys, %defaults );

# %fields must be defined by all children classes
our %fields;

#constants
our ( $STATUS_DELETED, $STATUS_ADDED, $STATUS_MODIFIED ) =
  ( 0, 1, 2 );    # Integrity status field
our ( $KEY_INDEX, $KEY_UNIQUE, $KEY_UNIQUE_MULT ) =
  ( 0, 1, 2 );    # Uniqueness of Attributes
our $debug = 0;

# Initialize Connection
our %config;
$config{driver} = "mysql";
$config{host}   = getVar( name => "host", namespace => "HoneyClient::DB" );
$config{port}   = getVar( name => "port", namespace => "HoneyClient::DB" );
$config{user}   = getVar( name => "user", namespace => "HoneyClient::DB" );
$config{pass}   = getVar( name => "pass", namespace => "HoneyClient::DB" );
$config{dbname} = getVar( name => "dbname", namespace => "HoneyClient::DB" );

if ( !db_exists(%config) ) {
    die;
}

END {
    $dbhandle->disconnect() if $dbhandle;
}

=pod

=head1 METHODS

=head2 Object Creation

=over 4

=item new

Receives an unblessed hash, imports the schema (if necessary), checks that
required fields contain the proper data, and returns the blessed object.

It must be called using an object class derived from HoneyClient::DB.
For Example:

  $my_obj = new HoneyClient::DB::SomeObj->new({
          field_a => "foo",
          field_b => "bar"
  });

=cut

sub new {
    my ( $class, $self ) = @_;

    bless( $self, $class );

    # Check if Schema has been imported
    _import_schema($class) if ( !exists( $_types{$class} ) );

    # Make sure required Attributes are set. Fail if not.
    my @missing = $self->_check_required();
    if ( scalar @missing ) {
        $LOG->fatal( "Object missing required attribute(s): "
              . join( ', ', @missing )
              . '.' );
        Carp::croak( "Object missing required attribute(s): "
              . join( ', ', @missing )
              . '.\n' );
    }

    # Check if ref and array objects have been initialized. If not call new
    foreach my $key ( keys %$self ) {
        eval {
            if ( $self->{$key} )
            {
                $self->{$key} = $_check{$class}{$key}->( $self->{$key} );
            }
        };
        if ($@) {
            $LOG->fatal("Invalid Object $key\t$@");
            Carp::croak "Invalid Object $key\n\t$@";
        }
        if ( $_types{$class}{$key} =~ m/(array|ref):(.*)/ ) {
            my $ref        = ref( $self->{$key} );
            my $childType  = $1;
            my $childClass = $2;
            if ( $childClass->can('new') ) {
                if ( $ref eq 'HASH' and $childType eq 'ref' ) {
                    $self->{$key} = $childClass->new( $self->{$key} );
                }
                if ( $ref eq 'ARRAY' and $childType eq 'array' ) {
                    foreach my $obj ( @{ $self->{$key} } ) {
                        $obj = $childClass->new($obj);
                    }
                }
            }
            else {
                $LOG->fatal("Invalid Object! $childType does not exist");
                Carp::croak "Invalid Object! $childType does not exist";
            }
        }
    }
    return $self;
}

################# Initialization Helper Functions #################

sub _check_required {
    my $self  = shift;
    my $class = ref $self;

    # make sure field is not undef if 'required' option is set
    if ( exists $_required{$class} ) {
        my @missing;
        foreach ( keys %{ $_required{$class} } ) {
            push( @missing, $_ )
              if ( !defined( $self->{$_} ) or ( $self->{$_} eq "" ) );
        }
        return @missing;
    }
    return;
}

sub _import_schema {
    my $class  = shift;
    my $schema = \%{ $class . "::fields" };

    # Parase Attributes; store types and options.
    while ( my ( $type, $attrib ) = each(%$schema) ) {
        my $ref = ref $attrib;

        # Attributes in array format use default options
        if ( $ref eq 'ARRAY' ) {
            foreach ( @{$attrib} ) {
                $_types{$class}{$_} = $type;
                if ( $type =~ m/(ref|array)/ ) {
                    delete $_types{$class};
                    $LOG->fatal("Invalid Object Type. ref AND array types must "
                      . "be defined as a hash containing 'objclass'");
                    Carp::croak "Invalid Object Type. ref AND array types must "
                      . "be defined as a hash containing 'objclass'";
                }
                $_check{$class}{$_} = $defaults{$type}{check_func}
                  or $_check{$class}{$_} = \&check_nothing;
            }
        }

        # Parse options for attributes in hash table format
        elsif ( $ref eq 'HASH' ) {
            while ( my ( $a, $opts ) = each %$attrib ) {
                $_types{$class}{$a} = $type;
                if ( $opts->{required} ) {
                    $_required{$class}{$a} = 1;
                }

                # array and ref types require the objclass option
                if ( $type =~ m/^(array|ref)$/ ) {
                    if ( !exists $opts->{objclass} ) {
                        $LOG->fatal("$1 of unknown class: $a");
                        Carp::croak "$1 of unknown class: $a";
                    }
                    if ( !exists $_types{ $opts->{objclass} } ) {
                        _import_schema( $opts->{objclass} );
                    }
                    $_types{$class}{$a} .= ':' . $opts->{objclass};
                }

                # Check function will ensure data is of proper format
                if ( $opts->{check_func} ) {
                    $_check{$class}{$a} = $opts->{check_func};
                }
                else {
                    $_check{$class}{$a} = $defaults{$type}{check_func}
                      or $_check{$class}{$a} = \&check_nothing;
                }

                # key option determines if attribute is an index
                if ( $opts->{key} ) {
                    $_keys{$class}{$a} = $opts->{key};
                }
                if ( $opts->{init_val} ) {
                    $_init_val{$class}{$a} = $opts->{key};
                }
            }
        }
        else {
            $LOG->warn("$class\{$type\} is defined improperly");
        }
    }

    # Add the table to the DB if necessary
    # TODO: Move to install script??
    if (!$class->deploy_table()) {
        $LOG->fatal("${class}->_import_schema: " . "Failed to deploy table");
        Carp::croak("${class}->_import_schema: " . "Failed to deploy table");
    }
}

=back

=head2 Database Operations

=over 4

=item insert

Creates and executes a SQL INSERT statement for the referenced object. The
object must be initialized at the time this method is called.

  $my_obj->insert();

B<Input>

There are no parameters, however the calling object is used as input for the
insert operation.

B<Return Value>

Returns the 'id' of the (parent) object inserted.

=cut

sub insert {
    my $obj = shift;
    my $id  = undef;

    $dbhandle = HoneyClient::DB::_connect(%config);

    # Attempt insert; commit if succeeds, else rollback
    $LOG->debug("Attempting insert operation.");
    eval { $id = _insert( $obj, undef ); };
    if ($@) {
        $LOG->warn("insert failed, Rolling Back: $@");
        $dbhandle->rollback();
    }
    else {
        $dbhandle->commit();
    }
    $dbhandle->disconnect() if $dbhandle;
    return $id;
}

##################### Insert Helper Functions #####################

sub _insert {
    my ( $obj, $fk_col, $fk_id ) = @_;
    my $ref = ref $obj;

    if ( $ref eq 'ARRAY' ) {
        return _insert_array( $obj, $fk_col, $fk_id );
    }
    elsif ( exists $_types{$ref} ) {
        return _insert_obj( $obj, $fk_col, $fk_id );
    }
    elsif ($ref) {
        $LOG->warn("Can't insert object of type $ref");
    }
    else {
        $LOG->warn("Attempted to insert scalar value into the database");
    }
    return undef;
}

sub _insert_array {
    my ( $obj, $fk_col, $fk_id ) = @_;
    my @entries;
    foreach (@$obj) {
        my $id = _insert( $_, $fk_col, $fk_id );
        ref($id) eq 'ARRAY' ? push( @entries, @$id ) : push( @entries, $id );
    }    #}
    return \@entries;
}

sub _insert_obj {
    my ( $obj, $fk_col, $fk_id ) = @_;
    my ( $class, $table ) = ( ref($obj), _get_table($obj) );
    my ( $id, %insert, %index, %children );

    # Process object attributes
    while ( my ( $col, $data ) = each %$obj ) {
        if ( !$_types{$class}{$col} ) {
            $LOG->warn("$col=>$data is not a valid field in $class");
            delete $obj->{$col};
        }
        # Store Arrays of child objects to insert later
        elsif ( $_types{$class}{$col} =~ m/(array)/ ) {
            $children{$col} = $data;
        }
        # Insert child w/ 1 to 1 relationships and create a foreign key to it
        elsif ( $_types{$class}{$col} =~ m/ref:(.*)/ ) {
            if ( my $ft = $1->_get_table() ) {
                $insert{ $ft . '_fk' } = _insert($data);
            }
        }
        # Add scalar attribute insert hash to be used @ INSERT time
        else {
            $insert{$col} = $dbhandle->quote($data);
        }
    }

    # In case this is a child object, add the foreign key to parent
    $insert{$fk_col} = $fk_id if ( $fk_col && $fk_id );

    # Generate and execute SQL INSERT statement
    my $sql =
        "INSERT INTO $table ("
      . join( ',', keys %insert )
      . ") VALUES ("
      . join( ',', values(%insert) ) . ')';
    eval {
        $LOG->debug($sql);
        $dbhandle->do($sql);
    };

    # Handle DB errors. If 1062 (collision) get the ID of pre-existing row
    if ($@) {
        if ( $dbhandle->err == 1062 ) {
            my $filter;
            while ( my ( $col, $key_type ) = each %{ $_keys{$class} } ) {
                if ( $key_type == $KEY_UNIQUE || $key_type == $KEY_UNIQUE_MULT )
                {
                    $filter->{$col} = $obj->{$col};
                }
            }
            my @rows = $class->_select( $filter, 'id' );
            if (scalar @rows) {
                $id = $rows[0]->{id};
            }
            else {
                $LOG->fatal("Error: Can't resolve duplicate records\t" . $dbhandle->err . ": $@");
                Carp::croak("Error: Can't resolve duplicate records\n\t" . $dbhandle->err . ": $@");
            }
        }
        else {
            $LOG->fatal("Error: " . $dbhandle->err . ": $@");
            Carp::croak("Error: " . $dbhandle->err . ": $@");
        }
    }
    else {
        $id = $dbhandle->{'mysql_insertid'};
    }

    # Insert Children
    foreach ( keys %children ) {
        my $rv = _insert( $children{$_}, $table . '_fk', $id );

        #TODO: Handle Insert Failure
    }
    return $id;
}

=item select

Creates and executes a SQL SELECT statement and returns an array of hash refs
containing result rows. If no fields are specified, all fields are returned.
The first parameter is a hash reference to a query filter. The filter may be
followed by a list of field names to retrieve.

  @my_objects = HoneyClient::DB::SomeObj->select($my_filter,@columns);

or

  $my_objects_ref = HoneyClient::DB::SomeObj->select($my_filter,@columns);

B<Input>

The first parameter is a hash_ref containing a filter. The filter is used to
generate a SQL query.

The filter is followed by a list of column to select.

Both parameters are optional. If the first parameter is a scalar, it is assumed
that there is no filter.

B<**NOTE**> Currently it is not possible to include a child object (ref or
array type) in the filter. Only 'id's of child objects are accepted.

B<Return Value>

Returns the 'id' of the (parent) object inserted.

=cut

sub select {
    my @results;
    eval {
        $dbhandle = HoneyClient::DB::_connect(%config);
        @results  = _select(@_);
        $dbhandle->disconnect() if $dbhandle;
    };
    if ($@) {
        $LOG->fatal("select error: $@");
        Carp::croak("select error: $@");
        @results = ();
    }
    wantarray ? return @results : return \@results;
}

sub _select {
    my ( $class, $filter, @fields ) = @_;

    # If 2nd argument is not a hashref, assume it is the first field.
    if ( $filter && ref($filter) ne 'HASH' ) {
        unshift( @fields, $filter );
        $filter = {};
    }

    # Prepare SQL statements
    my $sql = "SELECT ";
    $sql .=
      (
        scalar(@fields)
        ? join( ',', @fields )
        : join( ',', $class->get_fields() ) );
    $sql .= " FROM " . $class->_get_table() . " WHERE ";
    my @conditions;

    # Set condition statements
    while ( my ( $col, $data ) = each %$filter ) {
        if ( !exists $_types{$class}{$col} ) {

            # TODO: Handle non-existent field
        }
        elsif ( $_types{$class}{$col} =~ /array:.*/ ) {
            @$data = map $dbhandle->quote($_), @$data;
            push( @conditions, 'id IN (' . join( ',', @$data ) . ')' )
              if ( scalar(@$data) );
        }
        elsif ( $_types{$class}{$col} =~ /ref:(.*)/ ) {
            push @conditions,
              ( $1->_get_table() . '_fk=' . $dbhandle->quote($data) );
        }
        else {
            push @conditions, ( $col . '=' . $dbhandle->quote($data) );
        }
    }
    $sql .= join( ' AND ', @conditions );

    $LOG->debug($sql);
    my @results = ();
    my $sth = $dbhandle->prepare($sql);
    $sth->execute();
    while ( my $row = $sth->fetchrow_hashref() ) {
        push @results, $row;
    }
   
    return @results;
}

sub includes {
    my @ids;
    foreach (@_) {
        push( @ids, $_ ) if ( !( ref $_ ) && ( $_ =~ /^\d+$/ ) );
        if ( exists $_->{id} ) {
            push @ids, $_->{id};
        }
        else {
            next;    #push @ids, $_->_get_id();
        }
    }
    return \@ids;
}

sub _get_table {
    my $class = shift;
    my ( $table, $ref );
    ( $ref = ref($class) ) ? ( $table = $ref ) : ( $table = $class );
    $table =~ s/HoneyClient::DB:://g;
    $table =~ s/::/_/g;
    $table;
}

=back

=head2 Utility Functions

=over 4

=item get_fields

Retrieves a list of fields as defined by the schema, excluding array fields. Can
be used in conjunction with calls to HoneyClient::DB::select to execute a SELECT
query that retrieves all fields.

=back

=cut

sub get_fields {
    my $self = shift;
    my $class = ( ref($self) or $self );

    my @fields;
    # Begin Fields list w/ record id
    push @fields,'id';

    foreach ( keys %{ $_types{$class} } ) {
        if ( $_types{$class}{$_} !~ m/array:.*/ ) {
            if ( $_types{$class}{$_} =~ m/ref:(.*)/ ) {
                push( @fields, $1->_get_table . '_fk' );
            }
            else { push @fields, $_; }
        }
    }
    return @fields;
}

sub _connect {
    my %conf = @_;
    my $dsn  = "DBI:"
      . $conf{driver}
      . ":database="
      . $conf{dbname}
      . ";host="
      . $conf{host}
      . ";port="
      . $conf{port};
    my $dbh =
      DBI->connect_cached( $dsn, $conf{user}, $conf{pass},
        { 'RaiseError' => 1, 'PrintError' => 0 } );

    if ( $dbh ne '' ) {
        $dbh->{'AutoCommit'} = 0;    # In order to use Auto_Reconnect
                                     #$dbh->{mysql_auto_reconnect} = 1;

        #        _SigSetup(); # Signal handling if necessary
        return $dbh;
    }
    else {
        $LOG->fatal("__PACKAGE__->_Connect Failed: $DBI::errstr");
        Carp::croak "__PACKAGE__->_Connect Failed: $DBI::errstr";
    }
}

# Creates the table for the referenced class unless it exists

sub deploy_table {
    my $class = shift;
    my $table = $class->_get_table();

    # Check for existence of table in DB
    if ( table_exists($table) ) {
        if ($debug) {
            $LOG->warn("${class}->deploy_table: Table $table exists!!");
        }
        return 1;
    }
    $dbhandle = HoneyClient::DB::_connect(%config);
    my ( @mult_unique_key, @foreign_keys, %arrays );

    # Create SQL statement to create table
    my $sql = "CREATE TABLE $table (\n"
      . "\tid INT UNSIGNED AUTO_INCREMENT PRIMARY KEY";

    # Process each column in the %_types table
    while ( my ( $col, $type ) = each %{ $_types{$class} } )
    {    #each %{$class."::fields"}) {
            # Create a foreign key for reference types in new table
        if ( $type =~ m/ref:(.*)/ ) {
            $sql .= ",\n\t" . $1->_get_table() . "_fk INT UNSIGNED";
            push @foreign_keys, $1;
        }

        # Create a foreign key to new table for array types in the child table
        elsif ( $type =~ m/array:(.*)/ ) {
            $arrays{$col} = $1;
            next;
        }

        # Add column in new table for scalar data types
        else {
            $sql .= ",\n\t$col " . _get_db_type($type);
        }

        # Required columns will be added as NOT NULL
        if ( exists $_required{$class} && $_required{$class}{$col} ) {
            $sql .= " NOT NULL";
        }

        # Initial Values for columns