static void
S_set_pattern_from_token_re(lucy_RegexTokenizer *self, void *token_re) {
SV *rv = newRV((SV*)token_re);
STRLEN len = 0;
char *ptr = SvPVutf8((SV*)rv, len);
Lucy_CB_Mimic_Str(self->pattern, ptr, len);
SvREFCNT_dec(rv);
}
lucy_Err*
lucy_Err_trap(Cfish_Err_Attempt_t routine, void *context) {
lucy_Err *error = NULL;
SV *routine_sv = newSViv(PTR2IV(routine));
SV *context_sv = newSViv(PTR2IV(context));
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
EXTEND(SP, 2);
PUSHs(sv_2mortal(routine_sv));
PUSHs(sv_2mortal(context_sv));
PUTBACK;
int count = call_sv(attempt_xsub, G_EVAL | G_DISCARD);
if (count != 0) {
lucy_CharBuf *mess
= lucy_CB_newf("'attempt' returned too many values: %i32",
(int32_t)count);
error = lucy_Err_new(mess);
}
else {
SV *dollar_at = get_sv("@", FALSE);
if (SvTRUE(dollar_at)) {
if (sv_isobject(dollar_at)
&& sv_derived_from(dollar_at,"Clownfish::Err")
) {
IV error_iv = SvIV(SvRV(dollar_at));
error = INT2PTR(lucy_Err*, error_iv);
CFISH_INCREF(error);
}
else {
STRLEN len;
char *ptr = SvPVutf8(dollar_at, len);
lucy_CharBuf *mess = lucy_CB_new_from_trusted_utf8(ptr, len);
error = lucy_Err_new(mess);
}
}
kino_CharBuf*
kino_Host_callback_str(void *vobj, char *method, uint32_t num_args, ...)
{
va_list args;
SV *temp_retval;
kino_CharBuf *retval = NULL;
va_start(args, num_args);
temp_retval = S_do_callback_sv(vobj, method, num_args, args);
va_end(args);
// Make a stringified copy.
if (temp_retval && XSBind_sv_defined(temp_retval)) {
STRLEN len;
char *ptr = SvPVutf8(temp_retval, len);
retval = kino_CB_new_from_trusted_utf8(ptr, len);
}
FREETMPS;
LEAVE;
return retval;
}
void
LUCY_Inverter_Invert_Doc_IMP(lucy_Inverter *self, lucy_Doc *doc) {
dTHX;
HV *const fields = (HV*)LUCY_Doc_Get_Fields(doc);
I32 num_keys = hv_iterinit(fields);
// Prepare for the new doc.
LUCY_Inverter_Set_Doc(self, doc);
// Extract and invert the doc's fields.
while (num_keys--) {
HE *hash_entry = hv_iternext(fields);
lucy_InverterEntry *inv_entry = S_fetch_entry(aTHX_ self, hash_entry);
SV *value_sv = HeVAL(hash_entry);
lucy_InverterEntryIVARS *const entry_ivars
= lucy_InvEntry_IVARS(inv_entry);
lucy_FieldType *type = entry_ivars->type;
cfish_Obj *obj = NULL;
// Get the field value, forcing text fields to UTF-8.
switch (LUCY_FType_Primitive_ID(type) & lucy_FType_PRIMITIVE_ID_MASK) {
case lucy_FType_TEXT: {
STRLEN val_len;
char *val_ptr = SvPVutf8(value_sv, val_len);
obj = (cfish_Obj*)cfish_Str_new_wrap_trusted_utf8(val_ptr,
val_len);
break;
}
case lucy_FType_BLOB: {
STRLEN val_len;
char *val_ptr = SvPV(value_sv, val_len);
obj = (cfish_Obj*)cfish_Blob_new_wrap(val_ptr, val_len);
break;
}
case lucy_FType_INT32: {
obj = (cfish_Obj*)cfish_Int_new(SvIV(value_sv));
break;
}
case lucy_FType_INT64: {
// nwellnhof: Using SvNOK could avoid a int/float/int
// round-trip with 32-bit IVs.
int64_t val = sizeof(IV) == 8
? SvIV(value_sv)
: (int64_t)SvNV(value_sv); // lossy
obj = (cfish_Obj*)cfish_Int_new(val);
break;
}
case lucy_FType_FLOAT32:
case lucy_FType_FLOAT64: {
obj = (cfish_Obj*)cfish_Float_new(SvNV(value_sv));
break;
}
default:
THROW(CFISH_ERR, "Unrecognized type: %o", type);
}
CFISH_DECREF(entry_ivars->value);
entry_ivars->value = obj;
LUCY_Inverter_Add_Field(self, inv_entry);
}
}
IV
PerlIOEncode_fill(pTHX_ PerlIO * f)
{
PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
dSP;
IV code = 0;
PerlIO *n;
SSize_t avail;
if (PerlIO_flush(f) != 0)
return -1;
n = PerlIONext(f);
if (!PerlIO_fast_gets(n)) {
/* Things get too messy if we don't have a buffer layer
push a :perlio to do the job */
char mode[8];
n = PerlIO_push(aTHX_ n, &PerlIO_perlio, PerlIO_modestr(f,mode), Nullsv);
if (!n) {
Perl_die(aTHX_ "panic: cannot push :perlio for %p",f);
}
}
PUSHSTACKi(PERLSI_MAGIC);
SPAGAIN;
ENTER;
SAVETMPS;
retry:
avail = PerlIO_get_cnt(n);
if (avail <= 0) {
avail = PerlIO_fill(n);
if (avail == 0) {
avail = PerlIO_get_cnt(n);
}
else {
if (!PerlIO_error(n) && PerlIO_eof(n))
avail = 0;
}
}
if (avail > 0 || (e->flags & NEEDS_LINES)) {
STDCHAR *ptr = PerlIO_get_ptr(n);
SSize_t use = (avail >= 0) ? avail : 0;
SV *uni;
char *s = NULL;
STRLEN len = 0;
e->base.ptr = e->base.end = (STDCHAR *) NULL;
(void) PerlIOEncode_get_base(aTHX_ f);
if (!e->dataSV)
e->dataSV = newSV(0);
if (SvTYPE(e->dataSV) < SVt_PV) {
sv_upgrade(e->dataSV,SVt_PV);
}
if (e->flags & NEEDS_LINES) {
/* Encoding needs whole lines (e.g. iso-2022-*)
search back from end of available data for
and line marker
*/
STDCHAR *nl = ptr+use-1;
while (nl >= ptr) {
if (*nl == '\n') {
break;
}
nl--;
}
if (nl >= ptr && *nl == '\n') {
/* found a line - take up to and including that */
use = (nl+1)-ptr;
}
else if (avail > 0) {
/* No line, but not EOF - append avail to the pending data */
sv_catpvn(e->dataSV, (char*)ptr, use);
PerlIO_set_ptrcnt(n, ptr+use, 0);
goto retry;
}
else if (!SvCUR(e->dataSV)) {
goto end_of_file;
}
}
if (SvCUR(e->dataSV)) {
/* something left over from last time - create a normal
SV with new data appended
*/
if (use + SvCUR(e->dataSV) > e->base.bufsiz) {
if (e->flags & NEEDS_LINES) {
/* Have to grow buffer */
e->base.bufsiz = use + SvCUR(e->dataSV);
PerlIOEncode_get_base(aTHX_ f);
}
else {
use = e->base.bufsiz - SvCUR(e->dataSV);
}
}
sv_catpvn(e->dataSV,(char*)ptr,use);
}
else {
/* Create a "dummy" SV to represent the available data from layer below */
if (SvLEN(e->dataSV) && SvPVX_const(e->dataSV)) {
Safefree(SvPVX_mutable(e->dataSV));
}
if (use > (SSize_t)e->base.bufsiz) {
if (e->flags & NEEDS_LINES) {
/* Have to grow buffer */
e->base.bufsiz = use;
PerlIOEncode_get_base(aTHX_ f);
}
else {
use = e->base.bufsiz;
}
}
SvPV_set(e->dataSV, (char *) ptr);
SvLEN_set(e->dataSV, 0); /* Hands off sv.c - it isn't yours */
SvCUR_set(e->dataSV,use);
SvPOK_only(e->dataSV);
}
SvUTF8_off(e->dataSV);
PUSHMARK(sp);
XPUSHs(e->enc);
XPUSHs(e->dataSV);
XPUSHs(e->chk);
PUTBACK;
if (call_method("decode", G_SCALAR) != 1) {
Perl_die(aTHX_ "panic: decode did not return a value");
}
SPAGAIN;
uni = POPs;
PUTBACK;
/* Now get translated string (forced to UTF-8) and use as buffer */
if (SvPOK(uni)) {
s = SvPVutf8(uni, len);
#ifdef PARANOID_ENCODE_CHECKS
if (len && !is_utf8_string((U8*)s,len)) {
Perl_warn(aTHX_ "panic: decode did not return UTF-8 '%.*s'",(int) len,s);
}
#endif
}
if (len > 0) {
/* Got _something */
/* if decode gave us back dataSV then data may vanish when
we do ptrcnt adjust - so take our copy now.
(The copy is a pain - need a put-it-here option for decode.)
*/
sv_setpvn(e->bufsv,s,len);
e->base.ptr = e->base.buf = (STDCHAR*)SvPVX(e->bufsv);
e->base.end = e->base.ptr + SvCUR(e->bufsv);
PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
SvUTF8_on(e->bufsv);
/* Adjust ptr/cnt not taking anything which
did not translate - not clear this is a win */
/* compute amount we took */
use -= SvCUR(e->dataSV);
PerlIO_set_ptrcnt(n, ptr+use, (avail-use));
/* and as we did not take it it isn't pending */
SvCUR_set(e->dataSV,0);
} else {
/* Got nothing - assume partial character so we need some more */
/* Make sure e->dataSV is a normal SV before re-filling as
buffer alias will change under us
*/
s = SvPV(e->dataSV,len);
sv_setpvn(e->dataSV,s,len);
PerlIO_set_ptrcnt(n, ptr+use, (avail-use));
goto retry;
}
}
else {
end_of_file:
code = -1;
if (avail == 0)
PerlIOBase(f)->flags |= PERLIO_F_EOF;
else
PerlIOBase(f)->flags |= PERLIO_F_ERROR;
}
FREETMPS;
LEAVE;
POPSTACK;
return code;
}
