35 lines
740 B
Perl
35 lines
740 B
Perl
package Qpsmtpd::DB::File;
|
|
use strict;
|
|
use warnings;
|
|
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;
|