GTop

 view release on metacpan or  search on metacpan

GTop.xs  view on Meta::CPAN

                       __LINE__, (long)PL_curcop->cop_line, \
                       cop_file))

#define trace_free(self)                                    \
    GTOP_TRACE(fprintf(stderr, "free 0x%lx %d %ld:%s\n",    \
                       (unsigned long)self,                 \
                       __LINE__, (long)PL_curcop->cop_line, \
                       cop_file))


#define my_free(a) \
    trace_free(a); \
    safefree(a)

#define my_malloc safemalloc

typedef struct {
    unsigned old_method;
    int do_close;
    char *host;
    char *port;
} PerlGTop;

typedef PerlGTop * GTop;

#define OffsetOf(structure, field) \
(guint32)(&((structure *)NULL)->field)

#define any_ptr_deref(structure) \
((char *)structure + (int)(long)CvXSUBANY(cv).any_ptr)

#define newGTopXS(name, structure, field, type) \
    CvXSUBANY(newXS(name, XS_GTop_field_##type, __FILE__)).any_ptr = \
		    (void *)OffsetOf(structure, field);

#define newGTopXS_u_int64_t(name, structure, field) \
newGTopXS(name, structure, field, u_int64_t)

#define newGTopXS_int(name, structure, field) \
newGTopXS(name, structure, field, int)

#define newGTopXS_char(name, structure, field) \
newGTopXSub(name, structure, field, char)

static GTop my_gtop_new(pTHX_ char *host, char *port) 
{
    GTop RETVAL = (PerlGTop *)safemalloc(sizeof(PerlGTop));
    trace_malloc(RETVAL);
    RETVAL->old_method = glibtop_global_server->method;
    RETVAL->do_close = 0;
    RETVAL->host = NULL;
    RETVAL->port = NULL;

#if 0 && defined(USE_ITHREADS)
    Perl_warn(aTHX_ "perl=0x%lx my_gtop_new() called",
              (unsigned long)my_perl);
#endif
    
    if (host && port) {
	RETVAL->do_close = 1;
	my_setenv("LIBGTOP_HOST", host);
	my_setenv("LIBGTOP_PORT", port);
        New(0, RETVAL->host, strlen(host)+1, char);
        New(0, RETVAL->port, strlen(port)+1, char);
        Copy(host, RETVAL->host, strlen(host)+1, char);
        Copy(port, RETVAL->port, strlen(port)+1, char);
	glibtop_global_server->method = GLIBTOP_METHOD_INET;
	glibtop_init_r(&glibtop_global_server, 0, 0);
    }
    else {
	glibtop_init();
    }

    return RETVAL;
}

XS(XS_GTop_field_u_int64_t) 
{ 
    dXSARGS; 

    void *s = (void *)SvIV((SV*)SvRV(ST(0)));
    u_int64_t **ptr = (u_int64_t **)any_ptr_deref(s);

    ST(0) = sv_2mortal(newSVnv((unsigned long)*ptr));

    XSRETURN(1); 
}

XS(XS_GTop_field_int) 
{ 
    dXSARGS; 

    void *s = (void *)SvIV((SV*)SvRV(ST(0)));
    int **ptr = (int **)any_ptr_deref(s);

    ST(0) = sv_2mortal(newSViv((int)*ptr));

    XSRETURN(1); 
}

XS(XS_GTop_field_char) 
{ 
    dXSARGS; 

    void *s = (void *)SvIV((SV*)SvRV(ST(0)));
    char **ptr = (char **)any_ptr_deref(s);

    ST(0) = sv_2mortal(newSVpv((char *)*ptr, 0));

    XSRETURN(1); 
}

XS(XS_GTop_destroy)
{
    dXSARGS; 

    void *s = (void *)SvIV((SV*)SvRV(ST(0)));
    my_free(s);

    XSRETURN_EMPTY;
}



( run in 1.251 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )