view release on metacpan or  search on metacpan

dbdimp.c  view on Meta::CPAN

    phs->sv_type = SvTYPE(phs->sv);        /* part of mutation check    */
    phs->maxlen  = SvLEN(phs->sv)-1;       /* avail buffer space        */
    if (phs->maxlen < 0) {                 /* can happen with nulls     */
	phs->maxlen = 0;
    }

    phs->alen = value_len + phs->alen_incnull;

    imp_sth->all_params_len += phs->alen;

    if (dbis->debug >= 3) {
	PerlIO_printf(DBILOGFP, "       bind %s <== '%.*s' (size %ld/%ld, otype %d, indp %d)\n",
 	    phs->name,
	    (int)(phs->alen>SvIV(DBIS->neatsvpvlen) ? SvIV(DBIS->neatsvpvlen) : phs->alen),
	    (phs->progv) ? phs->progv : "",
 	    (long)phs->alen, (long)phs->maxlen, phs->ftype, phs->indp);
    }

    return 1;
}


int
dbd_bind_ph (sth, imp_sth, ph_namesv, newvalue, sql_type, attribs, is_inout, maxlen)
    SV *sth;
    imp_sth_t *imp_sth;
    SV *ph_namesv;
    SV *newvalue;
    IV sql_type;
    SV *attribs;
    int is_inout;
    IV maxlen;
{
    SV **phs_svp;
    STRLEN name_len;
    char *name;
    char namebuf[30];
    phs_t *phs;

    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_bind_ph\n"); }

    /* check if placeholder was passed as a number        */

    if (SvGMAGICAL(ph_namesv)) { /* eg if from tainted expression */
	mg_get(ph_namesv);
    }
    if (!SvNIOKp(ph_namesv)) {
	name = SvPV(ph_namesv, name_len);
    }
    if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) {
	sprintf(namebuf, ":p%d", (int)SvIV(ph_namesv));
	name = namebuf;
	name_len = strlen(name);
    }
    assert(name != Nullch);

    if (SvTYPE(newvalue) > SVt_PVLV) { /* hook for later array logic	*/
	croak("Can't bind a non-scalar value (%s)", neatsvpv(newvalue,0));
    }
    if (SvROK(newvalue) && !IS_DBI_HANDLE(newvalue)) {
	/* dbi handle allowed for cursor variables */
	croak("Can't bind a reference (%s)", neatsvpv(newvalue,0));
    }
    if (is_inout) {	/* may allow later */
        croak("inout parameters not supported");
    }

   if (dbis->debug >= 2) {
        PerlIO_printf(DBILOGFP, "         bind %s <== %s (type %ld", name, neatsvpv(newvalue,0), (long)sql_type);
        if (attribs) {
            PerlIO_printf(DBILOGFP, ", attribs: %s", neatsvpv(attribs,0));
        }
        PerlIO_printf(DBILOGFP, ")\n");
    }

    phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
    if (phs_svp == NULL) {
        croak("Can't bind unknown placeholder '%s' (%s)", name, neatsvpv(ph_namesv,0));
    }
    phs = (phs_t*)(void*)SvPVX(*phs_svp);	/* placeholder struct	*/

    if (phs->sv == &PL_sv_undef) { /* first bind for this placeholder	*/
        phs->ftype    = 1043;		 /* our default type VARCHAR	*/

        if (attribs) {	/* only look for pg_type on first bind of var	*/
            SV **svp;
	    /* Setup / Clear attributes as defined by attribs.		*/
	    /* XXX If attribs is EMPTY then reset attribs to default?	*/
            if ( (svp = hv_fetch((HV*)SvRV(attribs), "pg_type", 7,  0)) != NULL) {
                int pg_type = SvIV(*svp);
                if (!pgtype_bind_ok(pg_type)) {
                    croak("Can't bind %s, pg_type %d not supported by DBD::Pg", phs->name, pg_type);
                }
                if (sql_type) {
                    croak("Can't specify both TYPE (%d) and pg_type (%d) for %s", sql_type, pg_type, phs->name);
                }
                phs->ftype = pg_type;
            }
        }
        if (sql_type) {
            phs->ftype = pg_sql_type(imp_sth, phs->name, sql_type);
        }
    }   /* was first bind for this placeholder  */

    else if (sql_type && phs->ftype != pg_sql_type(imp_sth, phs->name, sql_type)) {
        croak("Can't change TYPE of param %s to %d after initial bind", phs->name, sql_type);
    }

    phs->maxlen = maxlen;		/* 0 if not inout		*/

    if (phs->sv == &PL_sv_undef) {     /* (first time bind) */
        phs->sv = newSV(0);
    }
    sv_setsv(phs->sv, newvalue);

    return dbd_rebind_ph(sth, imp_sth, phs);
}


int
dbd_st_execute (sth, imp_sth)   /* <= -2:error, >=0:ok row count, (-1=unknown count) */

dbdimp.c  view on Meta::CPAN

char * pgspi_err_desc (int err) {
    switch(err) {
      case SPI_ERROR_ARGUMENT:
        return "SPI_ERROR_ARGUMENT";
      case SPI_ERROR_UNCONNECTED:
        return "SPI_ERROR_UNCONNECTED";
      case SPI_ERROR_COPY:
        return "SPI_ERROR_COPY";
      case SPI_ERROR_CURSOR:
        return "SPI_ERROR_CURSOR";
      case SPI_ERROR_TRANSACTION:
        return "SPI_ERROR_TRANSACTION";
      case SPI_ERROR_OPUNKNOWN:
        return "SPI_ERROR_OPUNKNOWN";
      default:
        return "UNKNOWN SPI ERROR";
    }
}

AV *
dbd_st_fetch (sth, imp_sth)
    SV *sth;
    imp_sth_t *imp_sth;
{
    int num_fields;
    HeapTuple tup;
    HeapTuple       typeTup;
    TupleDesc tupdesc;
    Form_pg_attribute attdesc;
    int i;
    AV *av;
    SV *sv;
    Oid typoutput;
    Oid typioparam;
    char * attname;
    Datum attr;
    char * val;
    int len;
    bool isnull;

    if (dbis->debug >= 1) { PerlIO_printf(DBILOGFP, "dbd_st_fetch\n"); }

    /* Check that execute() was executed sucessfully */
    if ( !DBIc_ACTIVE(imp_sth) ) {
        pg_error(sth, 1, "no statement executing\n");
        return Nullav;
    }


    if ( imp_sth->cur_tuple == imp_sth->rows )  {
        imp_sth->cur_tuple = 0; 
/* XXX: probably we should consider sth closed here. check latest DBD::Pg */
        return Nullav; /* we reached the last tuple */
    }
    tup = imp_sth->tuples[imp_sth->cur_tuple];
    tupdesc = imp_sth->tupdesc;

    av = DBIS->get_fbav(imp_sth);
    num_fields = AvFILL(av)+1;

/* maybe we should use portals and cursor here? maybe later */

    for(i = 0; i < num_fields; ++i) {
        attdesc = imp_sth->tupdesc->attrs[i];
        attname = NameStr(imp_sth->tupdesc->attrs[i]->attname);
        attr = heap_getattr(tup, i +1, tupdesc, &isnull);

        sv  = AvARRAY(av)[i];
        if (isnull) { 
            sv_setsv(sv, &PL_sv_undef);
        } else  {
/* we have the value, now lets extract it correctly. We need to be aware 
   of boolean types to convert them to 0/1, but anything else we can get 
   as a CSTRING */
            typeTup = SearchSysCache(TYPEOID, ObjectIdGetDatum(attdesc->atttypid), 0, 0, 0);
            if (!HeapTupleIsValid(typeTup)) {
                elog(ERROR, "plperl: Cache lookup for attribute '%s' type %u failed", attname, tupdesc->attrs[i]->atttypid);
            }
            typoutput = (Oid) (((Form_pg_type) GETSTRUCT(typeTup))->typoutput);
            typioparam = getTypeIOParam(typeTup);

            ReleaseSysCache(typeTup);

            if (OidIsValid(typoutput)) {
/* fetch quickly for things that we know, 
   rely on GetCString for anything else */
 	      switch (attdesc->atttypid) {
	        case BOOLOID:
	   	  sv_setiv(sv, DatumGetBool(attr)?1:0 );
                  break;
	        case INT2OID:
	   	  sv_setiv(sv, DatumGetInt16(attr) );
                  break;
	        case INT4OID: 
	   	  sv_setiv(sv, DatumGetInt32(attr) );
                  break;
/* its a bit special
	        case INT8OID: 
	   	  sv_setnv(sv, DatumGetInt64(attr) );
                  break;
*/
  		default:
                  val = DatumGetCString(OidFunctionCall3(typoutput, attr,
                          ObjectIdGetDatum(typioparam),
                          Int32GetDatum(tupdesc->attrs[i]->atttypmod)
                        ));
 		  switch (attdesc->atttypid) {
/* chopblanks won't quite work 
                    case CHAROID:
                    case TEXTOID:
                    case NAMEOID:
                    case BPCHAROID:
                      if ( DBIc_has(imp_sth,DBIcf_ChopBlanks) ) {
                        len = strlen(val);
                        char *str = val;
                        while((len > 0) && (str[len-1] == ' ')) {
                            len--;
                        }
                        sv_setpvn(sv, val, len);
                      } else {
                        sv_setpv(sv, val);