diff --git a/lib/Qpsmtpd/DB.pm b/lib/Qpsmtpd/DB.pm index e497af3..0068308 100644 --- a/lib/Qpsmtpd/DB.pm +++ b/lib/Qpsmtpd/DB.pm @@ -5,12 +5,26 @@ use Qpsmtpd::DB::File::DBM; sub new { my ( $class, %arg ) = @_; - # The only supported class just now - return bless { %arg }, 'Qpsmtpd::DB::File::DBM'; + # Qpsmtpd::DB::File::DBM is the only supported class just now + my @child_classes = qw( + Qpsmtpd::DB::File::DBM + ); + my $manual_class = delete $arg{class}; + return $manual_class->new(%arg) if $manual_class; + my ( $child, @errors ); + for my $child_class ( @child_classes ) { + eval { + $child = $child_class->new(%arg); + }; + last if ! $@; + push @errors, "Couldn't load $child_class: $@"; + } + return $child if $child; + die join( "\n", "Couldn't load any storage modules", @errors ); } # noop default method for plugins that don't require locking -sub get_lock { 1 } +sub lock { 1 } sub name { my ( $self, $name ) = @_; diff --git a/lib/Qpsmtpd/DB/File.pm b/lib/Qpsmtpd/DB/File.pm index 3e37695..d9ea042 100644 --- a/lib/Qpsmtpd/DB/File.pm +++ b/lib/Qpsmtpd/DB/File.pm @@ -3,6 +3,11 @@ use strict; use warnings; use parent 'Qpsmtpd::DB'; +sub new { + my ( $class, %arg ) = @_; + return bless { %arg }, $class; +} + sub dir { my ( $self, @candidate_dirs ) = @_; return $self->{dir} if $self->{dir} and ! @candidate_dirs;