~stewart/dbd-drizzle/fixup-for-modern-perl : revision 26

3

*

4

* DBD::drizzle - DBI driver for the drizzle database

5

*

6

7

8

*

9

* You may distribute this under the terms of either the GNU General Public

999

}

1000

}

1001

#endif

1002

// XXX commented out until this is better understood

1003

// XXX according to eday, LOCAL INFILE is not going to be supported -cb

1004

/*

1005

if ((svp = hv_fetch( hv, "drizzle_local_infile", 18, FALSE)) && *svp)

1006

{

1007

unsigned int flag = SvTRUE(*svp);

1008

if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)

1009

PerlIO_printf(DBILOGFP,

1010

"imp_dbh->drizzle_dr_connect: Using" \

1011

" local infile %u.\n", flag);

1012

drizzleclient_options(con, DRIZZLE_OPT_LOCAL_INFILE, (const char *) &flag);

1013

}

1014

*/

1015

1002

}

1016

1003

}

1017

1004

1018

1005

//client_flag|= CLIENT_MULTI_RESULTS;

1019

1020

//result = drizzleclient_connect(con, host, user, password, dbname,

1021

// portNr, drizzle_socket, client_flag);

1022

// XXX handle options later

1023

// Everything here is already allocated, return is ok to ignore

1024

// XXX this is not smooth.. there's no host with UDS

1025

// XXX UDS isn't in drizzle, only mysql.. duh

1026

//if ( strcmp(host, "localhost") ) { } else

1027

//{ (void)drizzle_con_add_uds(drizzle, con, drizzle_socket, user,

1028

//password, dbname, DRIZZLE_CON_NONE); }

1006

// XXX not sure about this logic...

1029

1007

if (imp_dbh->con != NULL)

1030

1008

{

1031

1009

imp_dbh->con= drizzle_con_add_tcp(drizzle, NULL, host, portNr,

1434

1412

else if (kl == 20 && strEQ(key,"drizzle_auto_reconnect"))

1435

1413

imp_dbh->auto_reconnect = bool_value;

1436

1414

1437

else if (kl == 31 && strEQ(key,"drizzle_unsafe_bind_type_guessing"))

1415

else if (kl == 24 && strEQ(key,"drizzle_bind_type_guessing"))

1438

1416

imp_dbh->bind_type_guessing = SvIV(valuesv);

1439

1417

/*HELMUT */

1440

1418

#if defined(sv_utf8_decode)

1510

1488

result= sv_2mortal(newSViv(imp_dbh->auto_reconnect));

1511

1489

break;

1512

1490

case 'u':

1513

if (kl == strlen("unsafe_bind_type_guessing") &&

1514

strEQ(key, "unsafe_bind_type_guessing"))

1491

if (kl == strlen("bind_type_guessing") &&

1492

strEQ(key, "bind_type_guessing"))

1515

1493

result = sv_2mortal(newSViv(imp_dbh->bind_type_guessing));

1516

1494

break;

1517

1495

case 'e':

1611

1589

D_imp_dbh_from_sth;

1612

1590

1613

1591

1614

imp_sth->fetch_done= 0;

1615

1592

imp_sth->done_desc= 0;

1616

1593

imp_sth->result= NULL;

1617

imp_sth->currow= 0;

1618

1594

imp_sth->row= NULL;

1619

1595

1620

1596

//(void)drizzle_result_create(imp_dbh->con, imp_dbh->result);

1631

1607

Clean-up previous result set(s) for sth to prevent

1632

1608

'Commands out of sync' error

1633

1609

*/

1634

// XXX drizzle_con_ready() for conn pooling would be awesome

1610

// TODO drizzle_con_ready() for conn pooling would be awesome

1635

1611

drizzle_st_free_result_sets(sth, imp_sth);

1636

1612

// (void)drizzle_result_create(imp_dbh->con, imp_sth->result);

1637

1613

1668

1644

if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)

1669

1645

PerlIO_printf(DBILOGFP, "\t>- dbd_st_free_result_sets\n");

1670

1646

1671

// XXX the goal is to flush out the connection

1672

/*

1673

if (imp_sth->result) {

1674

// returns 0 when there's no row

1675

while (row = drizzle_row_buffer(imp_sth->result, &ret)) {

1676

if (ret != DRIZZLE_RETURN_OK) {

1677

do_error(sth, drizzle_result_error_code(imp_sth->result), drizzle_result_error(imp_sth->result),

1678

drizzle_result_sqlstate(imp_sth->result));

1679

}

1680

drizzle_row_free(imp_sth->result, row);

1681

}

1682

*/

1683

if (imp_sth->result)

1684

{

1685

drizzle_result_free(imp_sth->result);

1686

imp_sth->result= NULL;

1687

}

1688

//}

1689

1690

/*

1691

do

1692

{

1693

if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)

1694

PerlIO_printf(DBILOGFP, "\t<- dbd_st_free_result_sets RC %d\n", next_result_rc);

1695

1696

if (next_result_rc == 0)

1697

{

1698

if (!(imp_sth->result = drizzleclient_use_result(imp_dbh->pdrizzle)))

1699

{

1700

// Check for possible error

1701

if (drizzleclient_field_count(imp_dbh->pdrizzle))

1702

{

1703

if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)

1704

PerlIO_printf(DBILOGFP, "\t<- dbd_st_free_result_sets ERROR: %s\n",

1705

drizzleclient_error(imp_dbh->pdrizzle));

1706

1707

do_error(sth, drizzleclient_errno(imp_dbh->pdrizzle), drizzleclient_error(imp_dbh->pdrizzle),

1708

drizzleclient_sqlstate(imp_dbh->pdrizzle));

1709

return 0;

1710

}

1711

}

1712

}

1713

if (imp_sth->result)

1714

{

1715

drizzleclient_free_result(imp_sth->result);

1716

imp_sth->result=NULL;

1717

}

1718

} while ((next_result_rc= drizzleclient_next_result(imp_dbh->pdrizzle))==0);

1719

1720

if (next_result_rc > 0)

1721

{

1722

if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)

1723

PerlIO_printf(DBILOGFP, "\t<- dbd_st_free_result_sets: Error while processing multi-result set: %s\n",

1724

drizzleclient_error(imp_dbh->pdrizzle));

1725

1726

do_error(sth, drizzleclient_errno(imp_dbh->pdrizzle), drizzleclient_error(imp_dbh->pdrizzle),

1727

drizzleclient_sqlstate(imp_dbh->pdrizzle));

1647

/* Nice and simple , thanks Eric */

1648

if (imp_sth->result)

1649

{

1650

drizzle_result_free(imp_sth->result);

1651

imp_sth->result= NULL;

1728

1652

}

1729

1653

1730

1731

if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)

1732

PerlIO_printf(DBILOGFP, "\t<- dbd_st_free_result_sets\n");

1733

1734

1654

return 1;

1735

*/

1736

1655

}

1737

1656

1738

1657

1807

1726

1808

1727

if (imp_sth->row) {

1809

1728

/* We have a new rowset */

1810

imp_sth->currow=0;

1811

1812

1729

/* delete cached handle attributes */

1813

1730

/* XXX should be driven by a list to ease maintenance */

1814

1731

hv_delete((HV*)SvRV(sth), "NAME", 4, G_DISCARD);

1918

1835

}

1919

1836

1920

1837

salloc= parse_params(con,

1921

sbuf,

1922

&slen,

1923

params,

1924

num_params,

1925

bind_type_guessing);

1838

sbuf,

1839

&slen,

1840

params,

1841

num_params,

1842

bind_type_guessing);

1926

1843

1927

1844

if (salloc)

1928

1845

{

1959

1876

++sbuf;

1960

1877

}

1961

1878

*sbuf++= '\0';

1962

1963

if (!(query= malloc(strlen("SHOW COLUMNS FROM ``")+1+strlen(table)))) {

1879

1880

if (!(query= malloc(strlen("SHOW COLUMNS FROM ``") + 1 + strlen(table)))) {

1964

1881

do_error(h, JW_ERR_MEM, "Out of memory", NULL);

1965

1882

return -2;

1966

1883

}

1967

sprintf(query,"SHOW COLUMNS FROM `%s`", table);

1884

sprintf(query,"SHOW COLUMNS FROM `%s`", table);

1968

1885

*result= drizzle_query_str(con, NULL, query, &ret);

1969

1886

1970

1887

free(query);

1971

1888

1972

1889

free(table);

2005

1922

,drizzle_result_sqlstate(*result));

2006

1923

2007

1924

2008

// XXX this is *really* shady.. not sure how to differentiate yet

1925

/* Best way to be sure we return the right number if possible */

2009

1926

rows = drizzle_result_row_count(*result);

2010

1927

if (!rows)

2011

1928

rows = drizzle_result_affected_rows(*result);

2089

2006

DBIc_NUM_FIELDS(imp_sth)= colcount;

2090

2007

DBIc_ACTIVE_on(imp_sth);

2091

2008

imp_sth->done_desc= 0;

2092

imp_sth->fetch_done= 0;

2093

2009

}

2094

2010

}

2095

2011

2160

2076

AV *av;

2161

2077

int av_length, av_readonly;

2162

2078

drizzle_row_t row;

2079

2163

2080

D_imp_dbh_from_sth;

2164

2081

drizzle_con_st *con= imp_dbh->con;

2082

2165

2083

D_imp_xxh(sth);

2084

2166

2085

drizzle_return_t ret;

2167

2086

if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)

2168

2087

PerlIO_printf(DBILOGFP, "\t-> dbd_st_fetch\n");

2181

2100

return Nullav;

2182

2101

}

2183

2102

2184

imp_sth->currow++;

2185

2186

2103

if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)

2187

2104

{

2188

2105

PerlIO_printf(DBILOGFP, "\tdbd_st_fetch result set details\n");

2193

2110

drizzle_result_row_count(imp_sth->result));

2194

2111

PerlIO_printf(DBILOGFP, "\tdrizzle_result_affected_rows=%llu\n",

2195

2112

drizzle_result_affected_rows(imp_sth->result));

2196

PerlIO_printf(DBILOGFP, "\tdbd_st_fetch for %08lx, currow= %d\n",

2197

(u_long) sth,imp_sth->currow);

2198

2113

}

2199

2114

2200

2115

if ( imp_sth->row) {

2203

2118

} else {

2204

2119

if (imp_sth->unbuffered_result) {

2205

2120

// We dont buffer result, but we will buffer each row

2206

row= drizzle_row_buffer(imp_sth->result, &ret);

2121

row= drizzle_row_buffer(imp_sth->result, &ret);

2207

2122

} else {

2208

2123

row= drizzle_row_next(imp_sth->result);

2209

2124

}

2220

2135

drizzle_result_error(imp_sth->result),

2221

2136

drizzle_result_sqlstate(imp_sth->result));

2222

2137

2223

// XXX when would this ever be true?

2224

//if (!drizzleclient_more_results(con))

2225

2138

dbd_st_finish(sth, imp_sth);

2226

2139

return Nullav;

2227

2140

}

2228

2141

2229

2142

num_fields= drizzle_result_column_count(imp_sth->result);

2230

//fields= drizzleclient_fetch_fields(imp_sth->result);

2231

//lengths= drizzleclient_fetch_lengths(imp_sth->result);

2232

2143

lengths= (size_t *)drizzle_row_field_sizes(imp_sth->result);

2233

2144

2234

2145

if ((av= DBIc_FIELDS_AV(imp_sth)) != Nullav)

2299

2210

2300

2211

if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)

2301

2212

PerlIO_printf(DBILOGFP, "\t<- dbd_st_fetch, %d cols\n", num_fields);

2213

2302

2214

return av;

2303

2215

2304

2216

}

2535

2447

break;

2536

2448

2537

2449

case AV_ATTRIB_SQL_TYPE:

2538

//XXX hmmm

2539

2450

sv= newSViv((int) native2sql(drizzle_column_type(col))->sql_datatype);

2540

2451

break;

2541

2452

case AV_ATTRIB_IS_PRI_KEY:

2687

2598

if (strEQ(key, "TYPE"))

2688

2599

retsv= ST_FETCH_AV(AV_ATTRIB_SQL_TYPE);

2689

2600

break;

2690

case 'm':

2601

case 'd':

2691

2602

switch (kl) {

2692

case 10:

2603

case 12:

2693

2604

if (strEQ(key, "drizzle_type"))

2694

2605

retsv= ST_FETCH_AV(AV_ATTRIB_TYPE);

2695

2606

break;

2696

case 11:

2607

case 13:

2697

2608

if (strEQ(key, "drizzle_table"))

2698

2609

retsv= ST_FETCH_AV(AV_ATTRIB_TABLE);

2699

2610

break;

2700

case 12:

2611

case 14:

2701

2612

if ( strEQ(key, "drizzle_is_key"))

2702

2613

retsv= ST_FETCH_AV(AV_ATTRIB_IS_KEY);

2703

2614

else if (strEQ(key, "drizzle_is_num"))

2707

2618

else if (strEQ(key, "drizzle_result"))

2708

2619

retsv= sv_2mortal(newSViv((IV) imp_sth->result));

2709

2620

break;

2710

case 13:

2621

case 15:

2711

2622

if (strEQ(key, "drizzle_is_blob"))

2712

2623

retsv= ST_FETCH_AV(AV_ATTRIB_IS_BLOB);

2713

2624

break;

2714

case 14:

2625

case 16:

2715

2626

if (strEQ(key, "drizzle_insertid"))

2716

2627

{

2717

2628

/* We cannot return an IV, because the insertid is a long. */

2721

2632

return sv_2mortal(my_ulonglong2str(imp_dbh->insert_id));

2722

2633

}

2723

2634

break;

2724

case 15:

2635

case 17:

2725

2636

if (strEQ(key, "drizzle_type_name"))

2726

2637

retsv = ST_FETCH_AV(AV_ATTRIB_TYPE_NAME);

2727

2638

break;

2728

case 16:

2639

case 18:

2729

2640

if ( strEQ(key, "drizzle_is_pri_key"))

2730

2641

retsv= ST_FETCH_AV(AV_ATTRIB_IS_PRI_KEY);

2731

2642

else if (strEQ(key, "drizzle_max_length"))

2733

2644

else if (strEQ(key, "drizzle_unbuffered_result"))

2734

2645

retsv= boolSV(imp_sth->unbuffered_result);

2735

2646

break;

2736

case 19:

2647

case 21:

2737

2648

if (strEQ(key, "drizzle_warning_count"))

2738

2649

retsv= sv_2mortal(newSViv((IV) imp_sth->warning_count));

2739

2650

break;

2740

case 23:

2651

case 25:

2741

2652

if (strEQ(key, "drizzle_is_auto_increment"))

2742

2653

retsv = ST_FETCH_AV(AV_ATTRIB_IS_AUTO_INCREMENT);

2743

2654

break;

2915

2826

* the execute, so next time $dbh->quote() gets called, instant SIGSEGV!

2916

2827

*/

2917

2828

2918

// XXX pretty sure this one always allocates RAM so being careful

2829

/* this one always allocates RAM so being careful */

2919

2830

conres= drizzle_con_clone(imp_dbh->drizzle, &con, imp_dbh->con);

2920

2831

2921

2832

if (!my_login(h, imp_dbh))