qpsmtpd/lib/Qpsmtpd/DB/File.pm
Jared Johnson 1d29db66ff Move some DBM functions to Qpsmptd::DB::File::DBM
Not everything is moved and Qpsmtpd::DB* does not yet have test coverage
2014-11-25 17:52:18 -06:00

36 lines
755 B
Perl

package Qpsmtpd::DB::File;
use strict;
use warnings;
use lib 'lib';
use parent 'Qpsmtpd::DB';
sub dir {
my ( $self, @candidate_dirs ) = @_;
return $self->{dir} if $self->{dir} and ! @candidate_dirs;
push @candidate_dirs, ( $self->qphome . '/var/db', $self->qphome . '/config' );
for my $d ( @candidate_dirs ) {
next if ! $self->validate_dir($d);
return $self->{dir} = $d; # first match wins
}
}
sub validate_dir {
my ( $self, $d ) = @_;
return 0 if ! $d;
return 0 if ! -d $d;
return 1;
}
sub qphome {
my ( $self ) = @_;
my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!);
return $QPHOME;
}
sub path {
my ( $self ) = @_;
return $self->dir . '/' . $self->name . $self->file_extension;
}
1;