static int Perl_safe_eval(PerlInterpreter * my_perl, const char *string)
{
char *err = NULL;
Perl_eval_pv(my_perl, string, FALSE);
if ((err = SvPV(get_sv("@", TRUE), n_a)) && !zstr(err)) {
switch_log_printf(SWITCH_CHANNEL_LOG, SWITCH_LOG_ERROR, "[%s]\n%s\n", string, err);
return -1;
}
return 0;
}
void
LUCY_Doc_Serialize_IMP(lucy_Doc *self, lucy_OutStream *outstream) {
dTHX;
lucy_DocIVARS *const ivars = lucy_Doc_IVARS(self);
LUCY_OutStream_Write_C32(outstream, ivars->doc_id);
SV *frozen = S_nfreeze_fields(aTHX_ self);
STRLEN len;
char *buf = SvPV(frozen, len);
LUCY_OutStream_Write_C64(outstream, len);
LUCY_OutStream_Write_Bytes(outstream, buf, len);
SvREFCNT_dec(frozen);
}
void VParserXs::call (
string* rtnStrp, /* If non-null, load return value here */
int params, /* Number of parameters */
const char* method, /* Name of method to call */
...) /* Arguments to pass to method's @_ */
{
// Call $perlself->method (passedparam1, parsedparam2)
if (debug()) cout << "CALLBACK "<<method<<endl;
va_list ap;
va_start(ap, method);
{
dSP; /* Initialize stack pointer */
ENTER; /* everything created after here */
SAVETMPS; /* ...is a temporary variable. */
PUSHMARK(SP); /* remember the stack pointer */
SV* selfsv = newRV_inc(m_self); /* $self-> */
XPUSHs(sv_2mortal(selfsv));
while (params--) {
char* text = va_arg(ap, char *);
SV* sv;
if (text) {
sv = sv_2mortal(newSVpv (text, 0));
} else {
sv = &PL_sv_undef;
}
XPUSHs(sv); /* token */
}
PUTBACK; /* make local stack pointer global */
if (rtnStrp) {
int rtnCount = perl_call_method ((char*)method, G_SCALAR);
SPAGAIN; /* refresh stack pointer */
if (rtnCount > 0) {
SV* sv = POPs;
//printf("RTN %ld %d %s\n", SvTYPE(sv),SvTRUE(sv),SvPV_nolen(sv));
#ifdef SvPV_nolen // Perl 5.6 and later
*rtnStrp = SvPV_nolen(sv);
#else
*rtnStrp = SvPV(sv,PL_na);
#endif
}
PUTBACK;
} else {
perl_call_method ((char*)method, G_DISCARD | G_VOID);
}
FREETMPS; /* free that return value */
LEAVE; /* ...and the XPUSHed "mortal" args.*/
}
va_end(ap);
}
Bool
Drawable_text_out( Handle self, SV * text, int x, int y)
{
Bool ok;
STRLEN dlen;
char * c_text = SvPV( text, dlen);
Bool utf8 = prima_is_utf8_sv( text);
if ( utf8) dlen = utf8_length(( U8*) c_text, ( U8*) c_text + dlen);
ok = apc_gp_text_out( self, c_text, x, y, dlen, utf8);
if ( !ok) perl_error();
return ok;
}
/* XXX: same as Perl_do_sprintf();
* but Perl_do_sprintf() is not part of the "public" api
*/
void modperl_perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
{
STRLEN patlen;
char *pat = SvPV(*sarg, patlen);
bool do_taint = FALSE;
sv_vsetpvfn(sv, pat, patlen, (va_list *)NULL, sarg + 1, len - 1, &do_taint);
SvSETMAGIC(sv);
if (do_taint) {
SvTAINTED_on(sv);
}
}
PSTR NonEmptyStrFromScalar(PERL_CALL SV *string, BOOL isRef)
{
if(!string)
return NULL;
if(isRef && !(string = SvROK(string) ? SvRV(string) : NULL))
return NULL;
PSTR str = SvPV(string, PL_na);
return str && *str ? str : NULL;
}
struct t_hashtable *
weechat_perl_hash_to_hashtable (SV *hash, int size, const char *type_keys,
const char *type_values)
{
struct t_hashtable *hashtable;
HV *hash2;
SV *value;
char *str_key;
I32 retlen;
hashtable = weechat_hashtable_new (size, type_keys, type_values,
NULL, NULL);
if (!hashtable)
return NULL;
if ((hash) && SvROK(hash) && SvRV(hash)
&& (SvTYPE(SvRV(hash)) == SVt_PVHV))
{
hash2 = (HV *)SvRV(hash);
hv_iterinit (hash2);
while ((value = hv_iternextsv (hash2, &str_key, &retlen)))
{
if (strcmp (type_values, WEECHAT_HASHTABLE_STRING) == 0)
{
weechat_hashtable_set (hashtable, str_key,
SvPV (value, PL_na));
}
else if (strcmp (type_values, WEECHAT_HASHTABLE_POINTER) == 0)
{
weechat_hashtable_set (hashtable, str_key,
plugin_script_str2ptr (
weechat_perl_plugin,
NULL, NULL,
SvPV (value, PL_na)));
}
}
}
return hashtable;
}
uschar *
init_perl(uschar *startup_code)
{
static int argc = 2;
static char *argv[3] = { "exim-perl", "/dev/null", 0 };
SV *sv;
STRLEN len;
if (interp_perl) return 0;
interp_perl = perl_alloc();
perl_construct(interp_perl);
perl_parse(interp_perl, xs_init, argc, argv, 0);
perl_run(interp_perl);
{
dSP;
/*********************************************************************/
/* These lines by PH added to make "warn" output go to the Exim log; I
hope this doesn't break anything. */
sv = newSVpv(
"$SIG{__WARN__} = sub { my($s) = $_[0];"
"$s =~ s/\\n$//;"
"Exim::log_write($s) };", 0);
PUSHMARK(SP);
perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR);
SvREFCNT_dec(sv);
if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len);
/*********************************************************************/
sv = newSVpv(CS startup_code, 0);
PUSHMARK(SP);
perl_eval_sv(sv, G_SCALAR|G_DISCARD|G_KEEPERR);
SvREFCNT_dec(sv);
if (SvTRUE(ERRSV)) return US SvPV(ERRSV, len);
setlocale(LC_ALL, "C"); /* In case it got changed */
return NULL;
}
}
I32
Perl_debop(pTHX_ OP *o)
{
#ifdef DEBUGGING
SV *sv;
SV **svp;
STRLEN n_a;
Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]);
switch (o->op_type) {
case OP_CONST:
PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv));
break;
case OP_GVSV:
case OP_GV:
if (cGVOPo_gv) {
sv = NEWSV(0,0);
gv_fullname3(sv, cGVOPo_gv, Nullch);
PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
SvREFCNT_dec(sv);
}
else
PerlIO_printf(Perl_debug_log, "(NULL)");
break;
case OP_PADSV:
case OP_PADAV:
case OP_PADHV:
/* print the lexical's name */
svp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
if (svp)
PerlIO_printf(Perl_debug_log, "(%s)", SvPV(*svp,n_a));
else
PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
break;
default:
break;
}
PerlIO_printf(Perl_debug_log, "\n");
#endif /* DEBUGGING */
return 0;
}
static void cmd_run(char *data)
{
dSP;
struct stat statbuf;
char *fname;
int retcount;
/* add .pl suffix if it's missing */
data = (strlen(data) <= 3 || strcmp(data+strlen(data)-3, ".pl") == 0) ?
g_strdup(data) : g_strdup_printf("%s.pl", data);
if (g_path_is_absolute(data)) {
/* whole path specified */
fname = g_strdup(data);
} else {
/* check from ~/.irssi/scripts/ */
fname = g_strdup_printf("%s/.irssi/scripts/%s", g_get_home_dir(), data);
if (stat(fname, &statbuf) != 0) {
/* check from SCRIPTDIR */
g_free(fname),
fname = g_strdup_printf(SCRIPTDIR"/%s", data);
}
}
g_free(data);
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(fname, strlen(fname)))); g_free(fname);
PUTBACK;
retcount = perl_call_pv("load_file", G_EVAL|G_SCALAR);
SPAGAIN;
if (SvTRUE(ERRSV)) {
STRLEN n_a;
signal_emit("gui dialog", 2, "error", SvPV(ERRSV, n_a));
(void) POPs;
}
else if (retcount > 0) {
char *str = POPp;
if (str != NULL && *str != '\0')
signal_emit("gui dialog", 2, "error", str);
}
PUTBACK;
FREETMPS;
LEAVE;
}
static void perl_variable_to_json_internal( SV *input, json_writer_t *writer )
{
char *val;
int ival;
STRLEN len;
double number;
int type = -1;
if ( SvOK( input ) && SvROK( input ) ) {
type = SvTYPE( SvRV( input ) );
}
else if ( SvOK( input ) ) {
type = SvTYPE( input );
}
switch ( type ) {
case SVt_IV:
ival = SvIV( input );
json_writer_write_integer( writer, ival );
break;
case SVt_NV:
number = SvNV( input );
json_writer_write_number( writer, number );
break;
case SVt_PV:
val = SvPV( input, len );
json_writer_write_strn( writer, val, len );
break;
case SVt_PVNV:
if ( input == &PL_sv_yes ) {
json_writer_write_boolean( writer, TRUE );
}
else if ( input == &PL_sv_no ) {
json_writer_write_boolean( writer, FALSE );
}
break;
case SVt_PVAV:
perl_array_to_json( input, writer );
break;
case SVt_PVHV:
perl_hash_to_json( input, writer );
break;
default:
break;
}
}
/* parsing logs for regex type of firewalls
*/
static int
parse_regex(struct _std_event *ev_ptr,char *response, struct _log_info *l_info){
struct _kv_rel *kvrl=NULL;
struct _kv_rel *inner_kvrl=NULL;
SV *svp;
int i,j=0;
/*
* Execute the regex in perl interpreter
* It will extract values for all keys from the buffer
*/
if( SvIV( eval_pv( l_info->log_regex , FALSE ) ) ){
/* Iterate through each node of the kv_rel_hash
* and set its value in standard event
*/
for( kvrl=l_info->kv_rel_hash; ( kvrl != NULL ) ; kvrl=(struct _kv_rel *) (kvrl->hh.next) ) {
//printf("Key -%s-\n", kvrl->key);
inner_kvrl=kvrl;
while(inner_kvrl!=NULL){
strcpy( value_buffer, SvPV( get_sv(inner_kvrl->key,FALSE) , n_a) );
//printf("value -%s-\n", value_buffer);
i=0;
j=0;
while(inner_kvrl->conversion_fn[i]!=NULL && i<inner_kvrl->fn_index){
j=inner_kvrl->conversion_fn[i++] (ev_ptr,value_buffer);
switch(j){
case -3: //dont execute translation fn and exit while loop
case -1: //Exit from while loop
i=kvrl->fn_index;
break;
case -2: //Exit function (Drop event)
return -2;
break;
default: ;
}
}
//printf ("No. of conversions Done %d for key %s\n",i,kvrl->key);
if(j!=-3){
inner_kvrl->se_var->typecast_st(inner_kvrl->key,inner_kvrl->se_var,ev_ptr,value_buffer);
}
inner_kvrl=inner_kvrl->next;
}
}
return 1;
}else{
printf("Log Regex did not work\n");
return -1;
}
}
int psgi_response(struct wsgi_request *wsgi_req, AV *response) {
SV **status_code, **hitem ;
AV *headers, *body =NULL;
STRLEN hlen, hlen2;
int i;
char *chitem, *chitem2;
SV **harakiri;
if (wsgi_req->async_force_again) {
wsgi_req->async_force_again = 0;
wsgi_req->switches++;
SV *chunk = uwsgi_perl_obj_call(wsgi_req->async_placeholder, "getline");
if (!chunk) {
uwsgi_500(wsgi_req);
return UWSGI_OK;
}
chitem = SvPV( chunk, hlen);
if (hlen <= 0) {
SvREFCNT_dec(chunk);
if (wsgi_req->async_force_again) {
return UWSGI_AGAIN;
}
SV *closed = uwsgi_perl_obj_call(wsgi_req->async_placeholder, "close");
if (closed) {
SvREFCNT_dec(closed);
}
// check for psgix.harakiri
harakiri = hv_fetch((HV*)SvRV( (SV*)wsgi_req->async_environ), "psgix.harakiri.commit", 21, 0);
if (harakiri) {
if (SvTRUE(*harakiri)) wsgi_req->async_plagued = 1;
}
SvREFCNT_dec(wsgi_req->async_result);
return UWSGI_OK;
}
uwsgi_response_write_body_do(wsgi_req, chitem, hlen);
uwsgi_pl_check_write_errors {
SvREFCNT_dec(chunk);
return UWSGI_OK;
}
SvREFCNT_dec(chunk);
wsgi_req->async_force_again = 1;
return UWSGI_AGAIN;
}
static CORBA_boolean
put_sequence (GIOPSendBuffer *buf, CORBA_TypeCode tc, SV *sv)
{
dTHR;
CORBA_unsigned_long len, i;
SV **value;
if (sv == &PL_sv_undef) {
if (PL_dowarn & G_WARN_ON)
warn ("Uninitialized sequence");
len = 0;
buf_putn (buf, &len, sizeof (len));
return CORBA_TRUE;
}
/* get length, check type */
if (tc->subtypes[0]->kind == CORBA_tk_octet ||
tc->subtypes[0]->kind == CORBA_tk_char) {
len = SvCUR(sv);
} else {
if (!SvROK(sv) || (SvTYPE(SvRV(sv)) != SVt_PVAV)) {
warn("Sequence must be array reference");
return CORBA_FALSE;
}
len = 1+av_len((AV *)SvRV(sv));
}
if (tc->length != 0 && len > tc->length) {
warn("Sequence length (%d) exceeds bound (%d)", len, tc->length);
return CORBA_FALSE;
}
buf_putn (buf, &len, sizeof (len));
if (tc->subtypes[0]->kind == CORBA_tk_octet ||
tc->subtypes[0]->kind == CORBA_tk_char) {
giop_send_buffer_append_mem_indirect (buf, SvPV(sv, PL_na), len);
} else {
AV *av = (AV *)SvRV(sv);
for (i = 0; i < len; i++) {
value = av_fetch(av, i, 0);
if (!porbit_put_sv (buf, tc->subtypes[0],
value ? *value : &PL_sv_undef))
return CORBA_FALSE;
}
}
return CORBA_TRUE;
}
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);
}
}
}
static xmlNode *
pv_to_xmlnode(SV *value) {
unsigned int size;
char *string;
if (! SvPOK(value))
return NULL;
string = SvPV(value, size);
if (! string)
return NULL;
return lasso_string_fragment_to_xmlnode(string, size);
}
static unsigned long
fetch_trustmask(HV *hv, const char *key){
SV **val;
char *str;
STRLEN len;
val = hv_fetch(hv, key, strlen(key), 0);
if(val == NULL){
croak("Invalid signature level hash: %s key is missing", key);
}
str = SvPV(*val, len);
return trustmask(str, len);
}
static html_valid_status_t
html_valid_run (html_valid_t * htv, SV * html,
SV ** output_ptr, SV ** errors_ptr)
{
const char * html_string;
STRLEN html_length;
SV * output;
SV * errors;
TidyBuffer tidy_output = {0};
TidyBuffer tidy_errbuf = {0};
/* First set these up sanely in case the stuff hits the fan. */
* output_ptr = & PL_sv_undef;
* errors_ptr = & PL_sv_undef;
/* Work around bug where allocator sometimes does not get set. */
CopyAllocator (htv->tdoc, & tidy_output);
CopyAllocator (htv->tdoc, & tidy_errbuf);
html_string = SvPV (html, html_length);
CALL_TIDY (tidySetErrorBuffer (htv->tdoc, & tidy_errbuf));
htv->n_mallocs++;
CALL_TIDY (tidyParseString (htv->tdoc, html_string));
CALL_TIDY (tidyCleanAndRepair (htv->tdoc));
CALL_TIDY (tidyRunDiagnostics (htv->tdoc));
CALL_TIDY (tidySaveBuffer (htv->tdoc, & tidy_output));
htv->n_mallocs++;
/* Copy the contents of the buffers into the Perl scalars. */
output = newSVpv ((char *) tidy_output.bp, tidy_output.size);
errors = newSVpv ((char *) tidy_errbuf.bp, tidy_errbuf.size);
/* HTML Tidy randomly segfaults here due to "allocator" not being
set in some cases, hence the above CopyAllocator fix. */
tidyBufFree (& tidy_output);
htv->n_mallocs--;
tidyBufFree (& tidy_errbuf);
htv->n_mallocs--;
/* These are not our mallocs, they are Perl's mallocs, so we don't
increase htv->n_mallocs for these. After we return them, we no
longer take care of these. */
* output_ptr = output;
* errors_ptr = errors;
return html_valid_ok;
}
U32 jhash( SV* str )
{
STRLEN rawlen;
char* p;
U32 a, b, c, len, length;
/* extract the string data and string length from the perl scalar */
p = (char*)SvPV(str, rawlen);
length = len = (U32)rawlen;
/* Test for undef or null string case and return 0 */
if ( length == 0 ) {
DEBUG && printf( "Recieved a null or undef string!\n" );
return 0;
}
DEBUG && printf( "Received string '%.*s'.\n", (int)len, p );
a = b = 0x9e3779b9; /* golden ratio suggested by Jenkins */
c = 0;
while (len >= 12)
{
a += (p[0] + (((U32)p[1])<<8) + (((U32)p[2])<<16) +
(((U32)p[3])<<24));
b += (p[4] + (((U32)p[5])<<8) + (((U32)p[6])<<16) +
(((U32)p[7])<<24));
c += (p[8] + (((U32)p[9])<<8) + (((U32)p[10])<<16) +
(((U32)p[11])<<24));
MIX(a, b, c);
p += 12;
len -= 12;
}
c += length;
switch(len) {
case 11: c+=((U32)p[10]<<24);
case 10: c+=((U32)p[9]<<16);
case 9: c+=((U32)p[8]<<8);
case 8: b+=((U32)p[7]<<24);
case 7: b+=((U32)p[6]<<16);
case 6: b+=((U32)p[5]<<8);
case 5: b+=((U32)p[4]);
case 4: a+=((U32)p[3]<<24);
case 3: a+=((U32)p[2]<<16);
case 2: a+=((U32)p[1]<<8);
case 1: a+=((U32)p[0]);
}
MIX(a, b, c);
DEBUG && printf( "Hash value is %d.\n", (int)(c) );
return(c);
}
static CORBA_boolean
put_enum (GIOPSendBuffer *buf, CORBA_TypeCode tc, SV *sv)
{
dTHR;
CORBA_unsigned_long v = porbit_enum_find_member (tc, sv);
if (v < 0) {
warn ("Invalid enumeration value '%s'", SvPV(sv, PL_na));
return CORBA_FALSE;
}
buf_putn (buf, &v, sizeof (v));
return CORBA_TRUE;
}
int
Drawable_get_text_width( Handle self, SV * text, Bool addOverhang)
{
gpARGS;
int res;
STRLEN dlen;
char * c_text = SvPV( text, dlen);
Bool utf8 = prima_is_utf8_sv( text);
if ( utf8) dlen = utf8_length(( U8*) c_text, ( U8*) c_text + dlen);
gpENTER(0);
res = apc_gp_get_text_width( self, c_text, dlen, addOverhang, utf8);
gpLEAVE;
return res;
}
static gboolean
load_perl_plugin(PurplePlugin *plugin)
{
PurplePerlScript *gps = (PurplePerlScript *)plugin->info->extra_info;
char *atmp[3] = { plugin->path, NULL, NULL };
if (gps == NULL || gps->load_sub == NULL)
return FALSE;
purple_debug(PURPLE_DEBUG_INFO, "perl", "Loading perl script\n");
if (my_perl == NULL)
perl_init();
plugin->handle = gps;
atmp[1] = gps->package;
PERL_SET_CONTEXT(my_perl);
execute_perl("Purple::PerlLoader::load_n_eval", 2, atmp);
{
dSP;
PERL_SET_CONTEXT(my_perl);
SPAGAIN;
ENTER;
SAVETMPS;
PUSHMARK(sp);
XPUSHs(sv_2mortal(purple_perl_bless_object(plugin,
"Purple::Plugin")));
PUTBACK;
perl_call_pv(gps->load_sub, G_EVAL | G_SCALAR);
SPAGAIN;
if (SvTRUE(ERRSV)) {
STRLEN len;
purple_debug(PURPLE_DEBUG_ERROR, "perl",
"Perl function %s exited abnormally: %s\n",
gps->load_sub, SvPV(ERRSV, len));
}
PUTBACK;
FREETMPS;
LEAVE;
}
return TRUE;
}
U32 p5_sv_utf8(PerlInterpreter *my_perl, SV* sv) {
if (SvUTF8(sv)) { // UTF-8 flag set -> can use string as-is
return 1;
}
else { // pure 7 bit ASCII is valid UTF-8 as well
STRLEN len;
char * const pv = SvPV(sv, len);
STRLEN i;
for (i = 0; i < len; i++)
if (pv[i] < 0) // signed char!
return 0;
return 1;
}
}
static SV *sv_soundex (SV *source)
{
char *source_p;
char *source_end;
{
STRLEN source_len;
source_p = SvPV(source, source_len);
source_end = &source_p[source_len];
}
while (source_p != source_end)
{
char codepart_last = sv_soundex_table[(unsigned char) *source_p];
if (codepart_last != '\0')
{
SV *code = newSV(SOUNDEX_ACCURACY);
char *code_p = SvPVX(code);
char *code_end = &code_p[SOUNDEX_ACCURACY];
SvCUR_set(code, SOUNDEX_ACCURACY);
SvPOK_only(code);
*code_p++ = toupper(*source_p++);
while (source_p != source_end && code_p != code_end)
{
char c = *source_p++;
char codepart = sv_soundex_table[(unsigned char) c];
if (codepart != '\0')
if (codepart != codepart_last && (codepart_last = codepart) != '0')
*code_p++ = codepart;
}
while (code_p != code_end)
*code_p++ = '0';
*code_end = '\0';
return code;
}
source_p++;
}
return SvREFCNT_inc(perl_get_sv("Text::Soundex::nocode", FALSE));
}
static CORBA_boolean
put_char (GIOPSendBuffer *buf, SV *sv)
{
char *str;
STRLEN len;
str = SvPV(sv, len);
if (len < 1)
buf_putn (buf, "", 1);
else
buf_putn (buf, str, 1);
return CORBA_TRUE;
}
static html_valid_status_t
html_valid_set_string_option (html_valid_t * htv, const char * coption,
TidyOptionId ti, SV * value)
{
const char * cvalue;
STRLEN cvalue_length;
if (! SvOK (value)) {
warn ("cannot set option '%s' to undefined value",
coption);
return html_valid_undefined_option;
}
cvalue = SvPV (value, cvalue_length);
TIDY_CALL (tidyOptSetValue (htv->tdoc, ti, cvalue));
return html_valid_ok;
}
SV *
Drawable_linePattern( Handle self, Bool set, SV * pattern)
{
if ( set) {
STRLEN len;
unsigned char *pat = ( unsigned char *) SvPV( pattern, len);
if ( len > 255) len = 255;
apc_gp_set_line_pattern( self, pat, len);
} else {
unsigned char ret[ 256];
int len = apc_gp_get_line_pattern( self, ret);
return newSVpvn((char*) ret, len);
}
return nilSV;
}
void
plcb_convert_storage(PLCB_t *object, AV *docav, plcb_DOCVAL *vspec)
{
SV *pv = SvROK(vspec->value) ? SvRV(vspec->value) : vspec->value;
uint32_t fmt = vspec->spec;
if (object->cv_customenc) {
vspec->need_free = 1;
vspec->value = custom_convert(docav, object->cv_customenc, vspec->value, &vspec->flags, CONVERT_OUT);
} else if (fmt == PLCB_CF_JSON) {
vspec->flags = PLCB_LF_JSON|PLCB_CF_JSON;
vspec->need_free = 1;
vspec->value = serialize_convert(object->cv_jsonenc, vspec->value, CONVERT_OUT);
} else if (fmt == PLCB_CF_STORABLE) {
vspec->flags = PLCB_CF_STORABLE | PLCB_LF_STORABLE;
vspec->need_free = 1;
vspec->value = serialize_convert(object->cv_serialize, vspec->value, CONVERT_OUT);
} else if (fmt == PLCB_CF_RAW) {
vspec->flags = PLCB_CF_RAW | PLCB_LF_RAW;
vspec->need_free = 0;
if (!SvPOK(pv)) {
die("Raw conversion requires string value!");
}
} else if (vspec->spec == PLCB_CF_UTF8) {
vspec->flags = PLCB_CF_UTF8 | PLCB_LF_UTF8;
vspec->need_free = 0;
sv_utf8_upgrade(pv);
} else {
die("Unrecognized flags used (0x%x) but no custom converted installed!", vspec->spec);
}
if (!vspec->need_free) {
/* Use input as-is */
vspec->value = pv;
}
/* Assume the resultant value is an SV */
if (SvTYPE(vspec->value) == SVt_PV) {
vspec->encoded = SvPVX(vspec->value);
vspec->len = SvCUR(vspec->value);
} else {
vspec->encoded = SvPV(vspec->value, vspec->len);
}
}
static int output_body_obj(request_rec *r, SV *obj, int type)
{
dTHX;
SV *buf_sv;
apr_off_t clen = 0;
STRLEN len;
dSP;
char *buf;
int count;
if (type == SVt_PVMG && !respond_to(obj, "getline")) {
server_error(r, "response body object must be able to getline");
return HTTP_INTERNAL_SERVER_ERROR;
}
ENTER;
SAVETMPS;
SAVESPTR(PL_rs);
PL_rs = newRV_inc(newSViv(AP_IOBUFSIZE));
while (1) {
PUSHMARK(SP);
XPUSHs(obj);
PUTBACK;
count = call_method("getline", G_SCALAR);
if (count != 1) croak("Big trouble\n");
SPAGAIN;
buf_sv = POPs;
if (SvOK(buf_sv)) {
buf = SvPV(buf_sv, len);
clen += len;
ap_rwrite(buf, len, r);
} else {
break;
}
}
if (clen > 0) {
ap_set_content_length(r, clen);
}
PUSHMARK(SP);
XPUSHs(obj);
PUTBACK;
call_method("close", G_DISCARD);
SPAGAIN;
PUTBACK;
FREETMPS;
LEAVE;
return OK;
}
/**
* NI_get_end_n128(): get last address of IPv6 object as N128 integer.
* @ip: Net::IP::XS object.
* @end: reference to N128 integer.
*
* On success, @end will point to the ending address stored in the
* IPv6 object.
*/
int
NI_get_end_n128(SV *ipo, n128_t *end)
{
SV **ref;
STRLEN len;
const char *raw_end;
ref = hv_fetch((HV*) SvRV(ipo), "xs_v6_ip1", 9, 0);
if (!ref || !(*ref)) {
return 0;
}
raw_end = SvPV(*ref, len);
memcpy(end, raw_end, 16);
return 1;
}
