Retrieve exception message from postgresql function - perl

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();

Related

Solved: DBI cached statements gone and CGI::Session is stucked

I'm using Apache2.2(worker)/mod_perl 2.0.4/Apache::DBI/CGI::Session and Firebird RDBMS.
I also wrote CGI::Session::Driver::firebird.pm to work with Firebird RDBMS.
DB connection is pooled by Apache::DBI and give connection handle to CGI::Session {Handle=>$dbh}.
Number of DB connection is equals to number of worker processes.
I posted Programming with Apache::DBI and firebird. Get Stucked httpd on exception 3 month ago.
I found a reason of that issue, and want to know how to fix it.
$dbh = DBI->connect("dbi:Firebird:db=$DBSERVER:/home/cdbs/xxnet.fdb;
ib_charset=UTF8;ib_dialect=3",$DBUSER,$DBPASS,{
AutoCommit=>1,
LongReadLen=>8192,
RaiseError=>1
});
my $session = new CGI::Session('dbi:firebird',$sessid,{Handle=>$dbh});
my $ses_p1 = $session->param('p1');
eval { $dbh->begin_work()
my $sql = "SELECT * FROM SAMPLETABLE"
my $st = $dbh->prepare($sql);
$st->execute();
while (my $R = $st->fetchrow_hashref()) {
...
}
$st->finish();
}; warn $# if $#;
if ($#) {
$dbh->rollback();
}else{
$dbh->commit();
}
$session->flush();
When an sql error is occured, an eval block catches exception and rollback transaction.
After that, CGI::Session does not retrieve session object no more.
Because prepare_cached statement failes at CGI::Session::DBI.pm.
CGI::Session::DBI.pm use prepare_cached($sql,undef,3). '3' is safest way of using cached statement, but it never find broken statement at this situation.
How to fix this ?
raise request to change CGI::Session::DBI.pm to use prepare() statement ?
write store(),retrieve(),traverse() function in firebird.pm to use prepare() statement ?
It may other prepare_cached() going to fail after catch exception...
1) I add die statement on CGI::Session->errstr()
I got an error "new(): failed: load(): couldn't retrieve data: retrieve(): $sth->execute failed with error message"
2) I flush session object after session->load()
if $session is valid, changes are stored to DB.
3) I replace begin_work() to {AutoCommit}=0
results are same. I can use $dbh normally after catching exception and rollback, BUT new CGI::Session returns error.
------------------------------------------ added 2017/07/26 18:47 JST
Please give me your suggestion.
Thank you.
There are various things you could try before request changes to CGI::Session::Driver::DBI.pm ...
First, change the way new CGI::Session is called in order to diagnose if the problem happens when the session is created or loaded:
my $session = CGI::Session->new('dbi:firebird',$sessid,{Handle=>$dbh}) or die CGI::Session->errstr();
The methods param or delete stores changes to the session inside $session handle, not in DB. flush stores in DB the changes made inside the session handle. Use $session->flush() only after a session->param set/update or a session delete:
$session->param('p1','someParamValue');
$session->flush() or die 'Unable to update session storage!';
# OR
$session->delete();
$session->flush() or die 'Unable to update session storage!';
The method flush does not destroy $session handle (you still can call $session->param('p1') after the flush). In some cases mod_perl caches $session causing problems to the next attempt to load that same session. In those cases it needs to be destroyed when it's not needed anymore:
undef($session)
The last thing i can suggest is avoid using begin_work method, control the transaction behavior with AutoCommit instead (because the DBD::Firebird documentation says that's the way transactions should be controlled) and commit inside the eval block:
eval {
# Setting AutoCommit to 0 enables transaction behavior
$dbh->{AutoCommit} = 0;
my $sql = "SELECT * FROM SAMPLETABLE"
my $st = $dbh->prepare($sql);
$st->execute();
while (my $R = $st->fetchrow_hashref()) {
...
}
$st->finish();
$dbh->commit();
};
if ($#) {
warn "Tansaction aborted! $#";
$dbh->rollback();
}
# Remember to set AutoCommit to 1 after the eval
$dbh->{AutoCommit} = 1;
You said you wrote your own session driver for Firebird... You should see how the CGI/Driver/sqlite.pm or CGI/Driver/mysql.pm are made, maybe you need to write some fetching method you are missing...
Hope this helps!!

Sybase Warning messages from perl DBI

I am connecting to sybase 12 from a perl script and calling storedprocs, I get the following warnings
DBD::Sybase::db prepare failed: Server message number=2401 severity=11 state=2 line=0 server=SERVER_NAME text=Character
set conversion is not available between client character set 'utf8' and server character set 'iso_1'.
Server message number=2411 severity=10 state=1 line=0 server=SERVER_NAME text=No conversions will be done.
at line 210.
Now, I understand these are only warnings, and my process works perfectly fine, but I am calling my stored proc in a loop and throughout the day and hence it creates a lot of warning message in my log files which causes the entire process to run a bit slower than expected. Can someone help me how can i suppress these please?
You can use a callback to handle the messages you want ignored. See the DBD::Sybase docs. The below is derived from the docs. You specify the message numbers you would like to ignore.
%blocked_msgs = map { $_ => 1 } ( 2401, 2411 );
sub err_handler {
my($err, $sev, $state, $line, $server, $proc, $msg, $sql, $err_type) = #_;
if ( exists $blocked_msgs{$err} ) { # it's a blocked message
return 0; # This is not an error
}
return 1;
}
This is how you might use it:
$dbh = DBI->connect('dbi:Sybase:server=troll', 'sa', '');
$dbh->{syb_err_handler} = \&err_handler;
$dbh->do("exec someproc");
$dbh->disconnect;

How to create trigger in DB with help of `DBIx::Class` using add_trigger method?

I want to add trigger into my database. I use DBIx::Class and follow these examples: 1, 2.
My code is:
package App::Schema;
use base qw/DBIx::Class::Schema/;
__PACKAGE__->load_namespaces();
sub sqlt_deploy_hook {
my ($self, $schema) = #_;
$schema->add_trigger( name => 'foo' );
}
1;
But I get this error:
Failed to translate to YAML: translate: Error with producer 'SQL::Translator::Producer::YAML': Can't call method "name" on an undefined value at /home/kes/work/projects/x/app/local/lib/perl5/SQL/Translator/Schema/Trigger.pm line 198
When run command with all environment variables as required by dbic-migration:
dbic-migration --force --schema_class App::Schema --database PostgreSQL -Ilib prepare
Which point me somewhere into SQL::Translator::Schema::Trigger
What did I miss? How to fix this error?
UPD
Even when I add all arguments I got error:
Failed to translate to YAML: translate: Error with parser 'SQL::Translator::Parser::DBIx::Class': Table named users doesn't exist at /home/kes/work/projects/x/app/local/lib/perl5/SQL/Translator/Schema/Trigger.pm line 54
Here the target line:
my $table = $args->{schema}->get_table($arg)
or die "Table named $arg doesn't exist";
Modified code:
sub sqlt_deploy_hook {
my ($self, $schema) = #_;
warn "TABLES: " ,$schema->get_tables ,"\n";
$schema->add_trigger(()
,name => 'foo'
,perform_action_when => 'after'
,database_events => 'insert'
,on_table => 'users'
,action => 'text'
,scope => 'row'
);
}
This code produce next warnings:
TABLES: users
TABLES: dbix_class_deploymenthandler_versions
But DB has only one table at the moment. I expect it at least should produce:
TABLES: users dbix_class_deploymenthandler_versions
How to create trigger in DB?
There maybe the problem with DBIx::Class::ResultSource::default_sqlt_deploy_hook:
which was originally designed to expect the Result class name and the $sqlt_table instance of the table being deployed
As work around add next line of code before add_trigger:
return unless grep $_ eq 'users', $schema->get_tables;
But the recommend way is to create deploy/upgrade/downgrade .sql files manually

Ignoring GET error of an unexisting webpage

I use WWW::Mechanize to fetch and process web pages. I have a piece of code, which looping through a list of web pages. It looks approximately like this:
while (<$readFileHandle>) {
$mech->get("$url");
}
Now the problem occurs when one of the web pages in the list does not exist for some reason(which is ok). The issue is that in this case - the program returns an error and exits. The error looks like that:
Error GETing <url> Not Found at <PATH/file.pl> line ...
How can I ignore such type of error? I want the program just keep running.
You need to use eval {}; for this:
while ( my $url = readline($readFileHandle) ) {
chomp $url;
eval {
$mech->get($url);
};
if ($#) {
#error processing code
}
}

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

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.