DBD-Unify
view release on metacpan or search on metacpan
* Fix core dump during statement cleanup when SQLBE aborts unexpectedly (Todd Zervas)
* Fix glib detected free() invalid pointer error during perl cleanup due
to use of internal putenv <http://search.cpan.org/dist/perl/INSTALL#Environment_access> (Todd Zervas)
* Added DATETIME support for 9.1 and up (Todd Zervas)
0.81 - 10 Nov 2011, H.Merijn Brand (this was never released)
* Convert to Test::More::done_testing
* Up copyright to 2011
* NAME / DISTNAME in Makefile.PL
* Require perl-5.8.4 (prepare for Unicode support)
* Implement uni_unicode (slightly experimental)
0.80 - 30 Aug 2010, H.Merijn Brand
* Spelling changes
* Remove the need for PERL_POLLUTE
0.79 - 07 Jun 2010, H.Merijn Brand
* Use correct typedefs for date columns instead of generic UINTxx (Todd)
* Upped copyright to 2010
* Implement column_info ()
* Permanently removed DBDverbose (use dbd_verbose or uni_verbose instead)
The test case however uses scalarIO to catch errors, so if you use a
perl that does not support scalarIO (e.g. perlIO enabled), you will
have to disable the failing tests that use it yourself and hope for
the best (or better, upgrade to a perl that supports scalarIO).
Don't expect anything Unicode releated DataServer data to work on perl
versions below 5.8.4 (if you get it to work at all). Note that $LANG
will need to match your database locale. See the Unicode site for the
differences between the Unicode standards if you want to know what to
expect (http://www.unicode.org/versions/enumeratedversions.html) and
http://www.unicode.org/history/publicationdates.html for their age.
Perl version
Stable Devel Unicode
------ ------- -------
5.35.4 14.0.0 UCD 14.0.0 released 14 Sep 2021
5.32.0 5.31.10 13.0.0 UCD 13.0.0 released 10 Mar 2020
5.30.0 5.29.10 12.1.0 UCD 12.1.0 released 07 May 2019
5.29.9 12.0.0 UCD 12.0.0 released 05 Mar 2019
5.29.2 11.0.0 UCD 11.0.0 released 05 Jun 2018
5.28.0 5.27.2 10.0.0 UCD 10.0.0 released 20 Jun 2017
struct imp_drh_st {
dbih_drc_t com; /* MUST be first element in structure */
};
/* Define dbh implementor data structure */
struct imp_dbh_st {
dbih_dbc_t com; /* MUST be first element in structure */
short id; /* DB Handle ID for dynamic naming */
int unicode; /* Decode unicode on fetch */
int nchildren;
imp_sth_t **children; /* Keep track of prepared statements */
};
#define ST_STAT_ALLOCP 0x01
#define ST_STAT_ALLOCC 0x02
#define ST_STAT_ALLOCI 0x04
#define ST_STAT_ALLOCO 0x08
#define ST_STAT_OPEN 0x10
/* Define sth implementor data structure */
dbih_stc_t com; /* MUST be first element in structure */
short id; /* Statement ID, for dynamic naming */
short stat; /* Cursor open/closed */
char *statement; /* Statement text */
imp_fld_t *fld; /* Add knowledge about the fields */
imp_fld_t *prm; /* Add knowledge about the positionals */
int dbd_verbose; /* statement level verbosity */
int unicode; /* Decode unicode on fetch */
};
struct imp_fld_st {
char fnm[48]; /* Name */
int ftp; /* Type */
int fln; /* Length */
int fpr; /* Precision */
int fic; /* Indicator */
int fsc; /* Scale */
int fnl; /* NULL */
DBIc_IMPSET_on (imp_dbh); /* imp_dbh set up now */
DBIc_ACTIVE_on (imp_dbh); /* call disconnect before freeing */
DBIc_set (imp_dbh, DBIcf_AutoCommit, 0);
DBIc_set (imp_dbh, DBIcf_ChopBlanks, 1);
imp_dbh->id = n_dbh++;
imp_dbh->children = (imp_sth_t **)0;
imp_dbh->nchildren = 0;
imp_dbh->unicode = 0;
unless (auth && *auth)
auth = getenv ("USCHEMA");
if ((!user || !*user) && auth && *auth) {
(void)sprintf (statement, "set current schema to \"%s\"", auth);
dbg (3, " %s\n", statement);
EXEC SQL
EXECUTE IMMEDIATE :statement;
dbg (4, " After schema, sqlcode = %d\n", SQLCODE);
unless (sqlError (dbh))
if (kl == 11 && (strEQ (key, "uni_verbose") || strEQ (key, "dbd_verbose"))) {
dbd_verbose = SvIV (valuesv); /* dbd_verbose in DBD::Oracle since 1.22 :) */
dbg (2, "Set DBD_VERBOSE = %d\n", dbd_verbose);
return (TRUE);
}
if (kl == 10 && strEQ (key, "AutoCommit")) {
DBIc_set (imp_dbh, DBIcf_AutoCommit, 0); /* Allways off */
return (TRUE);
}
if (kl == 11 && strEQ (key, "uni_unicode")) {
imp_dbh->unicode = SvOK (valuesv) && SvTRUE (valuesv) ? 1 : 0;
return (TRUE);
}
if ((kl == 13 && strEQ (key, "uni_scanlevel")) ||
(kl == 9 && strEQ (key, "ScanLevel"))) {
auto int val = SvIV (valuesv);
dbg (3, "DBD::Unify::dbd_db_STORE (ScanLevel = %d)\n", val);
if (val < 1 || val > 16)
return (FALSE);
(void)sprintf (u_sql_do, "set transaction scan level %d", val);
EXEC SQL
SV *dbd_db_FETCH_attrib (SV *dbh, imp_dbh_t *imp_dbh, SV *keysv) {
dTHX;
STRLEN kl;
char *key = SvPV (keysv, kl);
unless (DBIc_ACTIVE (imp_dbh))
return (NULL);
if (kl == 11 && (strEQ (key, "uni_verbose") || strEQ (key, "dbd_verbose")))
return (newSViv (dbd_verbose));
if (kl == 11 && strEQ (key, "uni_unicode"))
return (newSViv (imp_dbh->unicode));
if (kl == 10 && strEQ (key, "AutoCommit"))
return (newSVsv (boolSV (0)));
return (NULL);
} /* dbd_db_FETCH_attrib */
/* ##### Unify ST stuff #################################################### */
static short new_sth_id (SV *dbh) {
register short i;
unless (use_sth_id (dbh, imp_dbh->id, imp_sth->id))
return (0);
if ((imp_sth->statement = (char *)malloc (strlen (statement) + 2)))
(void)strcpy (imp_sth->statement, statement);
imp_sth->stat = 0;
imp_sth->dbd_verbose = dbd_verbose;
imp_sth->fld = (imp_fld_t *)0;
imp_sth->prm = (imp_fld_t *)0;
imp_sth->unicode = imp_dbh->unicode;
if (attribs) {
SV **svp;
DBD_ATTRIB_GET_IV (attribs, "dbd_verbose", 11, svp, imp_sth->dbd_verbose);
DBD_ATTRIB_GET_IV (attribs, "uni_verbose", 11, svp, imp_sth->dbd_verbose);
}
st_dbg (3, imp_sth, "DBD::Unify::st_prepare %s (\"%s\")\n", u_sql_nm, statement);
dbd_st_diaper (imp_dbh, imp_sth);
st_dbg (6, imp_sth, "\r\n After get, sqlcode = %d\n", SQLCODE);
unless (sqlError (sth))
return (NULL);
i = fln;
if (DBIc_has (imp_sth, DBIcf_ChopBlanks)) {
while (i && (!fdC[i - 1] || fdC[i - 1] == ' '))
i--;
}
fdC[i] = (char)0;
sv_setpvn (sv, fdC, i);
if (imp_sth->unicode && is_utf8_string ((U8 *)fdC, i)) {
st_dbg (5, imp_sth, "is UTF8 ");
SvUTF8_on (sv);
}
st_dbg (4, imp_sth, "(%d) '%s'", i, SvPVX (sv));
break;
case SQLFLOAT:
st_dbg (4, imp_sth, "FLOAT %2d.%1d.%02d: ", fln, fpr, fsc);
EXEC SQL
GET DESCRIPTOR :o_sql_nm
i--;
}
s[i] = (char)0;
#endif
}
else {
s = "";
i = 0;
}
sv_setpvn (sv, s, i);
if (imp_sth->unicode && is_utf8_string ((U8 *)s, i)) {
st_dbg (5, imp_sth, "is UTF8 ");
SvUTF8_on (sv);
}
st_dbg (4, imp_sth, "(%d) '%s'", i, SvPVX (sv));
break;
}
case SQLBINARY: {
auto char *s;
char *key = SvPV (keysv, kl);
/*
st_dbg (4, imp_sth, "DBD::Unify::st_STORE (%s)->{%s}\n", imp_sth->name, key);
*/
if (kl == 11 && (strEQ (key, "uni_verbose") || strEQ (key, "dbd_verbose"))) {
imp_sth->dbd_verbose = SvIV (valuesv);
dbg (2, "Set DBD_VERBOSE for STH = %d\n", dbd_verbose);
return (TRUE);
}
if (kl == 11 && strEQ (key, "uni_unicode")) {
imp_sth->unicode = SvOK (valuesv) && SvTRUE (valuesv) ? 1 : 0;
return (TRUE);
}
return (FALSE); /* no values to store */
} /* dbd_st_STORE_attrib */
int uni2sql_type (SQLCOLTYPE t) {
/* see also perl5/site_perl/5.10.1/x86_64-linux/auto/DBI/dbi_sql.h
* and $UNIFY/../include/sqle_usr.h */
switch (t) { /* ANSI/ODBC Column type DBI */
unless (imp_sth->fld)
return (NULL);
i = DBIc_NUM_FIELDS (imp_sth);
p = DBIc_NUM_PARAMS (imp_sth);
if (kl == 11 && (strEQ (key, "uni_verbose") || strEQ (key, "dbd_verbose"))) {
retsv = newSViv (imp_sth->dbd_verbose);
}
else
if (kl == 11 && strEQ (key, "uni_unicode")) {
retsv = newSViv (imp_sth->unicode);
}
else
if (kl == 4 && strEQ (key, "NAME")) {
AV *av = newAV ();
retsv = newRV_inc (sv_2mortal ((SV *)av));
while (--i >= 0)
av_store (av, i, newSVpv (imp_sth->fld[i].fnm, 0));
}
else
if (kl == 4 && strEQ (key, "TYPE")) {
lib/DBD/Unify.pm view on Meta::CPAN
=head1 SYNOPSIS
# Examples marked NYT are Not Yet Tested, they might work
# all others have been tested.
# man DBI for explanation of each method (there's more than listed here)
$dbh = DBI->connect ("DBI:Unify:[\$dbname]", "", $schema, {
AutoCommit => 0,
ChopBlanks => 1,
uni_unicode => 0,
uni_verbose => 0,
uni_scanlevel => 2,
});
$dbh = DBI->connect_cached (...); # NYT
$dbh->do ($statement);
$dbh->do ($statement, \%attr);
$dbh->do ($statement, \%attr, @bind);
$dbh->commit;
$dbh->rollback;
$dbh->disconnect;
lib/DBD/Unify.pm view on Meta::CPAN
my $v = $DBD::Unify::GetInfo::info{int $info_type};
ref $v eq "CODE" and $v = $v->($dbh);
return $v;
} # get_info
sub private_attribute_info {
return {
dbd_verbose => undef,
uni_verbose => undef,
uni_unicode => undef,
};
} # private_attribute_info
sub ping {
my $dbh = shift;
$dbh->prepare ("select USER_NAME from SYS.DATABASE_USERS") or return 0;
return 1;
} # ping
sub prepare {
lib/DBD/Unify.pm view on Meta::CPAN
If you don't want to check for errors after B<every> call use
S<{ AutoCommit => 0, RaiseError => 1 }> instead. This will C<die> with
an error message if any DBI call fails.
=item Unicode
By default, this driver is completely Unicode unaware: what you put into
the database will be returned to you without the encoding applied.
To enable automatic decoding of UTF-8 when fetching from the database,
set the C<uni_unicode> attribute to a true value for the database handle
(statement handles will inherit) or to the statement handle.
$dbh->{uni_unicode} = 1;
When CHAR or TEXT fields are retrieved and the content fetched is valid
UTF-8, the value will be marked as such.
=item re-connect
Though both the syntax and the module support connecting to different
databases, even at the same time, the Unify libraries seem to quit
connecting to a new database, even if the old one is closed following
every rule of precaution.
parse_label|5.013007|5.013007|x
parse_listexpr|5.013008|5.013008|x
parse_lparen_question_flags|5.017009||Viu
PARSE_OPTIONAL|5.013007|5.013007|
parser_dup|5.009000|5.009000|u
parser_free|5.009005||Viu
parser_free_nexttoke_ops|5.017006||Viu
parse_stmtseq|5.013006|5.013006|x
parse_subsignature|5.031003|5.031003|x
parse_termexpr|5.013008|5.013008|x
parse_unicode_opts|5.008001||Viu
parse_uniprop_string|5.027011||Viu
PATCHLEVEL|5.003007||Viu
path_is_searchable|5.019001||Vniu
Pause|5.003007||Viu
pause|5.005000||Viu
pclose|5.003007||Viu
peep|5.003007||Viu
pending_ident|5.017004||Viu
PERL_ABS|5.008001|5.003007|p
Perl_acos|5.021004|5.021004|n
PL_threadhook|5.008000||Viu
PL_tmps_floor|5.005000||Viu
PL_tmps_ix|5.005000||Viu
PL_tmps_max|5.005000||Viu
PL_tmps_stack|5.005000||Viu
PL_tokenbuf||5.003007|ponu
PL_top_env|5.005000||Viu
PL_toptarget|5.005000||Viu
PL_TR_SPECIAL_HANDLING_UTF8|5.031006||Viu
PL_underlying_numeric_obj|5.027009||Viu
PL_unicode|5.008001||Viu
PL_unitcheckav|5.009005||Viu
PL_unitcheckav_save|5.009005||Viu
PL_unlockhook|5.007003||Viu
PL_unsafe|5.005000||Viu
PL_UpperLatin1|5.019005||Viu
PLUS|5.003007||Viu
PLUS_t8|5.035004||Viu
PLUS_t8_p8|5.033003||Viu
PLUS_t8_pb|5.033003||Viu
PLUS_tb|5.035004||Viu
#endif
#ifndef PERL_PV_PRETTY_DUMP
# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
#endif
#ifndef PERL_PV_PRETTY_REGPROP
# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
#endif
/* Hint: pv_escape
* Note that unicode functionality is only backported to
* those perl versions that support it. For older perl
* versions, the implementation will fall back to bytes.
*/
#ifndef pv_escape
#if defined(NEED_pv_escape)
static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
static
#else
extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
t/22-uni-utf8.t view on Meta::CPAN
my $dbname = "DBI:Unify:$ENV{DBPATH}";
my $txx = "xx_$$";
my $dbh;
ok ($dbh = DBI->connect ($dbname, undef, "", {
RaiseError => 1,
PrintError => 1,
AutoCommit => 0,
ChopBlanks => 1,
uni_verbose => 0,
uni_unicode => 1,
uni_scanlevel => 7,
}), "connect with attributes");
unless ($dbh) {
BAIL_OUT ("Unable to connect to Unify ($DBI::errstr)\n");
exit 0;
}
ok (1, "-- CREATE THE TABLE");
ok ($dbh->do (join " " =>
( run in 0.630 second using v1.01-cache-2.11-cpan-f29a10751f0 )