Apache::Language::DBI - DBI interface for Apache::Language
Index
Code Index:
NAME
Apache::Language::DBI - DBI interface for Apache::Language
SYNOPSIS
<Location /under/language/control/>
PerlSetVar Language::DBI::Datasource DBI:Pg:dbname=database;host=database.host
PerlSetVar Language::DBI::Username webserver
PerlSetVar Language::DBI::Password unguessable
PerlSetVar Language::DBI::TableName language [default]
Language::DBI::TableKey key [column for the key]
Language::DBI::TableLang lang [column for the lang]
Language::DBI::TableValue value [column for the value]
LanguageHandler Apache::Language::DBI
</Location>
DESCRIPTION
This LanguageHandler implements a per-location DBI dictionnary. It looks-up a given
table for a matching language/key pair and returns the best possible match.
The configurable directives are pretty self-explanatory.
TODO
Some sort of caching could be done.
SEE ALSO
SUPPORT
Please send any questions or comments to the Apache modperl
mailing list <modperl@apache.org> or to me at <gozer@ectoplasm.dyndns.com>
NOTES
This code was made possible by :
- Doug MacEachern <dougm@pobox.com> Creator of mod_perl. That should mean enough.
- Andreas Koenig <koenig@kulturbox.de> The one I got the idea from in the first place.
- The mod_perl mailing-list at <modperl@apache.org> for all your mod_perl related problems.
AUTHOR
Philippe M. Chiasson <gozer@ectoplasm.dyndns.com>
COPYRIGHT
Copyright (c) 1999 Philippe M. Chiasson. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
package Apache::Language::DBI;
use Apache::Language::Constants;
use DBI;
use vars qw($VERSION);
$VERSION = '0.03';
sub modified {
my ($class, $data, $cfg) = @_;
return undef;
}
sub store {
my ($class, $data, $cfg, $key, $lang, $value) = @_;
my ($rv, $sth);
if (fetch($class, $data, $cfg, $key, $lang)){
$sth = $cfg->{dbh}->prepare("update ".$cfg->{tablename}." set $cfg->{value}=? where $cfg->{key}=? and $cfg->{lang}=?");
$rv = $sth->execute($value,$key,$lang);
}
else {
$sth = $cfg->{dbh}->prepare("insert into ".$cfg->{tablename}."($cfg->{value},$cfg->{key},$cfg->{lang}) values (?,?,?)");
$rv = $sth->execute($value,$key,$lang);
}
return L_OK if $rv;
}
sub fetch {
my ($class, $data, $cfg, $key, $variant) = @_;
my @language;
my $sth;
unless ($variant) {
$sth = $cfg->{dbh}->prepare("select $cfg->{lang} from ".$cfg->{tablename}." where $cfg->{key}=?") || return undef;
if ($sth->execute($key)){
while (my @row = $sth->fetchrow){
$row[0] =~ s/\s+//;
push @language, $row[0];
}
$variant = $data->best_lang(@language);
}
}
return undef unless $variant;
$sth = $cfg->{dbh}->prepare("select $cfg->{value} from ".$cfg->{tablename}." where $cfg->{key}=? and $cfg->{lang}=?") || return undef;
$sth->execute($key,$variant);
return $sth->fetchrow;
}
sub firstkey {
my ($class, $data, $cfg) = @_;
$cfg->{listh} = $cfg->{dbh}->prepare("select distinct $cfg->{key} from ".$cfg->{tablename}." order by $cfg->{key}") || return undef;
return undef unless $cfg->{listh}->execute;
return $cfg->{listh}->fetchrow;
}
sub nextkey {
my ($class, $data, $cfg, $key) = @_;
return $cfg->{listh}->fetchrow;
}
sub initialize {
my ($self, $data, $cfg) = @_;
my $r = $data->{Request};
my $dbhfunc = $r->dir_config("Language::DBI::GetDBFunc");
my $Datasource = $r->dir_config("Language::DBI::Datasource") || "DBI:Pg:dbname=apache;host=herge";
my $username = $r->dir_config("Language::DBI::Username") || 'apache';
my $password = $r->dir_config("Language::DBI::Password") || 'www';
$cfg->{tablename} = $r->dir_config("Language::DBI::TableName") || 'language';
$cfg->{key} = $r->dir_config("Language::DBI::TableKey") || 'key';
$cfg->{lang} = $r->dir_config("Language::DBI::TableLang") || 'lang';
$cfg->{value} = $r->dir_config("Language::DBI::TableValue") || 'value';
if ($dbhfunc)
{
no strict 'refs';
$cfg->{dbh} = &$dbhfunc();
use strict 'refs';
}
else
{
$cfg->{dbh} = DBI->connect($Datasource, $username, $password);
}
if ($cfg->{dbh}){
return L_OK;
}
else {
warning("DBI initialization failed $DBI::errstr");
return L_ERROR;
}
}
1;
__END__