view release on metacpan or  search on metacpan

lib/DBI/BabyConnect.pm  view on Meta::CPAN

}
	
sub dbierror {
	my $class = shift;
	return "DBI ERROR No:", $DBI::err , " -- " ,  $DBI::errstr;
}

sub babyconfess {
	my $class = shift;
	eval { confess('') };
	my @stack = split m/\n/, $@;
	shift @stack for 1..3;
	my $stack = join "\n", @stack;
	return "$stack\n\n";
}


sub raiseerror {
	my $class = shift;
	if(@_) {
		$class->{dbraiseerror} = shift;

lib/DBI/BabyConnect.pm  view on Meta::CPAN

	#my ($src_pkg,$src_file,$src_line,$src_meth) = (caller, (caller 2)[3]);

	my $time = iso_date();
	print STDERR "\n\nDIE =================================== $time \n";
	print STDERR "msg=". $s."\n";
	print STDERR "\t++ $cur_pkg\n\t++ $cur_meth\n\t++ $cur_file\n\t++ $cur_line\n(END)\n";
	#$src_pkg && print STDERR "\n\t++ $src_pkg\n\t++ $src_meth\n\t++ $src_file\n\t++ $src_line\n";
	#print STDERR "DBI STATUS: DBI::err=\t".$DBI::err."\n\t DBI::errstr=:\t".$DBI::errstr."\n\t DBI LED=\t".$DBI::state."\n\n";

	eval { confess('') };
	my @stack = split m/\n/, $@;
	shift @stack for 1..3;
	my $stack = join "\n", @stack;
	print STDERR $stack,"\n\n";
};

$SIG{__WARN__} = sub {
#print STDERR "WARN: $_[0]" 
	my $s = shift;
	my ($cur_pkg,$cur_file,$cur_line,$cur_meth) = (caller, (caller 1)[3] || '');
	#my ($src_pkg,$src_file,$src_line,$src_meth) = (caller, (caller 0)[3]);