view release on metacpan or  search on metacpan

FANN.xs  view on Meta::CPAN

		stash = SvSTASH(klass);
	    else
		stash = gv_stashsv(klass, 1);
	    
	    sv_bless(rv, stash);
	}
	return rv;
    }
    return &PL_sv_undef;
}

static void *
_sv2obj(pTHX_ SV* self, char * ctype, int required) {
    SV *sv = SvRV(self);
    if (sv) {
        if (SvTYPE(sv) == SVt_PVMG) {
            MAGIC *mg = mg_find(sv, '~');
            if (mg) {
                if (strcmp(ctype, mg->mg_ptr) == 0 && mg->mg_obj) {
                    return INT2PTR(void *, SvIV(mg->mg_obj));
                }
            }
        }
    }
    if (required) {
        Perl_croak(aTHX_ "object of class %s expected", ctype);
    }
    return NULL;
}

static SV *
_fta2sv(pTHX_ fann_type *fta, unsigned int len) {
    unsigned int i;
    AV *av = newAV();
    av_extend(av, len - 1);
    for (i = 0; i < len; i++) {
        SV *sv = newSVnv(fta[i]);
        av_store(av, i, sv);
    }
    return newRV_noinc((SV*)av);
}

static AV*
_srv2av(pTHX_ SV* sv, unsigned int len, char * const name) {
    if (SvROK(sv)) {
        AV *av = (AV*)SvRV(sv);
        if (SvTYPE((SV*)av)==SVt_PVAV) {
            if (av_len(av)+1 == len) {
                return av;
            }
            else {
                Perl_croak(aTHX_ "wrong number of elements in %s array, %d found when %d were required",
                           name, (unsigned int)(av_len(av)+1), len);
            }
        }
    }
    Perl_croak(aTHX_ "wrong type for %s argument, array reference expected", name);
}

static fann_type*
_sv2fta(pTHX_ SV *sv, unsigned int len, int flags, char * const name) {
    unsigned int i;
    fann_type *fta;
    AV *av = _srv2av(aTHX_ sv, len, name);

    Newx(fta, len, fann_type);
    if (flags & WANT_MORTAL) SAVEFREEPV(fta);

    for (i = 0; i < len; i++) {
        SV ** svp = av_fetch(av, i, 0);
        fta[i] = SvNV(svp ? *svp : &PL_sv_undef);
    }
    return fta;
}

static void
_check_error(pTHX_ struct fann_error *self) {
    if (self) {
        if (fann_get_errno(self) != FANN_E_NO_ERROR) {
            ERRSV = newSVpv(self->errstr, strlen(self->errstr) - 2);
            fann_get_errstr(self);
            Perl_croak(aTHX_ Nullch);
        }
    }
    else {
        Perl_croak(aTHX_ "Constructor failed");
    }
}

static unsigned int
_sv2enum(pTHX_ SV *sv, unsigned int top, char * const name) {
	unsigned int value = SvUV(sv);
	if (value > top) {
		Perl_croak(aTHX_ "value %d is out of range for %s", value, name);
	}
	return value;
}

static SV *
_enum2sv(pTHX_ unsigned int value, char const * const * const names, unsigned int top, char const * const name) {
    SV *sv;
    if (value > top) {
        Perl_croak(aTHX_ "internal error: value %d out of range for %s", value, name);
    }
    sv = newSVpv(names[value], 0);
    SvUPGRADE(sv, SVt_PVIV);
    SvUV_set(sv, value);
    SvIOK_on(sv);
    SvIsUV_on(sv);
    return sv;
}

#define _sv2fann_train_enum(sv) _sv2enum(aTHX_ sv, FANN_TRAIN_QUICKPROP, "fann_train_enum")
#define _sv2fann_activationfunc_enum(sv) _sv2enum(aTHX_ sv, FANN_LINEAR_PIECE_SYMMETRIC, "fann_activationfunc_enum")
#define _sv2fann_errorfunc_enum(sv) _sv2enum(aTHX_ sv, FANN_ERRORFUNC_TANH, "fann_errorfunc_enum")
#define _sv2fann_stopfunc_enum(sv) _sv2enum(aTHX_ sv, FANN_STOPFUNC_BIT, "fann_stopfunc_enum")

#define _fann_train_enum2sv(sv) _enum2sv(aTHX_ sv, FANN_TRAIN_NAMES, FANN_TRAIN_QUICKPROP, "fann_train_enum")
#define _fann_activationfunc_enum2sv(sv) _enum2sv(aTHX_ sv, FANN_ACTIVATIONFUNC_NAMES, FANN_LINEAR_PIECE_SYMMETRIC, "fann_activationfunc_enum")
#define _fann_errorfunc_enum2sv(sv) _enum2sv(aTHX_ sv, FANN_ERRORFUNC_NAMES, FANN_ERRORFUNC_TANH, "fann_errorfunc_enum")
#define _fann_stopfunc_enum2sv(sv) _enum2sv(aTHX_ sv, FANN_STOPFUNC_NAMES, FANN_STOPFUNC_BIT, "fann_stopfunc_enum")



/* normalized names for train_data methods */

#define fann_train_data_create_from_file fann_read_train_from_file