[Bio] / FigKernelPackages / DBrtns.pm Repository:
ViewVC logotype

View of /FigKernelPackages/DBrtns.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (download) (as text) (annotate)
Tue Jan 11 18:59:39 2005 UTC (15 years, 2 months ago) by olson
Branch: MAIN
Changes since 1.6: +9 -3 lines
I ran into a bug today where I was using by_alias to look up aliases
for the peg-mapping code, and one of the aliases was DR6', with a
single-quote. Because the code in by_alias doesn't quote its argument,
the SQL failed with a syntax error.

The perl DBI library has a mechanism designed to solve this
problem. If you use ? in a sql string where you want to substitute an
argument from code, DBI will do the appropriate quoting for you. I've
made this accessible via the SQL method in the DBrtns module, so the
by_alias code now looks like this:

    if (($relational_db_response = $rdbH->SQL("SELECT id FROM ext_alias WHERE ( alias = ? )", undef, $alias))

and works properly in the face of $alias having a single-quote in
it. I believe this mechanism is also more efficient. Note the second
argument of SQL is a verbose flag, which means that any bound
variables (to replace ?s in the query) have to start at the third
argument.

I've also made a change in the SQL method such that the query is done
inside an eval{} block, and if it fails, the error is reraised using
confess so that it is possible to see the full backtrace so you can
find in the source where the bad query was.

package DBrtns;

use strict;
use POSIX;
use DBI;
use FIG_Config;

use Data::Dumper;
use Carp;

sub new {
    my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport) = @_;

    $dbms   = defined($dbms)   ? $dbms   : $FIG_Config::dbms;
    $dbname = defined($dbname) ? $dbname : $FIG_Config::db;
    $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser;
    $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
    $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass;
    $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport;

    my @opts;

    push(@opts, "port=${dbport}");

    #
    # Late-model mysql needs to have the client enable loading from local files.
    #
    
    if ($dbms eq "mysql")
    {
	push(@opts, "mysql_local_infile=1");
    }

    my $opts = join(";", @opts);
    my $data_source = "DBI:$dbms(AutoCommit => 1):dbname=$dbname;$opts";    
    my $dbh         = DBI->connect( $data_source, $dbuser, $dbpass )
	|| die "ERROR: Could not connect to $data_source; ", DBI->errstr, "\n"; 
    $dbh->{PrintError} = 1;
    $dbh->{RaiseError} = 0;
    if ($dbms eq "Pg")
    {
        $dbh->do(qq(SET "ENABLE_SEQSCAN" TO "OFF"));
        $dbh->do(qq(SET DATESTYLE TO Postgres,US));
    }

    bless {
	_dbh => $dbh,
        _dbms => $dbms,
	}, $class;
}

sub set_raise_exceptions
{
    my($self, $enable) = @_;
    my $dbh = $self->{_dbh};
    my $old = $dbh->{RaiseError};
    $dbh->{RaiseError} = $enable;
    return $old;
}

sub SQL {
    my($self, $sql, $verbose, @bind_values) = @_;
    my($dbh,$sth,$rc,$tmp);

    if ($verbose)
    {
	print STDERR "running: $sql\n";
    }

    $dbh  = $self->{_dbh};
    
    if ($sql =~ /^select/i)
    {
	my $ok = eval {
	    $tmp = $dbh->selectall_arrayref($sql, undef, @bind_values);
	};
	if (!$ok)
	{
	    confess $@;
	}
	return $tmp;
    }
    else
    {
        return $dbh->do($sql, undef, @bind_values);
#	$sth = $dbh->prepare($sql)
#	    or die "prepare failed: $DBI::errstr";
#	$sth->execute()
#	    or warn "execute failed: $DBI::errstr";
#	return 1;
    }
    return undef;
}

sub get_tables
{
    my($self) = @_;

    my $dbh = $self->{_dbh};

    my $quote = $dbh->get_info(29); # SQL_IDENTIFIER_QUOTE_CHAR

    my @tables = $dbh->tables();

    return map { $quote ne "" && s/^$quote(.*)$quote$/$1/; s/^[^.]+\.//; $_ } @tables;
}

sub table_exists
{
    my($self, $table) = @_;

    return (grep { $table eq $_ } $self->get_tables()) > 0;
}

sub drop_table {
    my $self = shift @_;
    my %arg  = @_;
    my $tbl  = $arg{tbl};
    my $dbh  = $self->{_dbh};
    my $dbms = $self->{_dbms};
    my $cmd;

    
    if ($dbms eq "mysql")
    {
	$cmd = "DROP TABLE IF EXISTS $tbl;" ;
    }
    else
    {
	if ($self->table_exists($tbl))
	{
	    $cmd = "DROP TABLE $tbl;" ;
	}
    }
    if ($cmd)
    {
	$dbh->do($cmd);
    }
}

sub create_table {
    my $self = shift @_;
    my %arg  = @_;
    my $tbl  = $arg{tbl};
    my $flds = $arg{flds};
    my $dbh  = $self->{_dbh};
    my $dbms = $self->{_dbms};
    $dbh->do("CREATE TABLE $tbl ( $flds );");
}

sub load_table {
    my $self     = shift @_;
    my %defaults = ( delim => "\t" );
    my %arg      = (%defaults, @_);
    my $file     = $arg{file};
    my $tbl      = $arg{tbl};
    my $delim    = $arg{delim};
    my $dbh  = $self->{_dbh};
    my $dbms = $self->{_dbms};

    if ($file)
    {
        if ($dbms eq "mysql")
        {
            $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");
        }
        elsif ($dbms eq "Pg")
        {
            $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");
        }
    }
}

sub create_index {
    my $self = shift @_;
    my %arg  = @_;
    my $tbl  = $arg{tbl};
    my $idx  = $arg{idx};
    my $flds = $arg{flds};
    my $type = $arg{type};
    my $dbh  = $self->{_dbh};
    my $dbms = $self->{_dbms};
    my $cmd  = "CREATE INDEX $idx ON $tbl ";
    if ($type && $dbms eq "Pg")
    {
        $cmd .= " USING $type ";
    }
    $cmd .= " ( $flds );";
    $dbh->do($cmd);
}

sub DESTROY {
    my($self) = @_;

    my($dbh);
    if ($dbh = $self->{_dbh})
    {
	$dbh->disconnect;
    }
}

sub vacuum_it {
    my($self,@tables) = @_;
    my($table);

    my $dbh  = $self->{_dbh};
    my $dbms = $self->{_dbms};
    if ($dbms eq "mysql")
    {
        return;
    }

    # this chunk is for Pg  (Postgres)
    if (@tables == 0)
    {
	$self->SQL("VACUUM ANALYZE");
    }
    else
    {
	foreach $table (@tables)
	{
	    $self->SQL("VACUUM ANALYZE $table");
	}
    }
}

#
# Following are database administration routines. They create an instance of a ServerAdmin class
# for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff).
#

sub get_server_admin
{
    if ($FIG_Config::dbms eq "mysql")
    {
	return MysqlAdmin->new();
    }
    elsif ($FIG_Config::dbms eq "Pg")
    {
	return new PostgresAdmin();
    }
    else
    {
	warn "Unknown server type $FIG_Config::dbms\n";
	return undef;
    }
}
package MysqlAdmin;

use POSIX;
use DBI;

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

    my $self = {};

    return bless($self, $class);
}

sub init_db
{
    my($self, $db_dir) = @_;

    if (!$db_dir)
    {
	warn "init_db failed: db_dir must be provided\n";
	return;
    }

    if (-d "$db_dir/mysql")
    {
	warn "init_db: mysql data directory already exists\n";
	return;
    }

    my $exe = "$FIG_Config::ext_bin/mysql_install_db";
    if (! -x $exe)
    {
	$exe = "mysql_install_db";
    } 

    my $rc = system($exe,
		    "--datadir=$db_dir",
		    "--user=$FIG_Config::dbuser");
    if ($rc != 0)
    {
	my $err = $?;
	if (WIFEXITED($err))
	{
	    my $exitstat = WEXITSTATUS($err);
	    warn "init_db failed: $exe returned result code $exitstat\n";
	}
	else
	{
	    warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n";
	}
	return;
    }

    return 1;
}

sub create_database
{
    my($self, $db_name) = @_;

    my $drh = DBI->install_driver("mysql");

    my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost,
					       user => $FIG_Config::dbuser,
					       password => $FIG_Config::dbpass });
    if (grep { $_ eq $db_name } @dbs)
    {
	warn "Database $db_name already exists\n";
	return;
    }

    my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost,
			$FIG_Config::dbuser, $FIG_Config::dbpass, 'admin');
    

    if (!$rc)
    {
	warn "create_database: createdb call failed: $DBI::errstr\n";
	return;
    }
    
    return 1;
}

sub start_server
{
    my($self) = @_;

    print "Starting mysql server\n";

    my(@opts);

    push(@opts, "--port=$FIG_Config::dbport");
    #
    # Don't do this; dbuser isn't the unix uid that we are using.
    #
    #push(@opts, "--user=$FIG_Config::dbuser");
    push(@opts, "--basedir=$FIG_Config::common_runtime");
    push(@opts, "--datadir=$FIG_Config::db_datadir");
    push(@opts, "--ledir=$FIG_Config::common_runtime/libexec");
    push(@opts, "--old-password");
    push(@opts, "--max-allowed-packet=128M");
    #
    # Oddly, this doesn't seem to work. need to set the environment variable.
    #
    #push(@opts, "--port=$FIG_Config::dbport");

    #
    # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise
    # try to use a system one.
    #

    my $exe = "$FIG_Config::ext_bin/mysqld_safe";
    if (! -x $exe)
    {
	$exe = "mysqld_safe";
    }

    my $pid = fork;

    if ($pid == 0)
    {
	POSIX::setsid();

	$ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
	exec $exe, @opts;
    }

    print "Forked db server $pid\n";
}


1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3