view release on metacpan or  search on metacpan

mongo_support.c  view on Meta::CPAN

static void serialize_regex_flags(buffer *buf, SV *sv) {
  char flags[] = {0,0,0,0,0,0};
  int i = 0, f = 0;
  STRLEN string_length;
  char *string = SvPV(sv, string_length);
                
  for(i = 2; i < string_length && string[i] != '-'; i++) {
    if (string[i] == 'i' ||
        string[i] == 'm' ||
        string[i] == 'x' ||
        string[i] == 'l' ||
        string[i] == 's' ||
        string[i] == 'u') {
      flags[f++] = string[i];
    }
    else if(string[i] == ':') {
      break;
    }
  }

  perl_mongo_serialize_string(buf, flags, strlen(flags));
}


void
perl_mongo_sv_to_bson (buffer *buf, SV *sv, AV *ids)
{
    if (!SvROK (sv)) {
        croak ("not a reference");
    }

    switch (SvTYPE (SvRV (sv))) {
    case SVt_PVHV:
        hv_to_bson (buf, sv, ids, EMPTY_STACK, ids != 0);
        break;
    case SVt_PVAV: {
        if (sv_isa(sv, "Tie::IxHash")) {
            ixhash_to_bson(buf, sv, ids, EMPTY_STACK, ids != 0);
        }
        else {
            /*
             * this is a special case of array:
             * ("foo" => "bar", "baz" => "bat")
             * which is, as far as i can tell,
             * indistinguishable from a "normal"
             * array.
             */

            I32 i;
            AV *av = (AV *)SvRV (sv);
            int start;
            
            if ((av_len (av) % 2) == 0) {
                croak ("odd number of elements in structure");
            }
            
            start = buf->pos-buf->start;
            buf->pos += INT_32;
            
            /* 
             * the best (and not very good) way i can think of for 
             * checking for ids is to go through the array once
             * looking for them... blah
             */
            if (ids) {
                int has_id = 0;
                for (i = 0; i <= av_len(av); i+= 2) {
                    SV **key = av_fetch(av, i, 0);
                    if (strcmp(SvPV_nolen(*key), "_id") == 0) {
                        SV **val = av_fetch(av, i+1, 0);
                        has_id = 1;
                        append_sv(buf, "_id", *val, EMPTY_STACK, ids != 0);
                        av_push(ids, *val);
                        break;
                    }
                }
                if (!has_id) {
                    perl_mongo_prep(buf, ids);
                }
            }

            for (i = 0; i <= av_len (av); i += 2) {
                SV **key, **val;
                STRLEN len;
                const char *str;

                if ( !((key = av_fetch (av, i, 0)) && (val = av_fetch (av, i + 1, 0))) ) {
                    croak ("failed to fetch array element");
                }

                str = SvPV(*key, len);

                if (!isUTF8(str, len)) {
                    str = SvPVutf8(*key, len);
                }
                append_sv (buf, str, *val, EMPTY_STACK, ids != 0);
            }

            perl_mongo_serialize_null(buf);
            perl_mongo_serialize_size(buf->start+start, buf);
        }
        break;
    }
    default:
        sv_dump(sv);
        croak ("type unhandled");
    }
}