DBD-TimesTen

 view release on metacpan or  search on metacpan

dbdimp.c  view on Meta::CPAN

             */
            dbd_error(sth, SQL_ERROR, "dbd_st_fetch/SQLFetch (long " \
               "truncated DBI attribute LongTruncOk not set and/or " \
               "LongReadLen too small)");
            return Nullav;
         }

         /* LongTruncOk true, just ensure perl has the right length
          * for the truncated data.
          */
         sv_setpvn(sv, (char*)fbh->data, fbh->ColDisplaySize);
      }
      else switch(fbh->ftype)
      {
         TIMESTAMP_STRUCT *ts;

         case SQL_C_TIMESTAMP:
            ts = (TIMESTAMP_STRUCT *)fbh->data;
            sprintf(cvbuf
                   ,"%04d-%02d-%02d %02d:%02d:%02d"
                   ,ts->year
                   ,ts->month
                   ,ts->day
                   ,ts->hour
                   ,ts->minute
                   ,ts->second);
            sv_setpv(sv, cvbuf);
            break;
         default:
            if (ChopBlanks && fbh->ColSqlType == SQL_CHAR && fbh->datalen > 0)
            {
               char *p = (char*)fbh->data;
               while(fbh->datalen && p[fbh->datalen - 1]==' ')
                  --fbh->datalen;
            }
            sv_setpvn(sv, (char*)fbh->data, fbh->datalen);
      }
   }

   return av;
}


int
   dbd_st_rows(sth, imp_sth)
   SV *sth;
imp_sth_t *imp_sth;
{
   return imp_sth->RowCount;
}


int
   dbd_st_finish(sth, imp_sth)
   SV *sth;
imp_sth_t *imp_sth;
{
   D_imp_dbh_from_sth;
   RETCODE rc;

   /* Cancel further fetches from this cursor.                 */
   /* We don't close the cursor till DESTROY (dbd_st_destroy). */
   /* The application may re execute(...) it.                  */
   if (DBIc_ACTIVE(imp_sth) && imp_dbh->hdbc != SQL_NULL_HDBC)
   {

      rc = SQLFreeStmt(imp_sth->hstmt, SQL_CLOSE);
      if (!SQL_ok(rc))
      {
         dbd_error(sth, rc, "dbd_st_finish/SQLFreeStmt(SQL_CLOSE)");
         return 0;
      }

      if (DBIc_TRACE_LEVEL(imp_sth) > 5)
      {
         PerlIO_printf(DBIc_LOGPIO(imp_dbh), "dbd_st_finish closed query:\n");
      }
   }
   DBIc_ACTIVE_off(imp_sth);
   return 1;
}


void
   dbd_st_destroy(sth, imp_sth)
   SV *sth;
imp_sth_t *imp_sth;
{
   D_imp_dbh_from_sth;
   RETCODE rc;

   /* Free contents of imp_sth */
   Safefree(imp_sth->fbh);
   Safefree(imp_sth->RowBuffer);
   Safefree(imp_sth->ColNames);
   Safefree(imp_sth->statement);

   if (imp_sth->out_params_av)
      sv_free((SV*)imp_sth->out_params_av);

   if (imp_sth->all_params_hv)
   {
      HV *hv = imp_sth->all_params_hv;
      SV *sv;
      char *key;
      I32 retlen;
      hv_iterinit(hv);
      while ((sv = hv_iternextsv(hv, &key, &retlen)) != NULL)
      {
         if (sv != &sv_undef)
         {
            phs_t *phs_tpl = (phs_t*)(void*)SvPVX(sv);
            sv_free(phs_tpl->sv);
         }
      }
      sv_free((SV*)imp_sth->all_params_hv);
   }

   /* SQLxxx functions dump core when no connection exists. This happens
    * when the db was disconnected before perl ending.  Hence,
    * checking for the dirty flag.
    */

dbdimp.c  view on Meta::CPAN

   return sv_2mortal(retsv);
}

/*
 * added "need_describe" flag to handle the situation where you don't
 * have a result set yet to describe.  Certain attributes don't need
 * the result set to operate, hence don't do a describe unless you need
 * to do one.
 * */
typedef struct {
   const char *str;
   unsigned len:8;
   unsigned array:1;
   unsigned need_describe:1;
   unsigned filler:22;
} T_st_params;

#define s_A(str,need_describe) { str, sizeof(str)-1,0,need_describe }
static T_st_params S_st_fetch_params[] = 
{
   s_A("NUM_OF_PARAMS",1),	/* 0 */
   s_A("NUM_OF_FIELDS",1),	/* 1 */
   s_A("NAME",1),		/* 2 */
   s_A("NULLABLE",1),		/* 3 */
   s_A("TYPE",1),		/* 4 */
   s_A("PRECISION",1),		/* 5 */
   s_A("SCALE",1),		/* 6 */
   s_A("CursorName",1),		/* 7 */
   s_A("ParamValues",1),	/* 8 */
   s_A("LongReadLen",0),	/* 9 */
   s_A("ttIgnoreNamedPlaceholders",0),	/* 10 */
   s_A("ttDefaultBindType",0),		/* 11 */
   s_A("ttQueryTimeout",0),	/* 12 */
   s_A("",0),			/* END */
};

static T_st_params S_st_store_params[] = 
{
   s_A("ttIgnoreNamedPlaceholders",0),	/* 0 */
   s_A("ttDefaultBindType",0),	/* 1 */
   s_A("ttQueryTimeout",0),	/* 2 */
   s_A("",0),			/* END */
};
#undef s_A

/*----------------------------------------
 * dummy routines st_XXXX
 *----------------------------------------
 */
SV *
   dbd_st_FETCH_attrib(sth, imp_sth, keysv)
   SV *sth;
imp_sth_t *imp_sth;
SV *keysv;
{
   STRLEN kl;
   char *key = SvPV(keysv,kl);
   int i;
   SV *retsv = NULL;
   T_st_params *par;
   char cursor_name[256];
   SWORD cursor_name_len;
   RETCODE rc;

   for (par = S_st_fetch_params; par->len > 0; par++)
      if (par->len == kl && strEQ(key, par->str))
	 break;


   if (par->len <= 0)
      return Nullsv;

   if (par->need_describe && !imp_sth->done_desc && !dbd_describe(sth, imp_sth)) 
   {
      /* dbd_describe has already called dbd_error()          */
      /* we can't return Nullsv here because the xs code will */
      /* then just pass the attribute name to DBI for FETCH.  */
      if (DBIc_TRACE_LEVEL(imp_sth) > 3) {
	 PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_FETCH_attrib (%s) needed query description, but failed\n", par->str);
      }
      if (DBIc_WARN(imp_sth)) {
	 warn("Describe failed during %s->FETCH(%s,%d)", SvPV(sth,na), key,imp_sth->done_desc);
      }
      return &sv_undef;
   }

   i = DBIc_NUM_FIELDS(imp_sth);


   switch(par - S_st_fetch_params)
   {
      AV *av;

      case 0:			/* NUM_OF_PARAMS */
	 return Nullsv;	/* handled by DBI */
      case 1:			/* NUM_OF_FIELDS */
	 if (DBIc_TRACE_LEVEL(imp_sth) > 8) {
	    PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_FETCH_attrib NUM_OF_FIELDS %d\n", i);
	 }
	 retsv = newSViv(i);
	 break;
      case 2: 			/* NAME */
	 av = newAV();
	 retsv = newRV(sv_2mortal((SV*)av));
	 if (DBIc_TRACE_LEVEL(imp_sth) > 8) {
	    int j;
	    PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_FETCH_attrib NAMES %d\n", i);

	    for (j = 0; j < i; j++)
	       PerlIO_printf(DBIc_LOGPIO(imp_sth), "\t%s\n", imp_sth->fbh[j].ColName);
	 }
	 while(--i >= 0) {
	    if (DBIc_TRACE_LEVEL(imp_sth) > 8)
	       PerlIO_printf(DBIc_LOGPIO(imp_sth), "    Colname %d => %s\n",
			     i, imp_sth->fbh[i].ColName);
	    av_store(av, i, newSVpv(imp_sth->fbh[i].ColName, 0));
	 }
	 break;
      case 3:			/* NULLABLE */
	 av = newAV();
	 retsv = newRV(sv_2mortal((SV*)av));
	 while(--i >= 0)
	    av_store(av, i,
		     (imp_sth->fbh[i].ColNullable == SQL_NO_NULLS)
		     ? &sv_no : &sv_yes);
	 break;
      case 4:			/* TYPE */
	 av = newAV();
	 retsv = newRV(sv_2mortal((SV*)av));
	 while(--i >= 0) 
	    av_store(av, i, newSViv(imp_sth->fbh[i].ColSqlType));
	 break;
      case 5:			/* PRECISION */
	 av = newAV();
	 retsv = newRV(sv_2mortal((SV*)av));
	 while(--i >= 0) 
	    av_store(av, i, newSViv(imp_sth->fbh[i].ColDef));
	 break;
      case 6:			/* SCALE */
	 av = newAV();
	 retsv = newRV(sv_2mortal((SV*)av));
	 while(--i >= 0) 
	    av_store(av, i, newSViv(imp_sth->fbh[i].ColScale));
	 break;
      case 7:			/* CursorName */
	 rc = SQLGetCursorName(imp_sth->hstmt,
			       cursor_name, sizeof(cursor_name), &cursor_name_len);
	 if (!SQL_ok(rc)) {
	    dbd_error(sth, rc, "st_FETCH/SQLGetCursorName");
	    return Nullsv;
	 }
	 retsv = newSVpv(cursor_name, cursor_name_len);
	 break;
      case 8:
      {
	 /* not sure if there's a memory leak here. */
	 HV *paramvalues = newHV();
	 if (imp_sth->all_params_hv) {
	    HV *hv = imp_sth->all_params_hv;
	    SV *sv;
	    char *key;
	    I32 retlen;
	    hv_iterinit(hv);
	    while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) {
	       if (sv != &sv_undef) {
		  phs_t *phs = (phs_t*)(void*)SvPVX(sv);
		  hv_store(paramvalues, phs->name, strlen(phs->name), newSVsv(phs->sv), 0);
	       }
	    }
	 }
	 /* ensure HV is freed when the ref is freed */
	 retsv = newRV_noinc((SV *)paramvalues);
      }
      break;
      case 9:
	 retsv = newSViv(DBIc_LongReadLen(imp_sth));
	 break;
      case 10:
	 retsv = newSViv(imp_sth->ttIgnoreNamedPlaceholders);
	 break;
      case 11:
	 retsv = newSViv(imp_sth->ttDefaultBindType);
	 break;
      case 12: /* query timeout */
	 retsv = newSViv(imp_sth->ttQueryTimeout);
	 break;
      default:
	 return Nullsv;
   }

   return sv_2mortal(retsv);
}


int
   dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)
   SV *sth;
imp_sth_t *imp_sth;
SV *keysv;
SV *valuesv;
{
   STRLEN kl;
   char *key = SvPV(keysv,kl);
   T_st_params *par;

   for (par = S_st_store_params; par->len > 0; par++)
      if (par->len == kl && strEQ(key, par->str))
	 break;

   if (par->len <= 0)
      return FALSE;



( run in 1.062 second using v1.01-cache-2.11-cpan-39bf76dae61 )