AnyMongo

 view release on metacpan or  search on metacpan

AnyMongo.xs  view on Meta::CPAN


SV*
bson_encode(SV *sv)
    INIT:
        buffer buf;
    CODE:
        CREATE_BUF(INITIAL_BUF_SIZE);
        perl_mongo_sv_to_bson(&buf,sv,NO_PREP);
        RETVAL = newSVpvn(buf.start, buf.pos-buf.start);
        Safefree(buf.start);
    OUTPUT:
        RETVAL

SV *
bson_decode(char *bson)
    INIT:
        buffer buf;
    CODE:
        buf.start = bson;
        buf.end = bson+strlen(bson);
        buf.pos = bson;
        RETVAL = perl_mongo_bson_to_sv(&buf);
    OUTPUT:
        RETVAL

MODULE = AnyMongo  PACKAGE = AnyMongo::BSON::OID

PROTOTYPES: DISABLE

SV *
_build_value (self, c_str)
        SV *self
        const char *c_str;

AnyMongo.xs  view on Meta::CPAN

        char id[12], oid[25];
    CODE:
        if (c_str && strlen(c_str) == 24) {
          memcpy(oid, c_str, 25);
        }
        else {
          perl_mongo_make_id(id);
          perl_mongo_make_oid(id, oid);
        }
        RETVAL = newSVpvn(oid, 24);
    OUTPUT:
        RETVAL

MODULE = AnyMongo  PACKAGE = AnyMongo::MongoSupport
PROTOTYPES: DISABLE

SV*
build_query_message(request_id,ns, opts, skip, limit, query, fields = 0)
         SV *request_id
         char *ns
         int opts

AnyMongo.xs  view on Meta::CPAN

         perl_mongo_serialize_int(&buf, limit);

         perl_mongo_sv_to_bson(&buf, query, NO_PREP);

         if (fields && SvROK(fields)) {
           perl_mongo_sv_to_bson(&buf, fields, NO_PREP);
         }
         perl_mongo_serialize_size(buf.start, &buf);
         RETVAL = newSVpvn(buf.start, buf.pos-buf.start);
         Safefree(buf.start);
    OUTPUT:
        RETVAL

void
build_insert_message(request_id,ns, a)
         SV *request_id
         char *ns
         AV *a
     PREINIT:
         buffer buf;
         mongo_msg_header header;

AnyMongo.xs  view on Meta::CPAN

         buffer buf;
         mongo_msg_header header;
     CODE:
         CREATE_BUF(INITIAL_BUF_SIZE);
         CREATE_HEADER(buf, ns, OP_DELETE);
         perl_mongo_serialize_int(&buf, flags);
         perl_mongo_sv_to_bson(&buf, criteria, NO_PREP);
         perl_mongo_serialize_size(buf.start, &buf);
         RETVAL = newSVpvn(buf.start, buf.pos-buf.start);
         Safefree(buf.start);
    OUTPUT:
         RETVAL

SV*
build_update_message(request_id,ns, criteria, obj, flags)
         SV *request_id;
         char *ns
         SV *criteria
         SV *obj
         int flags
    PREINIT:

AnyMongo.xs  view on Meta::CPAN

         
    CODE:
         CREATE_BUF(INITIAL_BUF_SIZE);
         CREATE_HEADER(buf, ns, OP_UPDATE);
         perl_mongo_serialize_int(&buf, flags);
         perl_mongo_sv_to_bson(&buf, criteria, NO_PREP);
         perl_mongo_sv_to_bson(&buf, obj, NO_PREP);
         perl_mongo_serialize_size(buf.start, &buf);
         RETVAL = newSVpvn(buf.start, buf.pos-buf.start);
         Safefree(buf.start);
    OUTPUT:
         RETVAL

SV*
build_get_more_message(request_id,ns, cursor_id,size)
        SV *request_id
        char *ns
        SV *cursor_id
        int size
    PREINIT:
        buffer buf;

AnyMongo.xs  view on Meta::CPAN

        // // standard message head
        // CREATE_MSG_HEADER(SvIV(request_id), 0, OP_GET_MORE);
        // APPEND_HEADER_NS(buf, ns, 0);
        // // batch size
        // perl_mongo_serialize_int(&buf, SvIV(size));
        // // cursor id
        // perl_mongo_serialize_long(&buf, (int64_t) SvIV(cursor_id));
        // perl_mongo_serialize_size(buf.start, &buf);
        RETVAL = newSVpvn(buf.start, buf.pos-buf.start);
        Safefree(buf.start);
    OUTPUT:
        RETVAL

SV*
build_kill_cursor_message(request_id_sv,cursor_id)
        SV *request_id_sv
        SV *cursor_id
    PREINIT:
        buffer buf;
        char quickbuf[128];
        mongo_msg_header header;

AnyMongo.xs  view on Meta::CPAN

        buf.end = buf.start + 128;
        // std header
        CREATE_MSG_HEADER(SvIV(request_id_sv), 0, OP_KILL_CURSORS);
        APPEND_HEADER(buf, 0);
        // # of cursors
        perl_mongo_serialize_int(&buf, 1);
        // cursor ids
        perl_mongo_serialize_long(&buf, (int64_t)SvIV(cursor_id));
        perl_mongo_serialize_size(buf.start, &buf);
        RETVAL = newSVpvn(buf.start, buf.pos-buf.start);
    OUTPUT:
        RETVAL

SV*
decode_bson_documents(SV *documents)
    PREINIT:
        buffer buf;
        AV *ret;
        char *bson;
    CODE:
        ret = newAV ();

AnyMongo.xs  view on Meta::CPAN

        do {
            SV *sv;
            // warn("perl_mongo_bson_to_sv...\n");
            sv = perl_mongo_bson_to_sv(&buf);
            // warn("perl_mongo_bson_to_sv END...\n");
            av_push (ret, sv);
            buf.start = buf.pos;
        } while( buf.pos < buf.end);
        
        RETVAL = newRV_noinc ((SV *)ret);
    OUTPUT:
        RETVAL

mongo_support.c  view on Meta::CPAN

static void append_sv (buffer *buf, const char *key, SV *sv, stackette *stack, int is_insert);

int perl_mongo_inc = 0;

// void
// perl_mongo_call_xs (pTHX_ void (*subaddr) (pTHX_ CV *), CV *cv, SV **mark)
// {
//     dSP;
//     PUSHMARK (mark);
//     (*subaddr) (aTHX_ cv);
//     PUTBACK;
// }

SV *
perl_mongo_call_reader (SV *self, const char *reader)
{
    dSP;
    SV *ret;
    I32 count;

    ENTER;
    SAVETMPS;

    PUSHMARK (SP);
    XPUSHs (self);
    PUTBACK;

    count = call_method (reader, G_SCALAR);

    SPAGAIN;

    if (count != 1) {
        croak ("reader didn't return a value");
    }

    ret = POPs;
    SvREFCNT_inc (ret);

    PUTBACK;
    FREETMPS;
    LEAVE;

    return ret;
}


SV *
perl_mongo_call_method (SV *self, const char *method, int num, ...)
{

mongo_support.c  view on Meta::CPAN

    XPUSHs (self);

    va_start( args, num );
 
    for( ; num > 0; num-- ) {
      XPUSHs (va_arg( args, SV* ));
    }
 
    va_end( args );

    PUTBACK;

    count = call_method (method, G_SCALAR);

    SPAGAIN;

    if (count != 1) {
        croak ("method didn't return a value");
    }

    ret = POPs;
    SvREFCNT_inc (ret);

    PUTBACK;
    FREETMPS;
    LEAVE;

    return ret;
}

SV *
perl_mongo_call_function (const char *func, int num, ...)
{
    dSP;

mongo_support.c  view on Meta::CPAN

    PUSHMARK (SP);

    va_start( args, num );
 
    for( ; num > 0; num-- ) {
      XPUSHs (va_arg( args, SV* ));
    }
 
    va_end( args );

    PUTBACK;

    count = call_pv (func, G_SCALAR);

    SPAGAIN;

    if (count != 1) {
        croak ("method didn't return a value");
    }

    ret = POPs;
    SvREFCNT_inc (ret);

    PUTBACK;
    FREETMPS;
    LEAVE;

    return ret;
}


void
perl_mongo_attach_ptr_to_instance (SV *self, void *ptr)
{

mongo_support.c  view on Meta::CPAN


    ENTER;
    SAVETMPS;

    PUSHMARK (SP);
    mXPUSHp (klass, strlen (klass));
    while ((init_arg = va_arg (ap, char *))) {
        mXPUSHp (init_arg, strlen (init_arg));
        XPUSHs (va_arg (ap, SV *));
    }
    PUTBACK;

    count = call_method ("new", G_SCALAR);

    SPAGAIN;

    if (count != 1) {
        croak ("constructor didn't return an instance");
    }

    ret = POPs;
    SvREFCNT_inc (ret);

    PUTBACK;
    FREETMPS;
    LEAVE;

    return ret;
}

SV *
perl_mongo_construct_instance_with_magic (const char *klass, void *ptr, ...)
{
    SV *ret;

mongo_support.c  view on Meta::CPAN

    SV *use_bool = get_sv("AnyMongo::BSON::use_boolean", 0);

    if (!use_bool) {
      value = newSViv(d);
      break;
    }

    SAVETMPS;
    
    PUSHMARK(SP);
    PUTBACK;
    if (d) {
        count = call_pv("boolean::true", G_SCALAR);
    }
    else {
        count = call_pv("boolean::false", G_SCALAR);
    }
    SPAGAIN;
    if (count == 1)
        value = newSVsv(POPs);
    
    if (count != 1 || !SvOK(value)) {
        value = newSViv(d);
    }
    
    PUTBACK;
    FREETMPS;
    break;
  }
  case BSON_UNDEF:
  case BSON_NULL: {
    value = newSV(0);
    break;
  }
  case BSON_INT: {
    value = newSViv(MONGO_32(*((int*)buf->pos)));



( run in 0.711 second using v1.01-cache-2.11-cpan-4e96b696675 )