view release on metacpan or  search on metacpan

lib/Lemonldap/NG/Portal/Lib/DBI.pm  view on Meta::CPAN

    is      => 'rw',
    lazy    => 1,
    builder => sub {
        my $conf = $_[0]->{conf};
        return $conf->{dbiUserTable} || $conf->{dbiAuthTable};
    }
);

has pivot => (
    is      => 'rw',
    lazy    => 1,
    builder => sub {
        my $conf = $_[0]->{conf};
        return $conf->{userPivot} || $conf->{dbiAuthLoginCol};
    }
);

has mailField => (
    is      => 'rw',
    lazy    => 1,
    builder => sub {
        my $conf = $_[0]->{conf};
        return
             $conf->{dbiMailCol}
          || $conf->{userPivot}
          || $conf->{dbiAuthLoginCol};
    }
);

# _dbh object: DB connection object
has _dbh => (
    is      => 'rw',
    lazy    => 1,
    builder => 'dbh',
);

sub dbh {
    my ($self) = @_;

    my $dbh = check_dbh( $self->{_dbh} );
    return $dbh if $dbh;
    delete $self->{_dbh};

    my $conf = $self->{conf};
    $self->{_dbh} = eval {
        DBI->connect_cached(
            $conf->{dbiAuthChain}, $conf->{dbiAuthUser},
            $conf->{dbiAuthPassword}, { RaiseError => 1, AutoCommit => 1, }
        );
    };
    if ($@) {
        $self->{p}->logger->error("DBI connection error: $@");
        return 0;
    }

    if ( $conf->{dbiAuthChain} =~ /^dbi:sqlite/i ) {
        $self->{_dbh}->{sqlite_unicode} = 1;
    }
    elsif ( $conf->{dbiAuthChain} =~ /^dbi:mysql/i ) {
        eval {
            $self->{_dbh}->{mysql_enable_utf8} = 1;
            $self->{_dbh}->do("set names 'utf8'");
        };
    }
    elsif ( $conf->{dbiAuthChain} =~ /^dbi:pg/i ) {
        $self->{_dbh}->{pg_enable_utf8} = 1;
    }

    return $self->{_dbh};
}

# INITIALIZATION

# All DBI modules have just to verify that DBI connection is available
sub init {
    my ($self) = @_;
    $self->_dbh
      or $self->logger->error("DBI connection has failed, but let's continue");
    unless ( $self->table ) {
        $self->logger->error(
            "SQL Table name is not set, can't load " . ref($self) );
        return 0;
    }
    return 1;
}

# RUNNING METHODS

# Return hashed password for use in SQL statement
# @param password clear password
# @param hash hash mechanism
# @return SQL statement string
sub hash_password {
    my ( $self, $password, $hash ) = @_;
    if ($hash) {
        $self->logger->debug( "Using " . uc($hash) . " to hash password" );
        return uc($hash) . "($password)";
    }

    $self->logger->debug("No password hash, using clear text for password");
    return $password;
}

# Return hashed password for use in SQL SELECT statement
# Call hash_password unless encrypt hash is choosen
# @param password clear password
# @param hash hash mechanism
# @return SQL statement string
sub hash_password_for_select {
    my ( $self, $password, $hash ) = @_;
    my $passwordCol = $self->conf->{dbiAuthPasswordCol};

    if ( $hash =~ /^encrypt$/i ) {
        return uc($hash) . "($password,$passwordCol)";
    }
    else {
        return $self->hash_password( $password, $hash );
    }
}

## @method protected Lemonldap::NG::Portal::_DBI get_password(ref dbh, string user)