view release on metacpan or  search on metacpan

mongo_support.c  view on Meta::CPAN

  }
  case BSON_BOOL: {
    dSP;
    char d = *buf->pos++;
    int count;
    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)));
    buf->pos += INT_32;
    break;
  }
  case BSON_LONG: {
#if defined(USE_64_BIT_INT)
    value = newSViv(MONGO_64(*((int64_t*)buf->pos)));
#else
    value = newSVnv((double)MONGO_64(*((int64_t*)buf->pos)));
#endif
    buf->pos += INT_64;
    break;
  }
  case BSON_DATE: {
    int64_t ms_i = MONGO_64(*(int64_t*)buf->pos);
    SV *datetime, *ms, **heval;
    HV *named_params;
    buf->pos += INT_64;
    ms_i /= 1000;

    datetime = sv_2mortal(newSVpv("DateTime", 0));
    ms = newSViv(ms_i);

    named_params = newHV();
    heval = hv_store(named_params, "epoch", strlen("epoch"), ms, 0);

    value = perl_mongo_call_function("DateTime::from_epoch", 2, datetime, 
                                     sv_2mortal(newRV_inc(sv_2mortal((SV*)named_params))));
    break;
  }
  case BSON_REGEX: {
    SV *pattern, *regex, *regex_ref;
    HV *stash;
    U32 flags = 0;
    REGEXP *re;
#if PERL_REVISION==5 && PERL_VERSION<=8
    PMOP pm;
    STRLEN len;
    char *pat;
#endif

    pattern = sv_2mortal(newSVpv(buf->pos, 0));
    buf->pos += strlen(buf->pos)+1;

    while(*(buf->pos) != 0) {
      switch(*(buf->pos)) {
      case 'l':
        flags |= PMf_LOCALE;
        break;
      case 'm':
        flags |= PMf_MULTILINE;
        break;
      case 'i':
        flags |= PMf_FOLD;
        break;
      case 'x':
        flags |= PMf_EXTENDED;
        break;
      case 's':
        flags |= PMf_SINGLELINE;
        break;
      }
      buf->pos++;
    }
    buf->pos++;

#if PERL_REVISION==5 && PERL_VERSION<=8
    /* 5.8 */
    pm.op_pmdynflags = flags;
    pat = SvPV(pattern, len);
    re = pregcomp(pat, pat + len, &pm);
#else
    /* 5.10 and beyond */
    re = re_compile(pattern, flags);
#endif
     // eo version-dependent code

#if PERL_REVISION==5 && PERL_VERSION>=12
    // they removed magic and made this a normal obj in 5.12
    regex_ref = newRV((SV*)re);
#else
    regex = sv_2mortal(newSVpv("",0));
    regex_ref = newRV((SV*)regex);

    sv_magic(regex, (SV*)re, PERL_MAGIC_qr, 0, 0);
#endif

mongo_support.c  view on Meta::CPAN

              if (!sign_ref) {
                croak( "couldn't get BigInt sign" );
              }
              else if ( SvPOK(*sign_ref) && strcmp(SvPV_nolen( *sign_ref ), "-") == 0 ) {
                sign = -1;
              }

              // get value
              av_ref = hv_fetch((HV*)SvRV(sv), "value", strlen("value"), 0);
              if (!av_ref) {
                croak( "couldn't get BigInt value" );
              }

              av = (AV*)SvRV(*av_ref);

              if ( av_len( av ) > 3 ) {
                croak( "BigInt is too large" );
              }

              for (i = 0; i <= av_len( av ); i++) {
                int j = 0;
                SV **val;
                
                if ( !(val = av_fetch (av, i, 0)) || !(SvPOK(*val) || SvIOK(*val)) ) {
                  sv_dump( sv );
                  croak ("failed to fetch BigInt element");
                }

                if ( SvIOK(*val) ) {
                  int64_t temp = SvIV(*val);

                  while (temp > 0) {
                    temp = temp / 10;
                    length++;
                  }

                  temp = (int64_t)(((int64_t)SvIV(*val)) * (int64_t)offset);
                  big = big + temp;
                }
                else {
                  STRLEN len;
                  char *str = SvPV(*val, len);

                  length += len;
                  big += ((int64_t)atoi(SvPV_nolen(*val))) * offset;
                }

                for (j = 0; j < length; j++) {
                  offset *= 10;
                }
              }

              perl_mongo_serialize_long(buf, big*sign);
            }
	    /* Tie::IxHash */
            else if (sv_isa(sv, "Tie::IxHash")) {
              set_type(buf, BSON_OBJECT);
              perl_mongo_serialize_key(buf, key, is_insert);
              ixhash_to_bson(buf, sv, NO_PREP, stack, is_insert);
            }
	    /* DateTime */
            else if (sv_isa(sv, "DateTime")) {
              SV *sec, *ms;
              set_type(buf, BSON_DATE);
              perl_mongo_serialize_key(buf, key, is_insert);
              sec = perl_mongo_call_reader (sv, "epoch");
              ms = perl_mongo_call_method (sv, "millisecond", 0);

              perl_mongo_serialize_long(buf, (int64_t)SvIV(sec)*1000+SvIV(ms));

              SvREFCNT_dec (sec);
              SvREFCNT_dec (ms);
            }
	    /* boolean */
            else if (sv_isa(sv, "boolean")) {
              set_type(buf, BSON_BOOL);
              perl_mongo_serialize_key(buf, key, is_insert);
              perl_mongo_serialize_byte(buf, SvIV(SvRV(sv)));
            }
            else if (sv_isa(sv, "AnyMongo::BSON::Code") || sv_derived_from(sv,"AnyMongo::BSON::Code")) {
              SV *code, *scope;
              char *code_str;
              STRLEN code_len;
              int start;

              set_type(buf, BSON_CODE);
              perl_mongo_serialize_key(buf, key, is_insert);

              start = buf->pos-buf->start;
              buf->pos += INT_32;

              code = perl_mongo_call_reader (sv, "code");
              code_str = SvPV(code, code_len);
              perl_mongo_serialize_int(buf, code_len+1);
              perl_mongo_serialize_string(buf, code_str, code_len);

              scope = perl_mongo_call_method (sv, "scope", 0);
              hv_to_bson(buf, scope, NO_PREP, EMPTY_STACK, is_insert);

              perl_mongo_serialize_size(buf->start+start, buf);

              SvREFCNT_dec(code);
              SvREFCNT_dec(scope);
            }
            else if (sv_isa(sv, "AnyMongo::BSON::Timestamp") || sv_derived_from(sv,"AnyMongo::BSON::Timestamp")) {
              SV *sec, *inc;
              set_type(buf, BSON_TIMESTAMP);
              perl_mongo_serialize_key(buf, key, is_insert);
              
              inc = perl_mongo_call_reader(sv, "inc");
              perl_mongo_serialize_int(buf, SvIV(inc));
              sec = perl_mongo_call_reader(sv, "sec");
              perl_mongo_serialize_int(buf, SvIV(sec));

              SvREFCNT_dec(sec);
              SvREFCNT_dec(inc);
            }
            else if (sv_isa(sv, "AnyMongo::BSON::MinKey") || sv_isa(sv, "MongoDB::MinKey")) {
              set_type(buf, BSON_MINKEY);
              perl_mongo_serialize_key(buf, key, is_insert);
            }
            else if (sv_isa(sv, "AnyMongo::BSON::MaxKey") || sv_isa(sv, "MongoDB::MaxKey")) {