view release on metacpan or  search on metacpan

DBI.xs  view on Meta::CPAN

        }

        /* if method was a 'func' then try falling back to real 'func' method */
        if (!imp_msv && (ima_flags & IMA_FUNC_REDIRECT)) {
            imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), "func", FALSE);
            if (imp_msv) {
                /* driver does have func method so undo the earlier 'func' stack changes */
                mPUSHs(newSVpv(meth_name, 0));
                PUTBACK;
                ++items;
                meth_name = "func";
                meth_type = methtype_ordinary;
            }
        }

        if (trace_level >= (is_nested_call ? 4 : 2)) {
            PerlIO *logfp = DBILOGFP;
            /* Full pkg method name (or just meth_name for ANON CODE)   */
            const char *imp_meth_name = (imp_msv && isGV(imp_msv)) ? GvNAME(imp_msv) : meth_name;
            HV *imp_stash = DBIc_IMP_STASH(imp_xxh);
            PerlIO_printf(logfp, "%c   -> %s ",
                    call_depth>1 ? '0'+call_depth-1 : (PL_dirty?'!':' '), imp_meth_name);
            if (imp_meth_name[0] == 'A' && strEQ(imp_meth_name,"AUTOLOAD"))
                    PerlIO_printf(logfp, "\"%s\" ", meth_name);
            if (imp_msv && isGV(imp_msv) && GvSTASH(imp_msv) != imp_stash)
                PerlIO_printf(logfp, "in %s ", HvNAME(GvSTASH(imp_msv)));
            PerlIO_printf(logfp, "for %s (%s", HvNAME(imp_stash),
                        SvPV_nolen(orig_h));
            if (h != orig_h)    /* show inner handle to aid tracing */
                 PerlIO_printf(logfp, "~0x%lx", (long)SvRV(h));
            else PerlIO_printf(logfp, "~INNER");
            for(i=1; i<items; ++i) {
                PerlIO_printf(logfp," %s",
                    (ima && i==ima->hidearg) ? "****" : neatsvpv(ST(i),0));
            }
#ifdef DBI_USE_THREADS
            PerlIO_printf(logfp, ") thr#%p\n", (void*)DBIc_THR_USER(imp_xxh));
#else
            PerlIO_printf(logfp, ")\n");
#endif
            PerlIO_flush(logfp);
        }

        if (!imp_msv || ! ((meth_cv = GvCV(imp_msv))) ) {
            if (PL_dirty || is_DESTROY) {
                outitems = 0;
                goto post_dispatch;
            }
            if (ima_flags & IMA_NOT_FOUND_OKAY) {
                outitems = 0;
                goto post_dispatch;
            }
            croak("Can't locate DBI object method \"%s\" via package \"%s\"",
                meth_name, HvNAME(DBIc_IMP_STASH(imp_xxh)));
        }

        PUSHMARK(mark);  /* mark arguments again so we can pass them on */

        /* Note: the handle on the stack is still an object blessed into a
         * DBI::* class and not the DBD::*::* class whose method is being
         * invoked. This is correct and should be largely transparent.
         */

        /* SHORT-CUT ALERT! */
        if (use_xsbypass && CvISXSUB(meth_cv) && CvXSUB(meth_cv)) {

            /* If we are calling an XSUB we jump directly to its C code and
             * bypass perl_call_sv(), pp_entersub() etc. This is fast.
             * This code is based on a small section of pp_entersub().
             */
            (void)(*CvXSUB(meth_cv))(aTHXo_ meth_cv); /* Call the C code directly */

            if (gimme == G_SCALAR) {    /* Enforce sanity in scalar context */
                if (ax != PL_stack_sp - PL_stack_base ) { /* outitems != 1 */
                    ST(0) =
                        (ax > PL_stack_sp - PL_stack_base)
                            ? &PL_sv_undef  /* outitems == 0 */
                            : *PL_stack_sp; /* outitems > 1 */
                    PL_stack_sp = PL_stack_base + ax;
                }
                outitems = 1;
            }
            else {
                outitems = PL_stack_sp - (PL_stack_base + ax - 1);
            }

        }
        else {
            /* sv_dump(imp_msv); */
            outitems = call_sv((SV*)meth_cv,
                (is_DESTROY ? gimme | G_EVAL | G_KEEPERR : gimme) );
        }

        XSprePUSH; /* reset SP to base of stack frame */

#ifdef DBI_save_hv_fetch_ent
        if (meth_type == methtype_FETCH)
            PL_hv_fetch_ent_mh = save_mh;       /* see start of block */
#endif
    }

    post_dispatch:

    if (is_DESTROY && DBI_IS_LAST_HANDLE(h)) { /* if destroying _this_ handle */
        SV *lhp = DBIc_PARENT_H(imp_xxh);
        if (lhp && SvROK(lhp)) {
            DBI_SET_LAST_HANDLE(lhp);
        }
        else {
            DBI_UNSET_LAST_HANDLE;
        }
    }

    if (keep_error) {
        /* if we didn't clear err before the call, check to see if a new error
         * or warning has been recorded. If so, turn off keep_error so it gets acted on
         */
        if (DBIc_ErrCount(imp_xxh) > ErrCount || err_hash(aTHX_ imp_xxh) != keep_error) {
            keep_error = 0;
        }
    }