# DBIWrapper.pm - The DataBase Wrapper Class that provides the DBI database
# connection and core functions for working with DBI databases.
# Created by James Pattie, 11/02/2000.

# Copyright (c) 2000-2005 Xperience, Inc. http://www.pcxperience.com/
# All rights reserved.  This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.

package DBIWrapper;
use strict;
use DBI;
use vars qw($AUTOLOAD $VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();

$VERSION = '0.23';

use vars qw($formUnEncodedCharacters %formUnEncodedCharactersHash);
$formUnEncodedCharacters = '<>"';
%formUnEncodedCharactersHash = ( '<' => '&lt;', '>' => '&gt;', '"' => '&quot;', '&' => '&amp;' );

=head1 NAME

DBIWrapper - Perl extension for generic DBI database access.

=head1 SYNOPSIS

  use DBIWrapper;
  my $db = DBIWrapper->new(dbType => "Pg",
                           dbName => "test_db",
                           dbHost => "localhost",
                           dbUser => "nobody",
                           dbPasswd => "",
                           dbPort => "5432",
                           predefinedDSN => "",
                           printError => 1,
                           raiseError => 1,
                           autoCommit => 0);
  if ($db->error())
  {
    die $db->errorMessage();
  }

  my $sth = $db->read("SELECT * FROM test_tb");
  my $result = $db->write(sql => "INSERT INTO test_tb (name, value) VALUES (?, ?)",
    plug => [ $name, $value ]);
  # this used DBI's substitution features to plugin the name and value.

  $db->close();  # close down the database connection.  Any read()'s
  # or write()'s will no longer be valid with this object until a new() is
  # issued again.

=head1 DESCRIPTION

DBIWrapper is the generic database Object for accessing the DBI database
interface.  It provides the lowest level of functionality needed by any
program wanting to access databases via the DBI.  Currently, DBIWrapper
is only aware of Pg (PostgreSQL), mysql (MySQL), Sybase and ODBC DBD
modules and how to work with them correctly.

Support for transactions on MySQL is now checked for and if found to be
available, the AutoCommit flag is turned off so that transactions will
be used.

The substitution array (if used) will cause each ##?1##, ##?2##, etc.
string in the sql string to be substituted for the corresponding value
in the substitution array.  It must start at ?1.  It is up to the user
to pass in the correct number of elements for both the plug and
substitution arrays.  The plug array is used to pass in the values for
DBI to replace in the sql string of ? which is standard DBI notation.

=head1 Sybase NOTES

The getDataArray(), getDataArrayHeader(), getDataHash(),
getDataHashHeader(), readXML(), readHTML() methods all properly handle
multiple result sets being returned from Sybase.  This could be the
result of multiple select statements or a compute clause.  In the
case of the Header() methods, the header row is based on the first
returned select statement, which may not be correct for the following
statements or compute blocks.

=head1 Exported FUNCTIONS

B<NOTE>: I<bool> = 1(true), 0(false)

=over 4

=item scalar new(dbType, dbName, dbHost, dbUser, dbPasswd, dbPort, printError, raiseError, autoCommit, predefinedDSN, setDateStyle, logLevel, server, interfaces)

 Creates a new instance of the DBIWrapper object and opens
 a connection to the specified database.  If predefinedDSN is
 specified then it is used instead of the dbName, dbHost, dbPort
 values.  This is mainly to support ODBC easier.
 If setDateStyle is 1 (default) and dbType = Pg, then the datestyle
 for PostgreSQL is set to US (MM/DD/YYYY).
 logLevel defaults to 0.  There are 4 levels 0, 1, 2 and 3 which log
 the following items when an error occurs:
 0) Nothing is output
 1) dbType, dbHost, dbName, printError, raiseError, autoCommit,
   setDateStyle, supportsTransactions, transactionType, server,
   interfaces
 2) all of 1 plus dbUser, dbPort, predefinedDSN
 3) all of 2 plus dbPasswd

 Sybase specific:
 server allows you to specify the database server to connect to by name
   and must be defined in your interfaces file.
 interfaces allows you to specify the Sybase interfaces file needed
   to properly connect to the Sybase database.

 If you do not specify server and interfaces, then dbHost and dbPort
 will be used.

=cut
sub new
{
  my $that = shift;
  my $class = ref($that) || $that;
  my $self = bless {}, $class;
  my %args = ( dbType => 'Pg', dbHost => 'localhost', dbUser => 'nobody', dbPasswd => '', dbPort => '5432', predefinedDSN => "", printError => 1, raiseError => 1, autoCommit => 0, setDateStyle => 1, logLevel => 0, interfaces => "", server => "", @_ );
  my ($dbType, $dbName, $dbHost, $dbUser, $dbPasswd, $dbPort, $predefinedDSN, $printError, $raiseError, $autoCommit, $setDateStyle, $logLevel, $interfaces, $server);

  $dbType = $args{dbType};
  $dbHost = $args{dbHost};
  $dbName = $args{dbName};
  $dbUser = $args{dbUser};
  $dbPasswd = $args{dbPasswd};
  $dbPort = $args{dbPort};
  $predefinedDSN = $args{predefinedDSN};
  $printError = $args{printError};
  $raiseError = $args{raiseError};
  $autoCommit = $args{autoCommit};
  $setDateStyle = $args{setDateStyle};
  $logLevel = $args{logLevel};
  $interfaces = $args{interfaces};
  $server = $args{server};
  $self->{supportsTransactions} = 1;  # by default all Databases support Transactions, except for MySQL.
  $self->{transactionType} = "";  # This is only set by MySQL so we know what type of transaction support is available.
  if ($dbType eq "mysql")
  {
    $autoCommit = 1;  # it may not do transactions yet.
    $self->{supportsTransactions} = 0;
  }

  $self->{error} = 0;  # nothing wrong yet.
  $self->{errorString} = "";
  $self->{errorPhrase} = "() - Error!<br />\n";

  $self->{dbType} = $dbType;
  $self->{dbHost} = $dbHost;
  $self->{dbName} = $dbName;
  $self->{dbUser} = $dbUser;
  $self->{dbPasswd} = $dbPasswd;
  $self->{dbPort} = $dbPort;
  $self->{predefinedDSN} = $predefinedDSN;
  $self->{printError} = $printError;
  $self->{raiseError} = $raiseError;
  $self->{autoCommit} = $autoCommit;
  $self->{setDateStyle} = $setDateStyle;
  $self->{logLevel} = $logLevel;
  $self->{interfaces} = (length $interfaces > 0 ? $interfaces : undef);
  $self->{server} = (length $server > 0 ? $server : undef);
  $self->{dbh} = undef;  # set this explicitly now so that we have something to check if an error occurs later.

  if (!$self->isValid(new => 1))
  {
    $self->error(errorString => "Error!<br />\n" . $self->errorMessage);
    return $self;
  }

  my $dbh;
  my $dsn;
  my %errorHandlers = ();
  $dsn = "dbi:$dbType:";

  if ($dbType =~ /^(Pg|mysql)$/)
  {
    if (length $predefinedDSN > 0)
    {
      $dsn .= $predefinedDSN;
    }
    else
    {
      $dsn .= "dbname=$dbName;host=$dbHost;port=$dbPort";
    }
  }
  elsif ($dbType eq "Sybase")
  {
    if (length $predefinedDSN > 0)
    {
      $dsn .= $predefinedDSN;
    }
    else
    {
      $dsn .= "database=$dbName";
      if (defined $interfaces)
      {
        $dsn .= ";server=$server;interfaces=$interfaces";
      }
      else
      {
        # use host and port
        $dsn .= ";host=$dbHost;port=$dbPort";
      }
    }
    $errorHandlers{syb_err_handler} = \&sybaseErrorHandler;
  }
  elsif ($dbType eq "ODBC")
  {
    if (length $predefinedDSN > 0)
    {
      $dsn .= $predefinedDSN;
    }
    else
    {
      $self->error(errorString => "Error!<br />\nYou must specify the 'predefinedDSN' for dbType = '$dbType'!<br />\n" . $self->debugMessage);
      return $self;
    }
  }

  eval {
    $dbh = DBI->connect($dsn, $dbUser, $dbPasswd, { PrintError => $printError, RaiseError => $raiseError, AutoCommit => $autoCommit, %errorHandlers });
  };
  if ($@)
  {
    $self->{dbh} = undef;
    $self->error(errorString => "Eval of connect failed!<br />\nError = '$@'.<br />\nDBIError = '" . $DBI::errstr . "'.<br />\n" . $self->debugMessage);
  }
  else
  {
    if ($dbh)
    {
      if (!$DBI::err)
      {
        $self->{dbh} = $dbh;
        if ($dbType eq "Pg" && $setDateStyle)
        {
          $self->write(sql => "SET datestyle TO 'POSTGRES,US'");
        }
        if ($dbType eq "mysql")
        {
          # check for Transaction support, and if present disable the AutoCommit flag.
          if ($self->mysqlHasTransactions)
          {
            $self->{supportsTransactions} = 1;
            $self->{dbh}->{AutoCommit} = 0;
          }
          if ($self->error)
          {
            $self->{dbh} = undef;
            $self->error(errorString => "Checking for Transactions with MySQL failed!<br />\n" . $DBI::errstr . "<br />\n" . $self->debugMessage);
          }
        }
      }
      else
      {
        $self->{dbh} = undef;
        $self->error(errorString => "connect failed!<br />\n" . $DBI::errstr . "<br />\n" . $self->debugMessage);
      }
    }
    else
    {
      $self->{dbh} = undef;
      $self->error(errorString => "connect failed!<br />\n" . $DBI::errstr . "<br />\n" . $self->debugMessage);
    }
  }

  return $self;
}

=item bool isValid()

 Returns 1 if the DBI object is valid, else 0 if invalid.

=cut
sub isValid
{
  my $self = shift;
  my %args = ( new => 0, @_ );
  my $new = $args{new};
  my $valid = 1;
  my $errorString = "";

  if (!$new)
  {
    if (!defined $self->{dbh})
    {
      $errorString .= "dbh is not defined!<br />\n";
      $valid = 0;
    }
  }
  if ($self->{dbType} !~ /^(Pg|mysql|ODBC|Sybase)$/)
  {
    $errorString .= "dbType = '$self->{dbType}' is invalid!<br />\n";
    $valid = 0;
  }
  if (length $self->{predefinedDSN} == 0) # only check the dbHost, dbName and dbPort values if not using predefinedDSN
  {
    if (length $self->{dbName} == 0)
    {
      $errorString .= "dbName = '$self->{dbName}' is invalid!<br />\n";
      $valid = 0;
    }
    if ($self->{dbType} eq "Sybase")
    {
      if (defined $self->{server} && !defined $self->{interfaces})
      {
        $errorString .= "server = '$self->{server}'.  interfaces must be specified!<br />\n";
        $valid = 0;
      }
      if (defined $self->{interfaces} && !defined $self->{server})
      {
        $errorString .= "interfaces = '$self->{interfaces}'.  server must be specified!<br />\n";
        $valid = 0;
      }
    }
    if ($self->{dbType} ne "Sybase" || ($self->{dbType} eq "Sybase" && (!defined $self->{server} && !defined $self->{interfaces})))
    {
      if (length $self->{dbHost} == 0)
      {
        $errorString .= "dbHost = '$self->{dbHost}' is invalid!<br />\n";
        $valid = 0;
      }
      if ($self->{dbPort} !~ /^(\d+)$/)
      {
        $errorString .= "dbPort = '$self->{dbPort}' is invalid!<br />\n";
        $valid = 0;
      }
    }
  }
  if (length $self->{dbUser} == 0)
  {
    $errorString .= "dbUser = '$self->{dbUser}' is invalid!<br />\n";
    $valid = 0;
  }
  if (length $self->{dbPasswd} == 0)
  {
    $errorString .= "dbPasswd = '$self->{dbPasswd}' is invalid!<br />\n";
    $valid = 0;
  }
  if ($self->{autoCommit} !~ /^(0|1)$/)
  {
    $errorString .= "autoCommit = '$self->{autoCommit}' is invalid!<br />\n";
    $valid = 0;
  }
  if ($self->{printError} !~ /^(0|1)$/)
  {
    $errorString .= "printError = '$self->{printError}' is invalid!<br />\n";
    $valid = 0;
  }
  if ($self->{raiseError} !~ /^(0|1)$/)
  {
    $errorString .= "raiseError = '$self->{raiseError}' is invalid!<br />\n";
    $valid = 0;
  }
  if ($self->{setDateStyle} !~ /^(0|1)$/)
  {
    $errorString .= "setDateStyle = '$self->{setDateStyle}' is invalid!<br />\n";
    $valid = 0;
  }
  if ($self->{logLevel} !~ /^(0|1|2|3)$/)
  {
    $errorString .= "logLevel = '$self->{logLevel}' is invalid!<br />\n";
    $valid = 0;
  }

  if (!$valid)
  {
    $self->error(errorString => "$errorString" . $self->debugMessage);
  }

  return $valid;
}

=item void close()

  Closes the connection to the database.

=cut
sub close
{
  my $self = shift;

  if (defined $self->{dbh} && ref $self->{dbh} eq "DBI::db")
  {
    my $result;
    eval { $result = $self->{dbh}->disconnect; };
    if ($@)
    {
      $self->error(errorString => "Eval of disconnect failed!<br />\nError = '$@'.<br />\n" . $self->debugMessage);
      return;
    }
    else
    {
      eval {
        if (!$result || $self->{dbh}->err)
        {
          $self->error(errorString => "disconnect failed!<br />\n" . $self->{dbh}->errstr . "<br />\n" . $self->debugMessage);
          return;
        }
      };
      if ($@)
      {
        $self->error(errorString => "Eval of result check failed!<br />\nError = '$@'.<br />\n" . $self->debugMessage);
        return;
      }
    }
    $self->{dbh} = undef;  # signal it is no longer valid!
  }
}

=item bool error(errorString)

 This method will set the error condition if an argument is
 specified.

 The current error state is returned, regardless of if we are
 setting an error or not.

 A \n is appended to the errorString so you don't have to provide it.
 errorString is prefixed with the caller's full method name followed
 by the errorPhrase string.

 You can either specify the errorString value by name:

 $self->error(errorString => "This is an error!");

 or by value:

 $self->error("This is an error!");

 If you specify multiple arguments (in pass by value mode), then
 we check to see if the first argument contains %'s that are not
 \ escaped and are not %%.  If this is the case, then the incoming
 arguments will be passed through sprintf() for formatting, else we
 just join them with a space ' ' and append them to the current
 errorString.


 To see if an error happened:

 if ($self->error) { die "Error: " . $self->errorMessage; }

=cut
sub error
{
  my $self = shift;
  my @callerArgs = caller(1);
  (my $subName = $callerArgs[3]) =~ s/^(.+)(::)([^:]+)$/$1->$3/;
  my $callerErrStr = "$subName$self->{errorPhrase}";

  if (scalar @_ > 0)
  {
    # we are setting an error condition.
    if (scalar @_ == 1)
    {
      $self->{errorString} .= $callerErrStr . @_[0];
    }
    else
    {
      if (@_[0] eq "errorString")
      {
        my %args = ( @_ );
        if (!exists $args{errorString})  # make sure we get the errorString argument!
        {
          $self->error($callerErrStr . "<b>errorString</b> is missing!<br />\n");
          return;
        }
        else
        {
          $self->{errorString} .= $callerErrStr . $args{errorString};
        }
      }
      else
      {
        # handle the sprintf case.
        if (@_[0] =~ /(?<!\\)%[^%]/)
        {
          # build up the string to eval for the sprintf.
          my $str = "\"@_[0]\"";
          for (my $i=1; $i < scalar @_; $i++)
          {
            $str .= ", \"@_[$i]\"";
          }
          $self->{errorString} .= $callerErrStr;
          eval "\$self->{errorString} .= sprintf($str);";
          if ($@)
          {
            $self->error($callerErrStr . $@);
            return;
          }
        }
        else
        {
          $self->{errorString} .= $callerErrStr . join(" ", @_);
        }
      }
    }
    $self->{errorString} .= "\n";
    $self->{error} = 1;
  }

  return $self->{error};
}

=item void setError(errorString)

 DEPRECATED: see error()

 optional: errorString
 returns: nothing
 Sets error = 1 and errorString = string passed in.
 The errorString is prefixed with the caller's full
 method name followed by the errorPhrase string.

 You can either call as
 setError(errorString => $string)
 or setError($string)

 If you do not specify anything, we blow an error
 telling you to specify errorString.

 \n is appended to the contents of the errorString
 passed in.

=cut

sub setError
{
  my $self = shift;
  my @callerArgs = caller(1);
  (my $subName = $callerArgs[3]) =~ s/^(.+)(::)([^:]+)$/$1->$3/;
  my $callerErrStr = "$subName$self->{errorPhrase}";
  my $deprecated = "DEPRECATED call to setError!  Convert to using error().<br />\n";

  if (scalar @_ == 1)
  {
    $self->{errorString} = $deprecated . $callerErrStr . @_[0];
  }
  else
  {
    my %args = ( @_ );
    if (!exists $args{errorString})  # make sure we get the errorString argument!
    {
      $self->setError($callerErrStr . "<b>errorString</b> is missing!<br />\n");
      return;
    }
    else
    {
      $self->{errorString} = $deprecated . $callerErrStr . $args{errorString};
    }
  }
  $self->{errorString} .= "\n";
  $self->{error} = 1;
}

=item void prefixError(errorString)

 optional: errorString
 returns: nothing
 Sets error = 1 and prefixes errorString with string passed in.
 The errorString is prefixed with the caller's full
 method name followed by the errorPhrase string.

 You can either specify the errorString value by name:

 $self->prefixError(errorString => "This is an error!");

 or by value:

 $self->prefixError("This is an error!");

 If you specify multiple arguments (in pass by value mode), then
 we check to see if the first argument contains %'s that are not
 \ escaped and are not %%.  If this is the case, then the incoming
 arguments will be passed through sprintf() for formatting, else we
 just join them with a space ' ' and append them to the current
 errorString.


 If you don't specify anything then
   If you have a previous error, we prefix the caller info to
     that error message.

=cut

sub prefixError
{
  my $self = shift;
  my @callerArgs = caller(1);
  (my $subName = $callerArgs[3]) =~ s/^(.+)(::)([^:]+)$/$1->$3/;
  my $callerErrStr = "$subName$self->{errorPhrase}";

  if (scalar @_ == 1)
  {
    $self->{errorString} = $callerErrStr . @_[0] . $self->{errorString} . "\n";
  }
  else
  {
    if (@_[0] eq "errorString")
    {
      my %args = ( @_ );
      if (!exists $args{errorString})  # make sure we get the errorString argument!
      {
        if ($self->{errorString})
        {
          # prefix the old errorString value.
          $self->{errorString} = $callerErrStr . $self->{errorString};
        }
        else
        {
          $self->error($callerErrStr . "<b>errorString</b> is missing!<br />\n");
          return;
        }
      }
      else
      {
        $self->{errorString} = $callerErrStr . $args{errorString} . "\n" . $self->{errorString};
      }
    }
    else
    {
      # handle the sprintf case.
      if (@_[0] =~ /(?<!\\)%[^%]/)
      {
        # build up the string to eval for the sprintf.
        my $str = "\"@_[0]\"";
        for (my $i=1; $i < scalar @_; $i++)
        {
          $str .= ", \"@_[$i]\"";
        }
        my $oldErrorStr = $self->{errorString};
        $self->{errorString} = $callerErrStr;
        eval "\$self->{errorString} .= sprintf($str);";
        if ($@)
        {
          $self->error($callerErrStr . $@);
          return;
        }
        $self->{errorString} .= "\n" . $oldErrorStr;
      }
      else
      {
        $self->{errorString} = $callerErrStr . join(" ", @_) . "\n" . $self->{errorString};
      }
    }
  }
  $self->{error} = 1;
}

=item scalar didErrorOccur(void)

 DEPRECATED: see error()

 Returns the value of error.

=cut

sub didErrorOccur
{
  my $self = shift;

  return $self->{error};
}

=item scalar errorMessage(void)

 Returns the value of errorString.

=cut

sub errorMessage
{
  my $self = shift;

  return $self->{errorString};
}

=item scalar errorStr(void)

 Returns the value of errorString.

 Alternative to errorMessage().

=cut

sub errorStr
{
  my $self = shift;

  return $self->{errorString};
}

=item void resetError(void)

 Resets the error condition flag and string.

=cut

sub resetError
{
  my $self = shift;

  $self->{error} = 0;
  $self->{errorString} = "";
}

=item void commit()

 causes the database to commit the current transaction.  Only works
 if AutoCommit is set to 0 and the database supports Transactions.

=cut
sub commit
{
  my $self = shift;

  if (!$self->{supportsTransactions})
  {
    return;
  }
  eval { $self->{dbh}->commit; };
  if ($@)
  {
    $self->error(errorString => "commit failed!<br />\nError = $@" . "<br />\n" . $self->debugMessage);
  }
  elsif ($DBI::err)
  {
    $self->error(errorString => "commit failed!<br />\nError = $DBI::errstr" . "<br />\n" . $self->debugMessage);
  }
}

=item void rollback()

 causes the database to rollback the current transaction.  Only
 works if AutoCommit is set to 0 and the database supports
 Transactions.

=cut
sub rollback
{
  my $self = shift;

  if (!$self->{supportsTransactions})
  {
    return;
  }
  eval { $self->{dbh}->rollback; };
  if ($@)
  {
    $self->error(errorString => "rollback failed!<br />\nError = $@" . "<br />\n" . $self->debugMessage);
  }
  elsif ($DBI::err)
  {
    $self->error(errorString => "rollback failed!<br />\nError = $DBI::errstr" . "<br />\n" . $self->debugMessage);
  }
}

=item ref read(sql => "", plug => [], substitute => [])

 (This function should only be called for SELECT statements).
 executes the specified sql statement passing in any values in plug
 to the execute method after doing any substitutions that are in
 substitute.  The resulting sql data is passed back to the user as a
 reference for them to do with as they please.

=cut
sub read
{
  my $self = shift;
  my $sql = "";
  my @plug = ();
  my @substitute = ();
  if (scalar @_ == 1)
  {
    $sql = shift;
  }
  else
  {
    my %args = ( plug => [], substitute => [], @_ );
    @plug = @{$args{'plug'}};
    @substitute = @{$args{'substitute'}};

    $sql = $args{'sql'};
  }
  # validate we got a sql statement to work with.
  if (length $sql == 0)
  {
    $self->error(errorString => "SQL string not passed in!" . "<br />\n" . $self->debugMessage);

    return undef;
  }

  # check and see if we need to do any substitutions.
  if (scalar @substitute > 0)
  {
    for (my $i=0; $i < scalar @substitute; $i++)
    {
      my $temp_string = "\\#\\#\\?" . ($i+1) . "\\#\\#";
      $sql =~ s/$temp_string/$substitute[$i]/g;
    }
  }

  # now prepare the statement
  my $sth;
  eval {
    $sth = $self->{dbh}->prepare($sql);
  };
  if ($@)
  {
    $self->error(errorString => "Eval of prepare failed!<br />\nError = '$@'.<br />\nsql='$sql'.<br />\nplug='" . join("', '", @plug) . "'.<br />\n" . $self->debugMessage);

    return undef;
  }
  elsif (!$sth || $DBI::err)
  {
    $self->error(errorString => "Preparing failed!<br />\n" . $DBI::errstr . "<br />\nsql='$sql'.<br />\nplug='" . join("', '", @plug) . "'.<br />\n" . $self->debugMessage);

    return undef;
  }

  # now execute the sql statement passing in any parameters given via plug
  my $rc;
  eval {
    $rc = $sth->execute(@plug);
  };
  if ($@)
  {
    $self->error(errorString => "Eval of execute failed!<br />\nError = '$@'.<br />\nsql='$sql'.<br />\nplug='" . join("', '", @plug) . "'.<br />\n" . $self->debugMessage);

    return undef;
  }
  elsif (!$rc || $DBI::err)
  {
    $self->error(errorString => "Execute failed!<br />\n" . $DBI::errstr . "<br />\nsql='$sql'.<br />\nplug='" . join("', '", @plug) . "'.<br />\n" . $self->debugMessage);

    return undef;
  }

  return $sth;
}

=item @ getDataArray(sql, plug, substitute)
 requires: sql
 optional: plug, substitute
 returns: array of arrayrefs as the result of
   $sth->fetchall_arrayref

 See read() for argument info.

=cut
sub getDataArray
{
  my $self = shift;
  my $sql = "";
  my $sth = undef;
  if (scalar @_ == 1)
  {
    $sql = shift;
    $sth = $self->read($sql);
  }
  else
  {
    my %args = ( plug => [], substitute => [], @_ );
    $sth = $self->read(%args);
  }

  my @data = ();

  if ($self->error)
  {
    $self->prefixError();
    return @data;
  }

  while (my $row = $sth->fetchrow_arrayref || ($self->{dbType} eq "Sybase" && $sth->{syb_more_results}))
  {
    if (defined $row && ref($row) eq "ARRAY" && scalar @{$row} > 0)
    {
      my @row = @{$row};
      push @data, \@row;
    }
  }

  $sth->finish;

  return @data;
}

=item @ getDataHash(sql, plug, substitute, case)
 requires: sql
 optional: plug, substitute, case
 returns: array of hashrefs where the column names are
   case preserved if case = 1, or lowercased if case = 0.

 case defaults to 0 (lowercase).

 See read() for argument info.

=cut
sub getDataHash
{
  my $self = shift;
  my $sql = "";
  my $case = 0;
  my $sth = undef;
  if (scalar @_ == 1)
  {
    $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
    $sql = shift;
    $sth = $self->read($sql);
  }
  else
  {
    my %args = ( plug => [], substitute => [], case => 0, @_ );
    my $case = $args{case};
    $self->{dbh}->{FetchHashKeyName} = ($case == 1 ? 'NAME' : 'NAME_lc');
    $sth = $self->read(%args);
  }

  my @data = ();

  if ($self->error)
  {
    $self->prefixError();
    return @data;
  }

  while (my $row = $sth->fetchrow_hashref || ($self->{dbType} eq "Sybase" && $sth->{syb_more_results}))
  {
    if (defined $row && ref($row) eq "HASH" && scalar keys %{$row} > 0)
    {
      my %row = %{$row};
      push @data, \%row;
    }
  }

  $sth->finish;

  return @data;
}

=item @ getDataArrayHeader(sql, plug, substitute, case)
 requires: sql
 optional: plug, substitute, case
 returns: array of arrayrefs

   The first row of the array is an array containing the
   column names in the order returned by the database.
   The column names are case preserved if case = 1, or
   lowercased if case = 0.

   NOTE:
   If 0 rows were returned, we still return an array with
   1 row in it, which is the header row.

 case defaults to 0 (lowercase).

 See read() for argument info.

=cut
sub getDataArrayHeader
{
  my $self = shift;
  my $sql = "";
  my $case = 0;
  my $sth = undef;
  if (scalar @_ == 1)
  {
    $sql = shift;
    $sth = $self->read($sql);
  }
  else
  {
    my %args = ( plug => [], substitute => [], case => 0, @_ );
    my $case = $args{case};
    $sth = $self->read(%args);
  }

  my @data = ();

  if ($self->error)
  {
    $self->prefixError();
    return @data;
  }

  # get the column NAMES
  push @data, $sth->{($case == 1 ? 'NAME' : 'NAME_lc')};

  while (my $row = $sth->fetchrow_arrayref || ($self->{dbType} eq "Sybase" && $sth->{syb_more_results}))
  {
    if (defined $row && ref($row) eq "ARRAY" && scalar @{$row} > 0)
    {
      my @row = @{$row};
      push @data, \@row;
    }
  }

  $sth->finish;

  return @data;
}

=item @ getDataHashHeader(sql, plug, substitute, case)
 requires: sql
 optional: plug, substitute, case
 returns: array of hashrefs where the column names are
   case preserved if case = 1, or lowercased if case = 0.

   The first row of the array is an array containing the
   column names in the order returned by the database.
   The column names respect the case flag.

   NOTE:
   If 0 rows were returned, we still return an array with
   1 row in it, which is the header row.

 case defaults to 0 (lowercase).

 See read() for argument info.

=cut
sub getDataHashHeader
{
  my $self = shift;
  my $sql = "";
  my $case = 0;
  my $sth = undef;
  if (scalar @_ == 1)
  {
    $self->{dbh}->{FetchHashKeyName} = 'NAME_lc';
    $sql = shift;
    $sth = $self->read($sql);
  }
  else
  {
    my %args = ( plug => [], substitute => [], case => 0, @_ );
    my $case = $args{case};
    $self->{dbh}->{FetchHashKeyName} = ($case == 1 ? 'NAME' : 'NAME_lc');
    $sth = $self->read(%args);
  }

  my @data = ();

  if ($self->error)
  {
    $self->prefixError();
    return @data;
  }

  # get the column NAMES
  push @data, $sth->{($case == 1 ? 'NAME' : 'NAME_lc')};

  while (my $row = $sth->fetchrow_hashref || ($self->{dbType} eq "Sybase" && $sth->{syb_more_results}))
  {
    if (defined $row && ref($row) eq "HASH" && scalar keys %{$row} > 0)
    {
      my %row = %{$row};
      push @data, \%row;
    }
  }

  $sth->finish;

  return @data;
}

=item scalar readXML(sql, plug, substitute, columns, displayNULLAs,
ignoreTags, sequence, displaySQL)

 requires: sql
 optional: plug, substitute, columns = 0, displayNULLAs, ignoreTags,
           sequence, displaySQL = 1
 returns:  valid XML document describing the data selected from the
  database.  Uses getDataHashHeader() to actually validate the data and
  execute the SELECT statement.  The resulting XML document
  will either have an error condition set (if read() signaled
  an error occured) or will be the result of traversing the
  data returned from getDataHashHeader().

  If displaySQL = 0, then we do not output the <select />
  tag in the xml, thus allowing you to send the xml to a web browser
  without potentially giving out sensitive information.

  Any undefined values (NULL) will be output using the displayNULLAs
  variable which defaults to 'NULL'.

  All values are run through the formEncodeString() method to
  make sure that any html/xml tags are properly encoded.  If you
  do not want certain tags encoded, use the ignoreTags and/or
  sequence arguments to affect how the formEncodeString() method
  fixes up the value.  See the formEncodeString() documentation for
  more details.

  If columns = 0, then all info will be returned in the <row>
  tag as attributes where the column name = column value.
  Ex.  <row name="test" value="testing" other="something else"/>
  When the column names were name, value and other.

  If columns = 1, then all info will be returned in <column>
  tags which are children of the <row> tag.  A column tag has
  attributes name and value.  name = column name and value =
  column value.
  Ex.
  <row>
    <column name="name" value="test"/>
    <column name="value" value="testing"/>
  </row>

  If columns = 2, then each row has tags defined named after the
  column with the contents being the value.  They are output in the
  order that the database returned them in.  The column value is not
  encoded, but is wrapped in <![CDATA[ ]]> tags so that any html/xml
  tags are safely ignored without having to be encoded.
  Ex:
  <row>
    <name><![CDATA[test]]></name>
    <value><![CDATA[testing]]></value>
  </row>

  Where there were 2 columns returned with names of name and value, in
  that order.

  The XML format is as follows:
  <?xml version="1.0" encoding="ISO-8859-1"?>
  <resultset version="1.2">
    <select sql="" plug=""/>
    <status result="" error=""/>
    <rows numRows="" columns="0|1|2">
      <row/>
    </rows>
  </resultset>

  If the XML document is an error document, then:
  <status result="Error" error="Error message"/>
  else
  <status result="Ok" error=""/>

  In <select> tag, sql = The sql SELECT string, plug = the
  string made when joining all the plug array entries
  together and comma seperating them.  The entries are
  single quoted.  Ex. plug="''" would represent no plug
  entries used.  plug="'x', 'y'" would mean that 2 entries
  were passed in: x, y.

  In <rows> numRows will be equal to the number of rows
  being returned or 0 if an error had occured.

  The <row> tag will depend on the value of columns.

=cut
sub readXML
{
  my $self = shift;
  my $sql = "";
  my @plug = ();
  my $plug = "";
  my $columns = 0;
  my $displayNULLAs = 'NULL';
  my $ignoreTags = "";
  my $sequence = "";
  my $displaySQL = 1;
  my $sth = undef;
  my @data = ();
  if (scalar @_ == 1)
  {
    $sql = shift;
    @data = $self->getDataHashHeader($sql);
  }
  else
  {
    my %args = ( plug => [], substitute => [], columns => 0, displayNULLAs => 'NULL', displaySQL => 1, @_ );
    @plug = @{$args{plug}};
    $plug = "'" . join("', '", @plug) . "'";
    $sql = $args{sql};
    $columns = $args{columns};
    $displayNULLAs = $args{displayNULLAs};
    $ignoreTags = $args{ignoreTags};
    $sequence = $args{sequence};
    $displaySQL = $args{displaySQL};
    @data = $self->getDataHashHeader(%args);
  }
  my $xmlDoc = "";

  my $resultSetVersion = "1.2";  # Update whenever the xml format changes.

  # make sure we don't have any invalid XML characters in the sql or plug strings.
  $sql = $self->formEncodeString(string => $sql, ignoreTags => $ignoreTags, sequence => $sequence);
  $plug = $self->formEncodeString(string => $plug, ignoreTags => $ignoreTags, sequence => $sequence);

  if ($self->error)
  {
    $self->prefixError();
    $self->{error} = 0;  # turn off the error message as the XML file will convey it.
    my $errorString = $self->formEncodeString(string => $self->errorString, ignoreTags => $ignoreTags, sequence => $sequence);

    $xmlDoc = <<"END_OF_CODE";
<?xml version="1.0" encoding="ISO-8859-1"?>
<resultset version="$resultSetVersion">
END_OF_CODE
    $xmlDoc .= qq(  <select sql="$sql" plug="$plug"/>\n) if $displaySQL;
    $xmlDoc .= <<"END_OF_CODE";
  <status result="Error" error="$errorString"/>
  <rows numRows="0" columns="$columns"/>
</resultset>
END_OF_CODE
  }
  else
  { # now process the result set returned and generate the XML document.
    $xmlDoc = <<"END_OF_CODE";
<?xml version="1.0" encoding="ISO-8859-1"?>
<resultset version="$resultSetVersion">
END_OF_CODE
    $xmlDoc .= qq(  <select sql="$sql" plug="$plug"/>\n) if $displaySQL;
    $xmlDoc .= <<"END_OF_CODE";
  <status result="Ok" error=""/>
  <rows numRows="#NUMROWS#" columns="$columns">
END_OF_CODE
    my $names = $data[0];  # get the list of column names returned.

    # fixup the names to make sure they don't have any invalid XML characters in them.
    my %encodedNames = ();
    foreach my $name (@{$names})
    {
      $encodedNames{$name} = $self->fixupAttributes(string => $name);
    }

    for(my $rowIndex = 1; $rowIndex < @data; $rowIndex++)
    {
      my $row = $data[$rowIndex];

      if ($columns)
      {
        # start the <row>
        $xmlDoc .= "    <row>\n";

        # now iterate over each entry in the row and create it's column tag.
        if (exists $row->{$names->[0]} && scalar @{$names} == keys %{$row})
        {  # they hopefully are the same row/header info.
          foreach my $name (@{$names})
          {
            my $data = $row->{$name};
            $data = $displayNULLAs if (not defined $data);  # set NULL entries to be NULL
            my $encodedData = $self->formEncodeString(string => $data, ignoreTags => $ignoreTags, sequence => $sequence);
            $encodedNames{$name} = $self->fixupAttributes(string => $name) if (!exists $encodedNames{$name});

            if ($columns == 1)
            {
              $xmlDoc .= "      <column name=\"$encodedNames{$name}\" value=\"$encodedData\"/>\n";
            }
            elsif ($columns == 2)
            {
              $xmlDoc .= "      <$encodedNames{$name}><![CDATA[$data]]></$encodedNames{$name}>\n";
            }
          }
        }
        else
        {
          foreach my $name (keys(%{$row}))
          {
            my $data = $row->{$name};
            $data = $displayNULLAs if (not defined $data);  # set NULL entries to be NULL
            my $encodedData = $self->formEncodeString(string => $data, ignoreTags => $ignoreTags, sequence => $sequence);
            $encodedNames{$name} = $self->fixupAttributes(string => $name) if (!exists $encodedNames{$name});

            if ($columns == 1)
            {
              $xmlDoc .= "      <column name=\"$encodedNames{$name}\" value=\"$encodedData\"/>\n";
            }
            elsif ($columns == 2)
            {
              $xmlDoc .= "      <$encodedNames{$name}><![CDATA[$data]]></$encodedNames{$name}>\n";
            }
          }
        }

        # end the <row>
        $xmlDoc .= "    </row>\n";
      }
      else
      {
        # start the <row>
        $xmlDoc .= "    <row";

        if (exists $row->{$names->[0]} && scalar @{$names} == keys %{$row})
        {  # they hopefully are the same row/header info.
          foreach my $name (@{$names})
          {
            my $data = $row->{$name};
            $data = $displayNULLAs if (not defined $data);  # set NULL entries to be NULL
            $data = $self->formEncodeString(string => $data, ignoreTags => $ignoreTags, sequence => $sequence);
            $encodedNames{$name} = $self->fixupAttributes(string => $name) if (!exists $encodedNames{$name});

            $xmlDoc .= " $encodedNames{$name}=\"$data\"";
          }
        }
        else
        {
          foreach my $name (keys %{$row})
          {
            my $data = $row->{$name};
            $data = $displayNULLAs if (not defined $data);  # set NULL entries to be NULL
            $data = $self->formEncodeString(string => $data, ignoreTags => $ignoreTags, sequence => $sequence);
            $encodedNames{$name} = $self->fixupAttributes(string => $name) if (!exists $encodedNames{$name});

            $xmlDoc .= " $encodedNames{$name}=\"$data\"";
          }
        }

        $xmlDoc .= "/>\n"; # end the <row>
      }
    }
    $xmlDoc .= <<"END_OF_CODE";
  </rows>
</resultset>
END_OF_CODE

    # now update the numRows value.
    my $numRows = (scalar(@data) - 1);
    $xmlDoc =~ s/#NUMROWS#/$numRows/;
  }

  return $xmlDoc;
}

=item scalar fixupAttributes(string)

Attempts to make sure that the given string can be a valid attribute in
an xml document.

Converts (, ), -, \, /, =, >, <, & to _
Deletes ', ", \n

=cut
sub fixupAttributes
{
  my $self = shift;
  my $string = "";
  if (scalar @_ == 1)
  {
    $string = shift;
  }
  else
  {
    my %args = ( string => "", @_ );
    $string = $args{string};
  }

  my @replace = ('&', '<', '>', '-', '\\(', '\\)', '\\\\', '/', '=');
  my @delete = ("'", '"', '\n');

  return $string if (length $string == 0);

  foreach my $entity (@replace)
  {
    $string =~ s/$entity/_/g;
  }

  foreach my $entity (@delete)
  {
    $string =~ s/$entity//g;
  }

  return $string;
}

=item scalar readHTML(sql, plug, substitute, tableClass, alternateRows,
displayNumRows, displayNULLAs, ignoreTags, sequence)

 requires: sql
 optional: plug, substitute, tableClass, alternateRows,
  displayNumRows, displayNULLAsk, ignoreTags, sequence
 returns:  valid HTML <table> describing the data selected from the
  database.  Uses getDataHashHeader() to actually validate the data and
  execute the SELECT statement.  The resulting HTML <table>
  will either have the error displayed (if read() signaled
  an error occured) or will be the result of traversing the
  data returned from getDataHashHeader().

  Any undefined values (NULL) will be output using the displayNULLAs
  variable which defaults to 'NULL'.

  All values are run through the formEncodeString() method to
  make sure that any html/xml tags are properly encoded.  If you
  do not want certain tags encoded, use the ignoreTags and/or
  sequence arguments to affect how the formEncodeString() method
  fixes up the value.  See the formEncodeString() documentation for
  more details.

 If an error occured, then the generated tr and td will have
 class="sqlError" assigned to them so you can change the way the
 sql Error row is displayed.  The error output will also be
 wrapped in a <span class="sqlError"></span> so you can change
 the display behaviour.

 tableClass defines the class to assign to this table so it knows
 how to display itself.  Defaults to "".  This allows you to have
 different readHTML generated tables on the same page and let them
 look different (border, width, cellspacing, cellpadding, etc.).

 alternateRows (boolean) lets the caller indicate they want to
 possibly have different row characteristics on every other row.
 Defaults to 1.

 displayNumRows (boolean) lets the caller indicate they want a <p>
 above the generated table that tells the user how many rows were
 returned.  Defaults to 1.  The generated paragraph has
 class="sqlNumRows" assigned to it so the caller can affect the
 characteristics of the output and the NumRows statement is wrapped
 in a <span class="sqlNumRows"></span>.

 The table header will be made up from the returned columns in the
 sql statement.  Each <th> will have the css class="column_name"
 defined so that the callers style can have th.column_name defined
 to dictate how the <th> is to be displayed.  The <tr> for the table
 header will have class="sqlHeader" assigned to it.

 Each <tr> will have class="sqlRow" assigned, unless alternateRows
 is enabled, which then causes the even rows to have class="sqlRow"
 and the odd rows to have class="sqlRow2" assigned. Each <td> will
 have the css class="column_name" defined so the callers style
 can have td.column_name defined to dictate how the <td> is to be
 displayed. The contents of the <td> entry will be wrapped in
 <span class="column_name"></span> to allow even more display
 control.

=cut
sub readHTML
{
  my $self = shift;
  my $sql = "";
  my @plug = ();
  my $plug = "";
  my $tableClass = "";
  my $alternateRows = 1;
  my $displayNumRows = 1;
  my $displayNULLAs = 'NULL';
  my $ignoreTags = "";
  my $sequence = "";
  my $sth = undef;
  my @data = ();
  if (scalar @_ == 1)
  {
    $sql = shift;
    @data = $self->getDataHashHeader($sql);
  }
  else
  {
    my %args = ( plug => [], substitute => [], tableClass => "", alternateRows => 1, displayNumRows => 1, displayNULLAs => 'NULL', @_ );
    @plug = @{$args{plug}};
    $plug = "'" . join("', '", @plug) . "'";
    $sql = $args{sql};
    $tableClass = $args{tableClass};
    $alternateRows = $args{alternateRows};
    $displayNumRows = $args{displayNumRows};
    $displayNULLAs = $args{displayNULLAs};
    $ignoreTags = $args{ignoreTags};
    $sequence = $args{sequence};
    @data = $self->getDataHashHeader(%args);
  }
  my $html = "";

  # make sure the defaults are sane.  The error handling will drop through and be caught so we output the table, etc.
  if ($alternateRows !~ /^(0|1)$/)
  {
    $self->error("alternateRows = '$alternateRows' is invalid!");
  }
  if ($displayNumRows !~ /^(0|1)$/)
  {
    $self->error("displayNumRows = '$displayNumRows' is invalid!");
  }

  if ($self->error)
  {
    $self->prefixError();
    $self->{error} = 0;  # turn off the error message as the HTML Table will convey it.
    my $errorString = $self->errorMessage;

    if ($displayNumRows)
    {
      $html .= <<"END_OF_CODE";
<p class="sqlNumRows"><span class="sqlNumRows"><b>0</b> rows returned.</span></p>
END_OF_CODE
    }
    $html .= <<"END_OF_CODE";
<table class="$tableClass">
  <tr class="sqlError">
    <td class="sqlError"><span class="sqlError">$errorString</span></td>
  </tr>
</table>
END_OF_CODE
  }
  else
  { # now process the result set returned and generate the HTML Table.
    if ($displayNumRows)
    {
      $html .= <<"END_OF_CODE";
<p class="sqlNumRows"><span class="sqlNumRows"><b>#NUMROWS#</b> rows returned.</span></p>
END_OF_CODE
    }
    $html .= "<table class=\"$tableClass\">\n";
    my $names = $data[0];  # get list of the names of the columns returned. (Lowercased)

    # display the headers
    $html .= "  <tr class=\"sqlHeader\">\n";
    my %encodedNames = ();
    foreach my $name (@{$names})
    {
      $encodedNames{$name} = $self->fixupAttributes(string => $name);
      $html .= "    <th class=\"$encodedNames{$name}\">$name</th>\n";
    }
    $html .= "  </tr>\n";

    my $counter = 0;
    for (my $rowIndex = 1; $rowIndex < @data; $rowIndex++)
    {
      my $row = $data[$rowIndex];

      my $class = ($alternateRows ? ($counter % 2 == 0 ? "sqlRows" : "sqlRows2") : "sqlRows");
      $html .= "  <tr class=\"$class\">\n";
      # now iterate over each entry in the row and create it's column tag.
      if (exists $row->{$names->[0]} && scalar @{$names} == keys %{$row})
      {  # they hopefully are the same row/header info.
        foreach my $name (@{$names})
        {
          my $data = $row->{$name};
          $data = $displayNULLAs if (not defined $data);  # set NULL entries to be NULL
          $data = $self->formEncodeString(string => $data, ignoreTags => $ignoreTags, sequence => $sequence);
          $encodedNames{$name} = $self->fixupAttributes(string => $name) if (!exists $encodedNames{$name});

          $html .= "    <td class=\"" . $encodedNames{$name} . "\"><span class=\"" . $encodedNames{$name} . "\">$data</span></td>\n";
        }
      }
      else
      {
        foreach my $name (keys(%{$row}))
        {
          my $data = $row->{$name};
          $data = $displayNULLAs if (not defined $data);  # set NULL entries to be NULL
          $data = $self->formEncodeString(string => $data, ignoreTags => $ignoreTags, sequence => $sequence);
          $encodedNames{$name} = $self->fixupAttributes(string => $name) if (!exists $encodedNames{$name});

          $html .= "    <td class=\"" . $encodedNames{$name} . "\"><span class=\"" . $encodedNames{$name} . "\">$data</span></td>\n";
        }
      }

      # end the <row>
      $html .= "  </tr>\n";
      $counter++;
    }
    $html .= "</table>\n";

    # now update the numRows value.
    my $numRows = (scalar(@data) - 1);
    $html =~ s/#NUMROWS#/$numRows/;
  }

  return $html;
}

=item int write(sql => "", plug => [], substitute => [])

 (This function should be called for any sql statement other than
 SELECT).
 executes the specified sql statement passing in any values in plug
 to the execute method after doing any substitutions that are in
 substitute.

 Returns the number of rows affected.

 If the sql to execute is an INSERT statement, then the oid or
 insertid (Postgresql or MySQL) values will be stored in the
 oid value in this object, for later access by getID().

=cut
sub write
{
  my $self = shift;
  my $sql = "";
  my @plug = ();
  my @substitute = ();
  if (scalar @_ == 1)
  {
    $sql = shift;
  }
  else
  {
    my %args = ( plug => [], substitute => [], @_ );
    @plug = @{$args{'plug'}};
    @substitute = @{$args{'substitute'}};
    $sql = $args{'sql'};
  }

  # validate we got a sql statement to work with.
  if (length $sql == 0)
  {
    $self->error(errorString => "SQL string not passed in!" . "<br />\n" . $self->debugMessage);

    return 0;
  }

  # check and see if we need to do any substitutions.
  if (scalar @substitute > 0)
  {
    for (my $i=0; $i < scalar @substitute; $i++)
    {
      my $temp_string = "\\#\\#\\?" . ($i+1) . "\\#\\#";
      $sql =~ s/$temp_string/$substitute[$i]/g;
    }
  }

  # now prepare the statement
  my $sth;
  eval {
    $sth = $self->{dbh}->prepare($sql);
  };
  if ($@)
  {
    $self->error(errorString => "Eval of prepare failed!<br />\nError = '$@'.<br />\nsql='$sql'.<br />\nplug='" . join("', '", @plug) . "'.<br />\n" . $self->debugMessage);

    return 0;
  }
  elsif (!$sth || $DBI::err)
  {
    $self->error(errorString => "Preparing failed!<br />\n" . $DBI::errstr . "<br />\nsql='$sql'.<br />\nplug='" . join("', '", @plug) . "'.<br />\n" . $self->debugMessage);

    return 0;
  }

  # now execute the sql statement passing in any parameters given via plug
  my $rv;
  eval {
    $rv = $sth->execute(@plug);
  };
  if ($@)
  {
    $self->error(errorString => "Eval of execute failed!<br />\nError = '$@'.<br />\nsql='$sql'.<br />\nplug='" . join("', '", @plug) . "'.<br />\n" . $self->debugMessage);

    return 0;
  }
  elsif (!$rv || $DBI::err)
  {
    $self->error(errorString => "Execute failed!<br />\n" . $DBI::errstr . "<br />\nsql='$sql'.<br />\nplug='" . join("', '", @plug) . "'.<br />\n" . $self->debugMessage);

    return 0;
  }

  # store the oid in the object, if this was an INSERT statement.
  if ($sql =~ /^INSERT/i)
  {
    if ($self->{dbType} eq "Pg")
    {
      $self->{oid} = $sth->{pg_oid_status};
    }
    elsif ($self->{dbType} eq "mysql")
    {
      $self->{oid} = $sth->{mysql_insertid};
    }
    elsif ($self->{dbType} eq "Sybase")
    {
      # kill the $sth so this hopefully works properly.
      $sth = undef;
      $self->{oid} = $self->{dbh}->last_insert_id();
    }
  }
  else
  {
    $self->{oid} = 0;
  }

  return $rv;
}

=item scalar getID("table.column")

This method will attempt to return the ID value of the just
INSERTed statement as implemented by MySQL, Sybase and PostgreSQL.
This is assuming that you just used the write() method and
that is was able to update the oid value.

This method requires a string value specifying the table.column that
is the ID field for the INSERT statement that just executed, if you
are using a PostgreSQL backend.

If using MySQL, you do not need to specify the table.column value,
but your table must have an AUTO_INCREMENT field defined.

If using Sybase, you do not need to specify the table.column value,
but you may not get a valid ID back if you used ? substitution or
the INSERT was in a stored procedure.  See the DBD::Sybase man-page
for more information.

If the database type is unsupported or an error happened, a value
of 0 will be returned.

=cut
sub getID
{
  my $self = shift;
  my $arg = shift;
  my $id = 0;

  if ($self->{dbType} eq "Pg")
  {
    my $oid = $self->{oid};
    # now I have to split the table.column apart and then do the lookup.
    if ($arg !~ /^(\w+\.\w+)$/)
    {
      $self->error("table.column = '$arg' is invalid!");
      return 0;
    }
    my ($table, $column) = split /\./, $arg;
    my $sth = $self->read(sql => "SELECT $column FROM $table WHERE oid = ?", plug => [ $oid ]);
    if ($self->error)
    {
      $self->prefixError();
      return 0;
    }
    my @result = $sth->fetchrow_array();
    if (defined $result[0])
    {
      $id = $result[0];
    }
  }
  elsif ($self->{dbType} =~ /^mysql|Sybase$/)
  {
    $id = $self->{oid};
  }

  return $id;
}

# This routine checks to see if the mysql database (currently connected) supports transactions
# and sets the transaction type variable.
sub mysqlHasTransactions
{
  my $self = shift;
  return 0 if (!defined $self->{dbh});

  return 1 if ($self->{dbType} ne "mysql");  # make sure we are working with a MySQL database.
  my $sth = $self->{dbh}->prepare("SHOW VARIABLES");
  my $rv;
  eval { $rv = $sth->execute(); };
  if ($@ || $DBI::err)
  {
    $self->error(errorString => "Execute failed!<br />\n" . $DBI::errstr . "<br />\n" . $self->debugMessage);
    return 0;
  }
  while (my $row = $sth->fetchrow_hashref())
  {
    if ($row->{Variable_name} eq 'have_bdb' && $row->{Value} eq 'YES')
    {
      $self->{transactionType} = "bdb";
      last;
    }
    if ($row->{Variable_name} eq 'have_innobase' && $row->{Value} eq 'YES')
    {
      $self->{transactionType} = "innobase";
      last;
    }
    if ($row->{Variable_name} eq 'have_gemini' && $row->{Value} eq 'YES')
    {
      $self->{transactionType} = "gemini";
      last;
    }
  }
  return $self->{transactionType};
}

=item string debugMessage()

 Returns the string that contains all the info that is to be logged
 at the current logLevel level.  If logLevel is not 0, 1, 2 or 3
 then a default of 3 is used.

=cut
sub debugMessage
{
  my $self = shift;
  my $logLevel = $self->{logLevel};
  my $result = "";
  $logLevel = 3 if ($logLevel !~ /^(0|1|2|3)$/);

  return $result if ($logLevel == 0);  # jump out now since they don't want any debug info displayed.

  # output the stuff that will always be done (level = 1)
  $result .= "dbType = '$self->{dbType}', dbHost = '$self->{dbHost}', dbName = '$self->{dbName}', printError = '$self->{printError}', raiseError = '$self->{raiseError}'";
  $result .= ", autoCommit = '$self->{autoCommit}', setDateStyle = '$self->{setDateStyle}', supportsTransactions = '$self->{supportsTransactions}', transactionType = '$self->{transactionType}'";
  $result .= ", server = '$self->{server}', interfaces = '$self->{interfaces}'";

  # output level 2 stuff
  if ($logLevel >= 2)
  {
    $result .= ", dbUser = '$self->{dbUser}', dbPort = '$self->{dbPort}', predefinedDSN = '$self->{predefinedDSN}'";
  }

  # output level 3 stuff
  if ($logLevel == 3)
  {
    $result .= ", dbPasswd = '$self->{dbPasswd}'";
  }

  $result .= "<br />\n";  # tack on the newline ending

  return $result;
}

=item int getLogLevel()

 returns the current logLevel value.

=cut
sub getLogLevel
{
  my $self = shift;

  return $self->{logLevel};
}

=item int setLogLevel(logLevel => 1)

 sets the logLevel value.  If the value is not specified then it
 defaults to logLevel 1.

 Returns 1 on Success, 0 on Error.

 We validate that the logLevel is 1, 2 or 3.

=cut
sub setLogLevel
{
  my $self = shift;
  my $logLevel = 1;
  if (scalar @_ == 1)
  {
    $logLevel = shift;
  }
  else
  {
    my %args = ( logLevel => 1, @_ );
    $logLevel = $args{logLevel};
  }

  if ($logLevel !~ /^(0|1|2|3)$/)
  {
    $self->error(errorString => "logLevel = '$logLevel' is invalid!<br />\n" . $self->debugMessage);
    return 0;
  }

  $self->{logLevel} = $logLevel;
  return 1;
}

=item string boolToDBI(string)

 Takes the string and returns a 1 for 1|t|true,
 returns a 0 for anything else.

 This method basically will output a true or false
 value that any database should recognize based upon
 the input string.

=cut
sub boolToDBI
{
  my $self = shift;
  my $string = "";
  if (scalar @_ == 1)
  {
    $string = shift;
  }
  else
  {
    my %args = ( string => "", @_ );
    $string = $args{string};
  }

  if ($string =~ /^(1|t|true)$/i)
  {
    return 1;
  }
  # must be false!
  return 0;
}

=item string dbiToBool(string)

 Takes the 1 or 0 from the DBI and returns
 true or false.

=cut
sub dbiToBool
{
  my $self = shift;
  my $string = "";
  if (scalar @_ == 1)
  {
    $string = shift;
  }
  else
  {
    my %args = ( string => "", @_ );
    $string = $args{string};
  }

  if ($string =~ /^(1)$/i)
  {
    return "true";
  }
  # must be false!
  return "false";
}

=item scalar formEncodeString(string, ignoreTags, sequence)

=item scalar formEncodeString(scalar)

 In scalar mode, takes the incoming string and encodes it to
 escape all <, > values as &lt;, &gt; unless they are \ escaped.

 To have the \ showup, you will have to do a \\ when defining this
 in perl, otherwise perl interprets the \whatever internally.

 In non-scalar mode, you specify the arguments by name.

 optional:
   string - string to encode all &, <, > characters to their html
     equivalents of &amp;, &lt;, &gt;.
   ignoreTags - string of pipe (|) seperated tag names that should not
     be encoded.  Ex:  ignoreTags => "b|i|u|span" would ignore all
     <b>, </b>, <i>, </i>, <u>, </u>, <span>, </span> tags that were
     not \ escaped.
   sequence - a named set of ignoreTags values that you want used.
     If both sequence and ignoreTags are specified, the ignoreTags
     value is used.  If you want to apply multiple sequences, specify
     them in a comma delimited format.
     Ex: sequence => 'formatting,seperator'

     available sequences are:
       formatting - "b|i|u|span|sub|sup|big|code|font|h1|h2|h3|h4|h5|h6|pre|small|strike|strong"
       block - "p|div|form"
       tables - "table|tr|td|th|tbody|tfoot|thead"
       seperator - "br|hr"
       formItems - "input|textarea|select|option"
       grouping - "ol|ul|li"

 returns: form encoded string ignoring those entries defined in
   ignoreTags or sequence and where the &, <, > was not \ escaped.

   Any &, <, > that were \ escaped will have the \ removed on output.

=cut
sub formEncodeString
{
  my $string;
  my $ignoreTags;
  my $sequence;
  my %sequences = (
       "formatting" => "b|i|u|span|sub|sup|big|code|font|h1|h2|h3|h4|h5|h6|pre|small|strike|strong",
       "block" => "p|div|form",
       "tables" => "table|tr|td|th|tbody|tfoot|thead",
       "seperator" => "br|hr",
       "formItems" => "input|textarea|select|option",
       "grouping" => "ol|ul|li",
       );

  if (scalar @_ == 1)  # handle being called as function
  {
    $string = shift;
  }
  else # handle being called as method
  {
    my $self = shift;
    if (scalar @_ == 1)
    {
      $string = shift;
    }
    else
    {
      my %args = ( string => "", ignoreTags => "", sequence => "", @_ );
      $string = $args{string};
      $ignoreTags = (length $args{ignoreTags} > 0 ? $args{ignoreTags} : undef);
      $sequence = (length $args{sequence} > 0 ? $args{sequence} : undef);

      if (!defined $ignoreTags && defined $sequence)
      {
        my @sequences = split /,/, $sequence;
        foreach my $sequence (@sequences)
        {
          $ignoreTags .= "|" if (length $ignoreTags);  # make sure multiple sequences are | seperated for the regular expression.
          $ignoreTags .= $sequences{$sequence};
          if (!exists $sequences{$sequence})
          {
            $self->setError(code => "1017");
            $self->displayError(message => "sequence = '$sequence' does not exist!");
          }
        }
      }
    }
  }

  if (length $string > 0)
  {
    # handle the special cases first.
    foreach my $char (qw/&/)
    {
      $string =~ s/(?<!\\)[$char]/$formUnEncodedCharactersHash{$char}/emg;
      # now remove the \ from any chars that were escaped.
      $string =~ s/(\\([$char]))/$2/mg;
    }
    # now handle the rest.
    if (defined $ignoreTags)
    {
      # handle the < case where we encode < if it is not \ escaped and also not one of the ignoreTags values.
      $string =~ s/(?<!\\)(<)(?!(\/)?($ignoreTags)(\s+[^>]+)?(\/)?>)/$formUnEncodedCharactersHash{$1}/emg;

      # handle the > case where we encode > if it is not \ escaped and does not have one of the ignoreTags before it.
      # escape the > tag when it is part of an ignoreTag entry.
      $string =~ s/(<(\/)?($ignoreTags)(\s+[^>]+)?(\/)?)(>)/$1\\$6/mg;
      # convert all non-escaped >'s.
      $string =~ s/(?<!\\)(>)/$formUnEncodedCharactersHash{$1}/emg;

      # now remove the \ from any chars that were escaped.
      $string =~ s/(\\([$formUnEncodedCharacters]))/$2/mg;
    }
    else
    {
      $string =~ s/(?<!\\)([$formUnEncodedCharacters])/$formUnEncodedCharactersHash{$1}/emg;
      # now remove the \ from any chars that were escaped.
      $string =~ s/(\\([$formUnEncodedCharacters]))/$2/mg;
    }
    # now fixup \n to \\n, as long as it is not already \ escaped.
    $string =~ s/(?<!\\)(\n)/\\n/mg;
  }

  return $string;
}

sub AUTOLOAD  # Read only access to data objects.
{
  my $self = shift;
  my $type = ref($self) || die "$self is not an object";
  my $name = $AUTOLOAD;
  $name =~ s/.*://; # strip fully-qualified portion
  unless (exists $self->{$name})
  {
    die "Can't access `$name' field in object of class $type";
  }
  return $self->{$name};
}

sub DESTROY
{
  my $self = shift;

  if (ref $self->{dbh} eq "DBI::db")
  {
    $self->close;
    if ($self->error)
    {
      die "DBIWrapper->DESTROY: " . $self->errorMessage;
    }
  }
}

=item bool sybaseErrorHandler()

returns 0 if the "error" is an informational error from sybase that we
can safely ignore.  Currently ignores the Text conversion errors that
are causing the connect to fail.

returns 1 for all other errors to cause DBI to process them.

=cut
sub sybaseErrorHandler
{
  my ($err, $sev, $state, $line, $server, $proc, $msg, $sql, $errType) = @_;

  # ignore the "errors" that are informational.
  if (($err == 2401 && $sev == 11 && $state == 2)
   || ($err == 2411 && $sev == 10 && $state == 1))
  {
    return 0;
  }
  return 1;
}

=back

=cut

1;
__END__

=head1 NOTE:

 All data fields are accessible by specifying the object and
 variable as follows:
 Ex.  $value = $obj->variable;

 Any methods where it is possible to specify just a single
 argument and still have it be valid, you can now specify
 the argument without having to name it first.

 Ex:  calling read() without using the substitute or plug
 options can be done as $dbi->read("SELECT * from test");

 Methods updated to support this:
 setError, read, readXML, write, setLogLevel

=head1 AUTHOR

James A. Pattie, james at pcxperience dot com

=head1 SEE ALSO

perl(1), DBI(3), DBIWrapper::XMLParser(3), DBIWrapper::ResultSet(3)

=cut