/* Copyright (c) 2011 Stefan Suciu Copyright (c) 2011 Damyan Ivanov Copyright (c) 1999-2008 Edwin Pratomo Portions Copyright (c) 2001-2005 Daniel Ritz You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. */ /* vim: set noai ts=4 et sw=4: */ #include "Firebird.h" DBISTATE_DECLARE; static int _cancel_callback(SV *dbh, IB_EVENT *ev) { ISC_STATUS status[ISC_STATUS_LENGTH]; D_imp_dbh(dbh); int ret = 0; if (ev->exec_cb) croak("Can't be called from inside a callback"); if (ev->perl_cb) { ev->state = INACTIVE; SvREFCNT_dec(ev->perl_cb); ev->perl_cb = (SV*)NULL; isc_cancel_events(status, &(imp_dbh->db), &(ev->id)); if (ib_error_check(dbh, status)) ret = 0; else ret = 1; } else croak("No callback found for this event handle. Have you called ib_register_callback?"); return ret; } static int _call_perlsub(IB_EVENT ISC_FAR *ev, short length, #if defined(INCLUDE_TYPES_PUB_H) const ISC_UCHAR *updated #else char ISC_FAR *updated #endif ) { int retval = 1; #if defined(USE_THREADS) || defined(USE_ITHREADS) || defined(MULTIPLICITY) /* save context, set context from dbh */ void *context = PERL_GET_CONTEXT; PERL_SET_CONTEXT(ev->dbh->context); { #else void *context = PERL_GET_CONTEXT; PerlInterpreter *cb_perl = perl_alloc(); PERL_SET_CONTEXT(cb_perl); { #endif dSP; int i, count; SV **svp; HV *posted_events = newHV(); ISC_ULONG ecount[15]; #if defined(INCLUDE_TYPES_PUB_H) ISC_UCHAR *result = ev->result_buffer; #else char ISC_FAR *result = ev->result_buffer; #endif while (length--) *result++ = *updated++; isc_event_counts(ecount, ev->epb_length, ev->event_buffer, ev->result_buffer); for (i = 0; i < ev->num; i++) { if (ecount[i]) { svp = hv_store(posted_events, *(ev->names + i), strlen(*(ev->names + i)), newSViv(ecount[i]), 0); if (svp == NULL) croak("Bad: key '%s' not stored", *(ev->names + i)); } } ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs(sv_2mortal(newRV_noinc((SV*)posted_events))); PUTBACK; count = perl_call_sv(ev->perl_cb, G_SCALAR); SPAGAIN; if (count > 0) retval = POPi; PUTBACK; FREETMPS; LEAVE; #if defined(USE_THREADS) || defined(USE_ITHREADS) || defined(MULTIPLICITY) } /* restore old context*/ PERL_SET_CONTEXT(context); #else } PERL_SET_CONTEXT(context); perl_free(cb_perl); #endif return retval; } /* callback function for events, called by Firebird */ /* static isc_callback _async_callback(IB_EVENT ISC_FAR *ev, short length, char ISC_FAR *updated) */ static ISC_EVENT_CALLBACK _async_callback(IB_EVENT ISC_FAR *ev, #if defined(INCLUDE_TYPES_PUB_H) ISC_USHORT length, const ISC_UCHAR *updated #else short length, char ISC_FAR *updated #endif ) { ISC_STATUS status[ISC_STATUS_LENGTH]; switch (ev->state) { case INACTIVE: break; case ACTIVE: ev->exec_cb = 1; if (_call_perlsub(ev, length, updated) == 0) { ev->state = INACTIVE; ev->exec_cb = 0; break; } ev->exec_cb = 0; isc_que_events( status, &(ev->dbh->db), &(ev->id), ev->epb_length, ev->event_buffer, (ISC_EVENT_CALLBACK)_async_callback, ev ); } return (0); } MODULE = DBD::Firebird PACKAGE = DBD::Firebird #ifndef FB_API_VER #define FB_API_VER 0 #endif BOOT: HV *stash = gv_stashpv( "DBD::Firebird", TRUE ); newCONSTSUB( stash, "fb_api_ver", newSViv(FB_API_VER) ); newCONSTSUB( stash, "client_major_version", newSViv( isc_get_client_major_version() ) ); newCONSTSUB( stash, "client_minor_version", newSViv( isc_get_client_minor_version() ) ); { char version_string[1024]; isc_get_client_version(version_string); int len = strlen(version_string); if (len > 1023) die("Version string buffer overflow detected"); SV *ver = newSVpv(version_string, len); newCONSTSUB( stash, "client_version", ver ); } INCLUDE: Firebird.xsi MODULE = DBD::Firebird PACKAGE = DBD::Firebird::db void _do(dbh, statement, attr=Nullsv) SV * dbh SV * statement PROTOTYPE: $$;$@ CODE: { D_imp_dbh(dbh); ISC_STATUS status[ISC_STATUS_LENGTH]; /* isc api status vector */ STRLEN slen; int retval; char *sbuf = SvPV(statement, slen); DBI_TRACE_imp_xxh(imp_dbh, 1, (DBIc_LOGPIO(imp_dbh), "db::_do\n" "Executing : %s\n", sbuf)); /* we need an open transaction */ if (!imp_dbh->tr) { DBI_TRACE_imp_xxh(imp_dbh, 1, (DBIc_LOGPIO(imp_dbh), "starting new transaction..\n")); if (!ib_start_transaction(dbh, imp_dbh)) { retval = -2; XST_mUNDEF(0); /* <= -2 means error */ return; } DBI_TRACE_imp_xxh(imp_dbh, 1, (DBIc_LOGPIO(imp_dbh), "new transaction started.\n")); } /* we need to count the DDL statement whether in soft / hard commit */ #if 0 /* only execute_immediate statment if NOT in soft commit mode */ if (!(imp_dbh->soft_commit)) { isc_dsql_execute_immediate(status, &(imp_dbh->db), &(imp_dbh->tr), 0, sbuf, imp_dbh->sqldialect, NULL); if (ib_error_check(dbh, status)) retval = -2; else retval = -1 ; } else #endif /* count DDL statements is necessary for ib_commit_transaction to work properly */ { isc_stmt_handle stmt = 0L; /* temp statment handle */ static char stmt_info[] = { isc_info_sql_stmt_type }; char info_buffer[20]; /* statment info buffer */ retval = -2; do { char count_item = 0; /* init statement handle */ if (isc_dsql_alloc_statement2(status, &(imp_dbh->db), &stmt)) break; /* prepare statement */ isc_dsql_prepare(status, &(imp_dbh->tr), &stmt, 0, sbuf, imp_dbh->sqldialect, NULL); if (ib_error_check(dbh, status)) break; /* get statement type */ if (!isc_dsql_sql_info(status, &stmt, sizeof(stmt_info), stmt_info, sizeof(info_buffer), info_buffer)) { /* need to count DDL statments */ short l = (short) isc_vax_integer((char *) info_buffer + 1, 2); ISC_LONG stmt_type = isc_vax_integer((char *) info_buffer + 3, l); switch (stmt_type) { case isc_info_sql_stmt_ddl: imp_dbh->sth_ddl++; break; case isc_info_sql_stmt_insert: count_item = isc_info_req_insert_count; break; case isc_info_sql_stmt_update: count_item = isc_info_req_update_count; break; case isc_info_sql_stmt_delete: count_item = isc_info_req_delete_count; break; } } else break; /* exec the statement */ isc_dsql_execute(status, &(imp_dbh->tr), &stmt, imp_dbh->sqldialect, NULL); if (!ib_error_check(dbh, status)) retval = -1; if (count_item) { ISC_LONG rows = ib_rows(dbh, &stmt, count_item); if ( rows >= 0 ) retval = rows; } } while (0); /* close statement */ if (stmt) isc_dsql_free_statement(status, &stmt, DSQL_drop); } /* for AutoCommit: commit */ if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) { if (!ib_commit_transaction(dbh, imp_dbh)) retval = -2; } if (retval < -1) XST_mUNDEF(0); else XST_mIV(0, retval); /* typically 1, rowcount or -1 */ } void _ping(dbh) SV * dbh CODE: { int ret; ret = dbd_db_ping(dbh); if (ret == 0) XST_mUNDEF(0); else XST_mIV(0, ret); } #define TX_INFOBUF(name, len) \ if (strEQ(item, #name)) { \ *p++ = (char) isc_info_tra_##name; \ res_len += len + 3; \ item_buf_len++; \ continue; \ } #define TX_RESBUF_CASE(name) \ case isc_info_tra_##name:\ {\ keyname = #name;\ /* PerlIO_printf(PerlIO_stderr(), "Got %s\n", keyname); */\ p++;\ length = isc_vax_integer (p, 2);\ p += 2;\ (void)hv_store(RETVAL, keyname, strlen(keyname), \ newSViv(isc_vax_integer(p, (short) length)), 0);\ p += length;\ break;\ } HV* ib_tx_info(dbh) SV* dbh PREINIT: char* p; char* result = NULL; short result_length = 0; ISC_STATUS status[ISC_STATUS_LENGTH]; CODE: { D_imp_dbh(dbh); char request[] = { isc_info_tra_id, #if defined(FB_API_VER) && FB_API_VER >= 20 /* FB 2.0: */ isc_info_tra_oldest_interesting, isc_info_tra_oldest_active, isc_info_tra_oldest_snapshot, isc_info_tra_lock_timeout, isc_info_tra_isolation, isc_info_tra_access, #endif isc_info_end }; RETVAL = newHV(); if (!RETVAL) { if (result) { Safefree(result); } do_error(dbh, 2, "unable to allocate hash return value"); XSRETURN_UNDEF; } if (!imp_dbh->tr) { do_error(dbh, 2, "No active transaction"); XSRETURN_UNDEF; } /* calc required result buffer size */ for (p = request; *p != isc_info_end; p++) { result_length++; /* identifier (1 byte)*/ switch (*p) { #if defined(FB_API_VER) && FB_API_VER >= 20 case isc_info_tra_isolation: /* result: length (2 bytes) + first content (1 byte) + length (2 bytes) + second content (2 bytes max) */ result_length += 7; break; case isc_info_tra_access: /* result: length (2 bytes) + content (1 byte) */ result_length += 3; break; #endif default: result_length += 2; /* length (2 bytes) */ result_length += 4; /* pessimistic */ } } result_length += 1; /* add 1 byte for isc_info_end */ /* try insufficient result_length: result_length = 40; */ try_alloc_result_buffer: Newxz(result, result_length, char); /* PerlIO_printf(PerlIO_stderr(), "result_length: %d\n", result_length); */ /* call */ isc_transaction_info(status, &(imp_dbh->tr), sizeof(request), request, result_length, result); if (ib_error_check(dbh, status)) { XSRETURN_UNDEF; } else { /* detect truncation */ for (p = result + result_length - 1; p > result; p--) { if (*p != 0) { break; } } if (p > result) { /* PerlIO_printf(PerlIO_stderr(), "First non-null byte found at: %d\n", (p - result)); */ if (*p == isc_info_truncated) { /* PerlIO_printf(PerlIO_stderr(), "Truncation detected.\n"); */ /* increase result_length, retry allocation */ result_length += 10; Safefree(result); result = NULL; goto try_alloc_result_buffer; } } /* parse result */ for (p = result; p < result + result_length; ) { char *keyname; short length; if (*p == isc_info_end) { /* PerlIO_printf(PerlIO_stderr(), "isc_info_end encountered at byte: %d\n", (p - result)); */ break; } switch (*p) { TX_RESBUF_CASE(id) #if defined(FB_API_VER) && FB_API_VER >= 20 TX_RESBUF_CASE(oldest_interesting) TX_RESBUF_CASE(oldest_active) TX_RESBUF_CASE(oldest_snapshot) TX_RESBUF_CASE(lock_timeout) case isc_info_tra_isolation: { HV* reshv; short length = isc_vax_integer(++p, 2); /* PerlIO_printf(PerlIO_stderr(), "Content length: %d\n", length); */ keyname = "isolation"; /* PerlIO_printf(PerlIO_stderr(), "Got 'isolation' at byte: %d\n", (p - 1 - result)); */ p += 2; if (*p == isc_info_tra_consistency) { (void)hv_store(RETVAL, keyname, strlen(keyname), newSVpv("consistency", 0), 0); } else if (*p == isc_info_tra_concurrency) { (void)hv_store(RETVAL, keyname, strlen(keyname), newSVpv("snapshot (concurrency)", 0), 0); } else if (*p == isc_info_tra_read_committed) { /* warn("got 'read_committed'"); */ reshv = newHV(); if (!reshv) { if (result) { Safefree(result); } do_error(dbh, 2, "unable to allocate hash for read_committed rec/no_rec version"); XSRETURN_UNDEF; } if (*(p + 1) == isc_info_tra_no_rec_version) { (void)hv_store(reshv, "read_committed", 14, newSVpv("no_rec_version", 0), 0); } else if (*(p + 1) == isc_info_tra_rec_version) { (void)hv_store(reshv, "read_committed", 14, newSVpv("rec_version", 0), 0); } else { warn("unrecognized byte"); continue; } (void)hv_store(RETVAL, keyname, strlen(keyname), newRV_noinc((SV*) reshv), 0); } else { PerlIO_printf(PerlIO_stderr(), "+2: got unrecognized byte: %d\n", *((char*)p)); } p += length; break; } case isc_info_tra_access: { short length = isc_vax_integer(++p, 2); keyname = "access"; /* PerlIO_printf(PerlIO_stderr(), "Got 'access' at byte: %d\n", (p - 1 - result)); */ p += 2; if (*p == isc_info_tra_readonly) { (void)hv_store(RETVAL, keyname, strlen(keyname), newSVpvn("readonly", 8), 0); } else if (*p == isc_info_tra_readwrite) { (void)hv_store(RETVAL, keyname, strlen(keyname), newSVpvn("readwrite", 9), 0); } p += length; break; } #endif default: /* PerlIO_printf(PerlIO_stderr(), "now at byte: %d\n", (p - result)); */ p++; } } } } OUTPUT: RETVAL CLEANUP: SvREFCNT_dec(RETVAL); #undef TX_INFOBUF #undef TX_RESBUF_CASE int ib_set_tx_param(dbh, ...) SV *dbh ALIAS: set_tx_param = 1 PREINIT: STRLEN len; char *tx_key, *tx_val, *tpb, *tmp_tpb; int i, rc = 0; int tpb_len; char am_set = 0, il_set = 0, ls_set = 0; I32 j; AV *av; HV *hv; SV *sv, *sv_value; HE *he; CODE: { D_imp_dbh(dbh); #ifdef PERL_UNUSED_VAR PERL_UNUSED_VAR(ix); /* -Wall */ #endif /* if no params or first parameter = 0 or undef -> reset TPB to NULL */ if (items < 3) { if ((items == 1) || !(SvTRUE(ST(1)))) { tpb = NULL; tmp_tpb = NULL; tpb_len = 0; goto do_set_tpb; } } /* we need to know the max. size of TBP, (buffer overflow problem) */ /* mem usage: -access_mode: max. 1 byte */ /* -isolation_level: max. 2 bytes */ /* -lock_resolution: max. 1 byte */ /* -reserving: max. 4 bytes + strlen(tablename) */ tpb_len = 5; /* 4 + 1 for tpb_version */ /* we need to add the length of each table name + 4 bytes */ for (i = 1; i < items-1; i += 2) { sv_value = ST(i + 1); if (strEQ(SvPV_nolen(ST(i)), "-reserving")) if (SvROK(sv_value) && SvTYPE(SvRV(sv_value)) == SVt_PVHV) { hv = (HV *)SvRV(sv_value); hv_iterinit(hv); while ((he = hv_iternext(hv))) { /* retrieve the size of table name(s) */ HePV(he, len); tpb_len += len + 4; } } } /* alloc it */ Newx(tmp_tpb, tpb_len, char); /* do set TPB values */ tpb = tmp_tpb; *tpb++ = isc_tpb_version3; for (i = 1; i < items; i += 2) { tx_key = SvPV_nolen(ST(i)); sv_value = ST(i + 1); /* value specified? */ if (i >= items - 1) { Safefree(tmp_tpb); croak("You must specify parameter => value pairs, but there's no value for %s", tx_key); } /**********************************************************************/ if (strEQ(tx_key, "-access_mode")) { if (am_set) { warn("-access_mode already set; ignoring second try!"); continue; } tx_val = SvPV_nolen(sv_value); if (strEQ(tx_val, "read_write")) *tpb++ = isc_tpb_write; else if (strEQ(tx_val, "read_only")) *tpb++ = isc_tpb_read; else { Safefree(tmp_tpb); croak("Unknown -access_mode value %s", tx_val); } am_set = 1; /* flag */ } /**********************************************************************/ else if (strEQ(tx_key, "-isolation_level")) { if (il_set) { warn("-isolation_level already set; ignoring second try!"); continue; } if (SvROK(sv_value) && SvTYPE(SvRV(sv_value)) == SVt_PVAV) { av = (AV *)SvRV(sv_value); /* sanity check */ for (j = 0; (j <= av_len(av)) && !rc; j++) { sv = *av_fetch(av, j, FALSE); if (strEQ(SvPV_nolen(sv), "read_committed")) { rc = 1; *tpb++ = isc_tpb_read_committed; } } if (!rc) { Safefree(tmp_tpb); croak("Invalid -isolation_level value"); } for (j = 0; j <= av_len(av); j++) { tx_val = SvPV_nolen(*(av_fetch(av, j, FALSE))); if (strEQ(tx_val, "record_version")) { *tpb++ = isc_tpb_rec_version; break; } else if (strEQ(tx_val, "no_record_version")) { *tpb++ = isc_tpb_no_rec_version; break; } else if (!strEQ(tx_val, "read_committed")) { Safefree(tmp_tpb); croak("Unknown -isolation_level value %s", tx_val); } } } else { tx_val = SvPV_nolen(sv_value); if (strEQ(tx_val, "read_committed")) *tpb++ = isc_tpb_read_committed; else if (strEQ(tx_val, "snapshot")) *tpb++ = isc_tpb_concurrency; else if (strEQ(tx_val, "snapshot_table_stability")) *tpb++ = isc_tpb_consistency; else { Safefree(tmp_tpb); croak("Unknown -isolation_level value %s", tx_val); } } il_set = 1; /* flag */ } /**********************************************************************/ else if (strEQ(tx_key, "-lock_resolution")) { if (ls_set) { warn("-lock_resolution already set; ignoring second try!"); continue; } if (SvROK(sv_value) && SvTYPE(SvRV(sv_value)) == SVt_PVHV) { #if defined(FB_API_VER) && FB_API_VER >= 20 hv = (HV *)SvRV(sv_value); if (hv_exists(hv, "wait", 4)) { *tpb++ = isc_tpb_wait; sv = *hv_fetch(hv, "wait", 4, FALSE); if (SvIOK(sv)) { IV lock_timeout = SvIV(sv); if (lock_timeout < 0) { do_error(dbh, 2, "Wait timeout value must be positive integer"); XSRETURN_UNDEF; } else if (lock_timeout > 0) { *tpb++ = isc_tpb_lock_timeout; *tpb++ = sizeof(ISC_LONG); /* length = 4 bytes */ *(ISC_LONG*)tpb = lock_timeout; /* infinite timeout */ tpb += sizeof(ISC_LONG); } } else { do_error(dbh, 2, "Wait timeout value must be positive integer"); XSRETURN_UNDEF; } } else { do_error(dbh, 2, "The only valid key is 'wait'"); XSRETURN_UNDEF; } #else do_error(dbh, 2, "Hashref unsupported. Must be compiled with Firebird 2.0 client library"); XSRETURN_UNDEF; #endif } else { tx_val = SvPV_nolen(sv_value); if (strEQ(tx_val, "wait")) *tpb++ = isc_tpb_wait; else if (strEQ(tx_val, "no_wait")) *tpb++ = isc_tpb_nowait; else { Safefree(tmp_tpb); croak("Unknown transaction parameter %s", tx_val); } } ls_set = 1; /* flag */ } /**********************************************************************/ else if (strEQ(tx_key, "-reserving")) { if (SvROK(sv_value) && SvTYPE(SvRV(sv_value)) == SVt_PVHV) { char *table_name; HV *table_opts; hv = (HV *)SvRV(sv_value); hv_iterinit(hv); while ((he = hv_iternext(hv))) { /* check val type */ if (SvROK(HeVAL(he)) && SvTYPE(SvRV(HeVAL(he))) == SVt_PVHV) { table_opts = (HV*)SvRV(HeVAL(he)); /* if (hv_exists(table_opts, "access", 6)) { comment: access is optional sv = *hv_fetch(table_opts, "access", 6, FALSE); if (strnEQ(SvPV_nolen(sv), "shared", 6)) *tpb++ = isc_tpb_shared; else if (strnEQ(SvPV_nolen(sv), "protected", 9)) *tpb++ = isc_tpb_protected; else { Safefree(tmp_tpb); croak("Invalid -reserving access value"); } } */ if (hv_exists(table_opts, "lock", 4)) { /* lock is required */ sv = *hv_fetch(table_opts, "lock", 4, FALSE); if (strnEQ(SvPV_nolen(sv), "read", 4)) *tpb++ = isc_tpb_lock_read; else if (strnEQ(SvPV_nolen(sv), "write", 5)) *tpb++ = isc_tpb_lock_write; else { Safefree(tmp_tpb); croak("Invalid -reserving lock value"); } } else /* lock */ { Safefree(tmp_tpb); croak("Lock value is required in -reserving"); } /* add the table name to TPB */ table_name = HePV(he, len); *tpb++ = len + 1; { unsigned int k; for (k = 0; k < len; k++) *tpb++ = toupper(*table_name++); } *tpb++ = 0; if (hv_exists(table_opts, "access", 6)) { /* access is optional */ sv = *hv_fetch(table_opts, "access", 6, FALSE); if (strnEQ(SvPV_nolen(sv), "shared", 6)) *tpb++ = isc_tpb_shared; else if (strnEQ(SvPV_nolen(sv), "protected", 9)) *tpb++ = isc_tpb_protected; else { Safefree(tmp_tpb); croak("Invalid -reserving access value"); } } } /* end hashref check*/ else { Safefree(tmp_tpb); croak("Reservation for a given table must be hashref."); } } /* end of while() */ } else { Safefree(tmp_tpb); croak("Invalid -reserving value. Must be hashref."); } } /* end table reservation */ else { Safefree(tmp_tpb); croak("Unknown transaction parameter %s", tx_key); } } /* an ugly label... */ do_set_tpb: Safefree(imp_dbh->tpb_buffer); imp_dbh->tpb_buffer = tmp_tpb; imp_dbh->tpb_length = tpb - imp_dbh->tpb_buffer; /* for AutoCommit: commit current transaction */ if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) { imp_dbh->sth_ddl++; ib_commit_transaction(dbh, imp_dbh); } RETVAL = 1; } OUTPUT: RETVAL #******************************************************************************* # only for use within database_info! #define DB_INFOBUF(name, len) \ if (strEQ(item, #name)) { \ *p++ = (char) isc_info_##name; \ res_len += len + 3; \ item_buf_len++; \ continue; \ } #define DB_RESBUF_CASEHDR(name) \ case isc_info_##name:\ keyname = #name; HV * ib_database_info(dbh, ...) SV *dbh PREINIT: unsigned int i, count; char item_buf[30], *p, *old_p; char *res_buf; short item_buf_len, res_len; AV *av; ISC_STATUS status[ISC_STATUS_LENGTH]; CODE: { D_imp_dbh(dbh); /* process input params, count max. result buffer length */ p = item_buf; res_len = 0; item_buf_len = 0; /* array or array ref? */ if (items == 2 && SvROK(ST(1)) && SvTYPE(SvRV(ST(1))) == SVt_PVAV) { av = (AV *)SvRV(ST(1)); count = av_len(av) + 1; } else { av = NULL; count = items; } /* loop thru all elements */ for (i = 0; i < count; i++) { char *item; /* fetch from array or array ref? */ if (av) item = SvPV_nolen(*av_fetch(av, i, FALSE)); else item = SvPV_nolen(ST(i + 1)); /* database characteristics */ DB_INFOBUF(allocation, 4); DB_INFOBUF(base_level, 2); DB_INFOBUF(db_id, 513); DB_INFOBUF(implementation, 3); DB_INFOBUF(no_reserve, 1); DB_INFOBUF(db_read_only, 1); DB_INFOBUF(ods_minor_version, 1); DB_INFOBUF(ods_version, 1); DB_INFOBUF(page_size, 4); DB_INFOBUF(version, 257); DB_INFOBUF(db_sql_dialect, 1); /* environmental characteristics */ DB_INFOBUF(current_memory, 4); DB_INFOBUF(forced_writes, 1); DB_INFOBUF(max_memory, 4); DB_INFOBUF(num_buffers, 4); DB_INFOBUF(sweep_interval, 4); DB_INFOBUF(user_names, 1024); /* can be more, can be less */ /* performance statistics */ DB_INFOBUF(fetches, 4); DB_INFOBUF(marks, 4); DB_INFOBUF(reads, 4); DB_INFOBUF(writes, 4); #if defined(FB_API_VER) && FB_API_VER >= 20 /* FB 2.0 */ DB_INFOBUF(active_tran_count, 4); DB_INFOBUF(creation_date, sizeof(ISC_TIMESTAMP)); /* 2 x 4 bytes */ #endif /* database operation counts */ /* XXX - not implemented (complicated: returns a descriptor for _each_ table...how to fetch / store this??) but do we really need these? */ } /* the end marker */ *p++ = isc_info_end; item_buf_len++; /* allocate the result buffer */ res_len += 256; /* add some safety...just in case */ Newx(res_buf, res_len, char); /* call the function */ isc_database_info(status, &(imp_dbh->db), item_buf_len, item_buf, res_len, res_buf); if (ib_error_check(dbh, status)) { Safefree(res_buf); XSRETURN_UNDEF; // croak("isc_database_info failed!"); } /* fill hash with key/value pairs */ RETVAL = newHV(); for (p = res_buf; *p != isc_info_end; ) { char *keyname; char item = *p++; int length = isc_vax_integer (p, 2); p += 2; old_p = p; switch (item) { /******************************************************************/ /* database characteristics */ DB_RESBUF_CASEHDR(allocation) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(base_level) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(++p, 1)), 0); break; DB_RESBUF_CASEHDR(db_id) { HV *reshv = newHV(); ISC_LONG slen; (void)hv_store(reshv, "connection", 10, (isc_vax_integer(p++, 1) == 2)? newSVpv("local", 0): newSVpv("remote", 0), 0); slen = isc_vax_integer(p++, 1); (void)hv_store(reshv, "database", 8, newSVpvn(p, slen), 0); p += slen; slen = isc_vax_integer(p++, 1); (void)hv_store(reshv, "site", 8, newSVpvn(p, slen), 0); (void)hv_store(RETVAL, keyname, strlen(keyname), newRV_noinc((SV *) reshv), 0); break; } DB_RESBUF_CASEHDR(implementation) { HV *reshv = newHV(); (void)hv_store(reshv, "implementation", 14, newSViv(isc_vax_integer(++p, 1)), 0); (void)hv_store(reshv, "class", 5, newSViv(isc_vax_integer(++p, 1)), 0); (void)hv_store(RETVAL, keyname, strlen(keyname), newRV_noinc((SV *) reshv), 0); break; } DB_RESBUF_CASEHDR(no_reserve) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(db_read_only) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(ods_minor_version) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(ods_version) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(page_size) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(version) { ISC_LONG slen; slen = isc_vax_integer(++p, 1); (void)hv_store(RETVAL, keyname, strlen(keyname), newSVpvn(++p, slen), 0); break; } #ifdef isc_dpb_sql_dialect DB_RESBUF_CASEHDR(db_sql_dialect) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; #endif /******************************************************************/ /* environmental characteristics */ DB_RESBUF_CASEHDR(current_memory) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(forced_writes) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(max_memory) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(num_buffers) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(sweep_interval) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(user_names) { AV *avres; SV **svp; ISC_LONG slen; /* array already existing? no -> create */ if (!hv_exists(RETVAL, "user_names", 10)) { avres = newAV(); (void)hv_store(RETVAL, "user_names", 10, newRV_noinc((SV *) avres), 0); } else { svp = hv_fetch(RETVAL, "user_names", 10, 0); if (!svp || !SvROK(*svp)) { Safefree(res_buf); croak("Error fetching hash value"); } avres = (AV *) SvRV(*svp); } /* add value to the array */ slen = isc_vax_integer(p++, 1); av_push(avres, newSVpvn(p, slen)); break; } /******************************************************************/ /* performance statistics */ DB_RESBUF_CASEHDR(fetches) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(marks) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(reads) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(writes) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; #if defined(FB_API_VER) && FB_API_VER >= 20 /* FB 2.0 */ DB_RESBUF_CASEHDR(active_tran_count) (void)hv_store(RETVAL, keyname, strlen(keyname), newSViv(isc_vax_integer(p, (short) length)), 0); break; DB_RESBUF_CASEHDR(creation_date) { struct tm times; ISC_TIMESTAMP cdatetime; char tbuf[100]; Zero(tbuf, sizeof(tbuf), char); cdatetime.timestamp_date = isc_vax_integer(p, sizeof(ISC_DATE)); cdatetime.timestamp_time = isc_vax_integer(p + sizeof(ISC_DATE), sizeof(ISC_TIME)); isc_decode_timestamp(&cdatetime, ×); strftime(tbuf, sizeof(tbuf), "%c", ×); (void)hv_store(RETVAL, keyname, strlen(keyname), newSVpvn(tbuf, strlen(tbuf)), 0); break; } #endif default: break; } p = old_p + length; } /* don't leak */ Safefree(res_buf); } OUTPUT: RETVAL CLEANUP: SvREFCNT_dec(RETVAL); #undef DB_INFOBUF #undef DB_RESBUF_CASEHDR int ib_drop_database(dbh) SV *dbh PREINIT: ISC_STATUS status[ISC_STATUS_LENGTH]; CODE: { D_imp_dbh(dbh); /* set the database handle to inactive */ DBIc_ACTIVE_off(imp_dbh); /* rollback */ if (imp_dbh->tr) { isc_rollback_transaction(status, &(imp_dbh->tr)); if (ib_error_check(dbh, status)) XSRETURN(FALSE); imp_dbh->tr = 0L; } FREE_SETNULL(imp_dbh->ib_charset); FREE_SETNULL(imp_dbh->tpb_buffer); FREE_SETNULL(imp_dbh->dateformat); FREE_SETNULL(imp_dbh->timeformat); FREE_SETNULL(imp_dbh->timestampformat); /* drop */ isc_drop_database(status, &(imp_dbh->db)); if (ib_error_check(dbh, status)) RETVAL = 0; else RETVAL = 1; } OUTPUT: RETVAL #******************************************************************************* SV * ib_init_event(dbh, ...) SV *dbh PREINIT: char *CLASS = "DBD::Firebird::Event"; int i; IB_EVENT ev; D_imp_dbh(dbh); CODE: { unsigned short cnt = items - 1; DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "Entering init_event(), %d items..\n", cnt)); if (cnt > 0) { /* check for max number of events in a single call to event block allocation */ if (cnt > MAX_EVENTS) croak("Max number of events exceeded."); /* init members */ ev.dbh = imp_dbh; ev.event_buffer = NULL; ev.result_buffer = NULL; ev.id = 0; ev.num = cnt; ev.perl_cb = NULL; ev.state = INACTIVE; ev.exec_cb = 0; Newx(ev.names, MAX_EVENTS, char *); for (i = 0; i < MAX_EVENTS; i++) { if (i < cnt) { /* dangerous! *(ev.names + i) = SvPV_nolen(ST(i + 1)); */ Newx(ev.names[i], SvCUR(ST(i + 1)) + 1, char); strcpy(ev.names[i], SvPV_nolen(ST(i + 1))); } else *(ev.names + i) = NULL; } ev.epb_length = (short) isc_event_block( &(ev.event_buffer), &(ev.result_buffer), cnt, *(ev.names + 0), *(ev.names + 1), *(ev.names + 2), *(ev.names + 3), *(ev.names + 4), *(ev.names + 5), *(ev.names + 6), *(ev.names + 7), *(ev.names + 8), *(ev.names + 9), *(ev.names + 10), *(ev.names + 11), *(ev.names + 12), *(ev.names + 13), *(ev.names + 14)); } else croak("Names of the events in interest are not specified"); { ISC_STATUS status[ISC_STATUS_LENGTH]; ISC_ULONG ecount[15]; isc_wait_for_event(status, &(imp_dbh->db), ev.epb_length, ev.event_buffer, ev.result_buffer); if (ib_error_check(dbh, status)) XSRETURN_UNDEF; //croak("error in isc_wait_for_event()"); isc_event_counts(ecount, ev.epb_length, ev.event_buffer, ev.result_buffer); } RETVAL = sv_bless( newRV_noinc(newSVpvn((char *)&ev, sizeof(ev))), gv_stashpvn(CLASS, strlen(CLASS), GV_ADD)); DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "Leaving init_event()\n")); } OUTPUT: RETVAL int ib_register_callback(dbh, ev_rv, perl_cb) SV *dbh SV *ev_rv SV *perl_cb PREINIT: IB_EVENT *ev = (IB_EVENT *)SvPV_nolen(SvRV(ev_rv)); ISC_STATUS status[ISC_STATUS_LENGTH]; D_imp_dbh(dbh); CODE: { DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "Entering register_callback()..\n")); /* save the perl callback function */ if (ev->perl_cb == (SV*)NULL) ev->perl_cb = newSVsv(perl_cb); else { if (_cancel_callback(dbh, ev)) SvSetSV(ev->perl_cb, perl_cb); else XSRETURN_UNDEF; } /* set up the events */ isc_que_events( status, &(imp_dbh->db), &(ev->id), ev->epb_length, ev->event_buffer, (ISC_EVENT_CALLBACK)_async_callback, ev); if (ib_error_check(dbh, status)) XSRETURN_UNDEF; else RETVAL = 1; ev->state = ACTIVE; } OUTPUT: RETVAL int ib_cancel_callback(dbh, ev_rv) SV *dbh SV *ev_rv PREINIT: IB_EVENT *ev = (IB_EVENT *) SvPV_nolen(SvRV(ev_rv)); CODE: RETVAL = _cancel_callback(dbh, ev); OUTPUT: RETVAL HV* ib_wait_event(dbh, ev_rv) SV *dbh SV *ev_rv PREINIT: int i; SV **svp; ISC_STATUS status[ISC_STATUS_LENGTH]; D_imp_dbh(dbh); IB_EVENT *ev = (IB_EVENT *)SvPV_nolen(SvRV(ev_rv)); CODE: { isc_wait_for_event(status, &(imp_dbh->db), ev->epb_length, ev->event_buffer, ev->result_buffer); if (ib_error_check(dbh, status)) { do_error(dbh, 2, "ib_wait_event() error"); XSRETURN_UNDEF; } else { ISC_ULONG ecount[15]; isc_event_counts(ecount, ev->epb_length, ev->event_buffer, ev->result_buffer); RETVAL = newHV(); for (i = 0; i < ev->num; i++) { if (ecount[i]) { DBI_TRACE_imp_xxh(imp_dbh, 2, (DBIc_LOGPIO(imp_dbh), "Event %s caught %lu times.\n", *(ev->names + i), (long unsigned)ecount[i])); svp = hv_store(RETVAL, *(ev->names + i), strlen(*(ev->names + i)), newSViv(ecount[i]), 0); if (svp == NULL) croak("Bad: key '%s' not stored", *(ev->names + i)); } } } } OUTPUT: RETVAL void _create_database(params) HV *params CODE: { ISC_STATUS status[ISC_STATUS_LENGTH]; /* isc api status vector */ char *str; size_t len; int page_size; SV *sql, **sv; unsigned short dialect; isc_db_handle db = 0; isc_tr_handle tr = 0; sv = hv_fetch(params, "db_path", 7, FALSE); if ((sv == NULL) || !SvOK(*sv)) croak("Missing db_path"); sql = sv_2mortal( newSVpv( "CREATE DATABASE '", 0 ) ); str = SvPV( *sv, len ); sv_catpvn( sql, str, len ); sv_catpvn( sql, "'", 1 ); sv = hv_fetch( params, "user", 4, FALSE ); if ( (sv != NULL) && SvOK(*sv) ) { str = SvPV( *sv, len ); sv_catpvn( sql, " USER '", 7 ); sv_catpvn( sql, str, len ); sv_catpvn( sql, "'", 1 ); } sv = hv_fetch( params, "password", 8, FALSE ); if ( (sv != NULL) && SvOK(*sv) ) { str = SvPV( *sv, len ); sv_catpvn( sql, " PASSWORD '", 11 ); sv_catpvn( sql, str, len ); sv_catpvn( sql, "'", 1 ); } sv = hv_fetch( params, "page_size", 9, FALSE ); if ( (sv != NULL) && SvOK(*sv) ) { page_size = SvIV(*sv); sv_catpvf( sql, " PAGE_SIZE %d", page_size ); } sv = hv_fetch( params, "character_set", 13, FALSE ); if ( (sv != NULL) && SvOK(*sv) ) { str = SvPV_nolen(*sv); sv_catpvf( sql, " DEFAULT CHARACTER SET %s", str ); } sv = hv_fetch( params, "dialect", 7, FALSE ); if ( (sv != NULL) && SvOK(*sv) ) { dialect = SvIV(*sv); } else { dialect = DEFAULT_SQL_DIALECT; } str = SvPV(sql, len); isc_dsql_execute_immediate( status, &db, &tr, len, str, dialect, NULL ); if( (str = ib_error_decode(status)) != NULL ) { croak("%s", str); } // disconnect from the just created database isc_detach_database( status, &db ); if ( (str = ib_error_decode(status)) != NULL ) { warn("%s", str); } } void _gfix(params) HV *params CODE: { ISC_STATUS status[ISC_STATUS_LENGTH]; /* isc api status vector */ char *db_path; size_t db_path_len; unsigned short buffers = 0; short forced_writes = -1; char *user = NULL, *pwd = NULL; size_t user_len, pwd_len; char ISC_FAR *dpb_buffer, *dpb; short buflen = 0; SV **sv; isc_db_handle db = 0; char *str; sv = hv_fetch(params, "db_path", 7, FALSE); if ((sv == NULL) || !SvOK(*sv)) croak("Missing db_path"); db_path = SvPV(*sv, db_path_len); if (( (sv = hv_fetch(params, "user", 4, FALSE)) != NULL) && SvOK(*sv)) { user = SvPV(*sv, user_len); DPB_PREP_STRING_LEN(buflen, user_len); } if (( (sv = hv_fetch(params, "password", 8, FALSE)) != NULL) && SvOK(*sv)) { pwd = SvPV(*sv, pwd_len); DPB_PREP_STRING_LEN(buflen, pwd_len); } /* the actual interesting stuff -- database parameters */ if (((sv = hv_fetch(params, "buffers", 7, FALSE)) != NULL) && SvOK(*sv)) { buffers = (unsigned short) SvIV(*sv); DPB_PREP_INTEGER(buflen); } if (((sv = hv_fetch(params, "forced_writes", 13, FALSE)) != NULL) && SvOK(*sv)) { forced_writes = SvTRUE(*sv) ? 1 : 0; DPB_PREP_INTEGER(buflen); } /* add length of other parameters to needed buflen */ buflen += 1; /* dbpversion */ /* Allocate DPB */ Newx(dpb_buffer, buflen, char); /* Fill DPB */ dpb = dpb_buffer; *dpb++ = isc_dpb_version1; if ( user != NULL ) { DPB_FILL_STRING_LEN(dpb, isc_dpb_user_name, user, user_len); } if ( pwd != NULL ) { DPB_FILL_STRING_LEN(dpb, isc_dpb_password, pwd, pwd_len); } if (buffers) { DPB_FILL_INTEGER(dpb, isc_dpb_num_buffers, buffers); } if (forced_writes >= 0) { DPB_FILL_INTEGER(dpb, isc_dpb_force_write, forced_writes); } if ( (dpb-dpb_buffer) != buflen ) { fprintf(stderr, "# gfix: DPB length mismatch: %ld != %d\n", dpb-dpb_buffer, buflen); fflush(stderr); abort(); } isc_attach_database(status, /* status vector */ db_path_len, db_path, &db, buflen, dpb_buffer); /* freeing database parameter buffer */ Safefree(dpb_buffer); /* return false on failed attach */ if ( ( str = ib_error_decode(status)) != NULL ) croak("gfix: %s", str); // disconnect from the just created database isc_detach_database( status, &db ); if ( (str = ib_error_decode(status)) != NULL ) { warn("gfix/detach: %s", str); } } MODULE = DBD::Firebird PACKAGE = DBD::Firebird::Event PROTOTYPES: DISABLE void DESTROY(ev_rv) SV *ev_rv PREINIT: IB_EVENT *evh = (IB_EVENT *)SvPV_nolen(SvRV(ev_rv)); int i; ISC_STATUS status[ISC_STATUS_LENGTH]; CODE: { DBI_TRACE_imp_xxh(evh->dbh, 2, (DBIc_LOGPIO(evh->dbh), "Entering DBD::Firebird::Event::DESTROY..\n")); #ifdef DBI_USE_THREADS if (PERL_GET_CONTEXT != evh->dbh->context) { DBI_TRACE_imp_xxh(evh->dbh, 2, (DBIc_LOGPIO(evh->dbh), "DBD::Firebird::Event::DESTROY ignored because owned by thread %p not current thread %p\n", evh->dbh->context, (PerlInterpreter *)PERL_GET_CONTEXT) ); XSRETURN(0); } #endif for (i = 0; i < evh->num; i++) if (*(evh->names + i)) Safefree(*(evh->names + i)); if (evh->names) Safefree(evh->names); if (evh->perl_cb) { SvREFCNT_dec(evh->perl_cb); isc_cancel_events(status, &(evh->dbh->db), &(evh->id)); } if (evh->event_buffer) #ifdef INCLUDE_TYPES_PUB_H isc_free((ISC_SCHAR*)evh->event_buffer); #else isc_free(evh->event_buffer); #endif if (evh->result_buffer) #ifdef INCLUDE_TYPES_PUB_H isc_free((ISC_SCHAR*)evh->result_buffer); #else isc_free(evh->result_buffer); #endif } MODULE = DBD::Firebird PACKAGE = DBD::Firebird::st char* ib_plan(sth) SV *sth CODE: { D_imp_sth(sth); ISC_STATUS status[ISC_STATUS_LENGTH]; char plan_info[1]; char plan_buffer[PLAN_BUFFER_LEN]; RETVAL = NULL; Zero(plan_buffer, sizeof(plan_buffer), char); plan_info[0] = isc_info_sql_get_plan; if (isc_dsql_sql_info(status, &(imp_sth->stmt), sizeof(plan_info), plan_info, sizeof(plan_buffer), plan_buffer)) { if (ib_error_check(sth, status)) { ib_cleanup_st_prepare(imp_sth); XSRETURN_UNDEF; } } if (plan_buffer[0] == isc_info_sql_get_plan) { short l = (short) isc_vax_integer((char *)plan_buffer + 1, 2); Newx(RETVAL, l + 2, char); snprintf(RETVAL, l+2, "%.*s%s", l, plan_buffer + 3, "\n"); //PerlIO_printf(PerlIO_stderr(), "Len: %d, orig len: %d\n", strlen(imp_sth->plan), l); } } OUTPUT: RETVAL