DBD-PrimeBase

 view release on metacpan or  search on metacpan

benchmarks/server-cfg  view on Meta::CPAN

}

#
# Abort if the server has crashed
# return: 0 if ok
#	  1 question should be retried
#

sub abort_if_fatal_error
{
  return 1 if ($DBI::errstr =~ /Table locked by another cursor/);
  return 0;
}

sub small_rollback_segment
{
  return 0;
}

sub reconnect_on_errors
{

benchmarks/server-cfg  view on Meta::CPAN

}

#
# Abort if the server has crashed
# return: 0 if ok
#	  1 question should be retried
#

sub abort_if_fatal_error
{
  return 1 if ($DBI::errstr =~ /Table locked by another cursor/);
  return 0;
}

sub small_rollback_segment
{
  return 1;
}

sub reconnect_on_errors
{

dbdimp.c  view on Meta::CPAN

	}\n\
	\n\
	open database :dbname;\n\
}\n\
end procedure NewPerlDatabase;\n\
";


static char *table_info = "\n\
procedure table_info()\n\
returns cursor;\n\
{\n\
varchar tname;\n\
cursor c;\n\
\n\
describe tables;\n\
\n\
select varchar[32]'' as TABLE_CAT, \n\
varchar[32]'' as TABLE_SCHEMA, \n\
varchar[32]'' as TABLE_NAME, \n\
varchar[32]'' as TABLE_TYPE, \n\
varchar[120]'' as REMARKS where $false into c;\n\
\n\
for each {\n\

dbdimp.c  view on Meta::CPAN

	   case PB_UNICODE:
			info->odbc_type = -8;
			info->type_name = "UNICODE";
			info->length = info->precision;
			break;
	}
	
}

/*----------------------------------------------------*/
PRIVATE void free_column_info(long sessid, unsigned long cursor_id, ColInfoPtr col_ptr, long num_columns)
{
ColInfoPtr ptr = col_ptr;

	/*PBISetCursorState(sessid, cursor_id, PB_CURSOR_FREE); */
	
	if (!col_ptr)
		return;
		
	while (num_columns) {
		if (ptr->bind) {
			
			if (ptr->bind != ptr->small_bind)
				my_free(ptr->bind);
		}
		ptr++;
		num_columns--;			
	}
		
	my_free(col_ptr);
}

/*----------------------------------------------------*/
PRIVATE ColInfoPtr  get_column_info(SV *sth, imp_sth_t *imp_sth, long sessid, unsigned long cursor_id, long num_columns)
{
ColInfoPtr info_list, ptr;
PBColumnInfo info;
PBDataFmt pbtype;
int i, rtc;

	info_list = my_malloc(sth, num_columns * sizeof(ColInfo));
	if (!info_list)
		return NULL;
		
	ptr = info_list;
	for (i = 1; i <= num_columns; i++, ptr++) {
		rtc = PBIColumnInfo(sessid, cursor_id, i, &pbtype, &info);
		if (rtc != PB_OK) {
			D_imp_dbh_from_sth;
			if (DBIS->debug >= 2)
				PerlIO_printf(DBILOGFP, "get_column_info:PBIColumnInfo() Failed\n");
				
			free_column_info(sessid, cursor_id, info_list, num_columns);
			pb_error(sth, imp_dbh);
			return NULL;
		}
		
		strcpy(ptr->name, info.name);
		ptr->display_size = info.width;
		
		
		ptr->pb_type = pbtype.type;
		ptr->length = pbtype.len;

dbdimp.c  view on Meta::CPAN


		ODBC_fixup(ptr, imp_sth);
		
		/* Bind the column. */
		ptr->b_size = ptr->display_size +1; /* Add 1 for NULL terminator. */
		ptr->bind = NULL;
		if (ptr->b_size) { /* Blobs may have a size of 0 if they are not to be bound. */
			if (ptr->b_size > MAX_SMALL_BIND) {
				ptr->bind = my_malloc(sth, ptr->b_size);
				if (!ptr->bind) {
					free_column_info(sessid, cursor_id, info_list, num_columns);
					return NULL;
				}
			} else 
				ptr->bind = ptr->small_bind;
				
			pbtype.type = PB_CSTRING;
			pbtype.len = ptr->b_size;
			
			rtc = PBIBindColumn(sessid, cursor_id, i, &pbtype, ptr->bind, 0, &(ptr->b_info), sizeof(ptr->b_info), 0);
			if (rtc != PB_OK) {
				D_imp_dbh_from_sth;
				if (DBIS->debug >= 2)
					PerlIO_printf(DBILOGFP, "get_column_info:PBIBindColumn() Failed inffo = %d\n", ptr->b_info);
					
				free_column_info(sessid, cursor_id, info_list, num_columns);
				pb_error(sth, imp_dbh);
				return NULL;
			}
		}
	}
	
	return 	info_list;
}


dbdimp.c  view on Meta::CPAN

{
char *ptr = statement, *s = "SELECT";
int cnt = 0, sqcnt = 0, dqcnt = 0;

	while (*ptr && isspace(*ptr)) ptr++; /* Skip leading white space. */
	
	while (*ptr && (toupper(*ptr) == *s)) {s++, ptr++;}
	
	if ( (!*s) && isspace(*ptr)) {
		imp_sth->is_select = TRUE;
		sprintf(imp_sth->cursor_name, "%sC", imp_sth->tag);
	}
	
	/* Count the paramater markers. */
	while (*ptr) {
		if ((*ptr == '\'') && !dqcnt){
			sqcnt = !sqcnt;
		} else if ((*ptr == '"')  && !sqcnt){
			dqcnt = !dqcnt;
		} else if ((*ptr == '?') && (!sqcnt) && (!dqcnt))
			cnt++;

dbdimp.c  view on Meta::CPAN

				return FAILED;
			}
		}
	}
	
	memset(ptr, 0, strlen(ptr));

	if (imp_sth->is_select && !declare) { /* Cursors are declared automaticly in the select. */
		char dec[40];
		
		sprintf(dec, "Undeclare %s ;", imp_sth->cursor_name);
			
		imp_sth->delayed_execution = 1;
	    rtc = PBIExecute(imp_sth->sessid, dec, PB_NTS, PB_EXECUTE_LATER, NULL, NULL, NULL);
		if (trace_f) fprintf(trace_f,"%s\n", dec);
		if (rtc != PB_OK) {
			if (DBIS->debug > 3) 
				PerlIO_printf(DBILOGFP, "statement_vars:PBIExecute 2 failed.\n");
			if (declare) {	
				D_imp_dbh_from_sth;
				pb_error(sth, imp_dbh);

dbdimp.c  view on Meta::CPAN

		b = imp_sth->stmt_text + strlen(statement);
	}
	
	/* Tollerate statements ending with ';' */
	b--;
	while ((b > imp_sth->stmt_text) && isspace(*b)) b--;
	if ( *b != ';')
		b++;
		
	if (imp_sth->is_select) {		
		sprintf(b, " INTO %s FOR EXTRACT;", imp_sth->cursor_name);
	} else
		*b = ';';
		
	return OK;
}

/*----------------------------------------------------*/
PUBLIC int dbd_st_prepare(SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs)
{
dTHR;

dbdimp.c  view on Meta::CPAN

/*----------------------------------------------------*/
PUBLIC void dbd_st_destroy(SV *sth, imp_sth_t *imp_sth)
{
dTHR;
START_TIMER

	/* Undeclare and PrimeBase-Talk  variables. */
	statement_vars(sth, imp_sth, FALSE);

    my_free(imp_sth->stmt_text);
    free_column_info(imp_sth->sessid, imp_sth->cursor_id, imp_sth->column_info, imp_sth->columns);

    DBIc_IMPSET_off(imp_sth);		/* let DBI know we've done it	*/
END_TIMER
}

/*------------------------------------------------------------
 * bind placeholder.
 *  ph_namesv	: index of execute() parameter 1..n 
 *  SV *attribs	: may be set by Solid.xs bind_param call 
 *  int is_inout: inout for procedure calls only 

dbdimp.c  view on Meta::CPAN

	if (rtc != PB_OK) {
		pb_error_str = "statement_vars:PBIExecute  failed.\n";
#ifdef DEBUG_IT
	PerlIO_printf(DBILOGFP, "Execution Failed: \"%s\"\n", imp_sth->stmt_text);
#endif
		goto x_error;
	}
	imp_sth->delayed_execution = 0;

	if (imp_sth->is_select) {
		rtc = PBIGetCursorID(imp_sth->sessid, imp_sth->cursor_name, &(imp_sth->cursor_id));
		if (rtc != PB_OK) {
			pb_error_str = "statement_vars:PBIGetCursorID  failed.\n";
			goto x_error;
		}
		
		rtc = PBICursorInfo(imp_sth->sessid, imp_sth->cursor_id ,&info);
		if (rtc != PB_OK) {
			pb_error_str = "statement_vars:PBICursorInfo  failed.\n";
			goto x_error;
		}

		
		DBIc_NUM_FIELDS(imp_sth) = info.columns;
		imp_sth->rows_effected = info.rows;
		imp_sth->columns = info.columns;
		imp_sth->column_info = get_column_info(sth, imp_sth, imp_sth->sessid, imp_sth->cursor_id, imp_sth->columns);
		if (!imp_sth->column_info)
			return FAILED;
			
		DBIc_ACTIVE_on(imp_sth);
	}
END_TIMER
/*dbd_st_finish(sth, imp_sth); */

   return OK;
    

dbdimp.c  view on Meta::CPAN

{
    return imp_sth->rows_effected;
}


/*----------------------------------------------------*/
PUBLIC int dbd_st_finish(SV *sth, imp_sth_t *imp_sth)
{
dTHR;
	if (imp_sth->is_select && DBIc_ACTIVE(imp_sth)) {
		PBISetCursorState(imp_sth->sessid, imp_sth->cursor_id, PB_CURSOR_FREE);
		/*PBISetCursorPosition(imp_sth->sessid, imp_sth->cursor_id, PB_FETCH_FIRST); */
    }
    DBIc_ACTIVE_off(imp_sth);
    return 1;
}


/*----------------------------------------------------*/
PUBLIC AV *dbd_st_fetch(SV *sth, imp_sth_t *imp_sth)
{
dTHR;

dbdimp.c  view on Meta::CPAN

long rows = 1, size;
int chop_blanks, truncate_blob, i, num_fields;
START_TIMER

	/* test-wisconsin calls dbd_st_fetch() after doing inserts and updates! */
    if ( !DBIc_ACTIVE(imp_sth) ) {
		/*dbi_error(sth, -1, "no select statement currently executing"); */
    	goto error;
    }

    rtc = PBIFetchRow(imp_sth->sessid, imp_sth->cursor_id, &rows, PB_FETCH_NEXT, &truncated, NULL, NULL);
	if (rtc == PB_ERROR) {
		D_imp_dbh_from_sth;
		
		if (DBIS->debug > 2) 
			PerlIO_printf(DBILOGFP, "dbd_st_fetch:PBIFetchRow  failed.\n");
			
		pb_error(sth, imp_dbh);
		goto error;
	}

dbdimp.c  view on Meta::CPAN




/*----------------------------------------------------*/
PUBLIC int dbd_st_prep_call(SV *sth, imp_sth_t *imp_sth, char *statement)
{
 dTHR;
D_imp_dbh_from_sth; /* <= "imp_dbh_t *imp_dbh = the_stmt_db_handle;" */

	/* The statement is assumed to be a procedure call that returns */
	/* a cursor. */
	imp_sth->sessid =  imp_dbh->sessid;
	sprintf(imp_sth->tag,"S%d", imp_dbh->seq_cnt);
	
	imp_dbh->seq_cnt++;
	imp_sth->max_blob =  0;

	imp_sth->is_select = TRUE;
	sprintf(imp_sth->cursor_name, "%sC", imp_sth->tag);

	imp_sth->stmt_text = my_malloc(sth, strlen(statement) + 40);
	if (!imp_sth->stmt_text)
		return FAILED;

	DBIc_IMPSET_on(imp_sth); /* Cleanup required after this. */


	sprintf (imp_sth->stmt_text, "cursor %s; %s = %s", imp_sth->cursor_name, imp_sth->cursor_name, statement);
	
   return OK;
}


/* ----------------------------------------------------------------	*/
PUBLIC int dbd_st_blob_read(SV *sth, imp_sth_t *imp_sth, int field, long offset, long len, SV *destrv, long destoffset)
{
dTHR;
SV *bufsv;

dbdimp.c  view on Meta::CPAN


	info += field-1;
	
	if ((field < 1) || (field > imp_sth->columns) || 
		((info->pb_type != PB_LBIN) && (info->pb_type != PB_LCHAR))) {
		dbi_error(sth, -1, "Invalid field for dbd_st_blob_read()");
		return FAILED;
	}
	
	/* This should probably be cached. */
    rtc = PBIGetColumnData(imp_sth->sessid, imp_sth->cursor_id, field, NULL, &blob_id, NULL, NULL);
	if (rtc == PB_ERROR) {
		pb_error_str = "dbd_st_blob_read:PBIGetColumnData  failed.\n";
		goto x_error;
	}

	bufsv = SvRV(destrv);
	sv_setpvn(bufsv,"",0);      /* ensure it's writable string  */
	SvGROW(bufsv, len+destoffset+1);    /* SvGROW doesn't do +1 */
	
	/* Get the data. */

dbdimp.c  view on Meta::CPAN


		case NUM_OF_FIELDS:			
		    retsv = newSViv(imp_sth->columns);
		    break;
		    
		case NUM_OF_PARAMS:			
		    retsv = newSViv(imp_sth->parm_cnt);
		    break;
		    
		case CursorName:			
		    retsv = newSVpv(imp_sth->cursor_name, 0);
		    break;
		    
		case NAME: 			
		    av = newAV();
		    retsv = newRV(sv_2mortal((SV*)av));
		    for (i=0; i < imp_sth->columns; i++, info++)
				av_store(av, i, newSVpv(info->name, 0));
				
		    break;
		    

dbdimp.c  view on Meta::CPAN

		    retsv = newRV(sv_2mortal((SV*)av));
		    for (i=0; i < imp_sth->columns; i++, info++)
				av_store(av, i, newSViv(info->scale));
				
		    break;
		    
		case NULLABLE:			
		    av = newAV();
		    retsv = newRV(sv_2mortal((SV*)av));
		    for (i=0; i < imp_sth->columns; i++, info++)
				av_store(av, i, newSViv(2)); /* This information isn't currently available in the cursor. Maybe in the future. */
				
		    break;
		    
    }

the_end:	
END_TIMER
	if (!retsv)
		return Nullsv;
    return sv_2mortal(retsv);

dbdimp.h  view on Meta::CPAN

    
    /* PrimeBase Stuff. */
    long sessid; 	/* The PrimeBase session id. */

    char tag[16]; 		/* A tag name unique to this statement. Used in name generation. */
    
    char *stmt_text;	/* The prepared statement.  */
    long parm_cnt;		/* The number of paramaters in the statement.  */
	char delayed_execution;
	char is_select;
	char cursor_name[32];
	unsigned long 	cursor_id;
	
    long columns;			/* The number of columns in the result set.  */
    void *column_info;		/* A pointer to column info. */
	unsigned long	max_blob;		/* The maximum length of blob data to get. */
	
    long rows_effected;	/* The number of rows effected after execution.  */
};

#define IMP_STH_EXECUTING	0x0001

t/30insertfetch.t  view on Meta::CPAN


    #
    #   ...and delete it........
    #
    Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"))
	   or DbiError($dbh->err, $dbh->errstr);

    #
    #   Now, try SELECT'ing the row out. This should fail.
    #
    Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
					   . " WHERE id = 1"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
	   or DbiError($cursor->err, $cursor->errstr);

    my ($row, $errstr);
    Test($state or (!defined($row = $cursor->fetchrow_arrayref)  &&
		    (!defined($errstr = $cursor->errstr) ||
		     $cursor->errstr eq '')))
	or DbiError($cursor->err, $cursor->errstr);

    Test($state or $cursor->finish, "\$sth->finish failed")
	   or DbiError($cursor->err, $cursor->errstr);

    Test($state or undef $cursor || 1);


    #
    #   Finally drop the test table.
    #
    Test($state or $dbh->do("DROP TABLE $table"))
	   or DbiError($dbh->err, $dbh->errstr);

}

t/40bindparam.t  view on Meta::CPAN

    #
    #   Create a new table; EDIT THIS!
    #
    Test($state or ($def = TableDefinition($table,
					   ["id",   "INTEGER",  4, 0],
					   ["name", "CHAR",    64, $COL_NULLABLE]),
		    $dbh->do($def)))
	   or DbiError($dbh->err, $dbh->errstr);


    Test($state or $cursor = $dbh->prepare("INSERT INTO $table"
	                                   . " VALUES (?, ?)"))
	   or DbiError($dbh->err, $dbh->errstr);

    #
    #   Insert some rows
    #

    # Automatic type detection
    my $numericVal = 1;
    my $charVal = "Alligator Descartes";
    Test($state or $cursor->execute($numericVal, $charVal))
	   or DbiError($dbh->err, $dbh->errstr);

    # Does the driver remember the automatically detected type?
    Test($state or $cursor->execute("3", "Jochen Wiedmann"))
	   or DbiError($dbh->err, $dbh->errstr);
    $numericVal = 2;
    $charVal = "Tim Bunce";
    Test($state or $cursor->execute($numericVal, $charVal))
	   or DbiError($dbh->err, $dbh->errstr);

    # Now try the explicit type settings
    Test($state or $cursor->bind_param(1, " 4", SQL_INTEGER()))
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->bind_param(2, "Andreas König"))
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->execute)
	   or DbiError($dbh->err, $dbh->errstr);

    # Works undef -> NULL?
    Test($state or $cursor->bind_param(1, 5, SQL_INTEGER()))
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->bind_param(2, undef))
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->execute)
 	or DbiError($dbh->err, $dbh->errstr);

    #
    #   Try various mixes of question marks, single and double quotes
    #
    Test($state or $dbh->do("INSERT INTO $table VALUES (6, '?')"))
	   or DbiError($dbh->err, $dbh->errstr);
    if ($mdriver eq 'mysql') {
	Test($state or $dbh->do("INSERT INTO $table VALUES (7, \"?\")"))
	    or DbiError($dbh->err, $dbh->errstr);
    }

    Test($state or undef $cursor  ||  1);

    #
    #   And now retreive the rows using bind_columns
    #
    Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
					   . " ORDER BY id"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->bind_columns(undef, \$id, \$name))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($ref = $cursor->fetch)  &&  $id == 1  &&
	 $name eq 'Alligator Descartes')
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));

    Test($state or (($ref = $cursor->fetch)  &&  $id == 2  &&
		    $name eq 'Tim Bunce'))
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));

    Test($state or (($ref = $cursor->fetch)  &&  $id == 3  &&
		    $name eq 'Jochen Wiedmann'))
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));

    Test($state or (($ref = $cursor->fetch)  &&  $id == 4  &&
		    $name eq 'Andreas König'))
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));

    Test($state or (($ref = $cursor->fetch)  &&  $id == 5  &&
		    !defined($name)))
	or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
		  $id, $name, $ref, scalar(@$ref));

    Test($state or (($ref = $cursor->fetch)  &&  $id == 6  &&
		   $name eq '?'))
	or print("Query returned id = $id, name = $name, expected 6,?\n");
    if ($mdriver eq 'mysql') {
	Test($state or (($ref = $cursor->fetch)  &&  $id == 7  &&
			$name eq '?'))
	    or print("Query returned id = $id, name = $name, expected 7,?\n");
    }

    Test($state or undef $cursor  or  1);


    #
    #   Finally drop the test table.
    #
    Test($state or $dbh->do("DROP TABLE $table"))
	   or DbiError($dbh->err, $dbh->errstr);
}

t/40blobs.t  view on Meta::CPAN

	    }
	}
        Test($state or $dbh->do($query))
	    or DbiError($dbh->err, $dbh->errstr);

	#
	#   Now, try SELECT'ing the row out.
	#
	
	
	Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
					       . " WHERE id = 1"))
	       or DbiError($dbh->err, $dbh->errstr);

	Test($state or $cursor->execute)
	       or DbiError($dbh->err, $dbh->errstr);

	Test($state or (defined($row = $cursor->fetchrow_arrayref)))
	    or DbiError($cursor->err, $cursor->errstr);


	Test($state or (@$row == 2  &&  $$row[0] == 1  &&  $$row[1] eq $blob))
	    or (ShowBlob($blob),
		ShowBlob(defined($$row[1]) ? $$row[1] : ""));

	Test($state or $cursor->finish)
	    or DbiError($cursor->err, $cursor->errstr);

	Test($state or undef $cursor || 1)
	    or DbiError($cursor->err, $cursor->errstr);

	#
	#   Finally drop the test table.
	#
	Test($state or $dbh->do("DROP TABLE $table"))
	    or DbiError($dbh->err, $dbh->errstr);
    }
}

t/40listfields.t  view on Meta::CPAN

	   or DbiError($dbh->err, $dbh->errstr);

    #
    #   Create a new table
    #
    Test($state or ($def = TableDefinition($table, @table_def),
		    $dbh->do($def)))
	   or DbiError($dbh->err, $dbh->errstr);


    Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
	   or DbiError($cursor->err, $cursor->errstr);

    my $res;
    Test($state or (($res = $cursor->{'NUM_OF_FIELDS'}) == @table_def))
	   or DbiError($cursor->err, $cursor->errstr);
    if (!$state && $verbose) {
	printf("Number of fields: %s\n", defined($res) ? $res : "undef");
    }

    Test($state or ($ref = $cursor->{'NAME'})  &&  @$ref == @table_def
	            &&  (lc $$ref[0]) eq $table_def[0][0]
		    &&  (lc $$ref[1]) eq $table_def[1][0])
	   or DbiError($cursor->err, $cursor->errstr);
    if (!$state && $verbose) {
	print "Names:\n";
	for ($i = 0;  $i < @$ref;  $i++) {
	    print "    ", $$ref[$i], "\n";
	}
    }

	# PrimeBase Change:
	# Currently if a column can contain nulls or not is not stored with the cursor
	# information.
	# 
	if ($mdriver ne 'PrimeBase') {
	    Test($state or ($ref = $cursor->{'NULLABLE'})  &&  @$ref == @table_def
			    &&  !($$ref[0] xor ($table_def[0][3] & $COL_NULLABLE))
			    &&  !($$ref[1] xor ($table_def[1][3] & $COL_NULLABLE)))
		   or DbiError($cursor->err, $cursor->errstr);

	    if (!$state && $verbose) {
			print "Nullable:\n";
			for ($i = 0;  $i < @$ref;  $i++) {
			    print "    ", ($$ref[$i] & $COL_NULLABLE) ? "yes" : "no", "\n";
			}
	    }
	}
	
    Test($state or (($ref = $cursor->{TYPE})  &&  (@$ref == @table_def)
		    &&  ($ref->[0] eq DBI::SQL_INTEGER())
		    &&  ($ref->[1] eq DBI::SQL_VARCHAR()  ||
			 $ref->[1] eq DBI::SQL_CHAR())))
	or printf("Expected types %d and %d, got %s and %s\n",
		  &DBI::SQL_INTEGER(), &DBI::SQL_VARCHAR(),
		  defined($ref->[0]) ? $ref->[0] : "undef",
		  defined($ref->[1]) ? $ref->[1] : "undef");

    Test($state or undef $cursor  ||  1);


    #
    #  Drop the test table
    #
    Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
	or DbiError($dbh->err, $dbh->errstr);
    Test($state or $cursor->execute)
	or DbiError($cursor->err, $cursor->errstr);

    #  NUM_OF_FIELDS should be zero (Non-Select)
    Test($state or ($cursor->{'NUM_OF_FIELDS'} == 0))
	or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
			       $cursor->{'NUM_OF_FIELDS'});
    Test($state or (undef $cursor) or 1);

    #
    #  Test different flavours of quote. Need to work around a bug in
    #  DBI 1.02 ...
    #
    my $quoted;
    if (!$state) {
	$quoted = eval { $dbh->quote(0, DBI::SQL_INTEGER()) };
    }
    Test($state or $@  or  $quoted eq 0);

t/40nulls.t  view on Meta::CPAN



    #
    #   Test whether or not a field containing a NULL is returned correctly
    #   as undef, or something much more bizarre
    #
    Test($state or $dbh->do("INSERT INTO $table VALUES"
	                    . " ( NULL, 'NULL-valued id' )"))
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
	                                   . " WHERE " . IsNull("id")))
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($rv = $cursor->fetchrow_arrayref) or $dbdriver eq 'CSV')
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or (!defined($$rv[0])  and  defined($$rv[1])) or
	 $dbdriver eq 'CSV')
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->finish)
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or undef $cursor  ||  1);


    #
    #   Finally drop the test table.
    #
    Test($state or $dbh->do("DROP TABLE $table"))
	   or DbiError($dbh->err, $dbh->errstr);

}

t/40numrows.t  view on Meta::CPAN

    #   This section should exercise the sth->rows
    #   method by preparing a statement, then finding the
    #   number of rows within it.
    #   Prior to execution, this should fail. After execution, the
    #   number of rows affected by the statement will be returned.
    #
    Test($state or $dbh->do("INSERT INTO $table"
			    . " VALUES( 1, 'Alligator Descartes' )"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
					   . " WHERE id = 1")))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($numrows = $cursor->rows) == 1  or  ($numrows == -1))
	or ErrMsgF("Expected 1 rows, got %s.\n", $numrows);

    Test($state or ($numrows = TrueRows($cursor)) == 1)
	or ErrMsgF("Expected to fetch 1 rows, got %s.\n", $numrows);

    Test($state or $cursor->finish)
           or DbiError($dbh->err, $dbh->errstr);

    Test($state or undef $cursor or 1);

    Test($state or $dbh->do("INSERT INTO $table"
			    . " VALUES( 2, 'Jochen Wiedmann' )"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
					    . " WHERE id >= 1")))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($numrows = $cursor->rows) == 2  or  ($numrows == -1))
	or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);

    Test($state or ($numrows = TrueRows($cursor)) == 2)
	or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);

    Test($state or $cursor->finish)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or undef $cursor or 1);

    Test($state or $dbh->do("INSERT INTO $table"
			    . " VALUES(3, 'Tim Bunce')"))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
					    . " WHERE id >= 2")))
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or $cursor->execute)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or ($numrows = $cursor->rows) == 2  or  ($numrows == -1))
	or ErrMsgF("Expected 2 rows, got %s.\n", $numrows);

    Test($state or ($numrows = TrueRows($cursor)) == 2)
	or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);

    Test($state or $cursor->finish)
	   or DbiError($dbh->err, $dbh->errstr);

    Test($state or undef $cursor or 1);

    #
    #   Finally drop the test table.
    #
    Test($state or $dbh->do("DROP TABLE $table"))
	   or DbiError($dbh->err, $dbh->errstr);

}



( run in 0.378 second using v1.01-cache-2.11-cpan-4d50c553e7e )