Parent Directory
| 
Revision Log
Revision 1.21 - (view) (download) (as text)
| 1 : | efrank | 1.1 | package DBrtns; |
| 2 : | |||
| 3 : | parrello | 1.18 | # Inherit the DBKernel methods. We must do this BEFORE the "use strict". |
| 4 : | use DBKernel; | ||
| 5 : | @ISA = qw(DBKernel); | ||
| 6 : | |||
| 7 : | efrank | 1.1 | use strict; |
| 8 : | olson | 1.5 | use POSIX; |
| 9 : | efrank | 1.1 | use DBI; |
| 10 : | use FIG_Config; | ||
| 11 : | |||
| 12 : | use Data::Dumper; | ||
| 13 : | overbeek | 1.2 | use Carp; |
| 14 : | |||
| 15 : | sub new { | ||
| 16 : | olson | 1.19 | my($class,$dbms,$dbname,$dbuser,$dbpass,$dbport, $dbhost) = @_; |
| 17 : | efrank | 1.1 | |
| 18 : | $dbms = defined($dbms) ? $dbms : $FIG_Config::dbms; | ||
| 19 : | $dbname = defined($dbname) ? $dbname : $FIG_Config::db; | ||
| 20 : | $dbuser = defined($dbuser) ? $dbuser : $FIG_Config::dbuser; | ||
| 21 : | $dbpass = defined($dbpass) ? $dbpass : $FIG_Config::dbpass; | ||
| 22 : | $dbport = defined($dbport) ? $dbport : $FIG_Config::dbport; | ||
| 23 : | olson | 1.19 | $dbhost = defined($dbhost) ? $dbhost : $FIG_Config::dbhost; |
| 24 : | efrank | 1.1 | |
| 25 : | olson | 1.19 | return DBKernel::new($class, $dbms, $dbname, $dbuser, $dbpass, $dbport, $dbhost); |
| 26 : | efrank | 1.1 | } |
| 27 : | |||
| 28 : | olson | 1.11 | =head1 get_inserted_id |
| 29 : | |||
| 30 : | Return the last ID of a row inserted into an autonumber/serial-containing table. | ||
| 31 : | |||
| 32 : | =cut | ||
| 33 : | |||
| 34 : | parrello | 1.18 | sub get_inserted_id { |
| 35 : | olson | 1.11 | my($self, $table, $sth) = @_; |
| 36 : | parrello | 1.18 | if ($self->{_dbms} eq "Pg") { |
| 37 : | my $oid = $sth->{pg_oid_status}; | ||
| 38 : | my $ret = $self->SQL("select id from $table where oid = ?", undef, $oid); | ||
| 39 : | return $ret->[0]->[0]; | ||
| 40 : | } elsif ($self->{_dbms} eq "mysql") { | ||
| 41 : | my $id = $self->{_dbh}->{mysql_insertid}; | ||
| 42 : | # print "mysql got $id\n"; | ||
| 43 : | return $id; | ||
| 44 : | olson | 1.11 | } |
| 45 : | } | ||
| 46 : | |||
| 47 : | olson | 1.5 | # |
| 48 : | # Following are database administration routines. They create an instance of a ServerAdmin class | ||
| 49 : | # for the appropriate server type (in order to eliminate the if mysql / if pg / etc stuff). | ||
| 50 : | # | ||
| 51 : | |||
| 52 : | sub get_server_admin | ||
| 53 : | { | ||
| 54 : | if ($FIG_Config::dbms eq "mysql") | ||
| 55 : | { | ||
| 56 : | return MysqlAdmin->new(); | ||
| 57 : | } | ||
| 58 : | elsif ($FIG_Config::dbms eq "Pg") | ||
| 59 : | { | ||
| 60 : | return new PostgresAdmin(); | ||
| 61 : | } | ||
| 62 : | else | ||
| 63 : | { | ||
| 64 : | warn "Unknown server type $FIG_Config::dbms\n"; | ||
| 65 : | return undef; | ||
| 66 : | } | ||
| 67 : | } | ||
| 68 : | package MysqlAdmin; | ||
| 69 : | |||
| 70 : | use POSIX; | ||
| 71 : | use DBI; | ||
| 72 : | |||
| 73 : | sub new | ||
| 74 : | { | ||
| 75 : | my($class) = @_; | ||
| 76 : | |||
| 77 : | my $self = {}; | ||
| 78 : | |||
| 79 : | return bless($self, $class); | ||
| 80 : | } | ||
| 81 : | |||
| 82 : | sub init_db | ||
| 83 : | { | ||
| 84 : | my($self, $db_dir) = @_; | ||
| 85 : | |||
| 86 : | if (!$db_dir) | ||
| 87 : | { | ||
| 88 : | warn "init_db failed: db_dir must be provided\n"; | ||
| 89 : | return; | ||
| 90 : | } | ||
| 91 : | |||
| 92 : | if (-d "$db_dir/mysql") | ||
| 93 : | { | ||
| 94 : | warn "init_db: mysql data directory already exists\n"; | ||
| 95 : | return; | ||
| 96 : | } | ||
| 97 : | |||
| 98 : | my $exe = "$FIG_Config::ext_bin/mysql_install_db"; | ||
| 99 : | if (! -x $exe) | ||
| 100 : | { | ||
| 101 : | $exe = "mysql_install_db"; | ||
| 102 : | parrello | 1.18 | } |
| 103 : | olson | 1.5 | |
| 104 : | my $rc = system($exe, | ||
| 105 : | "--datadir=$db_dir", | ||
| 106 : | olson | 1.15 | "--basedir=$FIG_Config::common_runtime", |
| 107 : | olson | 1.5 | "--user=$FIG_Config::dbuser"); |
| 108 : | if ($rc != 0) | ||
| 109 : | { | ||
| 110 : | my $err = $?; | ||
| 111 : | if (WIFEXITED($err)) | ||
| 112 : | { | ||
| 113 : | my $exitstat = WEXITSTATUS($err); | ||
| 114 : | warn "init_db failed: $exe returned result code $exitstat\n"; | ||
| 115 : | } | ||
| 116 : | else | ||
| 117 : | { | ||
| 118 : | warn "init_db failed: $exe died with signal ", WTERMSIG($err), "\n"; | ||
| 119 : | } | ||
| 120 : | return; | ||
| 121 : | } | ||
| 122 : | |||
| 123 : | return 1; | ||
| 124 : | } | ||
| 125 : | |||
| 126 : | sub create_database | ||
| 127 : | { | ||
| 128 : | my($self, $db_name) = @_; | ||
| 129 : | |||
| 130 : | my $drh = DBI->install_driver("mysql"); | ||
| 131 : | |||
| 132 : | my @dbs = DBI->data_sources("mysql", { host => $FIG_Config::dbhost, | ||
| 133 : | user => $FIG_Config::dbuser, | ||
| 134 : | password => $FIG_Config::dbpass }); | ||
| 135 : | if (grep { $_ eq $db_name } @dbs) | ||
| 136 : | { | ||
| 137 : | warn "Database $db_name already exists\n"; | ||
| 138 : | return; | ||
| 139 : | } | ||
| 140 : | |||
| 141 : | my $rc = $drh->func('createdb', $db_name, $FIG_Config::dbhost, | ||
| 142 : | $FIG_Config::dbuser, $FIG_Config::dbpass, 'admin'); | ||
| 143 : | parrello | 1.18 | |
| 144 : | olson | 1.5 | |
| 145 : | if (!$rc) | ||
| 146 : | { | ||
| 147 : | warn "create_database: createdb call failed: $DBI::errstr\n"; | ||
| 148 : | return; | ||
| 149 : | } | ||
| 150 : | parrello | 1.18 | |
| 151 : | olson | 1.5 | return 1; |
| 152 : | } | ||
| 153 : | |||
| 154 : | sub start_server | ||
| 155 : | { | ||
| 156 : | olson | 1.16 | my($self, $dont_fork) = @_; |
| 157 : | olson | 1.5 | |
| 158 : | print "Starting mysql server\n"; | ||
| 159 : | |||
| 160 : | my(@opts); | ||
| 161 : | |||
| 162 : | push(@opts, "--port=$FIG_Config::dbport"); | ||
| 163 : | # | ||
| 164 : | # Don't do this; dbuser isn't the unix uid that we are using. | ||
| 165 : | # | ||
| 166 : | #push(@opts, "--user=$FIG_Config::dbuser"); | ||
| 167 : | push(@opts, "--basedir=$FIG_Config::common_runtime"); | ||
| 168 : | push(@opts, "--datadir=$FIG_Config::db_datadir"); | ||
| 169 : | push(@opts, "--ledir=$FIG_Config::common_runtime/libexec"); | ||
| 170 : | olson | 1.6 | push(@opts, "--old-password"); |
| 171 : | push(@opts, "--max-allowed-packet=128M"); | ||
| 172 : | olson | 1.5 | # |
| 173 : | olson | 1.21 | # Use InnoDB for large-table support and allegedly better performance. |
| 174 : | # | ||
| 175 : | |||
| 176 : | push(@opts, "--default-table-type=innodb"); | ||
| 177 : | |||
| 178 : | # | ||
| 179 : | olson | 1.5 | # Oddly, this doesn't seem to work. need to set the environment variable. |
| 180 : | # | ||
| 181 : | #push(@opts, "--port=$FIG_Config::dbport"); | ||
| 182 : | |||
| 183 : | olson | 1.15 | if (@FIG_Config::db_server_startup_options) |
| 184 : | { | ||
| 185 : | push(@opts, @FIG_Config::db_server_startup_options) | ||
| 186 : | } | ||
| 187 : | |||
| 188 : | olson | 1.5 | # |
| 189 : | # We are going to assume that if mysql has shipped with this release, we'll use it. Otherwise | ||
| 190 : | # try to use a system one. | ||
| 191 : | # | ||
| 192 : | |||
| 193 : | my $exe = "$FIG_Config::ext_bin/mysqld_safe"; | ||
| 194 : | olson | 1.21 | |
| 195 : | print "Start $exe @opts\n"; | ||
| 196 : | olson | 1.5 | if (! -x $exe) |
| 197 : | { | ||
| 198 : | $exe = "mysqld_safe"; | ||
| 199 : | } | ||
| 200 : | |||
| 201 : | olson | 1.16 | if ($dont_fork) |
| 202 : | olson | 1.5 | { |
| 203 : | $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport; | ||
| 204 : | exec $exe, @opts; | ||
| 205 : | } | ||
| 206 : | olson | 1.16 | else |
| 207 : | { | ||
| 208 : | my $pid = fork; | ||
| 209 : | |||
| 210 : | if ($pid == 0) | ||
| 211 : | { | ||
| 212 : | POSIX::setsid(); | ||
| 213 : | parrello | 1.18 | |
| 214 : | olson | 1.16 | $ENV{MYSQL_TCP_PORT} = $FIG_Config::dbport; |
| 215 : | exec $exe, @opts; | ||
| 216 : | } | ||
| 217 : | print "Forked db server $pid\n"; | ||
| 218 : | } | ||
| 219 : | olson | 1.5 | |
| 220 : | } | ||
| 221 : | |||
| 222 : | parrello | 1.18 | 1; |
| MCS Webmaster | ViewVC Help |
| Powered by ViewVC 1.0.3 |