view release on metacpan or  search on metacpan

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

#connection()

sub connection {
	my $class = shift;
	return $class->{connection};
}
sub _set_connection {
	my $class = shift;
	my $dbiconnection = shift;
	$class->{connection} = $dbiconnection;
}
	
sub _internal_state {
	my $class = shift;
	if (@_)
	{
		my $state = shift;
		$class->{_internal_state} = $state;
	}
	else
	{
		return $class->{_internal_state};
	}
}

# used internally
sub state {
	my $class = shift;
	if (@_)
	{
		my $state = shift;
		$class->{state} = $state;
	}
	else
	{
		return $class->{state};
	}
}
	
sub status {
	my $class = shift;
	if (@_)
	{
		my $status = shift;
		$class->{status} = $status;
	}
	else
	{
		return $class->{status};
	}
}
	
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;
	}
	return $class->{dbraiseerror};
}

sub is_RaiseError {
	my $class = shift;
	return $class->raiseerror;
}


sub printerror {
	my $class = shift;
	if(@_) {
		$class->{dbprinterror} = shift;
	}
	return $class->{dbprinterror};
}
 sub is_PrintError
 {
 	my $class = shift;
 	return $class->printerror;
 }


sub autocommit {
	my $class = shift;
	if(@_) {
		$class->{dbautocommit} = shift;
	}
	return $class->{dbautocommit};
}

sub is_AutoCommit {
	my $class = shift;
	return $class->autocommit;
}

sub are_commited {
	my $class = shift;
	die "NOT IMPLEMENTED -- NEED DBI::BabiesTransactionBundle!\n";
}

sub are_rolled {
	my $class = shift;
	die "NOT IMPLEMENTED -- NEED DBI::BabiesTransactionBundle!\n";
}

sub autorollback {
	my $class = shift;
	if(@_) {

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

##############################################################################
# _confFromObject() used when calling reconnect() method that is
# called after the instantiation of the class 
sub _confFromObject {
	my $class = shift;
	my $conf = shift;

	# %$dbiParams are already set to default, but will be overridden from config file
	##foreach my $k (keys %$dbiDefaultParams) {
	##	$$dbiParams{$k} = $$dbiDefaultParams{$k};
	##}

	# override from conf object
	#foreach my $k (keys %$conf) {
	#	$$dbiParams{$k} = $$conf{$k};
	#}

	# override from conf object
	foreach my $k (keys %$dbiParams) {
		$$dbiParams{$k} = $$conf{$k} if defined $$conf{$k};
		# set'em in the class
		${$class->{_CONF}}{$k} = $$dbiParams{$k};
	}
	# override from conf object
	foreach my $k (keys %$dbiLags) {
		$$dbiLags{$k} = $$conf{$k} if defined $$conf{$k};
		# set'em in the class
		${$class->{_CONF}}{$k} = $$dbiLags{$k};
	}

}


# IO Section
########################################################################################
########################################################################################
########################################################################################
########################################################################################
sub _traceln {
	my $class = shift;
	my $s = shift;
	return unless $class->{debhook};
	$class->{debhook}->print("$s");
}

$SIG{__DIE__} = sub {
#print STDERR "DIE: $_[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) = @_ ? @_ : (undef,undef,undef,undef)
	#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]);

	my $time = iso_date();
	print STDERR "WARN =================================== $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";
	#print STDERR "++ $src_pkg\n++ $src_meth\n++ $src_file\n++ $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";
};

# when calling w/o beginning and ending, use this _tracing
sub _tracing {
	my $class = shift;
	my $cumu_conrun = $class->{cumu_conrun};
	return unless $class->{debhook};
	#return unless $class->{tracing};
	#if ($class->{tracing} ) {
	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) = @{$class->{src}};

	my $time = iso_date();
	$class->{debhook}->print("=================================== $time (CUMU: $cumu_conrun)\n");
	$class->{debhook}->print("msg=".$s."\n");
	$class->{debhook}->print("\t++ $cur_pkg\n\t++ $cur_meth\n\t++ $cur_file\n\t++ $cur_line\n");
	$class->{debhook}->print("\t++ $src_pkg\n\t++ $src_meth\n\t++ $src_file\n\t++ $src_line\n");
	#$class->{debhook}->print("DBI STATUS: DBI::err=\t$DBI::err\n\t DBI::errstr=:\t$DBI::errstr\n\t DBI LED=\t$DBI::state\n\n");
	$class->{debhook}->print("\tDBI STATUS: DBI::err=\t".$DBI::err."\n\t DBI::errstr=:\t".$DBI::errstr."\n\t DBI LED=\t".$DBI::state."\n");
	$class->{debhook}->print("(END)\n\n");
}


#beginning a trace
sub _tracingB {
	my $class = shift;
	my $cumu_conrun = $class->{cumu_conrun};
	# return unless this hook is enabled
	return unless $class->{debhook};
	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) = @{$class->{src}};

	my $time = iso_date();
	$class->{debhook}->print("=================================== $time (CUMU: $cumu_conrun)\n");
	$class->{debhook}->print("msg=".$s."\n");
	$class->{debhook}->print("\t++ $cur_pkg\n\t++ $cur_meth\n\t++ $cur_file\n\t++ $cur_line\n");
	$class->{debhook}->print("\t++ $src_pkg\n\t++ $src_meth\n\t++ $src_file\n\t++ $src_line\n");
}

# closing a trace
sub _tracingE {