add more error and argument checking

LibreCat · Aug 20, 2024 · 07018b6 · 07018b6
1 parent abe743f
commit 07018b6
Show file tree

Hide file tree

Showing 4 changed files with 40 additions and 37 deletions.
diff --git a/Changes b/Changes
@@ -1,6 +1,8 @@
 Revision history for Catmandu-DBI
 
 {{$NEXT}}
+  - add more error catching
+  - add more robust argument checking with Type::Tiny
 
 0.13  2024-03-20 16:40:53 CET
   - create indexes in the current schema

diff --git a/cpanfile b/cpanfile
@@ -5,6 +5,9 @@ requires 'DBI','>=1.630';
 requires 'Moo', '>=1.004006';
 requires 'MooX::Aliases', '>=0.001006';
 requires 'JSON';
+requires 'Type::Tiny';
+
+recommends 'Type::Tiny::XS';
 
 on 'test', sub {
     requires 'Test::Exception','0';

diff --git a/lib/Catmandu/Importer/DBI.pm b/lib/Catmandu/Importer/DBI.pm
@@ -1,26 +1,30 @@
 package Catmandu::Importer::DBI;
 
 use Catmandu::Sane;
+use Catmandu::Error;
 use DBI;
 use Moo;
 use MooX::Aliases;
+use Types::Standard qw(Str);
+use Types::Common::String qw(NonEmptyStr);
 use namespace::clean;
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
 
 our $VERSION = '0.13';
 
 with 'Catmandu::Importer';
 
-has data_source => (is => 'ro', required => 1, alias => 'dsn');
-has username    => (is => 'ro', alias    => 'user');
-has password    => (is => 'ro', alias    => 'pass');
-has query       => (is => 'ro', required => 1);
+has data_source => (is => 'ro', isa => NonEmptyStr, required => 1, alias => 'dsn');
+has username    => (is => 'ro', isa => Str, alias    => 'user');
+has password    => (is => 'ro', isa => Str, alias    => 'pass');
+has query       => (is => 'ro', isa => NonEmptyStr, required => 1);
 has dbh =>
     (is => 'ro', init_arg => undef, lazy => 1, builder => '_build_dbh',);
 has sth =>
     (is => 'ro', init_arg => undef, lazy => 1, builder => '_build_sth',);
 
-sub _build_dbh {
-    my $self = $_[0];
+sub _build_dbh ($self) {
     my $dbh = DBI->connect(
         $self->dsn,
         $self->user,
@@ -34,27 +38,23 @@ sub _build_dbh {
             sqlite_use_immediate_transaction => 1,
             sqlite_unicode                   => 1,
         }
-    ) or die($DBI::errstr);
+    ) or Catmandu::Error->throw($DBI::errstr);
     $dbh;
 }
 
-sub _build_sth {
-    my $self = $_[0];
-    my $sth  = $self->dbh->prepare($self->query) or die($self->dbh->errstr);
-    $sth->execute or die($sth->errstr);
+sub _build_sth ($self) {
+    my $sth  = $self->dbh->prepare($self->query) or Catmandu::Error->throw($self->dbh->errstr);
+    $sth->execute or Catmandu::Error->throw($sth->errstr);
     $sth;
 }
 
-sub generator {
-    my ($self) = @_;
-
-    return sub {
+sub generator ($self) {
+    sub {
         $self->sth->fetchrow_hashref();
-    }
+    };
 }
 
-sub DESTROY {
-    my ($self) = @_;
+sub DESTROY ($self) {
     $self->sth->finish;
     $self->dbh->disconnect;
 }

diff --git a/lib/Catmandu/Store/DBI.pm b/lib/Catmandu/Store/DBI.pm
@@ -7,7 +7,11 @@ use Catmandu::Store::DBI::Bag;
 use Moo;
 use MooX::Aliases;
 use Catmandu::Error;
+use Types::Standard qw(Str);
+use Types::Common::String qw(NonEmptyStr);
 use namespace::clean;
+use feature qw(signatures);
+no warnings qw(experimental::signatures);
 
 our $VERSION = "0.13";
 
@@ -16,6 +20,7 @@ with 'Catmandu::Transactional';
 
 has data_source => (
     is       => 'ro',
+    isa      => NonEmptyStr,
     required => 1,
     alias    => 'dsn',
     trigger  => sub {
@@ -24,12 +29,12 @@ has data_source => (
         $_[0]->{data_source} = $ds;
     },
 );
-has username => (is => 'ro', default => sub {''}, alias => 'user');
-has password => (is => 'ro', default => sub {''}, alias => 'pass');
-has default_order           => (is => 'ro', default => sub {'ID'});
+has username => (is => 'ro', isa => Str, default => sub {''}, alias => 'user');
+has password => (is => 'ro', isa => Str, default => sub {''}, alias => 'pass');
+has default_order           => (is => 'ro', isa => Str, default => sub {'ID'});
 has handler                 => (is => 'lazy');
-has _in_transaction         => (is => 'rw', writer => '_set_in_transaction',);
-has _dbh => (is => 'lazy', builder => '_build_dbh', writer => '_set_dbh',);
+has _in_transaction         => (is => 'rw', writer => '_set_in_transaction', init_arg => undef);
+has _dbh => (is => 'lazy', builder => '_build_dbh', writer => '_set_dbh', init_arg => undef);
 
 # DEPRECATED methods. Were only invented to tackle of problem of reconnection
 sub timeout {
@@ -49,8 +54,7 @@ sub handler_namespace {
     'Catmandu::Store::DBI::Handler';
 }
 
-sub _build_handler {
-    my ($self) = @_;
+sub _build_handler ($self) {
     my $driver = $self->dbh->{Driver}{Name} // '';
     my $ns     = $self->handler_namespace;
     my $pkg;
@@ -70,8 +74,7 @@ sub _build_handler {
     require_package($pkg, $ns)->new;
 }
 
-sub _build_dbh {
-    my ($self) = @_;
+sub _build_dbh ($self) {
     my $opts = {
         AutoCommit                       => 1,
         RaiseError                       => 1,
@@ -83,13 +86,11 @@ sub _build_dbh {
     };
     my $dbh
         = DBI->connect($self->data_source, $self->username, $self->password,
-        $opts,);
+        $opts,) or Catmandu::Error->throw($DBI::errstr);
     $dbh;
 }
 
-sub dbh {
-
-    my $self = $_[0];
+sub dbh ($self) {
     my $dbh  = $self->_dbh;
 
     # reconnect when dbh is not set (should never happen)
@@ -118,18 +119,16 @@ sub dbh {
 
 }
 
-sub reconnect {
+sub reconnect ($self) {
 
-    my $self = $_[0];
     my $dbh  = $self->_dbh;
     $dbh->disconnect if defined($dbh);
     $self->_set_dbh($self->_build_dbh);
     $self->_dbh;
 
 }
 
-sub transaction {
-    my ($self, $sub) = @_;
+sub transaction ($self, $sub) {
 
     if ($self->_in_transaction) {
         return $sub->();
@@ -155,8 +154,7 @@ sub transaction {
     @res;
 }
 
-sub DEMOLISH {
-    my ($self) = @_;
+sub DEMOLISH ($self) {
     $self->{_dbh}->disconnect if $self->{_dbh};
 }