I'm using Data::FormValidator to deal with some data validation in DBIx::Class (via DBIx::Class::Validation). DBIC::Validation ultimately does croak $results if the validation fails, where $results is a Data::FormValidator::Results object. Unfortunately, that croak does not trigger my try/catch around the DBIC calls.
Digging around a bit, I made this simplified test case (excluding DBIC entirely):
use strict;
use Data::FormValidator;
use TryCatch; #or Try::Tiny or eval, same results for each
#setup a profile and values that fail under that profile
my $input_profile = {
required => [ qw( good_ip bad_ip ) ],
constraints => {
good_ip => 'ip_address',
bad_ip => 'ip_address',
}
};
my $validator = new Data::FormValidator({default => $input_profile});
my $input_hashref = {
'good_ip' => '127.0.0.1',
'bad_ip' => '300.23.1.1',
};
try {
my $results = $validator->check($input_hashref,'default');
die $results;
} catch (Data::FormValidator::Results $e) {
print STDERR "failed with ".scalar(#{$e->invalid('bad_ip')})." invalid\n";
}
I would expect that my catch block would get triggered. Instead, nothing happens (execution continues).
Looking at the source of the Results object, I see that it overloads bool with it's success method. Removing that fixes my issue, but I don't understand why. If that's the whole problem, is there a good way to work around it?
TL;DR
This is a bug in TryCatch. $results stringifies to the empty string and TryCatch calls if $# when it should call if defined $#.
Here's an example without Data::FormValidator:
use strict;
use warnings 'all';
use 5.010;
package Foo;
use overload '""' => sub { '' };
sub new {
bless {}, $_[0];
}
package main;
use TryCatch;
try {
my $foo = Foo->new;
die $foo;
}
catch($e) {
say "<<<$e>>>";
}
TryCatch uses Devel::Declare to inject custom code when the Perl lexer encounters certain keywords. In this case, it generates something like this:*
try;
{
local $#;
eval {
my $foo = Foo->new;
die $foo;
};
$TryCatch::Error = $#;
}
if ($TryCatch::Error) {
Since $# is the empty string, if ($TryCatch::Error) is false and the catch block is never entered.
This is a bug (one of many for TryCatch). Use eval or Try::Tiny instead (just remember to check for defined, not truthy/falsey).
* If you want to see exactly what gets injected, set the environment variable TRYCATCH_DEBUG to 1.
Related
I have written a perl package Parsepw which will parse the configuration file and returns the userid and password from config file to main script.
My module looks like this:
package Parsepw;
use strict;
use warnings;
use Exporter qw(import);
our #EXPORT_OK = qw(parse_config_file);
sub parse_config_file {
...
#reads the config file, if not found print error message here else using regex extract user and password line
...
if ( $user && $ciphertext ){
return ( $user, $ciphertext );
}
}
1;
Below is my main script:
...
use Parsepw;
my ($user, $passwd) = Parsepw::parse_config_file();
print "$user, $passwd\n";
I am able to retrieve user and passwd in positive test scenario, but in negative test case how can I handle it.
If suppose parse_config_file subroutine couldn't able to parse the configuration file in the module how can I throw an error/warning to my main script? Since the return value I have is $user, $passwd, how can I have the error/warning message?
Without using package everything works fine if I put all the code in single script. I was trying to write separate package for first time.
You could return nothing (zero scalars) when there's an error.
sub parse_config_file {
...
if ( $user && $ciphertext ) {
return ( $user, $ciphertext );
} else {
return;
}
}
A list assignment in scalar returns the number of scalars returned by its right-hand side. This allows you to use
my ($user, $password) = parse_config_file(...)
or die(...);
...
or
if ( my ($user, $password) = parse_config_file(...) ) {
# Success
...
} else {
# Error
...
}
You could throw an exception on error.
use Carp qw( croak );
sub parse_config_file {
...
$user && $ciphertext
or croak("...");
return ( $user, $ciphertext );
}
You have various options to design the part of your module's interface that deals with errors.
One way, as ikegami says, could be to use a bare return, and let the module's user to check the results from parse_config_file.
If you want to "throw an exception", Perl offers a mechanism to do that using die passing blessed references, but you'll have to build a hierarchy of exception classes yourself (other languages provide a built hierarchy).
The example starts with the code for Foo.pm.
It defines a minimal hierarchy of exception classes (Foo::Exception and Foo::Exception::ParseError).
As #ikegami pointed out, it's good practice to overload stringification: the reason is explained in the documentation for die:
Because Perl stringifies uncaught exception messages before display, you'll probably want to overload stringification operations on exception objects. See overload for details about that.
In this case, I chose a minimalistic approach: strigifying an exception object will simply return its class name.
In the implementation for parse_config_file, we pass die an object to thrown a typed exception.
use strict;
use warnings;
package Foo::Exception;
use overload '""' => sub { ref(shift) };
sub new {
return bless {}, shift;
}
package Foo::Exception::ParseError;
use base 'Foo::Exception';
### The rest of the package, as in the example
### in your original question
package Foo;
use Exporter qw(import);
our #EXPORT_OK = qw(parse_config_file);
sub parse_config_file {
die Foo::Exception::ParseError->new();
}
1;
In the script that uses the library (foo.pl), we can use the usual eval … if (#$) … form to trap the exception and react according to its type. $# contains in this case a blessed reference (in other words, an object) representing the exception: you could enrich the exception classes so that they can contain additional information about the state of the process when the error occurred.
use lib '.';
use Foo qw/parse_config_file/;
eval {
parse_config_file();
};
if ($#) {
if ($#->isa('Foo::Exception::ParseError')) {
print "Error parsing file\n";
}
else {
die "Unexpected error!";
}
}
1;
How can I hide a "tie" call from the user so calling an accessor will implicitly do it for them?
I want to do this, because I have a data structure that can be accessed by the user, but values stored in this structure can be modified without the user's knowledge.
If an attribute in the data structure changes, I want any variables referencing that attribute modified as well so the user will always be using fresh data. Since the user will always want fresh data, it's simpler and more intuitive if the user doesn't even need to know it's happening.
This is what I have so far... it doesn't seem to work though, the output is:
hello
hello
What I want is:
hello
goodbye
Code:
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{
package File;
use Moose;
has '_text' => (is => 'rw', isa => 'Str', required => 1);
sub text {
my ($self) = #_;
tie my $text, 'FileText', $self;
return $text;
}
}
{
package FileText;
use Tie::Scalar;
sub TIESCALAR {
my ($class, $obj) = #_;
return bless \$obj, $class;
}
sub FETCH {
my ($self) = #_;
return $$self->_text();
}
sub STORE {
die "READ ONLY";
}
}
my $file = 'File'->new('_text' => 'hello');
my $text = $file->text();
say $text;
$file->_text('goodbye');
say $text;
I would not recommend doing this. You're introducing "action at a distance" which leads to some very difficult to catch bugs. The user thinks they're getting a string. A lexical string can only be altered by changing it directly and obviously. It has to be altered in place or obviously passed into a function or a reference attached to something.
my $text = $file->text;
say $text; # let's say it's 'foo'
...do some stuff...
$file->text('bar');
...do some more stuff...
# I should be able to safely assume it will still be 'foo'
say $text;
That block of code is easy to understand because all the things which could affect $text are immediately visible. This is what lexical context is all about, isolating what can change a variable.
By returning a thing which can change at any time, you've quietly broken this assumption. There's no indication to the user that assumption has been broken. When they go to print $text and get bar it is non-obvious what changed $text. Anything in the whole program could change $text. That small block of code is now infinitely more complicated.
Another way to look at it is this: scalar variables in Perl have a defined interface. Part of that interface says how they can be changed. You are breaking this interface and lying to the user. This is how overloaded/tied variables are typically abused.
Whatever problem you're trying to solve, you're solving it by adding more problems, by making the code more complex and difficult to understand. I would step back and ask what problem you're trying to solve with tying.
What I would do instead is to just return a scalar reference. This alerts the user that it can be changed out from under them at any time. No magic to cover up a very important piece of information.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{
package File;
use Moose;
has 'text_ref' => (
is => 'rw',
isa => 'Ref',
default => sub {
return \("");
}
);
sub BUILDARGS {
my $class = shift;
my %args = #_;
# "Cast" a scalar to a scalar ref.
if( defined $args{text} ) {
$args{text_ref} = \(delete $args{text});
}
return \%args;
}
sub text {
my $self = shift;
if( #_ ) {
# Change the existing text object.
${$self->text_ref} = shift;
return;
}
else {
return $self->text_ref;
}
}
}
my $file = 'File'->new('text' => 'hello');
my $text = $file->text();
say $$text;
$file->text('goodbye');
say $$text;
That said, here's how you do what you want.
I would recommend against using tie. It is very slow, considerably slower than a method call, buggy and quirky. One of its quirks is that the tied nature is attached to the variable itself, not the referenced data. That means you can't return a tied variable.
Instead, I would recommend using an overloaded object to store your changing text.
{
package ChangingText;
# Moose wants class types to be in a .pm file. We have to explciitly
# tell it this is a class type.
use Moose::Util::TypeConstraints qw(class_type);
class_type('ChangingText');
use overload
'""' => sub {
my $self = shift;
return $$self;
},
fallback => 1;
sub new {
my $class = shift;
my $text = shift;
return bless \$text, $class;
}
sub set_text {
my $self = shift;
my $new_text = shift;
$$self = $new_text;
return;
}
}
Overloaded objects have their own caveats, mostly due to code which expects strings writing things like if !ref $arg, but they are easier to deal with than the deep tie bugs.
To make this transparent, store the ChangingText object in the File object and then put a hand made text accessor around it to handle plain strings. The accessor makes sure to reuse the same ChangingText object.
To complete the illusion, BUILDARGS is used to change plain text initialization arguments into a ChangingText object.
{
package File;
use Moose;
has 'text_obj' => (
is => 'rw',
isa => 'ChangingText',
default => sub {
return ChangingText->new;
}
);
sub BUILDARGS {
my $class = shift;
my %args = #_;
# "Cast" plain text into a text object
if( defined $args{text} ) {
$args{text_obj} = ChangingText->new(delete $args{text});
}
return \%args;
}
sub text {
my $self = shift;
if( #_ ) {
# Change the existing text object.
$self->text_obj->set_text(shift);
return;
}
else {
return $self->text_obj;
}
}
}
Then it works transparently.
my $file = File->new('text' => 'hello');
my $text = $file->text();
say $text; # hello
$file->text('goodbye');
say $text; # goodbye
return $text just returns the value of the variable, not the variable itself. You can return a reference to it, though:
sub text {
my ($self) = #_;
tie my $text, 'FileText', $self;
return \$text;
}
You then have to use $$text to dereference it:
my $file = 'File'->new('_text' => 'hello');
my $text = $file->text();
say $$text;
$file->_text('goodbye');
say $$text;
I have a class called Question, and a bunch of sub-classes depending on the type of question. I can create objects against the sub-classes, but I shouldn't be able to create an object of class Question itself:
#! /usr/bin/env perl
use strict;
use warnings;
#
# LOAD IN YOUR QUESTIONS HERE
#
my #list_of_questions;
for my $question_type qw(Science Math English Dumb) {
my $class = "Question::$question_type";
my $question = $class->new;
push #list_of_questions, $question;
}
package Question;
use Carp;
sub new {
my $class = shift;
my $self = {};
if ( $class = eq "Question" ) {
carp qq(Need to make object a sub-class of "Question");
return;
}
bless $self, $class;
return $self;
}
yadda, yadda, yadda...
package Question::Math;
use parent qw(Question);
yadda, yadda, yadda...
package Question::Science;
use parent qw(Question);
yadda, yadda, yadda...
package Question::English;
use parent qw(Question);
yadda, yadda, yadda...
Notice these are not modules, but merely classes I've defined to be used in my program. Thus, I can't test module loading at runtime.
When I run the above, I get:
Can't locate object method "new" via package "Question::Dumb" (perhaps you forgot to load "Question::Dumb"?)
Is there any way to catch for this particular error, so I can handle it myself? I know I could create an array of valid types, but I was hoping someway of being able to add new question type without having to remember to update my array.
AFAICT what you want to do is check the symbol table to see if your "class" (aka "package") has been defined or not. Doing it manually is no hardship, but Class::Load provides slightly more readable sugar and applies "heuristics" - whatever that means. If you don't want to use this module then the source code for is_class_loaded will lead you to whatever answer you're actually seeking.
use Class::Load qw(is_class_loaded);
for my $question_type (qw(Math English Science Dumb)) {
my $class = "Question::$question_type";
if(!is_class_loaded($class)) {
# construct your new package at runtime, then
}
new_question($class);
}
Your variable name ("class_type") was weird, so I fixed it. I also don't know whether Module::Load is better, but we use Class::Load for this at work.
Edit: bare qw()s are deprecated in one of the newer Perls (5.14?). It's a stupid deprecation, but it's there, so we all have to learn to wrap our qw() foreachs in parens now.
You can't have an expression like Invalid::Class->new() not throw an exception in the calling code, but you can wrap it in exception handling and wrap that inside a method. The standard pattern is to supply a 'type' argument describing the subclass you which to create to a factory method. A common anti-pattern is to put that factory method on the base class, creating a circular dependency and having to do more work than should be required.
It is usual to have the factory method on the interface class and to have it construct sub-classes of an unrelated, dedicated base class, possibly warning or throwing when it fails. In code, that looks pretty much like so:
package Question;
use Try::Tiny;
use Carp qw/carp/;
sub new {
my ($class, $type, #args) = #_;
# could do some munging on $type to make it a class name here
my $real_class = "Question::$type";
return try {
$real_class->new(#args);
} catch {
# could differentiate exception types here
carp qq(Invalid Question type "$type");
};
}
package Question::Base;
sub new {
my ($class) = #_;
return bless {} => $class;
}
package Question::Math;
use base 'Question::Base'; # `use parent` expects to load a module
package main;
use Test::More tests => 2;
use Test::Warn;
isa_ok(Question->new('Math'), 'Question::Math');
warning_like(
sub { Question->new('Dumb') }, # I hear there's no such thing
qr/^Invalid Question/
);
Here's what I finally did:
package Question;
use Carp;
sub new {
my $class = shift;
my %params = #_;
#
# Standardize the Parameters
# Remove the dash, double-dash in front of the parameter and
# lowercase the name. Thus, -Question, --question, and question
# are all the same parameter.
#
my %option_hash;
my $question_type;
for my $key (keys %params) {
my $value = $params{$key};
$key =~ s/^-*//; #Remove leading dashes
$key = ucfirst ( lc $key ); #Make Key look like Method Name
if ( $key eq "Type" ) {
$question_type = ucfirst (lc $value);
}
else {
$option_hash{$key} = $value;
}
}
if ( not defined $question_type ) {
carp qq(Parameter "type" required for creating a new question.);
return;
}
#
# The real "class" of this question includes the question type
#
my $self = {};
$class .= "::$question_type";
bless $self, $class;
#
# All _real does is return a _true_ value. This method is in this
# class, so all sub-classes automatically inherit it. If the eval
# fails, this isn't a subclass, or someone wrote their own `_real_
# method in their sub-class.
#
eval { $self->_real; };
if ( $# ) {
carp qq(Invalid question type of $question_type);
return;
}
#
# Everything looks good! Let's fill up our question object
#
for my $method ( keys %option_hash ) {
my $method_set;
eval { $method_set = $self->$method( $option_hash{$method} ) };
if ( $# or not $method_set ) {
carp qq(Can't set "$method" for question type "$question_type");
return;
}
}
return $self;
}
Now, I'm setting my question like this:
my $question = Question->new(
--type => Integer,
--question => "Pick a number between 1 and 10.",
--help => "Try using the top row of your keyboard...",
--from => "1",
--to => "10",
);
if ( not defined $question ) {
die qq(The question is invalid!);
}
Darch use of the Try::Tiny is nice. It looks way better than wrapping everything in an eval. Unfortunately, it's not a standard module. This program is going on almost 100 separate systems, and using CPAN modules is too difficult. This is especially true since these systems are behind a firewall and can't access the CPAN website.
I basically use Darch's method except I create a _real method in my super-class that I try after I bless the object. If it executes (that's all I really care), then this is a sub-class of my super-class.
This does what I really want: Hide my sub-classes behind my superclass -- much like File::Spec does. Most of my classes have the same methods, and a few have one or two extra methods. For example, my Regex question type has a Pattern method that allows me to make sure the answer given matches a given pattern.
I'm following up on this question about perl web services. I've managed to get modules loading and executing from a main program. Each of the modules is something like this:
#!/usr/bin/perl
package NiMbox::perlet::skeleton;
use strict;
use warnings;
require Exporter;
our #ISA = qw(Exporter);
our #EXPORT_OK = qw(%DEFINITION main secondary);
our %DEFINITION;
$DEFINITION{'main'} = {
summary => 'skeleton main',
description => 'long skeleton main description',
args => { 'box' => {}, 'other' => {} }
};
$DEFINITION{'secondary'} = {
summary => 'skeleton secondary',
description => 'long skeleton secondary description'
};
sub main {
print "main...\n";
}
sub secondary {
print "secondary...\n"
}
1;
And invocation of these modules can then be done like this:
use NiMbox::perlet::skeleton;
my %DEFINITION = %NiMbox::perlet::skeleton::DEFINITION;
foreach my $s (keys %DEFINITION) {
print "calling sub '$s'\n";
NiMbox::perlet::skeleton->$s();
}
How would I get rid of the direct invocation of NiMbox::perlet:skeleton in a way in which I could do something that looks like this (which does not work but illustrates what I need to do):
my $perlet = 'skeleton';
use NiMbox::perlet::$perlet;
my %DEFINITION = %NiMbox::perlet::$perlet::DEFINITION;
foreach my $s (keys %DEFINITION) {
print "calling sub '$s'\n";
NiMbox::perlet::$perlet->$s();
}
Since I'm very close I would rather see what is missing in this example rather than use another library. Any ideas?
If you want to make the class name dynamic, you can do something like this:
my $class = 'NiMbox::perlet::' . $perlet;
my $class_file = $class;
$class_file =~ s{::}{/};
$class_file .= '.pm';
require $class_file;
$class->import;
(Or even better, use Module::Load as #Schwern suggests.
Getting the %DEFINITION class is a bit tricky since it would involve symbolic references. A better way would be to provide a class method that returns it, e.g.
package NiMbox::perlet::skeleton;
...
sub definition {
my %definition;
$definition{main} = { summary => 'skeleton main', ... };
return %definition;
}
Then you could do something like:
my %DEFINITION = $class->definition;
foreach my $s( keys %DEFINITION ) {
print "calling sub '$s'\n";
$class->$s;
}
I believe what you're looking for is Exporter or its many follow on modules. I see you're already using it in your module, but you're not using it to get %DEFINITION. You'd do that like so:
use NiMbox::perlet::skeleton qw(%DEFINITION);
foreach my $s (keys %DEFINITION) {
print "calling sub '$s'\n";
NiMbox::perlet::skeleton->$s();
}
That aliases %NiMbox::perlet::skeleton::DEFINITION to %DEFINITION and saves a bunch of typing.
To be able to use a variable definition of %DEFINITION you could use "symbolic references" to refer to the variable by name... but those are fraught with peril. Also, exporting global variables means you can only have one at a time in a given namespace. We can do better.
What I would suggest is instead changing the %DEFINITION hash into the definition() class method which returns a reference to %DEFINITION. You could return a hash, but the reference avoids wasting time copying.
package NiMbox::perlet::skeleton;
use strict;
use warnings;
my %DEFINITION = ...;
sub definition {
return \%DEFINITION;
}
Now you can call that method and get the hash ref.
use NiMbox::perlet::skeleton;
my $definition = NiMbox::perlet::skeleton->definition;
foreach my $s (keys %$definition) {
print "calling sub '$s'\n";
NiMbox::perlet::skeleton->$s();
}
Doing it dynamically, the only trick is to load the class. You can eval "require $class" or die $# but that has security implications. UNIVERSAL::require or Module::Load can handle that better for you.
use Module::Load;
my $class = 'NiMbox::perlet::skeleton';
load $class;
my $definition = $class->definition;
foreach my $s (keys %$definition) {
print "calling sub '$s'\n";
$class->$s();
}
package My::Module;
# $Id$
use strict;
use Carp;
use Data::Dumper;
use DBI;
$My::Module::VERSION = '0.1';
sub new {
my ($class, %opt) = #_;
my $opt_count = keys %opt;
$class->set_error('');
#return $class->set_error("Too many arguments to initialize.") if ($opt_count > 5);
#return $class->set_error("Missing arguments to initialize.") if ($opt_count < 2);
my $self = bless {
_DRIVER_OPTIONS => $opt{'mysql'},
},$class;
if (not defined $self) {
return $class->set_error( "new() failed: " . $class->errstr );
}
if ($self->{_DRIVER_OPTIONS}->{Host} ne '') {
$self->{_DRIVER_OPTIONS}->{DataSource} = 'DBI:mysql:database=' . $self->{_DRIVER_OPTIONS}->{Database} . ';host=' . $self->{_DRIVER_OPTIONS}->{Host};
} else {
$self->{_DRIVER_OPTIONS}->{DataSource} = 'DBI:mysql:database=' . $self->{_DRIVER_OPTIONS}->{Database} . ';';
}
$self->{Handle} = DBI->connect($self->{_DRIVER_OPTIONS}->{DataSource},
$self->{_DRIVER_OPTIONS}->{Username},
$self->{_DRIVER_OPTIONS}->{Password},
{ RaiseError=>1, PrintError=>1, AutoCommit=>1 }
);
return $self->set_error("new(): couldn't connect to database: " . DBI->errstr) unless ($self->{Handle});
$self->{_disconnect} = 1;
print Dumper \$self;
return $self;
}
sub database {
my $self = shift;
if (#_) { $self->{Handle} = shift }
return $self->{Handle};
}
sub set_error {
my $class = shift;
my $message = shift;
$class = ref($class) || $class;
no strict 'refs';
${ "$class\::errstr" } = sprintf($message || "", #_);
return;
}
*error = \&errstr;
sub errstr {
my $class = shift;
$class = ref( $class ) || $class;
no strict 'refs';
return ${ "$class\::errstr" } || '';
}
sub DESTROY {
my $self = shift;
unless (defined $self->{Handle} && $self->{Handle}->ping) {
$self->set_error(__PACKAGE__ . '::DESTROY(). Database handle has gone away');
return;
}
unless ($self->{Handle}->{AutoCommit}) {
$self->{Handle}->commit;
}
if ($self->{_disconnect}) {
$self->{Handle}->disconnect;
}
}
1;
Is that the right way so i can
re-use the database on my code
instead of having to open a new
connection or that will aswell open
a new connection every time i use it
?
Should i change anything on the
module ? or anything i did wrong ?
Currently i am just learning and thinked of doing my own engine module so i began with this.
Simple test code (the bellow code is not to be reviewed just a sample on how to use the module):
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
use lib 'path to module';
use My::Module;
my $session = My::Module->new(mysql => {
Database =>'module',
Host =>'10.0.0.2',
Username =>'module',
Password =>'module'
}) or die My::Module->errstr;
my $dbh = $session->database();
my $sth = $dbh->prepare(q{
SELECT session_id
FROM sessions
});
$sth->execute() || die print($dbh->errstr);
my $ref = $sth->fetchall_arrayref({});
$sth->finish;
print Dumper \$ref;
I would suggest using an existing database interface rather than rolling your own, as there are many secret gotchas that others have spent years figuring out and solving for you. DBIx::Connector is excellent, and with its fixup mode, will let you reuse database connections, even across process forks.
Additionally, if you use Moose you will never have to write your own object constructors or object fields again. :)
DBIx::Class combined with Moose would be even better, but not necessary until you find yourself needing more ORM-ish features.
Other than using a CPAN module to accomplish this task, here are my practical recommendations:
Don't return an error value from the constructor. Instead, throw an exception.
Access the internals of your class using accessors rather than using direct hash access.
If the user of your class did not enable AutoCommit, she chose not to enable AutoCommit for a reason. Therefore don't do:
unless ($self->{Handle}->{AutoCommit}) {
$self->{Handle}->commit;
}
in DESTROY.
Note that bless is not going to fail so long as it is given a modifiable reference (compare this to, say, the behavior of open which can fail to open a file even though the argument to open is a valid filename and would indicate this situation by returning a false value). Therefore, checking the return value of bless does not serve any useful purpose. If you want to handle the possibility of bless failing, you will have to catch fatal runtime exceptions.
Your way of exposing errors is very, very oldfashioned. If something exceptional happens, why not raise a proper exception? You seem to have modelled your error handling after the DBI module. Note that DBI also has a RaiseError option. Using that is almost always more reasonable than using the oldfashioned errorstr version. Unfortunately DBI can't change it's default anymore now, but for new code I entirely don't see the reason to copy this flawed idea.
You're also constructing a DBI connection within your code, based on parameters the user provided from the outside. Do you have a good reason for doing that? Allowing the user to pass in the DBI::dh he constructed himself would be more flexible. Yes, that requires slightly more code on the outside to set up objects and wire them together, but it will also result in a cleaner design. If wiring up your objects manually bothers you too much, you might want to have a look at Bread::Board to do the wiring for you instead of compromising on the design of your module.
Also, I second Ether's suggestion of using DBIx::Connector. It really takes a lot of pain out of managing database handles, which can be very error-prone.