view release on metacpan or  search on metacpan

Door.xs  view on Meta::CPAN

    if (count != 1)
        WARN(("servproc: Expected 1 value from server process, but got %d values", count));
    result = POPs;

    str = SvPV( result, PL_na );
    memmove(retval.ipc_door_data_pv, str, MAX_STRING);
    retval.cur=SvCUR(result);
    retval.len=SvLEN(result);

    if (door_return((char *) &retval, sizeof(retval),NULL,0) < 0)
        WARN(("door_return() failed in servproc: %s\n", strerror(errno)));

    PUTBACK;

    FREETMPS;
    LEAVE;

}

/*
Start XSUB
*/

MODULE=IPC::Door    PACKAGE=IPC::Door

INCLUDE: const-xs.inc

int
is_door(sv)
    SV * sv
PREINIT:
    char*       path;
    HV*         hv;
    SV**        svp;
    struct stat buf;
CODE:
    if (sv_isobject(sv) && sv_derived_from(sv, "IPC::Door")) {
        hv=(HV*)SvRV(sv);
        svp=hv_fetch( hv, "path", 4, FALSE);
        path=SvPV(*svp, PL_na);
    } else {
        path=SvPV(sv, PL_na);
    }
    if (stat(path, &buf) <0)
        XSRETURN_UNDEF;
    RETVAL=S_ISDOOR(buf.st_mode);
OUTPUT:
    RETVAL

void
__info(sv_path, sv_class)
    SV * sv_path
    SV * sv_class
PREINIT:
    char * path = SvPV(sv_path, PL_na);
    char * class = SvPV(sv_class, PL_na);
    int fd;
    struct stat stat;
    door_info_t info;
    SV * sv;
PPCODE:
    if ((fd = open(path, O_RDONLY)) < 0) {
        WARN(("open() failed: %s\n", strerror(errno)));
        XSRETURN_UNDEF;
    }
    if (fstat(fd, &stat) < 0) {
        WARN(("fstat() failed:%s \n", strerror(errno)));
        XSRETURN_UNDEF;
    }
    if (S_ISDOOR(stat.st_mode) == 0) {
        WARN(("%s is not a door\n", path));
        XSRETURN_UNDEF;
    }
    if ( !strcmp( class, "IPC::Door::Server" ) )
        fd = DOOR_QUERY;

    /* path is a door, so gather info */
    if (door_info( fd, &info) < 0) {
        WARN(("door_info() failed: %s", strerror(errno)));
        XSRETURN_UNDEF;
    } else {
        XPUSHs(sv_2mortal(newSViv((long) info.di_target)));
/* I don't know how useful these data will be in Perl.
        XPUSHs(sv_2mortal(newSViv((long) info.di_proc)));
        XPUSHs(sv_2mortal(newSViv((long) info.di_data)));
*/
        XPUSHs(sv_2mortal(newSViv((long) info.di_attributes)));
        XPUSHs(sv_2mortal(newSViv((long) info.di_uniquifier)));
    }

    if (close(fd) < 0) WARN(("close() failed\n"));



MODULE=IPC::Door    PACKAGE=IPC::Door::Server
int
__create(sv_class, sv_path, sv_callback, sv_attr)
    SV *sv_class
    SV *sv_path
    SV *sv_callback
    SV *sv_attr
PROTOTYPE: $$$
CODE:
    SV   *sv_server = SvRV(sv_class); /* IPC::Door::Server object */
    int  fd;
    char *path      = SvPV(sv_path, PL_na);
    char *callback  = SvPV(sv_callback, PL_na);

    /* Make sure sv_server is sane */
    if (!sv_isobject(sv_class)) {
        WARN(("Non-object passed in __create()"));
        XSRETURN_UNDEF;
    }

    /* Make sure that sv_callback is sane */
    if (!SvROK(sv_callback) || (SvTYPE(SvRV(sv_callback)) != SVt_PVCV)) {
        WARN(("%s is not a code reference\n", callback));
        XSRETURN_UNDEF;
    }

    /* set sv_callback */