view release on metacpan or  search on metacpan

lib/Apache/SdnFw/lib/DB.pm  view on Meta::CPAN

	my $dbh = DBI->connect("dbi:mysql:$db_string",$db_user,$db_pass, { RaiseError => 1, Warn => 0 });

	$dbh->{RaiseError} = 0;

	return $dbh;
}

sub db_connect {
	my $db_string = shift;
	my $db_user = shift;

	my $dbh = DBI->connect("dbi:Pg:$db_string",$db_user,undef, { RaiseError => 1, Warn => 0 });
	$dbh->{RaiseError} = 0;

	return $dbh;
}

sub debug_start {
	my $s = shift;
	my $q = shift; #query

	return undef unless($s->{dbdbst});

	my $t = time-$s->{dbdbst};

	my $c = shift; # caller
	my $nt = sprintf "%.4f", $t;
	my @nc = split ' ', $c;

	$s->{dbdbdata} .= "---|$nt|$nc[2]|$nc[0]|";

	return time; # time we started query
}

sub debug_end {
	my $s = shift;
	my $sq = shift; # time query started

	return unless($sq);

	my $cache_used = (shift) ? '*' : '';

	my $t = time-$sq;
	my $nt = sprintf "%.4f", $t;
	$s->{dbdbdata} .= "$nt|$cache_used\t";
}

=head2 db_insert

 $s->db_insert($table,\%data,[$keyfield]);

=cut

sub db_insert {
	my $s = shift;
	my $dbh = $s->{dbh};
	my $table = shift;
	my $data = shift;
	my $keyfield = shift;

	my (@keys,@values,$key,@bind);

	foreach $key (keys %$data) {
		next if ($data->{$key} eq '');
		next if ($data->{$key} eq 'NULL');
		push @keys, qq($key);
		if ($data->{$key} =~ m/^_raw:(.+)$/) {
			push @bind, $1;
			next;
		}
		push @bind, '?';
		push @values, $data->{$key};
	}

	my $columns = join ',', @keys;
	my $bind = join ',', @bind;

	my $query = qq|INSERT INTO $table ($columns) VALUES ($bind)|;
	if ($keyfield) {
		$query .= " RETURNING $keyfield";
	}

	my $st = debug_start($s,$query,(join ' ', caller)); # if (defined($s->{dbdbf}));

	my $sth;
	croak $dbh->errstr."\n$query\n\n" unless($sth = $dbh->prepare($query));
	croak $dbh->errstr."\n$query\n@values\n" unless($sth->execute(@values));

	debug_end($s,$st); # if (defined($s->{dbdbf}));

	if ($keyfield) {
		my $id = ($sth->fetchrow_array)[0];
		$sth->finish;
		return $id;
	} else {
		$sth->finish;
		return '';
	}
}

=head2 db_update_key

 $s->db_update_key($table,$keyfield,$keyid,\%data);

=cut

sub db_update_key {
	my $s = shift;
	my $dbh = $s->{dbh};
	my $table = shift;
	my $keyfield = shift; # can be item_id or item_id:location_id
	my $keyid = shift; # can be 1235 or 1234:7890
	my $data = shift;

	my (@keys,@values);

	my @keyfields;
	foreach my $kf (split ':', $keyfield) {
		push @keyfields, "$kf=?";
	}

	foreach my $key (keys %$data) {
		if ($data->{$key} eq '' || $data->{$key} eq 'NULL') {
			push @keys, qq($key=NULL);
			next;
		}
		if ($data->{$key} =~ /^_raw:(.+)$/) {
			push @keys, qq($key=$1);
			next;
		}
		push @keys, qq($key=?);
		push @values, $data->{$key};
	}
	
	my $columns = join ',', @keys;
	push @values, (split ':', $keyid);

	my $where = join ' AND ', @keyfields;