Thomas Skyt <thomas@sofagang.dk> wrote in message news:<pan.2002.07.18.20.59.48.674172.6964@sofagang.dk>...
> Det virker ikke efter hensigten - min intention er at kunne sætte
> variabler fra perl-scriptet af, ikke at skulle sætte dem fra httpd.conf.
>
> Er der virkelig ikke nogen "simpel" løsning på det?
En populaer maade er at lave et lille modul der "wrapper"
DBI->connect. Jeg har posted en variant jeg ofte bruger nedenfor.
brug det som
use Develooper::DB qw(db_open);
my $dbh = db_open; # default databasen
my $dbh_foo = db_open('foo'); # foo databasen
- ask
package Develooper::DB;
use strict;
use DBI;
use Carp;
use Exporter;
use vars qw(@ISA @EXPORT);
@EXPORT = qw(db_open);
@ISA = qw(Exporter);
my %dbh = ();
sub read_db_connection_parameters {
# XXX could read from a file...
return ("localhost",
"dbi:mysql:database=perlweb;host=x1.develooper.com;user=perlweb;;mysql_read_default_file=/home/perlweb/.my.cnf",
"perlweb", "xxXXXxx");
}
sub db_open {
my ($db, $attr) = @_;
$db ||= 'perlweb';
$attr = {} unless ref $attr;
carp "$$ Develooper::DB:
en_db called during server startup" if
$Apache::Server::Starting;
my $lock = delete $attr->{lock};
my $lock_timeout = delete $attr->{lock_timeout};
my $lock_name = delete $attr->{lock_name};
# default to RaiseError=>1 but allow caller to override
my $RaiseError = $attr->{RaiseError};
$RaiseError = (defined $RaiseError) ? $RaiseError : 1;
my $dbh = $dbh{$db};
unless ($dbh and $dbh->ping()) {
my ($host, @args) = read_db_connection_parameters();
$dbh = DBI->connect(@args, {
%$attr,
RaiseError => 0, # override RaiseError for connect
AutoCommit => 1, # make it explicit
});
if ($dbh) {
$dbh->{RaiseError} = $RaiseError;
$dbh{$db} = $dbh;
}
else {
carp "Could not open $args[0] on $host: $DBI::errstr" if
$RaiseError;
# fall through if not RaiseError
}
}
if ($lock) {
$lock_timeout = 180 unless $lock_timeout;
$lock_name = $0 unless $lock_name;
my $lockok = $dbh && $dbh->do(qq[SELECT
GET_LOCK("$lock_name",$lock_timeout)]);
croak "Unable to get $lock_name lock for $0\n" unless $lockok;
}
# return handle; undef if connect failed and RaiseError is false
return $dbh;
}
END {
local ($!, $?);
while (my ($db, $handle) = each %dbh) {
$handle->disconnect() if $handle->{Active};
delete $dbh{$db};
}
}
1;
--
http://askbjoernhansen.com/