Only in DBD-Pg-1.32-dist: Makefile.old diff -ur DBD-Pg-1.32-dist/Pg.pm DBD-Pg-1.32/Pg.pm --- DBD-Pg-1.32-dist/Pg.pm 2004-02-25 10:25:52.000000000 -0800 +++ DBD-Pg-1.32/Pg.pm 2004-12-12 17:56:15.000000000 -0800 @@ -145,7 +145,15 @@ }); # Connect to the database.. - DBD::Pg::db::_login($dbh, $dbname, $user, $auth) or return undef; + DBD::Pg::db::_login($dbh, $dbname, $user, $auth) or return undef; + + # Fill list of prepared query plans: + # This initializes the per-dbh plan cache, by + # asking Postgres for a list of existing query plans. + + DBD::Pg::db::_set_plancache_max($dbh, $ENV{'PLANCACHE_MAX'}); + DBD::Pg::db::_set_plancache_reap($dbh, $ENV{'PLANCACHE_REAP'}); + DBD::Pg::db::_init_plancache($dbh) or return undef; $dbh; } @@ -158,21 +166,248 @@ use strict; use Carp (); + # plancache: + # This hash maps sql statements to plan cache entries, + # avoiding the need to query pg_prepared_query_plans() + # before each and every prepare. + + my %plancache; + + # plancache_max, plancache_reap: + # Tuning knobs for the simple server-side LRU code. The + # $plancache_max setting is the maximum number of cached + # plans that may exist. The $plancache_reap setting + # is the number of entries (below $plancache_max) that an + # invocation of the LRU code will try to remove. + + my $plancache_max; + my $plancache_reap; + + # quote_ident: + # Quote an identifier. A quoted identifier refers to an object + # (e.g. column, table), and can contain any literal character except + # for a double quote (`"'). Double quotes must be escaped with a + # double quote (e.g. `"' -> `""'). This is a direct analogue of the + # server-side quote_ident() function. See section 4.1.1 of the + # PostgreSQL manual for more information. + + sub quote_ident { + my ($dbh, $s) = @_; + $s =~ s/"/""/g; + return "\"$s\""; + } + + # _prepare_with_plancache: + # Call _prepare. If the there is a cached plan that is + # suitable, tell _prepare to use it. Otherwise, call _prepare + # without specifying a plan (a new one will be created). + + sub _prepare_with_plancache { + my ($dbh, $sth, $stmt, @attribs) = @_; + my $hr, my $plan, my $atime; + + # Check cache + if ($hr = $plancache{$stmt}) { + $plan = $$hr{'plan_name'}; + } + + # Execute, possibly with cached plan + ($plan = DBD::Pg::st::_prepare($sth, $stmt, $plan, @attribs)) + or return undef; + + # Update cache: + # Only do this if the statement qualified for a server-side prepare. + + if ($plan != 1) { + $$hr{'plan_name'} = $plan; + $plancache{$stmt} = $hr; + } + + $sth; + } + + # _init_plancache: + # Get information about the prepared statements on the + # current connection. Place this information in the + # %plancache hash, destroying what was there before. + # + # Successive calls to prepare() can use the information + # in this hash to determine whether or not a particular + # statement has already been prepared on this connection. + # Usage of an existing plan eliminates lots of parsing + # and query optimization work that would otherwise be + # duplicated. + # + # This initialization is helpful only in conjunction with + # an external pools or load balancer. In all other cases + # (notably Apache::DBI), the DBD::Pg::st object travels + # with the underlying connection socket. + + sub _init_plancache { + my ($dbh) = @_; + my $stmt = 'select * from pg_prepared_query_plans()'; + + my $sth = DBI::_new_sth($dbh, {'Statement' => $stmt}); + + undef %plancache; + + _prepare_with_plancache($dbh, $sth, $stmt) + or return undef; + + $sth->execute() + or return undef; + + while ((my $hr = $sth->fetchrow_hashref())) { + $$hr{'plan_name'} = quote_ident($dbh, $$hr{'plan_name'}); + $plancache{$$hr{'plan_sql'}} = $hr; + } + + return 1; + } + + # _reap_plancache_single: + # Remove $stmt from the client-side and server-side + # query caches. + + sub _reap_plancache_single { + my ($dbh, $stmt) = @_; + + my $d_stmt = 'deallocate prepare ' . + $plancache{$stmt}{'plan_name'}; + + my $d_sth = DBI::_new_sth($dbh, {'Statement' => $d_stmt}); + + # Ineligible for server-side preparation: + # A deallocation will never generate a server-side query + # plan - even if we pass it to _prepare_with_plancache. + # To be explicit about this, we call _prepare directly. + + DBD::Pg::st::_prepare($d_sth, $d_stmt) + or return undef; + + $d_sth->execute() + or return undef; + + # Remove from client-side cache + delete $plancache{$stmt}; + + return 1; + } + + # _reap_plancache_lru: + # Deallocate the $count least frequently used prepared + # statements from the server's query plan cache. While + # the LRU calculation could be done on the client side, + # it'd involve keeping a seperate data structure to + # index %plancache by access_time, which would need to + # be updated from prepare - this is more code, impacts the + # fast path, and may not be appreciably faster than just + # doing the calculation on the server (save for cases of + # cache ping-pong, which we want to avoid altogether, + # rather than optimize). + + sub _reap_plancache_lru { + my ($dbh, $count) = @_; + + if ($count <= 0) + { return 1; } + + my $stmt = 'select * from pg_prepared_query_plans()' . + ' order by access_time asc'; + + my $sth = DBI::_new_sth($dbh, {'Statement' => $stmt}); + + _prepare_with_plancache($dbh, $sth, $stmt) + or return undef; + + $sth->execute() + or return undef; + + while (($count--) && (my $hr = $sth->fetchrow_hashref())) { + _reap_plancache_single($dbh, $$hr{'plan_sql'}); + } + + return 1; + } + + # _reap_plancache_full: + # Deallocate the entire plan cache. + + sub _reap_plancache_full { + my ($dbh) = @_; + + foreach my $sql (keys %plancache) { + _reap_plancache_single($dbh, $sql); + } + } + + # _rewrite_prepare_statement: + # Perform some rule-based rewriting of queries. + # This could include whitespace elimination, placeholder + # reordering, and other transformations. + + sub _rewrite_prepare_statement { + my($dbh, $stmt, @attribs)= @_; + return $stmt; + } + + # _set_plancache_max: + # Set the maximum number of statements that can be in the + # cache at any particular time. Returns the old value. + + sub _set_plancache_max { + my($dbh, $max)= @_; + + my $old_max = $plancache_max; + $plancache_max = ($max > 0 ? $max : 0); + + return $old_max; + } + + # _set_plancache_reap: + # Set the number of statements that will be deallocated + # in a single run of _reap_plancache_lru. + + sub _set_plancache_reap { + my($dbh, $count)= @_; + + my $old_reap = $plancache_reap; + $plancache_reap = ($count > 0 ? $count : 0); + + return $old_reap; + } + + # prepare: + # API function. See documentation. + sub prepare { - my($dbh, $statement, @attribs)= @_; + my($dbh, $stmt, @attribs)= @_; - # create a 'blank' sth + # Perform rule-based statement rewriting + $stmt = _rewrite_prepare_statement($dbh, $stmt); - my $sth = DBI::_new_sth($dbh, { - 'Statement' => $statement, - }); + # Invoke LRU code: + # If the plan cache is "disabled", trash all prepared statements. + # Otherwise, use the server-side LRU algorithm to prune old ones. + + if ($plancache_max == 0) { + _reap_plancache_full($dbh); + } else { + if ((my $cur = scalar(keys(%plancache))) >= $plancache_max) { + _reap_plancache_lru($dbh, $cur - $plancache_max + $plancache_reap) + or return undef; + } + } + + # Prepare statement + my $sth = DBI::_new_sth($dbh, {'Statement' => $stmt}); - DBD::Pg::st::_prepare($sth, $statement, @attribs) or return undef; + _prepare_with_plancache($dbh, $sth, $stmt, @attribs) + or return undef; $sth; } - sub ping { my($dbh) = @_; local $SIG{__WARN__} = sub { } if $dbh->{PrintError}; diff -ur DBD-Pg-1.32-dist/Pg.xsi DBD-Pg-1.32/Pg.xsi --- DBD-Pg-1.32-dist/Pg.xsi 2004-12-05 11:16:03.000000000 -0800 +++ DBD-Pg-1.32/Pg.xsi 2004-12-05 10:28:21.000000000 -0800 @@ -403,15 +403,24 @@ void -_prepare(sth, statement, attribs=Nullsv) +_prepare(sth, statement, force_plan = Nullsv, attribs = Nullsv) SV * sth char * statement + SV * force_plan SV * attribs CODE: { + STRLEN lna; D_imp_sth(sth); DBD_ATTRIBS_CHECK("_prepare", sth, attribs); - ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no; + + if (force_plan) + imp_sth->plan = (SvOK(force_plan) ? SvPV(force_plan, lna) : NULL); + + if (dbd_st_prepare(sth, imp_sth, statement, attribs)) + ST(0) = (imp_sth->plan ? newSVpv(imp_sth->plan, 0) : &sv_yes); + else + ST(0) = &sv_no; } diff -ur DBD-Pg-1.32-dist/dbdimp.c DBD-Pg-1.32/dbdimp.c --- DBD-Pg-1.32-dist/dbdimp.c 2004-02-03 11:50:22.000000000 -0800 +++ DBD-Pg-1.32/dbdimp.c 2004-12-11 07:48:55.000000000 -0800 @@ -382,7 +382,7 @@ /* We assume that disconnect will always work */ /* since most errors imply already disconnected. * XXX: Um we turn active off, then return 0 on a rollback failing? - * Check to see what happenens -- will we leak memory? :rl + * Check to see what happens -- will we leak memory? :rl */ DBIc_ACTIVE_off(imp_dbh); @@ -538,9 +538,9 @@ if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_prepare: statement = >%s<\n", statement); } /* scan statement for '?', ':1' and/or ':foo' style placeholders */ - if((dbd_preparse(sth, imp_sth, statement)) == 0) + if((dbd_preparse(sth, imp_sth, statement, NULL)) == 0) return 0; - + if (is_tx_stmt(statement)) { warn("please use DBI functions for transaction handling"); return(0); @@ -562,19 +562,23 @@ const char *statement; { static unsigned int prep_stmt_id = 0; + static char prep_stmt_str[48]; int place_holder_count, stmt_len, status; - int digits, i; + int plan_strlen = 0, i; int offset = 0; D_imp_dbh_from_sth; - - ++prep_stmt_id; - digits = 0; - i = prep_stmt_id; - do { - ++digits; - i /=10; - } while (i>0); /* 12*/ - + char *plan; + + if (imp_sth->plan) { + plan = imp_sth->plan; + plan_strlen = strlen(plan); + } else { + ++prep_stmt_id; + plan_strlen = snprintf(prep_stmt_str, 48, + "\"DBD::ChurlPg::cached_query %i\"", prep_stmt_id); + plan = prep_stmt_str; + } + /* //PerlIO_printf(DBILOGFP, "Statement: %s \n", statement); */ prescan_stmt(statement, &stmt_len, &place_holder_count); @@ -582,11 +586,11 @@ /* add space for placeholders candidates */ stmt_len += calc_ph_space(place_holder_count); - - offset += strlen ("PREPARE \"DBD::ChurlPg::cached_query \" ("); - offset += digits; /* number of digits in prep_statement_id */ + offset += strlen ("PREPARE "); + offset += strlen(" ()"); + offset += plan_strlen; offset += place_holder_count*strlen("varchar, "); - offset += strlen(") AS"); + offset += strlen(" AS "); stmt_len += offset; ++stmt_len; /* for term \0 */ @@ -613,23 +617,27 @@ server side prepare this statement TODO: remalloc*/ if (!is_dml(imp_sth->statement+offset) || imp_dbh->version.ver < 7.3) return 1; - - /* 1 == PREPARE -- TODO: Fix ugly number thing*/ - build_preamble(imp_sth->statement, 1, place_holder_count, prep_stmt_id); - - /* //PerlIO_printf(DBILOGFP, "Rewritten stmt: %s\n", imp_sth->statement); */ - - imp_sth->result = PQexec(imp_dbh->conn, imp_sth->statement); - status = imp_sth->result ? PQresultStatus(imp_sth->result) : -1; - if (status != PGRES_COMMAND_OK) { - pg_error(sth,status, PQerrorMessage(imp_dbh->conn)); - return 0; + + if (!imp_sth->plan) { + /* 1 == PREPARE -- TODO: Fix ugly number thing*/ + build_preamble(imp_sth->statement, 1, place_holder_count, plan); + + imp_sth->result = PQexec(imp_dbh->conn, imp_sth->statement); + status = imp_sth->result ? PQresultStatus(imp_sth->result) : -1; + + if (status != PGRES_COMMAND_OK) { + pg_error(sth,status, PQerrorMessage(imp_dbh->conn)); + return 0; + } + if (imp_sth->result) + PQclear(imp_sth->result); + + /* Return dynamically-generated plan name */ + imp_sth->plan = plan; } - if (imp_sth->result) - PQclear(imp_sth->result); - + /* 2 == EXECUTE -- TODO: Fix ugly number thing & remalloc*/ - build_preamble(imp_sth->statement, 2, place_holder_count, prep_stmt_id); + build_preamble(imp_sth->statement, 2, place_holder_count, plan); /* //PerlIO_printf(DBILOGFP, "Rewritten stmt: %s\n", imp_sth->statement); */ imp_sth->server_prepared = 1; @@ -1116,14 +1124,15 @@ { if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_destroy\n"); } - /* Free off contents of imp_sth */ - + /* Free off contents of imp_sth: + Skip this. We want prepared statements to remain in the cache. */ +#if 0 if (imp_sth->server_prepared) if (deallocate_statement(sth, imp_sth) < 1) warn("Something Ugly Happened. And whatever it was, it caused" "us not to be able to deallocate the prepared statement. " "Prolly a tx went bad or something like that"); - +#endif Safefree(imp_sth->statement); if (imp_sth->place_holders) Safefree(imp_sth->place_holders); diff -ur DBD-Pg-1.32-dist/dbdimp.h DBD-Pg-1.32/dbdimp.h --- DBD-Pg-1.32-dist/dbdimp.h 2004-01-21 15:47:18.000000000 -0800 +++ DBD-Pg-1.32/dbdimp.h 2004-12-05 10:24:59.000000000 -0800 @@ -63,6 +63,7 @@ /* Input Details */ char *statement; /* sql (see sth_scan) */ + char *plan; /* existing plan name to use, or null to use counter */ HV *all_params_hv; /* all params, keyed by name */ bool server_prepared; /* Did we prepare this server side?*/ diff -ur DBD-Pg-1.32-dist/prescan_stmt.c DBD-Pg-1.32/prescan_stmt.c --- DBD-Pg-1.32-dist/prescan_stmt.c 2004-01-13 08:59:26.000000000 -0800 +++ DBD-Pg-1.32/prescan_stmt.c 2004-12-11 07:48:42.000000000 -0800 @@ -1,5 +1,5 @@ /******************* - * pre_scan_stmt() + * prescan_stmt() * returns the length of the statement and * an estimate of how many place holders it contains. */ @@ -28,7 +28,7 @@ /******************* - * clc_ph_space() + * calc_ph_space() * givin a place_holder count, retuns the * string space needed to hold them. */ @@ -56,7 +56,7 @@ /******************* * is_dml() - * givin a statement/fragment makes a guess as to whether + * given a statement/fragment makes a guess as to whether * it be a DML statement */ @@ -81,10 +81,7 @@ as they actually look at the field type. Until I get a fix for this we don't prepare them */ - if (0/* !strcasecmp(token, "SELECT") - || !strcasecmp(token, "DELETE") */ - /*|| !strcasecmp(token, "UPDATE") - || !strcasecmp(token, "INSERT")*/ ) + if (!strcasecmp(token, "SELECT") || !strcasecmp(token, "DELETE")) { /* //PerlIO_printf(DBILOGFP, "Is DML\n"); */ return 1; @@ -135,7 +132,7 @@ /******************* - * scan_placeholders() + * rewrite_placeholders() * old preparse. this one takes a statement and sets up * the place holder SV* */ @@ -165,27 +162,7 @@ src = statement; dest = internal; - /* // PerlIO_printf(DBILOGFP, "HERE: stmt: %s\n", src); */ while ((ch = *src++)) { - if (in_comment) { - /* SQL-style and C++-style */ - if ((in_comment == '-' || in_comment == '/') && - '\n' == ch) - { - in_comment = '\0'; - - } else if (in_comment == '*' && '*' == ch && - '/' == *src) /* C style */ - { - /* *dest++ = ch; */ - /* avoids asterisk-slash-asterisk issues */ - ch = *src++; - in_comment = '\0'; - } - /* *dest++ = ch; */ - continue; - } - if (in_literal) { /* check if literal ends but keep quotes in literal */ if (ch == in_literal) { @@ -201,32 +178,7 @@ } *dest++ = ch; continue; - } - - /* Look for comments: SQL-style or C++-style or C-style */ - if (('-' == ch && '-' == *src) || - ('/' == ch && '/' == *src) || - ('/' == ch && '*' == *src)) - { - in_comment = *src; - /* We know *src & the next char are to be copied, so do - it. In the case of C-style comments, it happens to - help us avoid slash-asterisk-slash oddities. */ - /* *dest++ = ch; */ - continue; - } - - - /* collapse whitespace */ - if ('\n' == ch) { - *(src-1) = ' '; - ch = ' '; - } - if (isSPACE(ch) && src-2 > statement && - isSPACE(*(src-2)) ) - { - continue; - } + } /* check if no placeholders */ if (':' != ch && '?' != ch && '$' != ch) { @@ -249,8 +201,7 @@ if (ch != '?' && !isALNUM(*src)) continue; - - sprintf(dest," $%d", ++place_holder_count); + sprintf(dest,"$%d", ++place_holder_count); namelen = strlen(dest); dest += namelen; @@ -286,9 +237,6 @@ imp_sth->all_params_hv = newHV(); } - /* //PerlIO_printf(DBILOGFP, "phs name start:%s len: %i Index:%i\n", */ - /* // ph_name_start,namelen, place_holder_count); */ - hv =hv_fetch(imp_sth->all_params_hv,ph_name_start,namelen,0); if (NULL == hv) { @@ -328,15 +276,16 @@ * sticks the SQL needed to prepare/execute a statement * at the head of the statement. * type: is one of PREPARE or EXECUTE + * plan_name: a quoted and escaped plan name */ void -build_preamble (statement, type, place_holder_count, prep_stmt_id) +build_preamble (statement, type, place_holder_count, plan_name) char *statement; /* const char *type; */ int type; int place_holder_count; - int prep_stmt_id; + const char *plan_name; { int i; char *keyword; @@ -348,11 +297,9 @@ else croak("error"); + sprintf(statement, "%s %s", keyword, plan_name); - sprintf(statement, - "%s \"DBD::ChurlPg::cached_query %i\"", keyword, prep_stmt_id); - - /* //PerlIO_printf(DBILOGFP, "statement: %s\n", statement); */ + /* //PerlIO_printf(DBILOGFP, "statement: %s\n", statement); */ if (!place_holder_count) { statement += strlen(statement);