What's happening with this DBI:db object when errstr is called? - perl

I'm delegating an attribute in my current class called 'dbc' as a DBIx::Connector so that I can call $self->dbc->dbh from inside methods, however I'm not really understanding some behaviors I'm seeing when calling the 'errstr' method on the DBI::db instance:
This:
eval {
$dbh->do($sql);
};
$self->log->warn("Warning SQL error: $dbh->errstr") if ($#);
returns WARN - Warning SQL error: DBI::db=HASH(0xaf43130)->errstr
However, this works, and returns a proper error string:
eval {
$dbh->do($sql);
};
if($#){
my $errstr = $dbh->errstr;
$self->log->warn("Warning SQL error: $errstr");
}
What's happening here?

Perl doesn't interpolate method calls inside double-quoted strings. $dbh->errstr is calling a method. Try:
$self->log->warn("Warning SQL error: " . $dbh->errstr) if $#;

You're trying to interpolate a function call in a string.
Try concatenating the warning string with function call.
$self->log->warn("Warning SQL error: ".$dbh->errstr) if ($#);
This part of the error:
DBI::db=HASH(0xaf43130)
is the address of the db handle.

Related

Sub::Override doesn't override DBI methods. Why?

I'm writing a fork of DBI::Log, my purpose is to make it conditionally-pluggable to be able to log SQL queries more flexible, e.g. only from particular module or after specified call.
I faced with strange problem - Sub::Override can not override DBI::db::* and DBI::st::execute methods.
Scheme of overriding is following
1) I save reference to original method to variable, e.g. my $orig_execute = \&DBI::st::execute;
2) Create a new function with adding some additional logging code, e.g.
sub _execute {
my ( $sth, #args ) = #_;
warn "Execute is working!";
my $log = dbilog( "execute", $sth->{Database}, $sth->{Statement}, \#args );
my $retval = $orig_execute->( $sth, #args );
dbilog2($log);
return $retval;
}
3) Replace old to new function using Sub::Override
my $sub = Sub::Override->new;
$sub->replace( 'DBI::st::execute', \&_execute );
Here is a full code of changed DBI::Log module. It must do same as original DBI::Log, just use Sub::Override, so original unit tests must pass.
If I run test.pl and added debug output script I see that Sub::Override is working, but for some reason overrided function can not start - no Execute is working! message.

Unit testing in perl, Receiving hash ref as return expected to return a string from a key in a hash

I am trying to test the output of the following method:
package ASC::Builder::Error;
sub new {
my ($package, $first_param) = (shift, shift);
if (ref $first_param eq 'HASH') {
my %params = #_;
return bless { message => $first_param->{message}, %params}, $package;
}
else {
my %params = #_;
return bless {message => $first_param, %params}, $package;
}
}
This method is supposed to accept either an error hash or error string. If it accepts a hash it should output the value of the message key from the error hash.
This is the error hash located in ErrorLibrary.pm:
use constant {
CABLING_ERROR => {
code => 561,
message => "cabling is not correct at T1",
tt => { template => 'disabled'},
fatal => 1,
link =>'http://www.e-solution.com/CABLING_ERROR',
},
};
This is the message method along with the other keys of the hash located in Error.pm
package ASC::Builder::Error;
sub message {
return $_[0]->{message};
}
sub tt {
return {$_[0]->{tt} };
}
sub code {
return {$_[0]->{code} };
}
This is my current unit test located in error.t
#input value will either be a String or and Error Message Hash
# error hash
my $error_hash = CABLING_ERROR;
# error string
my $error_string = "cabling is not correct at T1.";
# error hash is passed into new and an error object is outputted
my $error_in = ASC::Builder::Error->new($error_hash);
# checks to see if the output object from new is an Error object
isa_ok($error_in, 'ASC::Builder::Error');
# checking that object can call the message() method
can_ok( $error_in, 'message');
# checks to see if the output message matches the message contained in the error hash(correct)
is($error_in->message(),( $error_string || $error_hash->{message} ), 'Returns correct error message');
And finally the results of my test:
# Failed test 'Returns correct error message'
# at t/67_error_post.t line 104.
# got: 'HASH(0x38b393d490)'
# expected: 'cabling is not correct at T1.'
#
# '
# Looks like you failed 1 test of 3.
t/67_error_post.t .. Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/3 subtests
On my machine
First of, if I run your code I get an error about CABLING_CHECK_TOR_INCORRECT_CABLING_ERROR being not defined. If I replace that with CABLING_ERROR, the test fails with this.
# got: 'cabling is not correct at T1'
# expected: 'cabling is not correct at T1.'
# Looks like you failed 1 test of 3.
Two possible outputs at the same time
Now to what you say the output is.
For some reason, your $error_in->message returns a hashref, which gets stringified by is(), because is() doesn't do data structures. You can use Test::Deep to do this.
use Test::Deep;
cmp_deeply(
$error_in->message,
any(
$error_string,
$error_hash->{message},
),
'Returns correct error message',
);
Here I assumed that your $error_string || $error_hash->{message} is intended to make it check for either one or the other.
But || will just check if $error_string has a true value and return it, or take the value of $error_hash->{message}. It compares the result of that operation to $error_in->message.
Testing clearly
However, this will likely not solve your real problem. Instead of having one test case that checks two possible things, make a dedicated test case for each possible input. That's what unit-testing is all about.
my $error_direct = ASC::Builder::Error->new('foo');
is $error_direct->message, 'foo', 'direct error message gets read correctly';
my $error_indirect = ASC::Builder::Error->new( { message => 'bar' } );
is $error_indirect->message, 'bar', 'indirect error message gets read correctly';
The above code will give you two test cases. One for a direct error string, and another one for an indirect hash.
ok 1 - direct error message gets read correctly
ok 2 - indirect error message gets read correctly
1..2
Don't waste time
At the same time, this also addresses another issue with your approach. In unit tests, you want to test the smallest possible unit. Don't tie them to your other business logic or your business production data.
Your ASC::Builder::Error class doesn't care about the type of error, so don't over-complicate by loading something additonal to give you the exact same error messages you have in real life. Just use simple things that are enough to prove stuff works.
The simpler your unit tests are, the easier it is to maintain them, and the easier it is to add more once you have more cases.

Retrieve exception message from postgresql function

I have a trigger function on a table that runs on inserts which for certain circumstances will raise an exception.
I maintain an old Perl application running on Catalyst that creates a transaction and inserts rows on the table.
When the trigger function raises an exception, I'd like to be able to print out just the error message I throw and not any debugging information (database operation, context, perl file, etc).
So for example, if my function throws something like:
raise exception 'Item with id % cannot be shipped at this time.', new.id;
I would like to only see
Item with id 13 cannot be shipped at this time.
and not
DBIx::Class::Row::insert(): DBI Exception: DBD::Pg::st execute failed: ERROR: Item with id 13 cannot be shipped at this time. [for Statement "INSERT INTO ... at /home/../lib/Class/Controller/Inv.pm line 260
The perl code is currently something like
$c->model('Class')->schema->txn_do(sub {
...
eval {
$shipment->insert;
1;
} or do {
$error = $#;
last;
};
if ($error) {
$c->stash->{error} = $error;
}
);
Thank you.
Perhaps this substitution:
my $error = $#;
$error =~ s/^.*ERROR: (.*) \[for Statement.*$/$1/;
You could access the errstr() method of the database handle, which is what is what is passed to warn/die anyway
warn $c->model('Class')->schema->storage->dbh->errstr();

Can't use object methods of SOAP object with SOAP::Lite

I am reading data from our Jira via SOAP and recieve an array of RemoteIssue-Objects. Now I want to iterate over these and get the status of each ticket. The documentation of RemoteIssue says that there is a getStatus()-Method. When I call it on the objects my program throws an error.
Some code:
my $soap = SOAP::Lite->uri($soap_uri)->proxy($soap_proxy);
my $login = $soap->login( $soap_user, $soap_password)->result;
if ($login) {
# This works
my $issues = $soap->getIssuesFromJqlSearch( $login, "project = \"$project\" AND fixVersion = \"$project_version\"", 500 );
if ($issues) {
foreach my $issue (#{$issues->result}) {
my $foo = $issue->getStatus(); # This doesn't work
print Dumper $foo;
}
}
}
$soap->logout();
The thrown error:
Can't locate object method "getStatus" via package "RemoteIssue" at D:\ZeuS\lib/ZeuS.pm line 81
Every other object method doesn't work either.
Does anyone know what I am doing wrong?
From what I gather, you're under the impression that you're receiving the Java object that you would manipulate on a Java consumer.
Unless $issue->getStatus() is a SOAP call (which I don't think it is) you're not dealing with the API, you're dealing with SOAP::Lite's representation in Perl of the response in XML.
getIssuesFromJqlSearch seems to be the remote call. From that, you should get $issues as a SOAP::SOM object. Which you then properly address with the result method.
This will have whatever methods are defined for the class this object is blessed into.
To see what all this object responds to try this:
use mro ();
use Scalar::Util qw<blessed>;
...
foreach my $issue (#{$issues->result}) {
say '$issue ISA ('
. join( ',', #{ mro::get_linear_isa( blessed( $issue )) } )
. ')'
;
...
}
$issue will only have those methods that have been defined for it on the Perl side.
NOTE: It is not clear from your code where ZeuS.pm comes into this thing.

Perl referencing and deferencing hash values when passing to subroutine?

I've been banging my head over this issue for about 5 hours now, I'm really frustrated and need some assistance.
I'm writing a Perl script that pulls jobs out of a MySQL table and then preforms various database admin tasks. The current task is "creating databases". The script successfully creates the database(s), but when I got to generating the config file for PHP developers it blows up.
I believe it is an issue with referencing and dereferencing variables, but I'm not quite sure what exactly is happening. I think after this function call, something happens to
$$result{'databaseName'}. This is how I get result: $result = $select->fetchrow_hashref()
Here is my function call, and the function implementation:
Function call (line 127):
generateConfig($$result{'databaseName'}, $newPassword, "php");
Function implementation:
sub generateConfig {
my($inName) = $_[0];
my($inPass) = $_[1];
my($inExt) = $_[2];
my($goodData) = 1;
my($select) = $dbh->prepare("SELECT id FROM $databasesTableName WHERE name = '$inName'");
my($path) = $documentRoot.$inName."_config.".$inExt;
$select->execute();
if ($select->rows < 1 ) {
$goodData = 0;
}
while ( $result = $select->fetchrow_hashref() )
{
my($insert) = $dbh->do("INSERT INTO $configTableName(databaseId, username, password, path)".
"VALUES('$$result{'id'}', '$inName', '$inPass', '$path')");
}
return 1;
}
Errors:
Use of uninitialized value in concatenation (.) or string at ./dbcreator.pl line 142.
Use of uninitialized value in concatenation (.) or string at ./dbcreator.pl line 154.
Line 142:
$update = $dbh->do("UPDATE ${tablename}
SET ${jobStatus}='${newStatus}'
WHERE id = '$$result{'id'}'");
Line 154:
print "Successfully created $$result{'databaseName'}\n";
The reason I think the problem comes from the function call is because if I comment out the function call, everything works great!
If anyone could help me understand what's going on, that would be great.
Thanks,
p.s. If you notice a security issue with the whole storing passwords as plain text in a database, that's going to be addressed after this is working correctly. =P
Dylan
You do not want to store a reference to the $result returned from fetchrow_hashref, as each subsequent call will overwrite that reference.
That's ok, you're not using the reference when you are calling generate_config, as you are passing data in by value.
Are you using the same $result variable in generate_config and in the calling function? You should be using your own 'my $result' in generate_config.
while ( my $result = $select->fetchrow_hashref() )
# ^^ #add my
That's all that can be said with the current snippets of code you've included.
Some cleanup:
When calling generate_config you are passing by value, not by reference. This is fine.
you are getting an undef warning, this means you are running with 'use strict;'. Good!
create lexical $result within the function, via my.
While $$hashr{key} is valid code, $hashr->{key} is preferred.
you're using dbh->prepare, might as well use placeholders.
sub generateConfig {
my($inName, inPass, $inExt) = #_;
my $goodData = 1;
my $select = $dbh->prepare("SELECT id FROM $databasesTableName WHERE name = ?");
my $insert = $dbh->prepare("
INSERT INTO $configTableName(
databaseID
,username
,password
,path)
VALUES( ?, ?, ?, ?)" );
my $path = $documentRoot . $inName . "_config." . $inExt;
$select->execute( $inName );
if ($select->rows < 1 ) {
$goodData = 0;
}
while ( my $result = $select->fetchrow_hashref() )
{
insert->execute( $result->{id}, $inName, $inPass, $path );
}
return 1;
}
EDIT: after reading your comment
I think that both errors have to do with your using $$result. If $result is the return value of fetchrow_hashref, like in:
$result = $select->fetchrow_hashref()
then the correct way to refer to its values should be:
print "Successfully created " . $result{'databaseName'} . "\n";
and:
$update = $dbh->do("UPDATE ${tablename}
SET ${jobStatus}='${newStatus}'
WHERE id = '$result{'id'}'");
OLD ANSWER:
In function generateConfig, you can pass a reference in using this syntax:
generateConfig(\$result{'databaseName'},$newPassword, "php");
($$ is used to dereference a reference to a string; \ gives you a reference to the object it is applied to).
Then, in the print statement itself, I would try:
print "Successfully created $result->{'databaseName'}->{columnName}\n";
indeed, fetchrow_hashref returns a hash (not a string).
This should fix one problem.
Furthermore, you are using the variable named $dbh but you don't show where it is set. Is it a global variable so that you can use it in generateConfig? Has it been initialized when generateConfig is executed?
This was driving me crazy when I was running hetchrow_hashref from Oracle result set.
Turened out the column names are always returned in upper case.
So once I started referencing the colum in upper case, problem went away:
insert->execute( $result->{ID}, $inName, $inPass, $path );