Bool
AbstractMenu_sub_call( Handle self, PMenuItemReg m)
{
char buffer[16], *context;
if ( m == nil) return false;
context = AbstractMenu_make_var_context( self, m, buffer);
if ( m-> flags. autotoggle ) {
m-> flags. checked = m-> flags. checked ? 0 : 1;
apc_menu_item_set_check( self, m);
}
if ( m-> code) {
if ( m-> flags. utf8_variable) {
SV * sv = newSVpv( context, 0);
SvUTF8_on( sv);
cv_call_perl((( PComponent) var-> owner)-> mate, SvRV( m-> code), "Si", sv, m-> flags. checked);
sv_free( sv);
} else
cv_call_perl((( PComponent) var-> owner)-> mate, SvRV( m-> code), "si", context, m-> flags. checked);
} else if ( m-> perlSub) {
if ( m-> flags. utf8_variable) {
SV * sv = newSVpv( context, 0);
SvUTF8_on( sv);
call_perl( var-> owner, m-> perlSub, "Si", sv, m-> flags. checked);
sv_free( sv);
} else
call_perl( var-> owner, m-> perlSub, "si", context, m-> flags. checked);
}
return true;
}
/* Load a YAML scalar into a Perl scalar */
SV *
load_scalar(perl_yaml_loader_t *loader)
{
SV *scalar;
char *string = (char *)loader->event.data.scalar.value;
STRLEN length = (STRLEN)loader->event.data.scalar.length;
char *anchor = (char *)loader->event.data.scalar.anchor;
char *tag = (char *)loader->event.data.scalar.tag;
if (tag) {
char *class;
char *prefix = TAG_PERL_PREFIX "regexp";
if (strnEQ(tag, prefix, strlen(prefix)))
return load_regexp(loader);
prefix = TAG_PERL_PREFIX "scalar:";
if (*tag == '!')
prefix = "!";
else if (strlen(tag) <= strlen(prefix) ||
! strnEQ(tag, prefix, strlen(prefix))
) croak(ERRMSG "bad tag found for scalar: '%s'", tag);
class = tag + strlen(prefix);
scalar = sv_setref_pvn(newSV(0), class, string, strlen(string));
SvUTF8_on(scalar);
return scalar;
}
if (loader->event.data.scalar.style == YAML_PLAIN_SCALAR_STYLE) {
if (strEQ(string, "~"))
return newSV(0);
else if (strEQ(string, ""))
return newSV(0);
else if (strEQ(string, "null"))
return newSV(0);
else if (strEQ(string, "true"))
return &PL_sv_yes;
else if (strEQ(string, "false"))
return &PL_sv_no;
}
scalar = newSVpvn(string, length);
if (loader->event.data.scalar.style == YAML_PLAIN_SCALAR_STYLE && looks_like_number(scalar) ) {
/* numify */
SvIV_please(scalar);
}
SvUTF8_on(scalar);
if (anchor)
hv_store(loader->anchors, anchor, strlen(anchor), SvREFCNT_inc(scalar), 0);
return scalar;
}
SV*
plcb_convert_retrieval(PLCB_t *object, AV *docav,
const char *data, size_t data_len, uint32_t flags)
{
SV *ret_sv, *input_sv, *flags_sv;
uint32_t f_common, f_legacy;
input_sv = newSVpvn(data, data_len);
f_common = flags & PLCB_CF_MASK;
f_legacy = flags & PLCB_LF_MASK;
flags_sv = *av_fetch(docav, PLCB_RETIDX_FMTSPEC, 1);
#define IS_FMT(fbase) f_common == PLCB_CF_##fbase || f_legacy == PLCB_LF_##fbase
if (object->cv_customdec) {
ret_sv = custom_convert(docav, object->cv_customdec, input_sv, &flags, CONVERT_IN);
/* Flags remain unchanged? */
} else if (IS_FMT(JSON)) {
SvUTF8_on(input_sv);
ret_sv = serialize_convert(object->cv_jsondec, input_sv, CONVERT_IN);
flags = PLCB_CF_JSON;
} else if (IS_FMT(STORABLE)) {
ret_sv = serialize_convert(object->cv_deserialize, input_sv, CONVERT_IN);
flags = PLCB_CF_STORABLE;
} else if (IS_FMT(UTF8)) {
SvUTF8_on(input_sv);
ret_sv = input_sv;
SvREFCNT_inc(ret_sv);
flags = PLCB_CF_UTF8;
} else {
if (IS_FMT(RAW)) {
flags = PLCB_CF_RAW;
} else {
warn("Unrecognized flags 0x%x. Assuming raw", flags);
}
ret_sv = input_sv;
SvREFCNT_inc(ret_sv);
}
#undef IS_FMT
SvREFCNT_dec(input_sv);
if (SvIOK(flags_sv) == 0 || SvUVX(flags_sv) != flags) {
sv_setuv(flags_sv, flags);
}
return ret_sv;
}
SV*
Application_fonts( Handle self, char * name, char * encoding)
{
int count, i;
AV * glo = newAV();
PFont fmtx = apc_fonts( self, name[0] ? name : nil,
encoding[0] ? encoding : nil, &count);
for ( i = 0; i < count; i++) {
SV * sv = sv_Font2HV( &fmtx[ i]);
HV * profile = ( HV*) SvRV( sv);
if ( fmtx[i]. utf8_flags & FONT_UTF8_NAME) {
SV ** entry = hv_fetch(( HV*) SvRV( sv), "name", 4, 0);
if ( entry && SvOK( *entry))
SvUTF8_on( *entry);
}
if ( fmtx[i]. utf8_flags & FONT_UTF8_FAMILY) {
SV ** entry = hv_fetch(( HV*) SvRV( sv), "family", 6, 0);
if ( name && SvOK( *entry))
SvUTF8_on( *entry);
}
if ( fmtx[i]. utf8_flags & FONT_UTF8_ENCODING) {
SV ** entry = hv_fetch(( HV*) SvRV( sv), "encoding", 8, 0);
if ( name && SvOK( *entry))
SvUTF8_on( *entry);
}
if ( name[0] == 0 && encoding[0] == 0) {
/* Read specially-coded (const char*) encodings[] vector,
stored in fmtx[i].encoding. First pointer is filled with 0s,
except the last byte which is a counter. Such scheme
allows max 31 encodings per entry to be coded with sizeof(char*)==8.
The interface must be re-implemented, but this requires
either change in gencls syntax so arrays can be members of hashes,
or passing of a dynamic-allocated pointer vector here.
*/
char ** enc = (char**) fmtx[i].encoding;
unsigned char * shift = (unsigned char*) enc + sizeof(char *) - 1, j = *shift;
AV * loc = newAV();
pset_sv_noinc( encoding, newSVpv(( j > 0) ? *(++enc) : "", 0));
while ( j--) av_push( loc, newSVpv(*(enc++),0));
pset_sv_noinc( encodings, newRV_noinc(( SV*) loc));
}
pdelete( resolution);
pdelete( codepage);
av_push( glo, sv);
}
free( fmtx);
return newRV_noinc(( SV *) glo);
}
SV *
Widget_hint( Handle self, Bool set, SV *hint)
{
enter_method;
if ( set) {
if ( var-> stage > csFrozen) return nilSV;
my-> first_that( self, (void*)hint_notify, (void*)hint);
free( var-> hint);
var-> hint = duplicate_string( SvPV_nolen( hint));
opt_assign( optUTF8_hint, prima_is_utf8_sv(hint));
if ( application && (( PApplication) application)-> hintVisible &&
(( PApplication) application)-> hintUnder == self)
{
SV * hintText = my-> get_hint( self);
Handle hintWidget = (( PApplication) application)-> hintWidget;
if ( strlen( var-> hint) == 0)
my-> set_hintVisible( self, 0);
if ( hintWidget)
CWidget(hintWidget)-> set_text( hintWidget, hintText);
sv_free( hintText);
}
opt_clear( optOwnerHint);
} else {
hint = newSVpv( var-> hint ? var-> hint : "", 0);
if ( is_opt( optUTF8_hint)) SvUTF8_on( hint);
return hint;
}
return nilSV;
}
static SV *
utf8_server( Handle self, PClipboardFormatReg instance, int function, SV * data)
{
ClipboardDataRec c;
switch( function) {
case cefInit:
return ( SV *) cfUTF8;
case cefFetch:
if ( apc_clipboard_get_data( self, cfUTF8, &c)) {
data = newSVpv(( char*) c. data, c. length);
SvUTF8_on( data);
free( c. data);
return data;
}
break;
case cefStore:
c. data = ( Byte*) SvPV( data, c. length);
instance-> success = apc_clipboard_set_data( self, cfUTF8, &c);
instance-> written = true;
break;
}
return nilSV;
}
static
XS (XS_Xchat_get_info)
{
SV *temp = NULL;
dXSARGS;
if (items != 1) {
xchat_print (ph, "Usage: Xchat::get_info(id)");
} else {
SV *id = ST (0);
const char *RETVAL;
RETVAL = xchat_get_info (ph, SvPV_nolen (id));
if (RETVAL == NULL) {
XSRETURN_UNDEF;
}
if (!strncmp ("win_ptr", SvPV_nolen (id), 7)) {
XSRETURN_IV (PTR2IV (RETVAL));
} else {
if (
!strncmp ("libdirfs", SvPV_nolen (id), 8) ||
!strncmp ("xchatdirfs", SvPV_nolen (id), 10)
) {
XSRETURN_PV (RETVAL);
} else {
temp = newSVpv (RETVAL, 0);
SvUTF8_on (temp);
PUSHMARK (SP);
XPUSHs (sv_2mortal (temp));
PUTBACK;
}
}
}
}
SV *
PJS_JSString2SV(
pTHX_
JSString *jstr
) {
SV *ret;
#if PJS_UTF8_NATIVE
char *str = JS_GetStringBytes(jstr);
ret = newSVpv(str, 0);
SvUTF8_on(ret);
#else
dSP;
jschar *chars = JS_GetStringChars(jstr);
SV *esv = newSVpv((char *)chars, JS_GetStringLength(jstr) * sizeof(jschar));
ENTER; SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(PJS_STR_ENCODING, 0)));
XPUSHs(sv_2mortal(esv));
PUTBACK;
call_pv("Encode::decode", G_SCALAR);
SPAGAIN;
ret = newSVsv(POPs);
PUTBACK;
FREETMPS; LEAVE;
// sv_utf8_downgrade(ret, 1); Its safe, but pays the cost?
#endif
return ret;
}
SV*
C2Sv( const xmlChar *string, const xmlChar *encoding )
{
SV *retval = &PL_sv_undef;
xmlCharEncoding enc;
STRLEN len = 0;
if ( string != NULL ) {
if ( encoding != NULL ) {
enc = xmlParseCharEncoding( (const char*)encoding );
}
else {
enc = 0;
}
if ( enc == 0 ) {
/* this happens if the encoding is "" or NULL */
enc = XML_CHAR_ENCODING_UTF8;
}
len = xmlStrlen( string );
retval = newSVpvn( (const char *)string, xmlStrlen(string) );
if ( enc == XML_CHAR_ENCODING_UTF8 ) {
/* create an UTF8 string. */
#ifdef HAVE_UTF8
xs_warn("C2Sv: set UTF8-SV-flag\n");
SvUTF8_on(retval);
#endif
}
}
return retval;
}
/* Load a scalar marked as a regexp as a Perl regular expression.
* This operation is less common and is tricky, so doing it in Perl code for
* now.
*/
SV *
load_regexp(perl_yaml_loader_t * loader)
{
dSP;
char *string = (char *)loader->event.data.scalar.value;
STRLEN length = (STRLEN)loader->event.data.scalar.length;
char *anchor = (char *)loader->event.data.scalar.anchor;
char *tag = (char *)loader->event.data.scalar.tag;
char *prefix = TAG_PERL_PREFIX "regexp:";
SV *regexp = newSVpvn(string, length);
SvUTF8_on(regexp);
ENTER;
SAVETMPS;
PUSHMARK(sp);
XPUSHs(regexp);
PUTBACK;
call_pv("YAML::XS::__qr_loader", G_SCALAR);
SPAGAIN;
regexp = newSVsv(POPs);
if (strlen(tag) > strlen(prefix) && strnEQ(tag, prefix, strlen(prefix))) {
char *class = tag + strlen(prefix);
sv_bless(regexp, gv_stashpv(class, TRUE));
}
/* Wraps the buf:length pair as an SV */
static SV *
sv_from_rowdata(const char *s, size_t n)
{
if (s && n) {
SV *ret = newSVpvn(s, n);
SvUTF8_on(ret);
return ret;
} else {
return SvREFCNT_inc(&PL_sv_undef);
}
}
static void
my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
{
STRLEN len;
const char * const s = SvPV_const(ssv,len);
sv_setpvn(dsv,s,len);
if (SvUTF8(ssv))
SvUTF8_on(dsv);
else
SvUTF8_off(dsv);
}
CALLER_OWN SV *owl_new_sv(const char * str)
{
SV *ret = newSVpv(str, 0);
if (is_utf8_string((const U8 *)str, strlen(str))) {
SvUTF8_on(ret);
} else {
char *escape = owl_escape_highbit(str);
owl_function_error("Internal error! Non-UTF-8 string encountered:\n%s", escape);
g_free(escape);
}
return ret;
}
SV *
sv_maybe_utf8(SV *sv)
{
#ifdef SvUTF8_on
if (SvPOK(sv))
{
if (has_highbit(SvPVX(sv),SvCUR(sv)))
SvUTF8_on(sv);
}
#endif
return sv;
}
static SV *
plperl_hash_from_tuple(HeapTuple tuple, TupleDesc tupdesc)
{
HV *hv;
int i;
hv = newHV();
for (i = 0; i < tupdesc->natts; i++)
{
Datum attr;
bool isnull;
char *attname;
char *outputstr;
Oid typoutput;
bool typisvarlena;
int namelen;
SV *sv;
if (tupdesc->attrs[i]->attisdropped)
continue;
attname = NameStr(tupdesc->attrs[i]->attname);
namelen = strlen(attname);
attr = heap_getattr(tuple, i + 1, tupdesc, &isnull);
if (isnull)
{
/* Store (attname => undef) and move on. */
hv_store(hv, attname, namelen, newSV(0), 0);
continue;
}
/* XXX should have a way to cache these lookups */
getTypeOutputInfo(tupdesc->attrs[i]->atttypid,
&typoutput, &typisvarlena);
outputstr = DatumGetCString(OidFunctionCall1(typoutput, attr));
sv = newSVpv(outputstr, 0);
#if PERL_BCDVERSION >= 0x5006000L
if (GetDatabaseEncoding() == PG_UTF8)
SvUTF8_on(sv);
#endif
hv_store(hv, attname, namelen, sv, 0);
pfree(outputstr);
}
return newRV_noinc((SV *) hv);
}
static void
Scalarize(pTHX_ SV *sv, AV *av)
{
int n = av_len(av)+1;
if (n == 0)
sv_setpvn(sv,"",0);
else
{
SV **svp;
if (n == 1 && (svp = av_fetch(av, 0, 0)))
{
STRLEN len = 0;
char *s = SvPV(*svp,len);
#ifdef SvUTF8
int utf8 = SvUTF8(*svp);
sv_setpvn(sv,s,len);
if (utf8)
SvUTF8_on(sv);
#else
sv_setpvn(sv,s,len);
#endif
}
else
{
Tcl_DString ds;
int i;
Tcl_DStringInit(&ds);
for (i=0; i < n; i++)
{
if ((svp = av_fetch(av, i, 0)))
{
SV *el = *svp;
int temp = 0;
if (SvROK(el) && !SvOBJECT(SvRV(el)) && SvTYPE(SvRV(el)) == SVt_PVAV)
{
el = newSVpv("",0);
temp = 1;
if ((AV *) SvRV(*svp) == av)
abort();
Scalarize(aTHX_ el,(AV *) SvRV(*svp));
}
Tcl_DStringAppendElement(&ds,Tcl_GetString(el));
if (temp)
SvREFCNT_dec(el);
}
}
sv_setpvn(sv,Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
sv_maybe_utf8(sv);
Tcl_DStringFree(&ds);
}
}
}
void
LUCY_Doc_Store_IMP(lucy_Doc *self, cfish_String *field, cfish_Obj *value) {
dTHX;
lucy_DocIVARS *const ivars = lucy_Doc_IVARS(self);
const char *key = CFISH_Str_Get_Ptr8(field);
size_t key_size = CFISH_Str_Get_Size(field);
SV *key_sv = newSVpvn(key, key_size);
SV *val_sv = XSBind_cfish_to_perl(aTHX_ value);
SvUTF8_on(key_sv);
(void)hv_store_ent((HV*)ivars->fields, key_sv, val_sv, 0);
// TODO: make this a thread-local instead of creating it every time?
SvREFCNT_dec(key_sv);
}
SV* _org_warhound_mdi_String2SV(CFTypeRef attrItem) {
SV* retval;
int stringSize = CFStringGetMaximumSizeForEncoding(CFStringGetLength(attrItem), kCFStringEncodingUTF8) + 1;
char* tmpptr = (char*)malloc(sizeof(char) * stringSize);
CFStringGetCString(attrItem, tmpptr, stringSize, kCFStringEncodingUTF8);
/* Do not mark this as mortal! We leave that responsibility to our caller,
* b/c XS often autogenerates the code for that and we don't want to
* conflict with XS */
retval = newSVpv(tmpptr, strlen(tmpptr));
free(tmpptr);
SvUTF8_on(retval);
return retval;
}
SV *
Widget_text( Handle self, Bool set, SV *text)
{
if ( set) {
if ( var-> stage > csFrozen) return nilSV;
free( var-> text);
var-> text = duplicate_string( SvPV_nolen( text));
opt_assign( optUTF8_text, prima_is_utf8_sv(text));
} else {
text = newSVpv( var-> text ? var-> text : "", 0);
if ( is_opt( optUTF8_text)) SvUTF8_on( text);
return text;
}
return nilSV;
}
void
lucy_Doc_store(lucy_Doc *self, const lucy_CharBuf *field, lucy_Obj *value) {
char *key = (char*)Lucy_CB_Get_Ptr8(field);
size_t key_size = Lucy_CB_Get_Size(field);
SV *key_sv = newSVpvn(key, key_size);
SV *val_sv = value == NULL
? newSV(0)
: Lucy_Obj_Is_A(value, LUCY_CHARBUF)
? XSBind_cb_to_sv((lucy_CharBuf*)value)
: (SV*)Lucy_Obj_To_Host(value);
SvUTF8_on(key_sv);
(void)hv_store_ent((HV*)self->fields, key_sv, val_sv, 0);
// TODO: make this a thread-local instead of creating it every time?
SvREFCNT_dec(key_sv);
}
void
LUCY_Doc_Store_IMP(lucy_Doc *self, cfish_String *field, cfish_Obj *value) {
lucy_DocIVARS *const ivars = lucy_Doc_IVARS(self);
const char *key = CFISH_Str_Get_Ptr8(field);
size_t key_size = CFISH_Str_Get_Size(field);
SV *key_sv = newSVpvn(key, key_size);
SV *val_sv = value == NULL
? newSV(0)
: CFISH_Obj_Is_A(value, CFISH_STRING)
? XSBind_str_to_sv((cfish_String*)value)
: (SV*)CFISH_Obj_To_Host(value);
SvUTF8_on(key_sv);
(void)hv_store_ent((HV*)ivars->fields, key_sv, val_sv, 0);
// TODO: make this a thread-local instead of creating it every time?
SvREFCNT_dec(key_sv);
}
SV* _org_warhound_mdi_ManyStrings2AVref(CFTypeRef attrItem) {
CFIndex x, top;
char* tmpptr;
int stringSize;
SV* midval;
AV* retAV = newAV();
top = CFArrayGetCount(attrItem);
for (x = 0; x < top; x++) {
stringSize = CFStringGetMaximumSizeForEncoding(CFStringGetLength(CFArrayGetValueAtIndex(attrItem, x)), kCFStringEncodingUTF8) + 1;
tmpptr = (char*)malloc(sizeof(char) * stringSize);
CFStringGetCString(CFArrayGetValueAtIndex(attrItem, x), tmpptr, stringSize, kCFStringEncodingUTF8);
midval = newSVpv(tmpptr, strlen(tmpptr));
SvUTF8_on(midval);
av_push(retAV, midval);
free(tmpptr);
}
return newRV((SV*)retAV);
}
static AV *
array2av (char *array[])
{
int count = 0;
SV *temp = NULL;
AV *av = newAV();
sv_2mortal ((SV *)av);
for (
count = 1;
count < 32 && array[count] != NULL && array[count][0] != 0;
count++
) {
temp = newSVpv (array[count], 0);
SvUTF8_on (temp);
av_push (av, temp);
}
return av;
}
SV *
AbstractMenu_text( Handle self, Bool set, char * varName, SV * text)
{
PMenuItemReg m;
if ( var-> stage > csFrozen) return nilSV;
m = find_menuitem( self, varName, true);
if ( m == nil) return nilSV;
if ( m-> text == nil) return nilSV;
if ( !set) {
SV * sv = newSVpv( m-> text ? m-> text : "", 0);
if ( m-> flags. utf8_text) SvUTF8_on( sv);
return sv;
}
free( m-> text);
m-> text = nil;
m-> text = duplicate_string( SvPV_nolen( text));
m-> flags. utf8_accel = prima_is_utf8_sv( text);
if ( m-> id > 0)
if ( var-> stage <= csNormal && var-> system)
apc_menu_item_set_text( self, m);
return nilSV;
}
SV *
AbstractMenu_action( Handle self, Bool set, char * varName, SV * action)
{
PMenuItemReg m;
if ( var-> stage > csFrozen) return nilSV;
m = find_menuitem( self, varName, true);
if ( !m) return nilSV;
if ( !set) {
if ( m-> code) return newSVsv( m-> code);
if ( m-> perlSub) {
SV * sv = newSVpv( m-> perlSub, 0);
if ( m-> flags. utf8_perlSub) SvUTF8_on( sv);
return sv;
}
return nilSV;
}
if ( m-> flags. divider || m-> down) return nilSV;
if ( SvROK( action))
{
if ( m-> code) sv_free( m-> code);
m-> code = nil;
if ( SvTYPE( SvRV( action)) == SVt_PVCV)
{
m-> code = newSVsv( action);
free( m-> perlSub);
m-> perlSub = nil;
}
m-> flags. utf8_perlSub = 0;
} else {
char * line = ( char *) SvPV_nolen( action);
free( m-> perlSub);
if ( m-> code) sv_free( m-> code);
m-> code = nil;
m-> perlSub = duplicate_string( line);
m-> flags. utf8_perlSub = prima_is_utf8_sv( action);
}
return nilSV;
}
static
XS (XS_Xchat_get_prefs)
{
const char *str;
int integer;
SV *temp = NULL;
dXSARGS;
if (items != 1) {
xchat_print (ph, "Usage: Xchat::get_prefs(name)");
} else {
switch (xchat_get_prefs (ph, SvPV_nolen (ST (0)), &str, &integer)) {
case 0:
XSRETURN_UNDEF;
break;
case 1:
temp = newSVpv (str, 0);
SvUTF8_on (temp);
SP -= items;
sp = mark;
XPUSHs (sv_2mortal (temp));
PUTBACK;
break;
case 2:
XSRETURN_IV (integer);
break;
case 3:
if (integer) {
XSRETURN_YES;
} else {
XSRETURN_NO;
}
}
}
}
lucy_HitDoc*
lucy_DefDocReader_fetch_doc(lucy_DefaultDocReader *self, int32_t doc_id) {
lucy_Schema *const schema = self->schema;
lucy_InStream *const dat_in = self->dat_in;
lucy_InStream *const ix_in = self->ix_in;
HV *fields = newHV();
int64_t start;
uint32_t num_fields;
SV *field_name_sv = newSV(1);
// Get data file pointer from index, read number of fields.
Lucy_InStream_Seek(ix_in, (int64_t)doc_id * 8);
start = Lucy_InStream_Read_U64(ix_in);
Lucy_InStream_Seek(dat_in, start);
num_fields = Lucy_InStream_Read_C32(dat_in);
// Decode stored data and build up the doc field by field.
while (num_fields--) {
STRLEN field_name_len;
char *field_name_ptr;
SV *value_sv;
lucy_FieldType *type;
// Read field name.
field_name_len = Lucy_InStream_Read_C32(dat_in);
field_name_ptr = SvGROW(field_name_sv, field_name_len + 1);
Lucy_InStream_Read_Bytes(dat_in, field_name_ptr, field_name_len);
SvPOK_on(field_name_sv);
SvCUR_set(field_name_sv, field_name_len);
SvUTF8_on(field_name_sv);
*SvEND(field_name_sv) = '\0';
// Find the Field's FieldType.
lucy_ZombieCharBuf *field_name_zcb
= CFISH_ZCB_WRAP_STR(field_name_ptr, field_name_len);
Lucy_ZCB_Assign_Str(field_name_zcb, field_name_ptr, field_name_len);
type = Lucy_Schema_Fetch_Type(schema, (lucy_CharBuf*)field_name_zcb);
// Read the field value.
switch (Lucy_FType_Primitive_ID(type) & lucy_FType_PRIMITIVE_ID_MASK) {
case lucy_FType_TEXT: {
STRLEN value_len = Lucy_InStream_Read_C32(dat_in);
value_sv = newSV((value_len ? value_len : 1));
Lucy_InStream_Read_Bytes(dat_in, SvPVX(value_sv), value_len);
SvCUR_set(value_sv, value_len);
*SvEND(value_sv) = '\0';
SvPOK_on(value_sv);
SvUTF8_on(value_sv);
break;
}
case lucy_FType_BLOB: {
STRLEN value_len = Lucy_InStream_Read_C32(dat_in);
value_sv = newSV((value_len ? value_len : 1));
Lucy_InStream_Read_Bytes(dat_in, SvPVX(value_sv), value_len);
SvCUR_set(value_sv, value_len);
*SvEND(value_sv) = '\0';
SvPOK_on(value_sv);
break;
}
case lucy_FType_FLOAT32:
value_sv = newSVnv(Lucy_InStream_Read_F32(dat_in));
break;
case lucy_FType_FLOAT64:
value_sv = newSVnv(Lucy_InStream_Read_F64(dat_in));
break;
case lucy_FType_INT32:
value_sv = newSViv((int32_t)Lucy_InStream_Read_C32(dat_in));
break;
case lucy_FType_INT64:
if (sizeof(IV) == 8) {
int64_t val = (int64_t)Lucy_InStream_Read_C64(dat_in);
value_sv = newSViv((IV)val);
}
else { // (lossy)
int64_t val = (int64_t)Lucy_InStream_Read_C64(dat_in);
value_sv = newSVnv((double)val);
}
break;
default:
value_sv = NULL;
CFISH_THROW(LUCY_ERR, "Unrecognized type: %o", type);
}
// Store the value.
(void)hv_store_ent(fields, field_name_sv, value_sv, 0);
}
SvREFCNT_dec(field_name_sv);
lucy_HitDoc *retval = lucy_HitDoc_new(fields, doc_id, 0.0);
SvREFCNT_dec((SV*)fields);
return retval;
}
JSBool PJS_invoke_perl_property_getter(JSContext *cx, JSObject *obj, jsval id, jsval *vp) {
dSP;
PJS_Context *pcx;
PJS_Class *pcls;
PJS_Property *pprop;
SV *caller;
char *name;
jsint slot;
U8 invocation_mode;
if (!(JSVAL_IS_INT(id) || JSVAL_IS_STRING(id))) {
return JS_TRUE;
}
if((pcx = PJS_GET_CONTEXT(cx)) == NULL) {
JS_ReportError(cx, "Can't find context %d", cx);
return JS_FALSE;
}
if (JS_TypeOfValue(cx, OBJECT_TO_JSVAL(obj)) == JSTYPE_OBJECT) {
/* Called as instsance */
JSClass *clasp = PJS_GET_CLASS(cx, obj);
name = (char *) clasp->name;
invocation_mode = 1;
}
else {
/* Called as static */
JSFunction *parent_jfunc = JS_ValueToFunction(cx, OBJECT_TO_JSVAL(obj));
if (parent_jfunc == NULL) {
JS_ReportError(cx, "Failed to extract class for static property getter");
return JS_FALSE;
}
name = (char *) JS_GetFunctionName(parent_jfunc);
invocation_mode = 0;
}
if ((pcls = PJS_GetClassByName(pcx, name)) == NULL) {
JS_ReportError(cx, "Can't find class '%s'", name);
return JS_FALSE;
}
if (invocation_mode) {
caller = (SV *) JS_GetPrivate(cx, obj);
}
else {
caller = newSVpv(pcls->pkg, 0);
}
if (JSVAL_IS_INT(id)) {
slot = JSVAL_TO_INT(id);
if ((pprop = PJS_get_property_by_id(pcls, (int8) slot)) == NULL) {
if (SvTRUE(pcls->property_getter)) {
if (perl_call_sv_with_jsvals(cx, obj, pcls->property_getter, caller, 1, &id, vp) < 0) {
return JS_FALSE;
}
return JS_TRUE;
}
JS_ReportError(cx, "Can't find property handler");
return JS_FALSE;
}
if (pprop->getter == NULL) {
JS_ReportError(cx, "Property is write-only");
return JS_FALSE;
}
if (perl_call_sv_with_jsvals(cx, obj, pprop->getter, caller, 0, NULL, vp) < 0) {
return JS_FALSE;
}
}
else if (JSVAL_IS_STRING(id) && SvTRUE(pcls->property_getter)) {
SV *sv = sv_newmortal();
#ifdef JS_C_STRINGS_ARE_UTF8
char *tmp = JS_smprintf("%hs", JS_GetStringChars(JSVAL_TO_STRING(id)));
sv_setpv(sv, tmp);
SvUTF8_on(sv);
free(tmp);
#else
sv_setpv(sv, JS_GetStringBytes(JSVAL_TO_STRING(id)));
#endif
if (PJS_get_method_by_name(pcls, SvPV_nolen(sv))) {
return JS_TRUE;
}
if (perl_call_sv_with_jsvals(cx, obj, pcls->property_getter, caller, 1, &id, vp) < 0) {
return JS_FALSE;
}
}
return JS_TRUE;
}
static SV *
plperl_call_perl_func(plperl_proc_desc *desc, FunctionCallInfo fcinfo)
{
dSP;
SV *retval;
int i;
int count;
SV *sv;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(&PL_sv_undef); /* no trigger data */
for (i = 0; i < desc->nargs; i++)
{
if (fcinfo->argnull[i])
XPUSHs(&PL_sv_undef);
else if (desc->arg_is_rowtype[i])
{
HeapTupleHeader td;
Oid tupType;
int32 tupTypmod;
TupleDesc tupdesc;
HeapTupleData tmptup;
SV *hashref;
td = DatumGetHeapTupleHeader(fcinfo->arg[i]);
/* Extract rowtype info and find a tupdesc */
tupType = HeapTupleHeaderGetTypeId(td);
tupTypmod = HeapTupleHeaderGetTypMod(td);
tupdesc = lookup_rowtype_tupdesc(tupType, tupTypmod);
/* Build a temporary HeapTuple control structure */
tmptup.t_len = HeapTupleHeaderGetDatumLength(td);
tmptup.t_data = td;
hashref = plperl_hash_from_tuple(&tmptup, tupdesc);
XPUSHs(sv_2mortal(hashref));
}
else
{
char *tmp;
tmp = DatumGetCString(FunctionCall1(&(desc->arg_out_func[i]),
fcinfo->arg[i]));
sv = newSVpv(tmp, 0);
#if PERL_BCDVERSION >= 0x5006000L
if (GetDatabaseEncoding() == PG_UTF8)
SvUTF8_on(sv);
#endif
XPUSHs(sv_2mortal(sv));
pfree(tmp);
}
}
PUTBACK;
/* Do NOT use G_KEEPERR here */
count = perl_call_sv(desc->reference, G_SCALAR | G_EVAL);
SPAGAIN;
if (count != 1)
{
PUTBACK;
FREETMPS;
LEAVE;
elog(ERROR, "didn't get a return item from function");
}
if (SvTRUE(ERRSV))
{
(void) POPs;
PUTBACK;
FREETMPS;
LEAVE;
/* XXX need to find a way to assign an errcode here */
ereport(ERROR,
(errmsg("error from Perl function: %s",
strip_trailing_ws(SvPV(ERRSV, PL_na)))));
}
retval = newSVsv(POPs);
PUTBACK;
FREETMPS;
LEAVE;
return retval;
}
static SV *
arg_to_sv (GIArgument * arg,
GITypeInfo * info,
GITransfer transfer,
GPerlI11nInvocationInfo *iinfo)
{
GITypeTag tag = g_type_info_get_tag (info);
gboolean own = transfer >= GI_TRANSFER_CONTAINER;
dwarn (" arg_to_sv: info %p with type tag %d (%s)\n",
info, tag, g_type_tag_to_string (tag));
switch (tag) {
case GI_TYPE_TAG_VOID:
{
SV *sv = callback_data_to_sv (arg->v_pointer, iinfo);
dwarn (" argument with no type information -> %s\n",
sv ? "callback data" : "undef");
return sv ? SvREFCNT_inc (sv) : &PL_sv_undef;
}
case GI_TYPE_TAG_BOOLEAN:
return boolSV (arg->v_boolean);
case GI_TYPE_TAG_INT8:
return newSViv (arg->v_int8);
case GI_TYPE_TAG_UINT8:
return newSVuv (arg->v_uint8);
case GI_TYPE_TAG_INT16:
return newSViv (arg->v_int16);
case GI_TYPE_TAG_UINT16:
return newSVuv (arg->v_uint16);
case GI_TYPE_TAG_INT32:
return newSViv (arg->v_int32);
case GI_TYPE_TAG_UINT32:
return newSVuv (arg->v_uint32);
case GI_TYPE_TAG_INT64:
return newSVGInt64 (arg->v_int64);
case GI_TYPE_TAG_UINT64:
return newSVGUInt64 (arg->v_uint64);
case GI_TYPE_TAG_FLOAT:
return newSVnv (arg->v_float);
case GI_TYPE_TAG_DOUBLE:
return newSVnv (arg->v_double);
case GI_TYPE_TAG_UNICHAR:
{
SV *sv;
gchar buffer[6];
gint length = g_unichar_to_utf8 (arg->v_uint32, buffer);
sv = newSVpv (buffer, length);
SvUTF8_on (sv);
return sv;
}
case GI_TYPE_TAG_GTYPE: {
/* GType == gsize */
const char *package = gperl_package_from_type (arg->v_size);
if (!package)
package = g_type_name (arg->v_size);
return newSVpv (package, PL_na);
}
case GI_TYPE_TAG_ARRAY:
return array_to_sv (info, arg->v_pointer, transfer, iinfo);
case GI_TYPE_TAG_INTERFACE:
return interface_to_sv (info, arg, own, iinfo);
case GI_TYPE_TAG_GLIST:
case GI_TYPE_TAG_GSLIST:
return glist_to_sv (info, arg->v_pointer, transfer);
case GI_TYPE_TAG_GHASH:
return ghash_to_sv (info, arg->v_pointer, transfer);
case GI_TYPE_TAG_ERROR:
ccroak ("FIXME - GI_TYPE_TAG_ERROR");
break;
case GI_TYPE_TAG_UTF8:
{
SV *sv = newSVGChar (arg->v_string);
if (own)
g_free (arg->v_string);
return sv;
}
case GI_TYPE_TAG_FILENAME:
{
SV *sv = newSVpv (arg->v_string, PL_na);
if (own)
g_free (arg->v_string);
return sv;
}
default:
ccroak ("Unhandled info tag %d in arg_to_sv", tag);
}
return NULL;
}
