/usr/share/perl5/Lemonldap/NG/Common/Conf/_DBI.pm is in liblemonldap-ng-common-perl 1.9.16-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 | package Lemonldap::NG::Common::Conf::_DBI;
use strict;
use utf8;
use DBI;
use Lemonldap::NG::Common::Conf::Constants; #inherits
our $VERSION = '1.9.15';
our @ISA = qw(Lemonldap::NG::Common::Conf::Constants);
our ( @EXPORT, %EXPORT_TAGS );
BEGIN {
*Lemonldap::NG::Common::Conf::_dbh = \&_dbh;
push @EXPORT, @Lemonldap::NG::Common::Conf::Constants::EXPORT;
%EXPORT_TAGS = %Lemonldap::NG::Common::Conf::Constants::EXPORT_TAGS;
push @EXPORT,
qw(prereq available lastCfg _dbh lock isLocked unlock delete logError);
}
sub prereq {
my $self = shift;
unless ( $self->{dbiChain} ) {
$Lemonldap::NG::Common::Conf::msg =
'"dbiChain" is required in *DBI configuration type';
return 0;
}
$Lemonldap::NG::Common::Conf::msg .=
'Warning: "dbiUser" parameter is not set'
unless ( $self->{dbiUser} );
$self->{dbiTable} ||= "lmConfig";
1;
}
sub available {
my $self = shift;
my $sth =
$self->_dbh->prepare( "SELECT DISTINCT cfgNum from "
. $self->{dbiTable}
. " order by cfgNum" );
$sth->execute();
my @conf;
while ( my @row = $sth->fetchrow_array ) {
push @conf, $row[0];
}
return @conf;
}
sub lastCfg {
my $self = shift;
my @row = $self->_dbh->selectrow_array(
"SELECT max(cfgNum) from " . $self->{dbiTable} );
return $row[0];
}
sub _dbh {
my $self = shift;
$self->{dbiTable} ||= "lmConfig";
return $self->{_dbh} if ( $self->{_dbh} and $self->{_dbh}->ping );
$self->{_dbh} = DBI->connect_cached( $self->{dbiChain}, $self->{dbiUser},
$self->{dbiPassword}, { RaiseError => 1, AutoCommit => 1, } );
if ( $self->{dbiChain} =~ /^dbi:sqlite/i ) {
$self->{_dbh}->{sqlite_unicode} = 1;
}
elsif ( $self->{dbiChain} =~ /^dbi:mysql/i ) {
$self->{_dbh}->{mysql_enable_utf8} = 1;
$self->{_dbh}->do("set names 'utf8'");
}
elsif ( $self->{dbiChain} =~ /^dbi:pg/i ) {
$self->{_dbh}->{pg_enable_utf8} = 1;
}
return $self->{_dbh};
}
sub lock {
my $self = shift;
if ( $self->{dbiChain} =~ /^dbi:mysql:/i ) {
my @row = $self->_dbh->selectrow_array("SELECT GET_LOCK('lmconf', 0)");
return $row[0] || 0;
}
return 1;
}
sub isLocked {
my $self = shift;
if ( $self->{dbiChain} =~ /^dbi:mysql:/i ) {
my @row = $self->_dbh->selectrow_array("SELECT IS_FREE_LOCK('lmconf')");
return $row[0] ? 0 : 1;
}
return 0;
}
sub unlock {
my $self = shift;
if ( $self->{dbiChain} =~ /^dbi:mysql:/i ) {
my @row = $self->_dbh->selectrow_array("SELECT RELEASE_LOCK('lmconf')");
return $row[0] || 0;
}
return 1;
}
sub delete {
my ( $self, $cfgNum ) = @_;
my $req =
$self->_dbh->prepare("DELETE FROM $self->{dbiTable} WHERE cfgNum=?");
my $res = $req->execute($cfgNum);
$Lemonldap::NG::Common::Conf::msg .=
"Unable to find conf $cfgNum (" . $self->_dbh->errstr . ")"
unless ($res);
return $res;
}
sub logError {
my $self = shift;
$Lemonldap::NG::Common::Conf::msg .=
"Database error: " . $self->_dbh->errstr . "\n";
}
1;
__END__
|