/* Xchat::Internal::hook_fd(fd, callback, flags, userdata) */
static
XS (XS_Xchat_hook_fd)
{
int fd;
SV *callback;
int flags;
SV *userdata;
xchat_hook *hook;
HookData *data;
dXSARGS;
if (items != 4) {
xchat_print (ph,
"Usage: Xchat::Internal::hook_fd(fd, callback, flags, userdata)");
} else {
fd = (int) SvIV (ST (0));
callback = ST (1);
flags = (int) SvIV (ST (2));
userdata = ST (3);
data = NULL;
#ifdef WIN32
if ((flags & XCHAT_FD_NOTSOCKET) == 0) {
/* this _get_osfhandle if from win32iop.h in the perl distribution,
* not the one provided by Windows
*/
fd = _get_osfhandle(fd);
if (fd < 0) {
xchat_print(ph, "Invalid file descriptor");
XSRETURN_UNDEF;
}
}
#endif
data = malloc (sizeof (HookData));
if (data == NULL) {
XSRETURN_UNDEF;
}
data->callback = sv_mortalcopy (callback);
SvREFCNT_inc (data->callback);
data->userdata = sv_mortalcopy (userdata);
SvREFCNT_inc (data->userdata);
data->package = NULL;
hook = xchat_hook_fd (ph, fd, flags, fd_cb, data);
data->hook = hook;
XSRETURN_IV (PTR2IV (hook));
}
}
static JSBool
perlarray_pop(
JSContext *cx,
JSObject *obj,
uintN argc,
jsval *argv,
jsval *rval
) {
dTHX;
SV *ref = (SV *)JS_GetPrivate(cx, obj);
AV *av = (AV *)SvRV(ref);
SV *sv;
JSBool ok;
PJS_ARRAY_CHECK
sv = av_pop(av);
if(!sv || sv == &PL_sv_undef) {
*rval = JSVAL_VOID;
return JS_TRUE;
}
ENTER; SAVETMPS;
ok = PJS_ReflectPerl2JS(aTHX_ cx, obj, sv_mortalcopy(sv), rval);
FREETMPS; LEAVE;
return ok;
}
static JSBool
perlarray_get(
JSContext *cx,
JSObject *obj,
jsval id,
jsval *vp
) {
dTHX;
SV *ref = (SV *)JS_GetPrivate(cx, obj);
AV *av = (AV *)SvRV(ref);
JSBool ok = JS_TRUE;
PJS_ARRAY_CHECK
if(JSVAL_IS_INT(id)) {
I32 ix = JSVAL_TO_INT(id);
SV **v;
ENTER; SAVETMPS;
v = av_fetch(av, ix, 0);
if(v) {
if(SvGMAGICAL(*v)) mg_get(*v);
ok = PJS_ReflectPerl2JS(aTHX_ cx, obj, sv_mortalcopy(*v), vp);
}
else {
JS_ReportError(cx, "Failed to retrieve element at index: %d", ix);
ok = JS_FALSE;
}
FREETMPS; LEAVE;
}
return ok;
}
void HRA_fetch_a(SV *self, SV *attr, char *t)
{
dXSARGS;
SP -= 3;
if(GIMME_V == G_VOID) {
XSRETURN(0);
}
SV *aobj = attr_get(self, attr, t, 0);
if(!aobj) {
HR_DEBUG("Can't find attribute!");
XSRETURN_EMPTY;
} else {
HR_DEBUG("Found aobj=%p", aobj);
}
hrattr_simple *aptr = attr_from_sv(SvRV(aobj));
HR_DEBUG("Attrhash=%p", aptr->attrhash);
int nkeys = hv_iterinit(aptr->attrhash);
HR_DEBUG("We have %d keys", nkeys);
if(GIMME_V == G_SCALAR) {
HR_DEBUG("Scalar return value requested");
XSRETURN_IV(nkeys);
}
HR_DEBUG("Will do some stack voodoo");
EXTEND(sp, nkeys);
HE *cur = hv_iternext(aptr->attrhash);
for(; cur != NULL; cur = hv_iternext(aptr->attrhash))
{
XPUSHs(sv_mortalcopy(hv_iterval(aptr->attrhash, cur)));
}
PUTBACK;
}
static
XS (XS_Xchat_unhook)
{
xchat_hook *hook;
HookData *userdata;
int retCount = 0;
dXSARGS;
if (items != 1) {
xchat_print (ph, "Usage: Xchat::unhook(hook)");
} else {
hook = INT2PTR (xchat_hook *, SvUV (ST (0)));
userdata = (HookData *) xchat_unhook (ph, hook);
if (userdata != NULL) {
if (userdata->callback != NULL) {
SvREFCNT_dec (userdata->callback);
}
if (userdata->userdata != NULL) {
XPUSHs (sv_mortalcopy (userdata->userdata));
SvREFCNT_dec (userdata->userdata);
retCount = 1;
}
if (userdata->package != NULL) {
SvREFCNT_dec (userdata->package);
}
free (userdata);
}
XSRETURN (retCount);
}
XSRETURN_EMPTY;
}
char *
PJS_ConvertUC(
pTHX_
SV *sv,
STRLEN *len
) {
dSP;
char *ret;
STRLEN elen;
SvPV_force(sv, elen);
if(SvUTF8(sv) && !sv_utf8_downgrade(sv, 1)) {
SV *svtmp;
ENTER; SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(PJS_STR_ENCODING, 0)));
XPUSHs(sv_mortalcopy(sv));
PUTBACK;
call_pv("Encode::encode", G_SCALAR);
SPAGAIN;
svtmp = newSVsv(POPs);
SAVEMORTALIZESV(svtmp);
ret = SvPV(svtmp, elen);
PUTBACK;
FREETMPS; LEAVE;
*len = -(elen / 2);
} else {
ret = SvPV(sv, elen);
*len = elen;
}
return ret;
}
static int perl_source_event(PERL_SOURCE_REC *rec)
{
dSP;
int retcount;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_mortalcopy(rec->data));
PUTBACK;
perl_source_ref(rec);
retcount = perl_call_sv(rec->func, G_EVAL|G_SCALAR);
SPAGAIN;
if (SvTRUE(ERRSV)) {
char *error = g_strdup(SvPV(ERRSV, PL_na));
signal_emit("script error", 2, rec->script, error);
g_free(error);
}
if (perl_source_unref(rec) && rec->once)
perl_source_destroy(rec);
PUTBACK;
FREETMPS;
LEAVE;
return 1;
}
static inline void do_check(SV *cv, SV *value, SV *key) {
dTHX;
SV *ok = &PL_sv_undef, *msg = &PL_sv_undef;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUSHs(sv_mortalcopy(value));
PUTBACK;
int count = call_sv(cv, G_ARRAY);
// could return 0 or 1 or 2 or more
SPAGAIN;
if (count) count == 1 ? (ok = POPs) : (msg = POPs, ok = POPs);
if (!SvTRUE(ok)) {
croak("Bad value \"%s\" for attribute \"%s\": %s", SvPV_nolen(value),
SvPV_nolen(key), SvTRUE(msg) ? SvPV_nolen(msg) : "");
}
PUTBACK;
FREETMPS;
LEAVE;
};
/* Xchat::Internal::hook_command(name, priority, callback, help_text, userdata) */
static
XS (XS_Xchat_hook_command)
{
char *name;
int pri;
SV *callback;
char *help_text = NULL;
SV *userdata;
xchat_hook *hook;
HookData *data;
dXSARGS;
if (items != 5) {
xchat_print (ph,
"Usage: Xchat::Internal::hook_command(name, priority, callback, help_text, userdata)");
} else {
name = SvPV_nolen (ST (0));
pri = (int) SvIV (ST (1));
callback = ST (2);
/* leave the help text has NULL if the help text is undefined to avoid
* overriding the default help message for builtin commands */
if (SvOK(ST (3))) {
help_text = SvPV_nolen (ST (3));
}
userdata = ST (4);
data = NULL;
data = malloc (sizeof (HookData));
if (data == NULL) {
XSRETURN_UNDEF;
}
data->callback = sv_mortalcopy (callback);
SvREFCNT_inc (data->callback);
data->userdata = sv_mortalcopy (userdata);
SvREFCNT_inc (data->userdata);
data->depth = 0;
data->package = NULL;
hook = xchat_hook_command (ph, name, pri, command_cb, help_text, data);
XSRETURN_IV (PTR2IV (hook));
}
}
static int
timer_cb (void *userdata)
{
HookData *data = (HookData *) userdata;
int retVal = 0;
int count = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK (SP);
XPUSHs (data->userdata);
PUTBACK;
if (data->ctx) {
hexchat_set_context (ph, data->ctx);
}
set_current_package (data->package);
count = call_sv (data->callback, G_EVAL);
set_current_package (&PL_sv_undef);
SPAGAIN;
if (SvTRUE (ERRSV)) {
hexchat_printf (ph, "Error in timer callback %s", SvPV_nolen (ERRSV));
if (!SvOK (POPs)) {} /* remove undef from the top of the stack */
retVal = HEXCHAT_EAT_ALL;
} else {
if (count != 1) {
hexchat_print (ph, "Timer handler should only return 1 value.");
retVal = HEXCHAT_EAT_NONE;
} else {
retVal = POPi;
if (retVal == 0) {
/* if 0 is return the timer is going to get unhooked */
PUSHMARK (SP);
XPUSHs (sv_2mortal (newSViv (PTR2IV (data->hook))));
XPUSHs (sv_mortalcopy (data->package));
PUTBACK;
call_pv ("Xchat::unhook", G_EVAL);
SPAGAIN;
}
}
}
PUTBACK;
FREETMPS;
LEAVE;
return retVal;
}
//*****************************************************************************
//
// SYNOPSIS
//
bool perl_visitor::operator()(
HTML_Node *node, int depth, bool is_end_tag
) const
//
// DESCRIPTION
//
// This function serves as the "glue code" between the called visitor
// function in C++ and the real visitor function in Perl.
//
// PARAMETERS
//
// node The HTML node we're currently visiting.
//
// depth How far down into the HTML tree we are (depth starts at
// zero).
//
// is_end_tag This is set to true only after visiting all of an HTML
// node's child nodes, if any.
//
// RETURN VALUE
//
// Returns the value of the Perl function.
//
// SEE ALSO
//
// Sriram Srinivasan. "Advanced Perl Programming," O'Reilly and
// Associates, Inc., Sebastopol, CA, 1997, pp. 352-353.
//
//*****************************************************************************
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK( sp );
if ( hash_ref_ )
XPUSHs( sv_mortalcopy( hash_ref_ ) );
XPUSHs( blessed( "HTML_Node", node ) );
XPUSHs( sv_2mortal( newSViv( depth ) ) );
XPUSHs( sv_2mortal( newSViv( is_end_tag ) ) );
PUTBACK;
int const result_count = perl_call_sv( func_ref_, G_SCALAR );
SPAGAIN;
if ( result_count != 1 )
croak( "HTML::Tree: "
"visitor function didn't return a single scalar value "
"(it returned %d)", result_count
);
bool const result = POPi;
PUTBACK;
FREETMPS;
LEAVE;
return result;
}
/* Xchat::Internal::hook_timer(timeout, callback, userdata) */
static
XS (XS_Xchat_hook_timer)
{
int timeout;
SV *callback;
SV *userdata;
xchat_hook *hook;
SV *package;
HookData *data;
dXSARGS;
if (items != 4) {
xchat_print (ph,
"Usage: Xchat::Internal::hook_timer(timeout, callback, userdata, package)");
} else {
timeout = (int) SvIV (ST (0));
callback = ST (1);
data = NULL;
userdata = ST (2);
package = ST (3);
data = malloc (sizeof (HookData));
if (data == NULL) {
XSRETURN_UNDEF;
}
data->callback = sv_mortalcopy (callback);
SvREFCNT_inc (data->callback);
data->userdata = sv_mortalcopy (userdata);
SvREFCNT_inc (data->userdata);
data->ctx = xchat_get_context (ph);
data->package = sv_mortalcopy (package);
SvREFCNT_inc (data->package);
hook = xchat_hook_timer (ph, timeout, timer_cb, data);
data->hook = hook;
XSRETURN_IV (PTR2IV (hook));
}
}
/* Xchat::Internal::hook_server(name, priority, callback, userdata) */
static
XS (XS_Xchat_hook_server)
{
char *name;
int pri;
SV *callback;
SV *userdata;
xchat_hook *hook;
HookData *data;
dXSARGS;
if (items != 4) {
xchat_print (ph,
"Usage: Xchat::Internal::hook_server(name, priority, callback, userdata)");
} else {
name = SvPV_nolen (ST (0));
pri = (int) SvIV (ST (1));
callback = ST (2);
userdata = ST (3);
data = NULL;
data = malloc (sizeof (HookData));
if (data == NULL) {
XSRETURN_UNDEF;
}
data->callback = sv_mortalcopy (callback);
SvREFCNT_inc (data->callback);
data->userdata = sv_mortalcopy (userdata);
SvREFCNT_inc (data->userdata);
data->depth = 0;
data->package = NULL;
hook = xchat_hook_server (ph, name, pri, server_cb, data);
XSRETURN_IV (PTR2IV (hook));
}
}
// invoce cv, passing arg, store result of that invocation to hash, return an SV
// from HeVAL
static inline SV *invoke_and_store(SV *arg, SV *cv, HV *hash, SV *key) {
dTHX;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUSHs(sv_mortalcopy(arg));
PUTBACK;
int count = call_sv(cv, G_SCALAR);
if (count != 1) croak("bad count");
SPAGAIN;
SV *tmp = POPs;
SV *result = hv_he_store_or_croak(hash, key, tmp);
PUTBACK;
FREETMPS;
LEAVE;
return result;
}
/*
* This is the main Load function.
* It takes a yaml stream and turns it into 0 or more Perl objects.
*/
void
Load(SV *yaml_sv)
{
dXSARGS;
perl_yaml_loader_t loader;
SV *node;
char *yaml_str;
STRLEN yaml_len;
/* If UTF8, make copy and downgrade */
if (SvPV_nolen(yaml_sv) && SvUTF8(yaml_sv)) {
yaml_sv = sv_mortalcopy(yaml_sv);
}
yaml_str = SvPVbyte(yaml_sv, yaml_len);
sp = mark;
if (0 && (items || ax)) {} /* XXX Quiet the -Wall warnings for now. */
yaml_parser_initialize(&loader.parser);
loader.document = 0;
yaml_parser_set_input_string(
&loader.parser,
(unsigned char *)yaml_str,
yaml_len
);
/* Get the first event. Must be a STREAM_START */
if (!yaml_parser_parse(&loader.parser, &loader.event))
goto load_error;
if (loader.event.type != YAML_STREAM_START_EVENT)
croak(ERRMSG "Expected STREAM_START_EVENT; Got: %d != %d",
loader.event.type,
YAML_STREAM_START_EVENT
);
loader.anchors = newHV();
sv_2mortal((SV*)loader.anchors);
/* Keep calling load_node until end of stream */
while (1) {
loader.document++;
if (!yaml_parser_parse(&loader.parser, &loader.event))
goto load_error;
if (loader.event.type == YAML_STREAM_END_EVENT)
break;
node = load_node(&loader);
hv_clear(loader.anchors);
if (! node) break;
XPUSHs(sv_2mortal(node));
if (!yaml_parser_parse(&loader.parser, &loader.event))
goto load_error;
if (loader.event.type != YAML_DOCUMENT_END_EVENT)
croak(ERRMSG "Expected DOCUMENT_END_EVENT");
}
/* Make sure the last event is a STREAM_END */
if (loader.event.type != YAML_STREAM_END_EVENT)
croak(ERRMSG "Expected STREAM_END_EVENT; Got: %d != %d",
loader.event.type,
YAML_STREAM_END_EVENT
);
yaml_parser_delete(&loader.parser);
PUTBACK;
return;
load_error:
croak(loader_error_msg(&loader, NULL));
}
/*
* This is the main Load function.
* It takes a yaml stream and turns it into 0 or more Perl objects.
*/
void
Load(SV *yaml_sv)
{
dXSARGS;
perl_yaml_loader_t loader;
SV *node;
const unsigned char *yaml_str;
STRLEN yaml_len;
yaml_str = (const unsigned char *)SvPV_const(yaml_sv, yaml_len);
if (DO_UTF8(yaml_sv)) {
yaml_sv = sv_mortalcopy(yaml_sv);
if (!sv_utf8_downgrade(yaml_sv, TRUE))
croak("%s", "Wide character in YAML::XS::Load()");
yaml_str = (const unsigned char *)SvPV_const(yaml_sv, yaml_len);
}
sp = mark;
if (0 && (items || ax)) {} /* XXX Quiet the -Wall warnings for now. */
yaml_parser_initialize(&loader.parser);
loader.document = 0;
yaml_parser_set_input_string(
&loader.parser,
yaml_str,
yaml_len
);
/* Get the first event. Must be a STREAM_START */
if (!yaml_parser_parse(&loader.parser, &loader.event))
goto load_error;
if (loader.event.type != YAML_STREAM_START_EVENT)
croak("%sExpected STREAM_START_EVENT; Got: %d != %d",
ERRMSG,
loader.event.type,
YAML_STREAM_START_EVENT
);
loader.anchors = newHV();
sv_2mortal((SV *)loader.anchors);
/* Keep calling load_node until end of stream */
while (1) {
loader.document++;
/* We are through with the previous event - delete it! */
yaml_event_delete(&loader.event);
if (!yaml_parser_parse(&loader.parser, &loader.event))
goto load_error;
if (loader.event.type == YAML_STREAM_END_EVENT)
break;
node = load_node(&loader);
/* We are through with the previous event - delete it! */
yaml_event_delete(&loader.event);
hv_clear(loader.anchors);
if (! node) break;
XPUSHs(sv_2mortal(node));
if (!yaml_parser_parse(&loader.parser, &loader.event))
goto load_error;
if (loader.event.type != YAML_DOCUMENT_END_EVENT)
croak("%sExpected DOCUMENT_END_EVENT", ERRMSG);
}
/* Make sure the last event is a STREAM_END */
if (loader.event.type != YAML_STREAM_END_EVENT)
croak("%sExpected STREAM_END_EVENT; Got: %d != %d",
ERRMSG,
loader.event.type,
YAML_STREAM_END_EVENT
);
yaml_parser_delete(&loader.parser);
PUTBACK;
return;
load_error:
croak("%s", loader_error_msg(&loader, NULL));
}
static void
report_event(PSTATE* p_state,
event_id_t event,
char *beg, char *end, U32 utf8,
token_pos_t *tokens, int num_tokens,
SV* self
)
{
struct p_handler *h;
dTHX;
dSP;
AV *array;
STRLEN my_na;
char *argspec;
char *s;
#ifdef UNICODE_HTML_PARSER
#define CHR_DIST(a,b) (utf8 ? utf8_distance((U8*)(a),(U8*)(b)) : (a) - (b))
#else
#define CHR_DIST(a,b) ((a) - (b))
#endif
/* capture offsets */
STRLEN offset = p_state->offset;
STRLEN line = p_state->line;
STRLEN column = p_state->column;
#if 0
{ /* used for debugging at some point */
char *s = beg;
int i;
/* print debug output */
switch(event) {
case E_DECLARATION: printf("DECLARATION"); break;
case E_COMMENT: printf("COMMENT"); break;
case E_START: printf("START"); break;
case E_END: printf("END"); break;
case E_TEXT: printf("TEXT"); break;
case E_PROCESS: printf("PROCESS"); break;
case E_NONE: printf("NONE"); break;
default: printf("EVENT #%d", event); break;
}
printf(" [");
while (s < end) {
if (*s == '\n') {
putchar('\\'); putchar('n');
}
else
putchar(*s);
s++;
}
printf("] %d\n", end - beg);
for (i = 0; i < num_tokens; i++) {
printf(" token %d: %d %d\n",
i,
tokens[i].beg - beg,
tokens[i].end - tokens[i].beg);
}
}
#endif
if (p_state->pending_end_tag && event != E_TEXT && event != E_COMMENT) {
token_pos_t t;
char dummy;
t.beg = p_state->pending_end_tag;
t.end = p_state->pending_end_tag + strlen(p_state->pending_end_tag);
p_state->pending_end_tag = 0;
report_event(p_state, E_END, &dummy, &dummy, 0, &t, 1, self);
SPAGAIN;
}
/* update offsets */
p_state->offset += CHR_DIST(end, beg);
if (line) {
char *s = beg;
char *nl = NULL;
while (s < end) {
if (*s == '\n') {
p_state->line++;
nl = s;
}
s++;
}
if (nl)
p_state->column = CHR_DIST(end, nl) - 1;
else
p_state->column += CHR_DIST(end, beg);
}
if (event == E_NONE)
goto IGNORE_EVENT;
#ifdef MARKED_SECTION
if (p_state->ms == MS_IGNORE)
goto IGNORE_EVENT;
#endif
/* tag filters */
if (p_state->ignore_tags || p_state->report_tags || p_state->ignore_elements) {
if (event == E_START || event == E_END) {
SV* tagname = p_state->tmp;
assert(num_tokens >= 1);
sv_setpvn(tagname, tokens[0].beg, tokens[0].end - tokens[0].beg);
if (utf8)
SvUTF8_on(tagname);
else
SvUTF8_off(tagname);
if (!CASE_SENSITIVE(p_state))
sv_lower(aTHX_ tagname);
if (p_state->ignoring_element) {
if (sv_eq(p_state->ignoring_element, tagname)) {
if (event == E_START)
p_state->ignore_depth++;
else if (--p_state->ignore_depth == 0) {
SvREFCNT_dec(p_state->ignoring_element);
p_state->ignoring_element = 0;
}
}
goto IGNORE_EVENT;
}
if (p_state->ignore_elements &&
hv_fetch_ent(p_state->ignore_elements, tagname, 0, 0))
{
p_state->ignoring_element = newSVsv(tagname);
p_state->ignore_depth = 1;
goto IGNORE_EVENT;
}
if (p_state->ignore_tags &&
hv_fetch_ent(p_state->ignore_tags, tagname, 0, 0))
{
goto IGNORE_EVENT;
}
if (p_state->report_tags &&
!hv_fetch_ent(p_state->report_tags, tagname, 0, 0))
{
goto IGNORE_EVENT;
}
}
else if (p_state->ignoring_element) {
goto IGNORE_EVENT;
}
}
h = &p_state->handlers[event];
if (!h->cb) {
/* event = E_DEFAULT; */
h = &p_state->handlers[E_DEFAULT];
if (!h->cb)
goto IGNORE_EVENT;
}
if (SvTYPE(h->cb) != SVt_PVAV && !SvTRUE(h->cb)) {
/* FALSE scalar ('' or 0) means IGNORE this event */
return;
}
if (p_state->unbroken_text && event == E_TEXT) {
/* should buffer text */
if (!p_state->pend_text)
p_state->pend_text = newSV(256);
if (SvOK(p_state->pend_text)) {
if (p_state->is_cdata != p_state->pend_text_is_cdata) {
flush_pending_text(p_state, self);
SPAGAIN;
goto INIT_PEND_TEXT;
}
}
else {
INIT_PEND_TEXT:
p_state->pend_text_offset = offset;
p_state->pend_text_line = line;
p_state->pend_text_column = column;
p_state->pend_text_is_cdata = p_state->is_cdata;
sv_setpvn(p_state->pend_text, "", 0);
if (!utf8)
SvUTF8_off(p_state->pend_text);
}
#ifdef UNICODE_HTML_PARSER
if (utf8 && !SvUTF8(p_state->pend_text))
sv_utf8_upgrade(p_state->pend_text);
if (utf8 || !SvUTF8(p_state->pend_text)) {
sv_catpvn(p_state->pend_text, beg, end - beg);
}
else {
SV *tmp = newSVpvn(beg, end - beg);
sv_utf8_upgrade(tmp);
sv_catsv(p_state->pend_text, tmp);
SvREFCNT_dec(tmp);
}
#else
sv_catpvn(p_state->pend_text, beg, end - beg);
#endif
return;
}
else if (p_state->pend_text && SvOK(p_state->pend_text)) {
flush_pending_text(p_state, self);
SPAGAIN;
}
/* At this point we have decided to generate an event callback */
argspec = h->argspec ? SvPV(h->argspec, my_na) : "";
if (SvTYPE(h->cb) == SVt_PVAV) {
if (*argspec == ARG_FLAG_FLAT_ARRAY) {
argspec++;
array = (AV*)h->cb;
}
else {
/* start sub-array for accumulator array */
array = newAV();
}
}
else {
array = 0;
if (*argspec == ARG_FLAG_FLAT_ARRAY)
argspec++;
/* start argument stack for callback */
ENTER;
SAVETMPS;
PUSHMARK(SP);
}
for (s = argspec; *s; s++) {
SV* arg = 0;
int push_arg = 1;
enum argcode argcode = (enum argcode)*s;
switch( argcode ) {
case ARG_SELF:
arg = sv_mortalcopy(self);
break;
case ARG_TOKENS:
if (num_tokens >= 1) {
AV* av = newAV();
SV* prev_token = &PL_sv_undef;
int i;
av_extend(av, num_tokens);
for (i = 0; i < num_tokens; i++) {
if (tokens[i].beg) {
prev_token = newSVpvn(tokens[i].beg, tokens[i].end-tokens[i].beg);
if (utf8)
SvUTF8_on(prev_token);
av_push(av, prev_token);
}
else { /* boolean */
av_push(av, p_state->bool_attr_val
? newSVsv(p_state->bool_attr_val)
: newSVsv(prev_token));
}
}
arg = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case ARG_TOKENPOS:
if (num_tokens >= 1 && tokens[0].beg >= beg) {
AV* av = newAV();
int i;
av_extend(av, num_tokens*2);
for (i = 0; i < num_tokens; i++) {
if (tokens[i].beg) {
av_push(av, newSViv(CHR_DIST(tokens[i].beg, beg)));
av_push(av, newSViv(CHR_DIST(tokens[i].end, tokens[i].beg)));
}
else { /* boolean tag value */
av_push(av, newSViv(0));
av_push(av, newSViv(0));
}
}
arg = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case ARG_TOKEN0:
case ARG_TAGNAME:
/* fall through */
case ARG_TAG:
if (num_tokens >= 1) {
arg = sv_2mortal(newSVpvn(tokens[0].beg,
tokens[0].end - tokens[0].beg));
if (utf8)
SvUTF8_on(arg);
if (!CASE_SENSITIVE(p_state) && argcode != ARG_TOKEN0)
sv_lower(aTHX_ arg);
if (argcode == ARG_TAG && event != E_START) {
char *e_type = "!##/#?#";
sv_insert(arg, 0, 0, &e_type[event], 1);
}
}
break;
case ARG_ATTR:
case ARG_ATTRARR:
if (event == E_START) {
HV* hv;
int i;
if (argcode == ARG_ATTR) {
hv = newHV();
arg = sv_2mortal(newRV_noinc((SV*)hv));
}
else {
#ifdef __GNUC__
/* gcc -Wall reports this variable as possibly used uninitialized */
hv = 0;
#endif
push_arg = 0; /* deal with argument pushing here */
}
for (i = 1; i < num_tokens; i += 2) {
SV* attrname = newSVpvn(tokens[i].beg,
tokens[i].end-tokens[i].beg);
SV* attrval;
if (utf8)
SvUTF8_on(attrname);
if (tokens[i+1].beg) {
char *beg = tokens[i+1].beg;
STRLEN len = tokens[i+1].end - beg;
if (*beg == '"' || *beg == '\'') {
assert(len >= 2 && *beg == beg[len-1]);
beg++; len -= 2;
}
attrval = newSVpvn(beg, len);
if (utf8)
SvUTF8_on(attrval);
if (!p_state->attr_encoded) {
#ifdef UNICODE_HTML_PARSER
if (p_state->utf8_mode)
sv_utf8_decode(attrval);
#endif
decode_entities(aTHX_ attrval, p_state->entity2char, 0);
if (p_state->utf8_mode)
SvUTF8_off(attrval);
}
}
else { /* boolean */
if (p_state->bool_attr_val)
attrval = newSVsv(p_state->bool_attr_val);
else
attrval = newSVsv(attrname);
}
if (!CASE_SENSITIVE(p_state))
sv_lower(aTHX_ attrname);
if (argcode == ARG_ATTR) {
if (hv_exists_ent(hv, attrname, 0) ||
!hv_store_ent(hv, attrname, attrval, 0)) {
SvREFCNT_dec(attrval);
}
SvREFCNT_dec(attrname);
}
else { /* ARG_ATTRARR */
if (array) {
av_push(array, attrname);
av_push(array, attrval);
}
else {
XPUSHs(sv_2mortal(attrname));
XPUSHs(sv_2mortal(attrval));
}
}
}
}
else if (argcode == ARG_ATTRARR) {
push_arg = 0;
}
break;
case ARG_ATTRSEQ: /* (v2 compatibility stuff) */
if (event == E_START) {
AV* av = newAV();
int i;
for (i = 1; i < num_tokens; i += 2) {
SV* attrname = newSVpvn(tokens[i].beg,
tokens[i].end-tokens[i].beg);
if (utf8)
SvUTF8_on(attrname);
if (!CASE_SENSITIVE(p_state))
sv_lower(aTHX_ attrname);
av_push(av, attrname);
}
arg = sv_2mortal(newRV_noinc((SV*)av));
}
break;
case ARG_TEXT:
arg = sv_2mortal(newSVpvn(beg, end - beg));
if (utf8)
SvUTF8_on(arg);
break;
case ARG_DTEXT:
if (event == E_TEXT) {
arg = sv_2mortal(newSVpvn(beg, end - beg));
if (utf8)
SvUTF8_on(arg);
if (!p_state->is_cdata) {
#ifdef UNICODE_HTML_PARSER
if (p_state->utf8_mode)
sv_utf8_decode(arg);
#endif
decode_entities(aTHX_ arg, p_state->entity2char, 1);
if (p_state->utf8_mode)
SvUTF8_off(arg);
}
}
break;
case ARG_IS_CDATA:
if (event == E_TEXT) {
arg = boolSV(p_state->is_cdata);
}
break;
case ARG_SKIPPED_TEXT:
arg = sv_2mortal(p_state->skipped_text);
p_state->skipped_text = newSVpvn("", 0);
break;
case ARG_OFFSET:
arg = sv_2mortal(newSViv(offset));
break;
case ARG_OFFSET_END:
arg = sv_2mortal(newSViv(offset + CHR_DIST(end, beg)));
break;
case ARG_LENGTH:
arg = sv_2mortal(newSViv(CHR_DIST(end, beg)));
break;
case ARG_LINE:
arg = sv_2mortal(newSViv(line));
break;
case ARG_COLUMN:
arg = sv_2mortal(newSViv(column));
break;
case ARG_EVENT:
assert(event >= 0 && event < EVENT_COUNT);
arg = sv_2mortal(newSVpv(event_id_str[event], 0));
break;
case ARG_LITERAL:
{
int len = (unsigned char)s[1];
arg = sv_2mortal(newSVpvn(s+2, len));
if (SvUTF8(h->argspec))
SvUTF8_on(arg);
s += len + 1;
}
break;
case ARG_UNDEF:
arg = sv_mortalcopy(&PL_sv_undef);
break;
default:
arg = sv_2mortal(newSVpvf("Bad argspec %d", *s));
break;
}
if (push_arg) {
if (!arg)
arg = sv_mortalcopy(&PL_sv_undef);
if (array) {
/* have to fix mortality here or add mortality to
* XPUSHs after removing it from the switch cases.
*/
av_push(array, SvREFCNT_inc(arg));
}
else {
XPUSHs(arg);
}
}
}
if (array) {
if (array != (AV*)h->cb)
av_push((AV*)h->cb, newRV_noinc((SV*)array));
}
else {
PUTBACK;
if ((enum argcode)*argspec == ARG_SELF && !SvROK(h->cb)) {
char *method = SvPV(h->cb, my_na);
perl_call_method(method, G_DISCARD | G_EVAL | G_VOID);
}
else {
perl_call_sv(h->cb, G_DISCARD | G_EVAL | G_VOID);
}
if (SvTRUE(ERRSV)) {
RETHROW;
}
FREETMPS;
LEAVE;
}
if (p_state->skipped_text)
SvCUR_set(p_state->skipped_text, 0);
return;
IGNORE_EVENT:
if (p_state->skipped_text) {
if (event != E_TEXT && p_state->pend_text && SvOK(p_state->pend_text))
flush_pending_text(p_state, self);
#ifdef UNICODE_HTML_PARSER
if (utf8 && !SvUTF8(p_state->skipped_text))
sv_utf8_upgrade(p_state->skipped_text);
if (utf8 || !SvUTF8(p_state->skipped_text)) {
#endif
sv_catpvn(p_state->skipped_text, beg, end - beg);
#ifdef UNICODE_HTML_PARSER
}
else {
SV *tmp = newSVpvn(beg, end - beg);
sv_utf8_upgrade(tmp);
sv_catsv(p_state->pend_text, tmp);
SvREFCNT_dec(tmp);
}
#endif
}
#undef CHR_DIST
return;
}
SV *p5_err_sv(PerlInterpreter *my_perl) {
PERL_SET_CONTEXT(my_perl);
return sv_mortalcopy(ERRSV);
}
SV *single_hook_call(pTHX_ SV *self, const char *hook_id_str, const char *id_pre,
const char *id, const SingleHook *hook, SV *in, int mortal)
{
dSP;
int count;
SV *out;
CT_DEBUG(MAIN, ("single_hook_call(hid='%s', id='%s%s', hook=%p, in=%p(%d), mortal=%d)",
hook_id_str, id_pre, id, hook, in, in ? (int) SvREFCNT(in) : 0, mortal));
assert(self != NULL);
assert(hook != NULL);
if (hook->sub == NULL)
return in;
ENTER;
SAVETMPS;
PUSHMARK(SP);
if (hook->arg)
{
I32 ix, len;
len = av_len(hook->arg);
for (ix = 0; ix <= len; ++ix)
{
SV **pSV = av_fetch(hook->arg, ix, 0);
SV *sv;
if (pSV == NULL)
fatal("NULL returned by av_fetch() in single_hook_call()");
if (SvROK(*pSV) && sv_isa(*pSV, ARGTYPE_PACKAGE))
{
HookArgType type = (HookArgType) SvIV(SvRV(*pSV));
switch (type)
{
case HOOK_ARG_SELF:
sv = sv_mortalcopy(self);
break;
case HOOK_ARG_DATA:
assert(in != NULL);
sv = sv_mortalcopy(in);
break;
case HOOK_ARG_TYPE:
assert(id != NULL);
sv = sv_newmortal();
if (id_pre)
{
sv_setpv(sv, id_pre);
sv_catpv(sv, CONST_CHAR(id));
}
else
sv_setpv(sv, id);
break;
case HOOK_ARG_HOOK:
if (hook_id_str)
{
sv = sv_newmortal();
sv_setpv(sv, hook_id_str);
}
else
{
sv = &PL_sv_undef;
}
break;
default:
fatal("Invalid hook argument type (%d) in single_hook_call()", type);
break;
}
}
else
sv = sv_mortalcopy(*pSV);
XPUSHs(sv);
}
}
else
{
if (in)
{
/* only push the data argument */
XPUSHs(in);
}
}
PUTBACK;
count = call_sv(hook->sub, G_SCALAR);
SPAGAIN;
if (count != 1)
fatal("Hook returned %d elements instead of 1", count);
out = POPs;
CT_DEBUG(MAIN, ("single_hook_call: in=%p(%d), out=%p(%d)",
in, in ? (int) SvREFCNT(in) : 0, out, (int) SvREFCNT(out)));
if (!mortal && in != NULL)
SvREFCNT_dec(in);
SvREFCNT_inc(out);
PUTBACK;
FREETMPS;
LEAVE;
if (mortal)
sv_2mortal(out);
CT_DEBUG(MAIN, ("single_hook_call: out=%p(%d)", out, (int) SvREFCNT(out)));
return out;
}
SV *p5_err_sv(PerlInterpreter *my_perl) {
return sv_mortalcopy(ERRSV);
}