View of /FigKernelPackages/DBrtns.pm

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;
    $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 =~ /^\s*select/i)
    {
	eval {
	    $tmp = $dbh->selectall_arrayref($sql, undef, @bind_values);
	};
	if (!$tmp or $@)
	{
	    confess "Try running 'load_links' and 'load_attributes' to fix this error:\n$@";
	    #print STDERR "DBrtns.pm error: SQL $sql failed\n";
	    #return;
	}
	return $tmp;
    }
    else
    {
	my $rc;
	my $ok = eval {
	    $rc = $dbh->do($sql, undef, @bind_values);
	};

	if (!$ok)
	{
	    confess "query failed: " . substr($sql, 0, 100) . ": $@";
	}
	return $rc;

	
#	$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;" ;
    }
    elsif ($dbms eq "Pg")
    {
	if ($self->table_exists($tbl))
	{
	    $cmd = "DROP TABLE $tbl CASCADE;" ;
	}
    }
    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};
    my $type;

    if ($arg{type}) 
    {
	$type = " engine = $arg{type} ";
    }

    eval {
	$dbh->do("CREATE TABLE $tbl ( $flds ) $type;");
    };
    if ($@)
    {
	confess "create table $tbl failed: $@";
    }
}

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};
    my $result;
    
    if ($file)
    {
        if ($dbms eq "mysql")
        {
            $result = $dbh->do("LOAD DATA LOCAL INFILE '$file' REPLACE INTO TABLE $tbl;");
        }
        elsif ($dbms eq "Pg")
        {
            $result = $dbh->do("COPY $tbl FROM '$file' USING DELIMITERS '$delim';");
        }
    }
    return $result;
}

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");
	}
    }
}

=pod

=head1 get_inserted_id

Return the last ID of a row inserted into an autonumber/serial-containing table.

=cut

sub get_inserted_id
{
    my($self, $table, $sth) = @_;
    if ($self->{_dbms} eq "Pg")
    {
	my $oid = $sth->{pg_oid_status};
	my $ret = $self->SQL("select id from $table where oid = ?", undef, $oid);
	return $ret->[0]->[0];
    }
    elsif ($self->{_dbms} eq "mysql")
    {
	my $id = $self->{_dbh}->{mysql_insertid};
	# print "mysql got $id\n";
	return $id;
    }
}

#
# 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",
		    "--basedir=$FIG_Config::common_runtime",
		    "--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, $dont_fork) = @_;

    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");

    if (@FIG_Config::db_server_startup_options)
    {
	push(@opts, @FIG_Config::db_server_startup_options)
    }

    #
    # 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";
    }

    if ($dont_fork)
    {
	$ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport;
	exec $exe, @opts;
    }
    else
    {
	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