root/honeyclient/branches/rel/1.0/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 1.00.

=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 = 1.00;

    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 );
our %display_rank;

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

our $last_error_code;

#constants
# Integrity status field
our ( $STATUS_DELETED, $STATUS_ADDED, $STATUS_MODIFIED ) = ( 0, 1, 2 );
# Uniqueness of Attributes
our ( $KEY_INDEX, $KEY_UNIQUE, $KEY_UNIQUE_MULT ) = ( 0, 1, 2 );
# Option for get_fields()
our ( $FIELDS_ALL, $FIELDS_SEARCH, $FIELDS_DISPLAY ) = ( 0 , 1, 2);
# Error Codes
our ($ERROR_NONE,$ERROR_INSERT_FAILED,$ERROR_DUPLICATE_FOUND,$ERROR_DUPLICATE_UNRESOLVED)
    = (0,1,2,3);
our @ERROR_MESSAGES = (
    "Success",
    "Failed with a fatal error",
    "Duplicate object found. Non-fatal warning",
    "Duplicate object found. Unable to retrieve ID of duplicate record",
);
our $LAST_ERROR = $ERROR_NONE;

# 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 = 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( "$class->new(): Object missing required attribute(s): " .
            join( ', ', @missing ) . '.' );
        Carp::croak( "$class->new(): Object missing required attribute(s): " .
            join( ', ', @missing ) . '.\n' );
    }

    # Check data validity. Initialize uninitialized ref and array objects
    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,$childClass)  = ($1,$2);

            if ( $childClass->can('new') ) {
                if ( $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 undefined 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" };
    my (%rank_display, %rank_search);
    my $MAX_RANK = 10000;

    # 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 ( exists $opts->{required} && $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};
                }
                #DEBUG: Test new code
                if( $opts->{searchable} ) {
                    #TODO: $_search_fields{$class}
                }
                if( exists $opts->{display_rank} ) {
                    my $rank = $opts->{display_rank};
                    if ($opts->{display_rank}) {
                        while (exists $rank_display{$rank}) {
                                $rank++;
                        }
                        $rank_display{$rank} = $a;
                    }
                }
                elsif ($type =~ m/^(array|ref)$/) {}
                else {
                    $rank_display{$MAX_RANK++} = $a;
                }
            }
        }
        else {
            $LOG->warn("$class\{$type\} is defined improperly");
        }
    }
    my @temp = map $rank_display{$_}, sort( keys( %rank_display ) );
    $display_rank{$class} = \@temp;

    # Add the table to the DB if necessary
    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;
    my $objType  = ref $obj;

    $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();
    }
    elsif ($LAST_ERROR != $ERROR_NONE) {
        $LOG->warn("Rolling Back $objType Insert. Code #$LAST_ERROR: ".$ERROR_MESSAGES[$LAST_ERROR]);
        $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 );
    my $error = $ERROR_NONE;

# 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 . '_' .$col . '_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(
                '-columns'=>['id'],
                '-where'=>$filter,
            );
            if (scalar @rows) {
                $id = $rows[0]->{id};
                $error = $ERROR_DUPLICATE_FOUND;
            }
            else {
                $LAST_ERROR = $ERROR_DUPLICATE_UNRESOLVED;
                $LOG->fatal("Error: Can't resolve duplicate records\t" . $dbhandle->err . ": $@");
                Carp::croak("Error: Can't resolve duplicate records\n\t" . $dbhandle->err . ": $@");
            }
        }
        else {
            $LAST_ERROR = $ERROR_INSERT_FAILED;
            $LOG->fatal("Error #".$dbhandle->err."while executing SQL:\n\t$sql\n$@");
            Carp::croak("Error #".$dbhandle->err."while executing SQL:\n\t$sql\n$@");
        }
    }
    else {
        $id = $dbhandle->{'mysql_insertid'};
    }
# Insert Children
    foreach ( keys %children ) {
        my $rv = _insert( $children{$_}, $table . '_' .$_ . '_fk', $id );
    }
    $LAST_ERROR = $error;
    return $id;
}

=head3 QUERY CONDITIONS

The following functions accept conditions using the '-where' argument. These
conditions filter results to the desired information. Currently any scalar field
is searchable (string, int, text, timestamp), while ref objects are searchable
only by their ids (for now).

The following query will list Regkey changes that occurred to the Windows
auto-start key .

  @runKeys = HoneyClient::DB::Regkey->select(
      -where => {
          key_name => 'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',
      },
  );

In order to perform a partial match search, a tilda can be added to the front
of the column name. This is not applicable to ranges. The following query will
return any Registry change with the string 'Run' in the key name(path).

  @runKeys = HoneyClient::DB::Regkey->select(
      -where => {
          '~key_name' => 'Run',
      },
  );

B<NOTE:> In this case, the column name must be quoted, or used as a variable.

A query can search a range, for instance, the following will show all
Honeyclients in a given date range.

  @octoberClients = HoneyClient::DB::Client->select(
      -where => {
          start_time => ['2007-10-01 00::00::00','2007-10-31 23::59::59'
      },
  );

The '-where' option accepts filters on multiple columns as well.


=item select

Creates and executes a SQL SELECT statement and returns an array of hash refs
containing result rows.

The following would select the name, age, address, and phone columns for all
records with the name 'bob', and an age in the range of 25-50 (inclusive).

  @my_objects = HoneyClient::DB::Process->select(
      -columns => qw(name,pid,parent_name,created_time),
      -where => {
          name => 'bob',
          age => [25,50],
      },
  );

B<Input>

The select() function can take as arguments a hash containing the following keys:

=item * B<'-columns'>

List of columns to be selected. By default, if no -columns argument is given,
all columns are selected. See L<get_fields>.

=item * B<'-where'>

This field can contain a set of conditions used to filter the results. Refer to
L<QUERY CONDITIONS> for more info.

=cut

sub select {
# Connect, Create, and execute SQL query
    $dbhandle = HoneyClient::DB::_connect(%config);
    my @results = _select(@_);

# Disconnect and return results
    $dbhandle->disconnect() if $dbhandle;
    wantarray ? return @results : return \@results;
}

sub _select {
    my (@results,$sql);
    eval {
# Create SQL query
        $sql = _build_query(@_);
        $LOG->debug($sql);

# Execute SQL query
        my $sth = $dbhandle->prepare($sql);
        $sth->execute();

# Retrieve results and exit
        while ( my $row = $sth->fetchrow_hashref() ) {
            push @results, $row;
        }
    };
    if ($@) {
        $LOG->warn("Error while executing SQL:\n\t$sql\n$@");
        return ();
    }
    return @results;
}

sub _build_query {
    my ( $class, %args) = @_;
    my @fields;
    if (exists($args{'-columns'}) && scalar(@{$args{'-columns'}})) {
        @fields = @{$args{'-columns'}};
    }
    else {
        @fields = $class->get_fields();
    }
# Column Rename where columns are passed as a hash table e.g. {col_name => "Display Name"} becomes "col_name AS 'Display Name'"
    foreach my $col_def (@fields) {
        if (ref $col_def eq 'HASH') {
             while (my ($col,$as) = (each %$col_def)) {
                 push @fields, "$col AS '$as'";
             }
         }
     }
# Prepare SQL statement
    my $sql = "SELECT "; $sql .= join( ',', @fields); $sql .= " FROM " . $class->_get_table();
# Set condition statements
    $sql .= $class->_where_condition($args{'-where'});
    return $sql;
}

# Generates a where condition (e.g. " WHERE id=5 AND name='foo'")
sub _where_condition {
    my ($class,$cond) = @_;
    my @conditions;
    if (!keys(%$cond)) {
        return '';
    }
    while ( my ( $col, $data ) = each %$cond ) {
        my $partial = 0;
        if ($col =~ /^\~(.*)/) {
            $col = $1;
            $partial = 1;
        }
        if ( !exists $_types{$class}{$col} && $col ne 'id' && $col !~ m/_fk$/) {
            next; #TODO: Handle non-existent field
        }
        my $cf = ($_check{$class}{$col} || \&check_nothing);
        if (my $ref = ref($data)) {
            eval {
                if (my ($type,$sub_class) = $_types{$class}{$col} =~ /(array|ref):(.*)/ ) {
                    if ($ref eq 'HASH') {
                        my ($left,$right) = ('id',$class->get_col_name($col));
                        if ($type eq 'ref') {
                            ($left, $right) = ($right,$left);
                        }
                        my $sub_query = $sub_class->select(
                           -columns => [$right],
                           -where => $data,
                        );
                        push @conditions, $left.' IN ('.$sub_query.')';
                    }
                }
                elsif ($ref eq 'ARRAY' && &$cf($data->[0]) && &$cf($data->[1])) {
                    push @conditions, ( $class->get_col_name($col) . ' BETWEEN ' .
                        $dbhandle->quote($data->[0]) . ' AND '.
                        $dbhandle->quote($data->[1])
                    );
                }
            };
            #TODO: Handle Failure
        }
        else {
            if (exists $_types{$class}{$col} && $_types{$class}{$col} =~ /ref:(.*)/ ) {
               if (check_int($data)) {
                   push @conditions,($class->get_col_name($col).