SSize_t
PerlIOScalar_write(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
{
if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) {
Off_t offset;
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
SV *sv = s->var;
char *dst;
if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) {
dst = SvGROW(sv, SvCUR(sv) + count);
offset = SvCUR(sv);
s->posn = offset + count;
}
else {
if ((s->posn + count) > SvCUR(sv))
dst = SvGROW(sv, (STRLEN)s->posn + count);
else
dst = SvPV_nolen(sv);
offset = s->posn;
s->posn += count;
}
Move(vbuf, dst + offset, count, char);
if ((STRLEN) s->posn > SvCUR(sv))
SvCUR_set(sv, (STRLEN)s->posn);
SvPOK_on(s->var);
return count;
}
GLvoid * EL(SV * sv, int needlen)
{
STRLEN skip = 0;
SV * svref;
if (SvREADONLY(sv))
croak("Readonly value for buffer");
if(SvROK(sv)) {
svref = SvRV(sv);
sv = svref;
}
else
{
#ifdef USE_STRICT_UNGLOB
if (SvFAKE(sv) && SvTYPE(sv) == SVt_PVGV)
sv_unglob(sv);
#endif
SvUPGRADE(sv, SVt_PV);
SvGROW(sv, (unsigned int)(needlen + 1));
SvPOK_on(sv);
SvCUR_set(sv, needlen);
*SvEND(sv) = '\0'; /* Why is this here? -chm */
}
return SvPV_force(sv, skip);
}
IV
PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
STRLEN oldcur = SvCUR(s->var);
STRLEN newlen;
switch (whence) {
case SEEK_SET:
s->posn = offset;
break;
case SEEK_CUR:
s->posn = offset + s->posn;
break;
case SEEK_END:
s->posn = offset + SvCUR(s->var);
break;
}
if (s->posn < 0) {
if (ckWARN(WARN_LAYER))
Perl_warner(aTHX_ packWARN(WARN_LAYER), "Offset outside string");
SETERRNO(EINVAL, SS_IVCHAN);
return -1;
}
newlen = (STRLEN) s->posn;
if (newlen > oldcur) {
(void) SvGROW(s->var, newlen);
Zero(SvPVX(s->var) + oldcur, newlen - oldcur, char);
/* No SvCUR_set(), though. This is just a seek, not a write. */
}
void * pgtk_alloc_temp(int size)
{
dTHR;
SV * s = sv_2mortal(newSVpv("",0));
SvGROW(s, size);
memset(SvPV(s, PL_na), 0, size);
return SvPV(s, PL_na);
}
/* maxlen 0 = read one text line */
I32
Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
{
filter_t funcp;
SV *datasv = NULL;
if (!PL_rsfp_filters)
return -1;
if (idx > AvFILLp(PL_rsfp_filters)) { /* Any more filters? */
/* Provide a default input filter to make life easy. */
/* Note that we append to the line. This is handy. */
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: from rsfp\n", idx));
if (maxlen) {
/* Want a block */
int len ;
const int old_len = SvCUR(buf_sv);
/* ensure buf_sv is large enough */
SvGROW(buf_sv, (STRLEN)(old_len + maxlen)) ;
if ((len = PerlIO_read(PL_rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){
if (PerlIO_error(PL_rsfp))
return -1; /* error */
else
return 0 ; /* end of file */
}
SvCUR_set(buf_sv, old_len + len) ;
} else {
/* Want a line */
if (sv_gets(buf_sv, PL_rsfp, SvCUR(buf_sv)) == NULL) {
if (PerlIO_error(PL_rsfp))
return -1; /* error */
else
return 0 ; /* end of file */
}
}
return SvCUR(buf_sv);
}
/* Skip this filter slot if filter has been deleted */
if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef) {
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: skipped (filter deleted)\n",
idx));
return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
}
/* Get function pointer hidden within datasv */
funcp = DPTR2FPTR(filter_t, IoANY(datasv));
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: via function %p (%s)\n",
idx, datasv, SvPV_nolen_const(datasv)));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
return (*funcp)(aTHX_ idx, buf_sv, maxlen);
}
SSize_t
PerlIOScalar_unread(pTHX_ PerlIO * f, const void *vbuf, Size_t count)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
char *dst = SvGROW(s->var, (STRLEN)s->posn + count);
Move(vbuf, dst + s->posn, count, char);
s->posn += count;
SvCUR_set(s->var, (STRLEN)s->posn);
SvPOK_on(s->var);
return count;
}
void* get_mortalspace( int n, char packtype ) {
/* n is the number of elements of space required, packtype is 'f' or 'i' */
SV* work;
int * dummy;
if (packtype!='f' && packtype!='i' && packtype!='d'
&& packtype!='u' && packtype!='s' && packtype!='v')
Perl_croak(aTHX_ "Programming error: invalid type conversion specified to get_mortalspace");
work = sv_2mortal(newSVpv("", 0));
if (packtype=='f')
SvGROW( work, sizeof(float)*n ); /* Pregrow for efficiency */
if (packtype=='i')
SvGROW( work, sizeof(int)*n );
if (packtype=='d')
SvGROW( work, sizeof(double)*n);
if (packtype=='u')
SvGROW( work, sizeof(char)*n);
if (packtype=='s')
SvGROW( work, sizeof(short)*n);
if (packtype=='v')
SvGROW( work, sizeof(dummy)*n);
return (void *) SvPV(work, PL_na);
}
static
int
nkf_putchar_grow(unsigned int c)
{
/* extends string length */
o_len += incsize;
SvGROW(result, o_len);
/* to avoid linear growing, increase extension size */
incsize *= 2;
output = SvPVX(result);
/* SvPV(result,o_len) breaks o_len */
return output[output_ctr++] = c;
}
void
Perl_set_version(pTHX_ const char *name, STRLEN nlen, const char *strval, STRLEN plen, NV nvval)
{
SV* ver = GvSV(gv_add_by_type(gv_fetchpvn(name, nlen, GV_ADD, SVt_PVNV),
SVt_PVNV));
PERL_ARGS_ASSERT_SET_VERSION;
SvREADONLY_off(ver);
SvUPGRADE(ver, SVt_PVNV);
SvPVX(ver) = SvGROW(ver, plen+1);
Move(strval, SvPVX(ver), plen, char);
SvCUR_set(ver, plen);
SvNVX(ver) = nvval;
/* not the PROTECT bit */
SvFLAGS(ver) |= (SVf_NOK|SVp_NOK|SVf_POK|SVp_POK|SVf_READONLY);
}
IV
PerlIOScalar_seek(pTHX_ PerlIO * f, Off_t offset, int whence)
{
PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar);
switch (whence) {
case 0:
s->posn = offset;
break;
case 1:
s->posn = offset + s->posn;
break;
case 2:
s->posn = offset + SvCUR(s->var);
break;
}
if ((STRLEN) s->posn > SvCUR(s->var)) {
(void) SvGROW(s->var, (STRLEN) s->posn);
}
return 0;
}
void pdl_grow (pdl* a, int newsize) {
SV* foo;
HV* hash;
STRLEN nbytes;
STRLEN ncurr;
STRLEN len;
if(a->state & PDL_DONTTOUCHDATA) {
die("Trying to touch data of an untouchable (mmapped?) pdl");
}
if(a->datasv == NULL)
a->datasv = newSVpv("",0);
foo = a->datasv;
nbytes = ((STRLEN) newsize) * pdl_howbig(a->datatype);
ncurr = SvCUR( foo );
if (ncurr == nbytes)
return; /* Nothing to be done */
/* We don't want to do this: if someone is resizing it
* but wanting to preserve data.. */
#ifdef FEOIJFOESIJFOJE
if (ncurr>nbytes) /* Nuke back to zero */
sv_setpvn(foo,"",0);
#endif
if(nbytes > (1024*1024*1024)) {
SV *sv = get_sv("PDL::BIGPDL",0);
if(sv == NULL || !(SvTRUE(sv)))
die("Probably false alloc of over 1Gb PDL! (set $PDL::BIGPDL = 1 to enable)");
fflush(stdout);
}
{
void *p;
p = SvGROW ( foo, nbytes ); SvCUR_set( foo, nbytes );
}
a->data = (void *) SvPV( foo, len ); a->nvals = newsize;
}
static void
grow_gap(pTHX_ SV* sv, STRLEN grow, char** t, char** s, char** e)
{
/*
SvPVX ---> AAAAAA...BBBBBB
^ ^ ^
t s e
*/
STRLEN t_offset = *t - SvPVX(sv);
STRLEN s_offset = *s - SvPVX(sv);
STRLEN e_offset = *e - SvPVX(sv);
SvGROW(sv, e_offset + grow + 1);
*t = SvPVX(sv) + t_offset;
*s = SvPVX(sv) + s_offset;
*e = SvPVX(sv) + e_offset;
Move(*s, *s+grow, *e - *s, char);
*s += grow;
*e += grow;
}
STDCHAR *
PerlIOEncode_get_base(pTHX_ PerlIO * f)
{
PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
if (!e->base.bufsiz)
e->base.bufsiz = 1024;
if (!e->bufsv) {
e->bufsv = newSV(e->base.bufsiz);
sv_setpvn(e->bufsv, "", 0);
}
e->base.buf = (STDCHAR *) SvPVX(e->bufsv);
if (!e->base.ptr)
e->base.ptr = e->base.buf;
if (!e->base.end)
e->base.end = e->base.buf;
if (e->base.ptr < e->base.buf
|| e->base.ptr > e->base.buf + SvLEN(e->bufsv)) {
Perl_warn(aTHX_ " ptr %p(%p)%p", e->base.buf, e->base.ptr,
e->base.buf + SvLEN(e->bufsv));
abort();
}
if (SvLEN(e->bufsv) < e->base.bufsiz) {
SSize_t poff = e->base.ptr - e->base.buf;
SSize_t eoff = e->base.end - e->base.buf;
e->base.buf = (STDCHAR *) SvGROW(e->bufsv, e->base.bufsiz);
e->base.ptr = e->base.buf + poff;
e->base.end = e->base.buf + eoff;
}
if (e->base.ptr < e->base.buf
|| e->base.ptr > e->base.buf + SvLEN(e->bufsv)) {
Perl_warn(aTHX_ " ptr %p(%p)%p", e->base.buf, e->base.ptr,
e->base.buf + SvLEN(e->bufsv));
abort();
}
return e->base.buf;
}
void HRXSATTR_ithread_postdup(SV *newself, SV *newtable, HV *ptr_map)
{
hrattr_simple *attr = attr_from_sv(SvRV(newself));
HR_DEBUG("Fetching new attrhash_ref");
SV *new_attrhash_ref = hr_dup_newsv_for_oldsv(ptr_map, attr->attrhash, 0);
attr->attrhash = (HV*)SvRV(new_attrhash_ref);
SvREFCNT_inc(attr->attrhash); /*Because the copy hash will soon be deleted*/
attr->table = SvRV(newtable);
HR_DEBUG("New attrhash: %p", attr->attrhash);
/*Now do the equivalent of: my @keys = keys %attrhash; foreach my $key (@keys)*/
int n_keys = hv_iterinit(attr->attrhash);
if(n_keys) {
char **keylist = NULL;
char **klist_head = NULL;
int tmp_len, i;
HR_DEBUG("Have %d keys", n_keys);
Newx(keylist, n_keys, char*);
klist_head = keylist;
while(hv_iternextsv(attr->attrhash, keylist++, &tmp_len));
/*No body*/
for(i=0, keylist = klist_head; i < n_keys; i++) {
HR_DEBUG("Key: %s", keylist[i]);
SV *stored = hv_delete(attr->attrhash, keylist[i], strlen(keylist[i]), 0);
assert(stored);
assert(SvROK(stored));
mk_ptr_string(new_s, SvRV(stored));
hv_store(attr->attrhash, new_s, strlen(new_s), stored, 0);
HR_Action v_actions[] = {
HR_DREF_FLDS_ptr_from_hv(SvRV(stored), new_attrhash_ref),
HR_ACTION_LIST_TERMINATOR
};
HR_DEBUG("Will add new actions for value in attrhash");
HR_add_actions_real(stored, v_actions);
}
Safefree(klist_head);
}
HR_Action attr_actions[] = {
HR_DREF_FLDS_arg_for_cfunc(SvRV(newself), &attr_destroy_trigger),
HR_ACTION_LIST_TERMINATOR
};
HR_DEBUG("Will add new actions for attribute object");
HR_add_actions_real(newself, attr_actions);
if(attr->encap) {
hrattr_encap *aencap = attr_encap_cast(attr);
SV *new_encap = hr_dup_newsv_for_oldsv(ptr_map, aencap->obj_paddr, 1);
char *ainfo = (char*)hr_dup_get_kinfo(
ptr_map, HR_DUPKEY_AENCAP, aencap->obj_paddr);
if(*ainfo == HRK_DUP_WEAK_ENCAP) {
sv_rvweaken(new_encap);
}
HR_Action encap_actions[] = {
HR_DREF_FLDS_arg_for_cfunc(SvRV(newself), (SV*)&encap_attr_destroy_hook),
HR_ACTION_LIST_TERMINATOR
};
HR_DEBUG("Will add actions for new encapsulated object");
HR_add_actions_real(new_encap, encap_actions);
aencap->obj_rv = new_encap;
aencap->obj_paddr = (char*)SvRV(new_encap);
/*We also need to change our key string...*/
char *oldstr = attr_strkey(aencap, sizeof(hrattr_encap));
char *oldptr = strrchr(oldstr, HR_PREFIX_DELIM[0]);
assert(oldptr);
HR_DEBUG("Old attr string: %s", oldstr);
oldptr++;
*(oldptr) = '\0';
mk_ptr_string(newptr, aencap->obj_paddr);
SvGROW(SvRV(newself), sizeof(hrattr_encap)
+strlen(oldstr)+strlen(newptr)+1);
strcat(oldstr, newptr);
HR_DEBUG("New string: %s", oldstr);
}
}
MP_INLINE static apr_size_t modperl_filter_read(pTHX_
modperl_filter_t *filter,
SV *buffer,
apr_size_t wanted)
{
int num_buckets = 0;
apr_size_t len = 0;
(void)SvUPGRADE(buffer, SVt_PV);
SvCUR(buffer) = 0;
/* calling SvPOK_only here may leave buffer an invalid state since
* SvPVX may be NULL. But it's very likely that something is copied.
* So, we turn the POK flag on here. Later we check if SvPVX is NULL
* and turn the flag off again if so. */
SvPOK_only(buffer);
/* sometimes the EOS bucket arrives in the same brigade with other
* buckets, so that particular read() will not return 0 and will
* be called again if called in the while ($filter->read(...))
* loop. In that case we return 0.
*/
if (filter->seen_eos) {
return 0;
}
/* modperl_brigade_dump(filter->bb_in, NULL); */
MP_TRACE_f(MP_FUNC, MP_FILTER_NAME_FORMAT
"wanted: %db",
MP_FILTER_NAME(filter->f),
wanted);
if (filter->remaining) {
if (filter->remaining >= wanted) {
MP_TRACE_f(MP_FUNC, MP_FILTER_NAME_FORMAT
"eating and returning %d [%s]\n\tof "
"remaining %db",
MP_FILTER_NAME(filter->f),
wanted,
MP_TRACE_STR_TRUNC(filter->pool, filter->leftover, wanted),
filter->remaining);
SvGROW(buffer, wanted+1);
sv_catpvn(buffer, filter->leftover, wanted);
filter->leftover += wanted;
filter->remaining -= wanted;
return wanted;
}
else {
MP_TRACE_f(MP_FUNC, MP_FILTER_NAME_FORMAT
"eating remaining %db",
MP_FILTER_NAME(filter->f),
filter->remaining);
SvGROW(buffer, filter->remaining+1);
sv_catpvn(buffer, filter->leftover, filter->remaining);
len = filter->remaining;
filter->remaining = 0;
filter->leftover = NULL;
}
}
while (1) {
const char *buf;
apr_size_t buf_len;
if (!get_bucket(filter)) {
break;
}
num_buckets++;
filter->rc = apr_bucket_read(filter->bucket, &buf, &buf_len, 0);
if (filter->rc == APR_SUCCESS) {
MP_TRACE_f(MP_FUNC,
MP_FILTER_NAME_FORMAT
"read in: %s bucket with %db (0x%lx)",
MP_FILTER_NAME(filter->f),
filter->bucket->type->name,
buf_len,
(unsigned long)filter->bucket);
}
else {
SvREFCNT_dec(buffer);
modperl_croak(aTHX_ filter->rc, "Apache2::Filter::read");
}
if (buf_len) {
if ((SvCUR(buffer) + buf_len) >= wanted) {
int nibble = wanted - SvCUR(buffer);
SvGROW(buffer, SvCUR(buffer)+nibble+1);
sv_catpvn(buffer, buf, nibble);
filter->leftover = (char *)buf+nibble;
filter->remaining = buf_len - nibble;
len += nibble;
break;
}
else {
len += buf_len;
SvGROW(buffer, SvCUR(buffer)+buf_len+1);
sv_catpvn(buffer, buf, buf_len);
}
}
}
if (!SvPVX(buffer)) {
SvPOK_off(buffer);
}
MP_TRACE_f(MP_FUNC,
MP_FILTER_NAME_FORMAT
"return: %db from %d bucket%s [%s]\n\t(%db leftover)",
MP_FILTER_NAME(filter->f),
len, num_buckets, ((num_buckets == 1) ? "" : "s"),
MP_TRACE_STR_TRUNC(filter->pool, SvPVX(buffer), len),
filter->remaining);
return len;
}
void _mpack_item(SV *res, SV *o)
{
size_t len, res_len, new_len;
char *s, *res_s;
res_s = SvPVbyte(res, res_len);
unsigned i;
if (!SvOK(o)) {
new_len = res_len + mp_sizeof_nil();
res_s = SvGROW(res, new_len);
SvCUR_set(res, new_len);
mp_encode_nil(res_s + res_len);
return;
}
if (SvROK(o)) {
o = SvRV(o);
if (SvOBJECT(o)) {
SvGETMAGIC(o);
HV *stash = SvSTASH(o);
GV *mtd = gv_fetchmethod_autoload(stash, "msgpack", 0);
if (!mtd)
croak("Object has no method 'msgpack'");
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs (sv_bless (sv_2mortal (newRV_inc(o)), stash));
PUTBACK;
call_sv((SV *)GvCV(mtd), G_SCALAR);
SPAGAIN;
SV *pkt = POPs;
if (!SvOK(pkt))
croak("O->msgpack returned undef");
s = SvPV(pkt, len);
new_len = res_len + len;
res_s = SvGROW(res, new_len);
SvCUR_set(res, new_len);
memcpy(res_s + res_len, s, len);
PUTBACK;
FREETMPS;
LEAVE;
return;
}
switch(SvTYPE(o)) {
case SVt_PVAV: {
AV *a = (AV *)o;
len = av_len(a) + 1;
new_len = res_len + mp_sizeof_array(len);
res_s = SvGROW(res, new_len);
SvCUR_set(res, new_len);
mp_encode_array(res_s + res_len, len);
for (i = 0; i < len; i++) {
SV **item = av_fetch(a, i, 0);
if (!item)
_mpack_item(res, 0);
else
_mpack_item(res, *item);
}
break;
}
case SVt_PVHV: {
HV *h = (HV *)o;
len = hv_iterinit(h);
new_len = res_len + mp_sizeof_map(len);
res_s = SvGROW(res, new_len);
SvCUR_set(res, new_len);
mp_encode_map(res_s + res_len, len);
for (;;) {
HE * iter = hv_iternext(h);
if (!iter)
break;
SV *k = hv_iterkeysv(iter);
SV *v = HeVAL(iter);
_mpack_item(res, k);
_mpack_item(res, v);
}
break;
}
default:
croak("Can't serialize reference");
}
return;
}
switch(SvTYPE(o)) {
case SVt_PV:
case SVt_PVIV:
case SVt_PVNV:
case SVt_PVMG:
case SVt_REGEXP:
if (!looks_like_number(o)) {
s = SvPV(o, len);
new_len = res_len + mp_sizeof_str(len);
res_s = SvGROW(res, new_len);
SvCUR_set(res, new_len);
mp_encode_str(res_s + res_len, s, len);
break;
}
case SVt_NV: {
NV v = SvNV(o);
IV iv = (IV)v;
if (v != iv) {
new_len = res_len + mp_sizeof_double(v);
res_s = SvGROW(res, new_len);
SvCUR_set(res, new_len);
mp_encode_double(res_s + res_len, v);
break;
}
}
case SVt_IV: {
IV v = SvIV(o);
if (v >= 0) {
new_len = res_len + mp_sizeof_uint(v);
res_s = SvGROW(res, new_len);
SvCUR_set(res, new_len);
mp_encode_uint(res_s + res_len, v);
} else {
new_len = res_len + mp_sizeof_int(v);
res_s = SvGROW(res, new_len);
SvCUR_set(res, new_len);
mp_encode_int(res_s + res_len, v);
}
break;
}
default:
croak("Internal msgpack error %d", SvTYPE(o));
}
}
SV * parse_in_chunks(char * filepath, size_t filesize) {
char *buf;
size_t bytes_read = 0;
int max_buf = 1000;
char *err_msg;
int block = BLOCK_HEADER;
int cur_event_type = 0;
int event_type = 0;
char event_block = 0;
char *brnl, *breq;
AV * data;
AV * datawrapper;
AV * events;
char *line;
char * nl = "\n";
char * eq = "=";
int rewind_pos = 0;
size_t cur_fpos = 0;
SV * pbuf;
SV * pmax_buf;
AV * HANDLERS = get_av("Opsview::Utils::NDOLogsImporter::HANDLERS", 0);
AV * INPUT_DATA_TYPE = get_av("Opsview::Utils::NDOLogsImporter::INPUT_DATA_TYPE", 0);
int init_last_pos;
int init_block;
if ( first_read ) {
if ( ! ( fh = PerlIO_open( filepath, "rb" ) ) ) {
croak("Could not open file: %s\n", strerror(errno));
}
bytes_left = filesize;
init_last_pos = prev_pos = first_read = 0;
init_block = block = BLOCK_HEADER;
} else {
init_block = block = BLOCK_EVENTS;
init_last_pos = prev_pos;
}
read_begin:
brnl = NULL;
breq = NULL;
pbuf = get_sv("Opsview::Utils::NDOLogsImporter::PARSE_BUF", 0);
pmax_buf = get_sv("Opsview::Utils::NDOLogsImporter::MAX_BUF_SIZE", 0);
buf = SvPVX(pbuf);
max_buf = SvIVX(pmax_buf);
if ( max_buf < 1024 * 1024 && ! automated_tests ) {
max_buf = 1024*1024;
SvIV_set( pmax_buf, max_buf );
SvGROW( pbuf, max_buf + 1);
SvCUR_set( pbuf, max_buf);
}
if ( bytes_left > 0 ) {
bytes_read = PerlIO_read(fh, buf + prev_pos, max_buf-prev_pos);
cur_fpos = PerlIO_tell(fh);
if ( bytes_read < 0 ) {
err_msg = strerror(errno);
PerlIO_close( fh );
croak("Could not read file: %s\n", err_msg);
}
bytes_left -= bytes_read;
events = (AV *)sv_2mortal((SV *)newAV());
rewind_pos = last_999(buf+prev_pos, bytes_read);
prev_pos = bytes_read + prev_pos - rewind_pos;
buf[prev_pos] = '\0';
// avg ratio events:file_size = 0.21%
if ( prev_pos > 1000 ) {
av_extend( events, (int)(prev_pos * 0.0021) );
}
for ( line = strtok_r(buf, nl, &brnl); line != NULL; line = strtok_r(NULL, nl, &brnl) )
{
switch(block) {
case BLOCK_HEADER:
{
if ( strEQ(line, "STARTDATADUMP") ) {
block = BLOCK_EVENTS;
}
}
break;
case BLOCK_EVENTS:
{
if ( strEQ(line, "1000") ) { /* NDO_API_ENDDATADUMP */
block = BLOCK_FOOTER;
continue;
}
cur_event_type = atoi(line);
/* ignore events we are not handling */
if ( ! av_exists(HANDLERS, cur_event_type) ) {
block = BLOCK_IGNORE_EVENT;
continue;
}
event_block = BLOCK_EVENT_STARTED;
if ( cur_event_type != event_type ) {
datawrapper = (AV *)sv_2mortal((SV *)newAV());
data = (AV *)sv_2mortal((SV *)newAV());
av_push( events, newSViv( cur_event_type ) );
av_push( datawrapper, newRV( (SV *)data ) );
av_push( events, newRV( (SV *)datawrapper ) );
event_type = cur_event_type;
} else {
data = (AV *)sv_2mortal((SV *)newAV());
av_push( datawrapper, newRV( (SV *)data ) );
}
block = BLOCK_EVENT;
}
break;
case BLOCK_EVENT:
{
if ( strEQ(line, "999") ) { /* NDO_API_ENDDATA */
block = BLOCK_EVENTS;
event_block = BLOCK_EVENT_ENDED;
} else {
char *k;
char *v;
int key;
int key_type = 0;
int v_len = 0;
k = strtok_r(line, eq, &breq);
v = strtok_r(NULL, "\0", &breq);
key = atoi(k);
/* invalid key, skip parsing */
if ( key == 0 ) {
goto remove_invalid;
}
SV ** const k_type = av_fetch(INPUT_DATA_TYPE, key, 0 );
if ( k_type ) {
key_type = SvIVx( *k_type );
}
if ( v ) {
if ( key_type & 1 ) {
v_len = ndo_unescape_buffer( v );
} else {
v_len = strlen(v);
}
}
if ( key_type & 2 ) {
AV * datanstptr;
SV ** const datanst = av_fetch(data, key, 0 );
if ( datanst ) {
datanstptr = (AV *)SvRV( *datanst );
} else {
datanstptr = (AV *)sv_2mortal((SV *)newAV());
av_store( data, key, newRV( (SV *)datanstptr ) );
}
if ( v ) {
av_push( datanstptr, newSVpvn(v, v_len) );
} else {
av_push( datanstptr, newSVpvn("", 0) );
}
} else {
if ( v ) {
av_store( data, key, newSVpvn(v, v_len) );
} else {
av_store( data, key, newSVpvn("", 0) );
}
}
}
}
break;
case BLOCK_FOOTER:
{
if ( strEQ(line, "GOODBYE") ) {
block = BLOCK_HEADER;
}
}
break;
case BLOCK_IGNORE_EVENT:
{
if ( strEQ(line, "999") ) { /* NDO_API_ENDDATA */
block = BLOCK_EVENTS; // go back to EVENTS
continue;
}
}
break;
}
};
/* there were some events */
if ( event_block != BLOCK_HEADER ) {
if ( event_block != BLOCK_EVENT_ENDED ) {
remove_invalid:
av_pop( datawrapper );
}
/* remove whole block if the last block has no events */
if ( av_len( datawrapper ) == -1 ) {
av_pop( events );
av_pop( events );
}
}
if ( av_len(events) > 0 ) {
if ( rewind_pos > 0 && cur_fpos < filesize ) {
memmove(buf, buf+prev_pos+1, rewind_pos-1);
}
prev_pos = rewind_pos - 1;
return newRV_inc((SV *) events);
} else {
if ( cur_fpos < filesize && event_block != BLOCK_HEADER && event_block != BLOCK_EVENT_ENDED ) {
int new_max_buf = max_buf * 2;
SvIV_set( pmax_buf, new_max_buf );
SvGROW( pbuf, new_max_buf + 1);
SvCUR_set( pbuf, new_max_buf);
//start again as previous buffer would be tokenized already
prev_pos = 0;
block = init_block;
event_type = 0;
PerlIO_close( fh );
if ( ! ( fh = PerlIO_open( filepath, "rb" ) ) ) {
croak("Could not re-open file: %s\n", strerror(errno));
}
PerlIO_seek(fh, cur_fpos-bytes_read-init_last_pos, SEEK_SET);
bytes_left += bytes_read + init_last_pos;
goto read_begin;
}
}
}
parser_reset_iterator();
return &PL_sv_undef;
}
void* pack2D_sz ( SV* arg, char packtype, int *nx, int *ny ) {
int iscalar;
float scalar;
short sscalar;
double dscalar;
unsigned char uscalar;
AV* array;
AV* array2 = Nullav;
I32 i,j,n,m,m_old;
SV* work;
SV** work2;
double nval = 0.0;
int isref;
STRLEN len;
if (nx != NULL) *nx = -1;
if (ny != NULL) *ny = -1;
m_old = -1;
if (is_scalar_ref(arg)) /* Scalar ref */
return (void*) SvPV(SvRV(arg), len);
if (packtype!='f' && packtype!='i' && packtype!='d' && packtype!='s'
&& packtype!='u')
croak("Programming error: invalid type conversion specified to pack2D");
/* Is arg a scalar? Return pointer to char part */
if (!SvROK(arg) && SvTYPE(arg)!=SVt_PVGV) { return (void *) SvPV(arg, PL_na); }
/*
Create a work char variable - be cunning and make it a mortal *SV
which will go away automagically when we leave the current
context, i.e. no need to malloc and worry about freeing - thus
we can use pack2D in a typemap!
*/
work = sv_2mortal(newSVpv("", 0));
/* Is it a glob or reference to an array? */
if (SvTYPE(arg)==SVt_PVGV || (SvROK(arg) && SvTYPE(SvRV(arg))==SVt_PVAV)) {
if (SvTYPE(arg)==SVt_PVGV) {
array = GvAVn((GV*) arg); /* glob */
}else{
array = (AV *) SvRV(arg); /* reference */
}
n = av_len(array);
if (nx != NULL) *nx = n + 1;
/* Pack array into string */
for(i=0; i<=n; i++) { /* Loop over 1st dimension */
work2 = av_fetch( array, i, 0 ); /* Fetch */
isref = work2!=NULL && SvROK(*work2); /* Is is a reference */
if (isref) {
array2 = (AV *) SvRV(*work2); /* array of 2nd dimension */
m = av_len(array2); /* Length */
} else {
m=0; /* 1D array */
nval = SvNV(*work2);
}
/* first time around store value in m_old else compare*/
if (m_old != -1 && m_old != m)
Perl_croak(aTHX_ "2D array is not rectangular. Row %d has %d elements, not %d",(n+1),(m+1),(m_old+1));
m_old = m;
/* Pregrow storage for efficiency on first row - note assumes
array is rectangular but better than nothing */
if (i==0) {
if (packtype=='f')
SvGROW( work, sizeof(float)*(n+1)*(m+1) );
if (packtype=='i')
SvGROW( work, sizeof(int)*(n+1)*(m+1) );
if (packtype=='s')
SvGROW( work, sizeof(short)*(n+1)*(m+1) );
if (packtype=='u')
SvGROW( work, sizeof(char)*(n+1)*(m+1) );
if (packtype=='d')
SvGROW( work, sizeof(double)*(n+1)*(m+1) );
}
for(j=0; j<=m; j++) { /* Loop over 2nd dimension */
if (isref) {
work2 = av_fetch( array2, j, 0 ); /* Fetch element */
if (work2==NULL)
nval = 0.0; /* Undefined */
else {
if (SvROK(*work2))
goto errexit; /* Croak if reference [i.e. not 1D] */
nval = SvNV(*work2);
}
}
if (packtype=='d') {
dscalar = (double) nval;
sv_catpvn( work, (char *) &dscalar, sizeof(double));
}
if (packtype=='f') {
scalar = (float) nval;
sv_catpvn( work, (char *) &scalar, sizeof(float));
}
if (packtype=='i') {
iscalar = (int) nval;
sv_catpvn( work, (char *) &iscalar, sizeof(int));
}
if (packtype=='s') {
sscalar = (short) nval;
sv_catpvn( work, (char *) &sscalar, sizeof(short));
}
if (packtype=='u') {
uscalar = (unsigned char) nval;
sv_catpvn( work, (char *) &uscalar, sizeof(char));
}
}
}
/* Store ny */
if (ny != NULL) *ny = m + 1;
/* Return a pointer to the byte array */
return (void *) SvPV(work, PL_na);
}
errexit:
croak("Routine can only handle scalar packed char values or refs to 1D or 2D arrays");
}
void _parse_header(pTHX_ srl_splitter_t *splitter) {
int magic_string = 1;
int high_magic_string = 1;
U8 version_encoding;
U8 version;
U8 encoding_flags;
UV header_len;
int is_zlib_encoded = 0;
int is_snappy_encoded = 0;
int is_snappyincr_encoded = 0;
// SRL_MAGIC_STRLEN + PROTOCOL_LENGTH + OPTIONAL-HEADER-SIZE(at least 1 byte) + DATA(at least 1 byte)
if (splitter->input_len < SRL_MAGIC_STRLEN + 1 + 1 + 1){
croak("input Sereal string lacks data");
} else if ( (high_magic_string = strncmp(splitter->input_str, SRL_MAGIC_STRING, SRL_MAGIC_STRLEN))
&& (magic_string = strncmp(splitter->input_str, SRL_MAGIC_STRING_HIGHBIT, SRL_MAGIC_STRLEN)) ) {
croak("input Sereal string has wrong Sereal magic");
}
splitter->pos += SRL_MAGIC_STRLEN;
version_encoding = (U8)*(splitter->pos);
version = (U8)(version_encoding & SRL_PROTOCOL_VERSION_MASK);
encoding_flags = (U8)(version_encoding & SRL_PROTOCOL_ENCODING_MASK);
if ( version <= 0
|| ( version < 3 && high_magic_string )
|| ( version > 2 && magic_string ) ) {
croak("unsupported Sereal versions/protocol");
}
switch(encoding_flags) {
case SRL_PROTOCOL_ENCODING_RAW:
/* no op */
SRL_SPLITTER_TRACE("encoding is raw %s", "");
break;
case SRL_PROTOCOL_ENCODING_SNAPPY:
SRL_SPLITTER_TRACE("encoding is snappy %s", "");
is_snappy_encoded = 1;
break;
case SRL_PROTOCOL_ENCODING_SNAPPY_INCREMENTAL:
SRL_SPLITTER_TRACE("encoding is snappy incr %s", "");
is_snappy_encoded = is_snappyincr_encoded = 1;
break;
case SRL_PROTOCOL_ENCODING_ZLIB:
SRL_SPLITTER_TRACE("encoding is zlib %s", "");
is_zlib_encoded = 1;
break;
default:
croak("Sereal document encoded in an unknown format");
}
SRL_SPLITTER_TRACE("header version is %hhu", version);
// move after protocol version
splitter->pos += 1;
header_len= _read_varint_uv_nocheck(splitter);
SRL_SPLITTER_TRACE("header len is %lu", header_len);
//TODO: add code for processing the header
splitter->pos += header_len;
if (version < 2) {
splitter->input_body_pos = splitter->input_str;
} else {
splitter->input_body_pos = splitter->pos;
}
if (is_snappy_encoded) {
UV compressed_len;
uint32_t uncompressed_len;
int decompress_ok;
char * new_input_str;
if (is_snappyincr_encoded) {
compressed_len = _read_varint_uv_nocheck(splitter);
} else {
compressed_len = splitter->input_len - (splitter->pos - splitter->input_str);
}
SRL_SPLITTER_TRACE("snappy compressed len %"UVuf, compressed_len);
// splitter->pos is now at start of compressed payload
int snappy_header_len;
char *old_pos;
old_pos = splitter->pos;
snappy_header_len = csnappy_get_uncompressed_length(
(char *)old_pos,
compressed_len,
&uncompressed_len
);
if (snappy_header_len == CSNAPPY_E_HEADER_BAD) {
croak("invalid Snappy header in Snappy-compressed Sereal packet");
}
// allocate a new SV for uncompressed data
SvREFCNT_dec(splitter->input_sv);
splitter->input_sv = newSVpvs("");
new_input_str = SvGROW(splitter->input_sv, uncompressed_len);
decompress_ok = csnappy_decompress_noheader((char *) (old_pos + snappy_header_len),
compressed_len - snappy_header_len,
(char *) new_input_str,
&uncompressed_len);
if ( decompress_ok != 0 ) {
croak("Snappy decompression of Sereal packet payload failed");
}
splitter->input_str = new_input_str;
SRL_SPLITTER_TRACE(" decompress OK: uncompressed length: %d\n", uncompressed_len);
splitter->pos = splitter->input_str;;
splitter->input_len = uncompressed_len;
splitter->input_body_pos = splitter->pos;
} else if (is_zlib_encoded) {
UV uncompressed_len = _read_varint_uv_nocheck(splitter);
UV compressed_len = _read_varint_uv_nocheck(splitter);
char * new_input_str;
// splitter->pos is now at start of compressed payload
SRL_SPLITTER_TRACE("unzipping %s", "");
SRL_SPLITTER_TRACE("compressed_len : %" UVuf, compressed_len);
SRL_SPLITTER_TRACE("uncompressed_len : %" UVuf, uncompressed_len);
mz_ulong tmp = uncompressed_len;
// allocate a new SV for uncompressed data
SvREFCNT_dec(splitter->input_sv);
splitter->input_sv = newSVpvs("");
new_input_str = SvGROW(splitter->input_sv, uncompressed_len);
char *compressed = splitter->pos;
int decompress_ok = mz_uncompress( (unsigned char *) new_input_str,
&tmp,
(const unsigned char *) compressed,
compressed_len );
if (decompress_ok != Z_OK)
croak("ZLIB decompression of Sereal packet payload failed");
splitter->input_str = new_input_str;
SRL_SPLITTER_TRACE(" decompress OK: length %lu\n", uncompressed_len);
splitter->pos = splitter->input_str;
splitter->input_len = (STRLEN)tmp;
splitter->input_body_pos = splitter->pos;
}
}
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;
}
void* pack1D_sz( SV* arg, char packtype, int * nelem) {
int iscalar;
float scalar;
double dscalar;
short sscalar;
unsigned char uscalar;
AV* array;
I32 i,n;
SV* work;
SV** work2;
double nval;
STRLEN len;
/* assume no size known */
if (nelem != NULL) *nelem = -1;
if (is_scalar_ref(arg)) /* Scalar ref */
return (void*) SvPV(SvRV(arg), len);
if (packtype!='f' && packtype!='i' && packtype!='d' && packtype!='s'
&& packtype != 'u')
Perl_croak(aTHX_ "Programming error: invalid type conversion specified to pack1D");
/*
Create a work char variable - be cunning and make it a mortal *SV
which will go away automagically when we leave the current
context, i.e. no need to malloc and worry about freeing - thus
we can use pack1D in a typemap!
*/
work = sv_2mortal(newSVpv("", 0));
/* Is arg a scalar? Return scalar*/
if (!SvROK(arg) && SvTYPE(arg)!=SVt_PVGV) {
if (packtype=='f') {
scalar = (float) SvNV(arg); /* Get the scalar value */
sv_setpvn(work, (char *) &scalar, sizeof(float)); /* Pack it in */
}
if (packtype=='i') {
iscalar = (int) SvNV(arg); /* Get the scalar value */
sv_setpvn(work, (char *) &iscalar, sizeof(int)); /* Pack it in */
}
if (packtype=='d') {
dscalar = (double) SvNV(arg); /*Get the scalar value */
sv_setpvn(work, (char *) &dscalar, sizeof(double)); /* Pack it in */
}
if (packtype=='s') {
sscalar = (short) SvNV(arg); /*Get the scalar value */
sv_setpvn(work, (char *) &sscalar, sizeof(short)); /* Pack it in */
}
if (packtype=='u') {
uscalar = (unsigned char) SvNV(arg); /*Get the scalar value */
sv_setpvn(work, (char *) &uscalar, sizeof(char)); /* Pack it in */
}
return (void *) SvPV(work, PL_na); /* Return the pointer */
}
/* Is it a glob or reference to an array? */
if (SvTYPE(arg)==SVt_PVGV || (SvROK(arg) && SvTYPE(SvRV(arg))==SVt_PVAV)) {
if (SvTYPE(arg)==SVt_PVGV) {
array = (AV *) GvAVn((GV*) arg); /* glob */
}else{
array = (AV *) SvRV(arg); /* reference */
}
n = av_len(array);
if ( nelem != NULL )
*nelem = n + 1;
if (packtype=='f')
SvGROW( work, sizeof(float)*(n+1) ); /* Pregrow for efficiency */
if (packtype=='i')
SvGROW( work, sizeof(int)*(n+1) );
if (packtype=='d')
SvGROW( work, sizeof(double)*(n+1) );
if (packtype=='s')
SvGROW( work, sizeof(short)*(n+1) );
if (packtype=='u')
SvGROW( work, sizeof(char)*(n+1) );
/* Pack array into string */
for(i=0; i<=n; i++) {
work2 = av_fetch( array, i, 0 ); /* Fetch */
if (work2==NULL)
nval = 0.0; /* Undefined */
else {
if (SvROK(*work2))
goto errexit; /* Croak if reference [i.e. not 1D] */
nval = SvNV(*work2);
}
if (packtype=='f') {
scalar = (float) nval;
sv_catpvn( work, (char *) &scalar, sizeof(float));
}
if (packtype=='i') {
iscalar = (int) nval;
sv_catpvn( work, (char *) &iscalar, sizeof(int));
}
if (packtype=='d') {
dscalar = (double) nval;
sv_catpvn( work, (char *) &dscalar, sizeof(double));
}
if (packtype=='s') {
sscalar = (short) nval;
sv_catpvn( work, (char *) &sscalar, sizeof(short));
}
if (packtype=='u') {
uscalar = (unsigned char) nval;
sv_catpvn( work, (char *) &uscalar, sizeof(char));
}
}
/* Return a pointer to the byte array */
return (void *) SvPV(work, PL_na);
}
errexit:
Perl_croak(aTHX_ "Routine can only handle scalar values or refs to 1D arrays of scalars");
}