AnyMongo

 view release on metacpan or  search on metacpan

AnyMongo.xs  view on Meta::CPAN

#include "mongo_support.h"

MODULE = AnyMongo  PACKAGE = AnyMongo

PROTOTYPES: DISABLE

BOOT:
    gv_fetchpv("AnyMongo::BSON::bson_char",  GV_ADDMULTI, SVt_IV);
    gv_fetchpv("AnyMongo::BSON::utf8_flag_on",  GV_ADDMULTI, SVt_IV);
    gv_fetchpv("AnyMongo::BSON::use_boolean",  GV_ADDMULTI, SVt_IV);

MODULE = AnyMongo  PACKAGE = AnyMongo::BSON
PROTOTYPES: DISABLE

SV*
bson_encode(SV *sv)
    INIT:
        buffer buf;
    CODE:

lib/AnyMongo/BSON.pm  view on Meta::CPAN

  $AnyMongo::BSON::VERSION = '0.03';
}
# ABSTRACT: BSON encoding and decoding utilities
use strict;
use warnings;
use AnyMongo;
use parent 'Exporter';
our @EXPORT_OK = qw(bson_encode bson_decode);

$AnyMongo::BSON::char = '$';
$AnyMongo::BSON::utf8_flag_on = '$';


$AnyMongo::BSON::use_boolean = 0;

1;


=pod

=head1 NAME

lib/AnyMongo/Compat.pm  view on Meta::CPAN

    return sub {
        my ($self,$class) = @_;
        return 1 if $class eq $fake_class;
        return $self->SUPER::isa($class);
    };
}


*MongoDB::BSON::char = *AnyMongo::BSON::char;
*MongoDB::BSON::use_boolean = *AnyMongo::BSON::use_boolean;
*MongoDB::BSON::utf8_flag_on = *AnyMongo::BSON::utf8_flag_on;

# fake these isa
*AnyMongo::Database::isa = make_fake_isa('MongoDB::Database');
*AnyMongo::Collection::isa = make_fake_isa('MongoDB::Collection');
*AnyMongo::Cursor::isa = make_fake_isa('MongoDB::Cursor');
*AnyMongo::BSON::Timestamp::isa = make_fake_isa('MongoDB::Timestamp');
*AnyMongo::BSON::OID::isa = make_fake_isa('MongoDB::OID');
*AnyMongo::BSON::Code::isa = make_fake_isa('MongoDB::Code');
*AnyMongo::BSON::MaxKey::isa = make_fake_isa('MongoDB::MaxKey');
*AnyMongo::BSON::MinKey::isa = make_fake_isa('MongoDB::MinKey');

mongo_support.c  view on Meta::CPAN

    stash = gv_stashpv("AnyMongo::BSON::OID", 0);
    return sv_bless(newRV_noinc((SV *)id_hv), stash);
}

static SV *
elem_to_sv (int type, buffer *buf)
{
  SV *value = 0;
  
  SV *flag = get_sv("AnyMongo::BSON::utf8_flag_on", 0);

  switch(type) {
  case BSON_OID: {
    value = oid_to_sv(buf);
    buf->pos += OID_SIZE;
    break;
  }
  case BSON_DOUBLE: {
    double d = *(double*)buf->pos;
    int64_t i, *i_p;

mongo_support.c  view on Meta::CPAN

        const char *str;

        if (!(k = av_fetch(keys, i, 0)) ||
            !(v = av_fetch(values, i, 0))) {
            croak ("failed to fetch associative array value");
        }

        str = SvPV(*k, len);

        if (isUTF8(str, len)) {
          str = SvPVutf8(*k, len);
        }

        append_sv(buf, str, *v, stack, is_insert);
    }

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

    // free the ixhash elem
    Safefree(stack);

mongo_support.c  view on Meta::CPAN

                if (sv_len (sv) != strlen (SvPV_nolen (sv))) {
                    set_type(buf, BSON_BINARY);
                    perl_mongo_serialize_key(buf, key, is_insert);
                    perl_mongo_serialize_bindata(buf, sv);
                }
                else {
                    STRLEN len;
                    const char *str = SvPV(sv, len);

                    if (!isUTF8(str, len)) {
                      str = SvPVutf8(sv, len);
                    }


                    set_type(buf, BSON_STRING);
                    perl_mongo_serialize_key(buf, key, is_insert);
                    perl_mongo_serialize_int(buf, len+1);
                    perl_mongo_serialize_string(buf, str, len);
                }
                break;
            default:

mongo_support.c  view on Meta::CPAN

                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:

t/perl-driver-api/bson.t  view on Meta::CPAN

    $c->batch_insert([{x => 1}, {x => 2}, {x => 3}, {x => 4}, {x => 5}]);
    my $cursor = $c->query({x => {":gt" => 2, ":lte" => 4}})->sort({x => 1});

    my $result = $cursor->next;
    is($result->{x}, 3);
    $result = $cursor->next;
    is($result->{x}, 4);
    ok(!$cursor->has_next);
}

# utf8
{
    $c->drop;

    # should convert invalid utf8 to valid
    my $invalid = "\xFE";
    $c->insert({char => $invalid});
    my $x =$c->find_one;
    # now that the utf8 flag is set, it converts it back to a single char for
    # unknown reasons
    is($x->{char}, "\xFE");

    $c->remove;

    # should be the same with valid utf8
    my $valid = "\xE6\xB5\x8B\xE8\xAF\x95";
    $c->insert({char => $valid});
    $x = $c->find_one;

    # make sure it's being returned as a utf8 string
    ok(utf8::is_utf8($x->{char}));
    is(length $x->{char}, 2);
}

# undefined
{
    my $err = $db->last_error(); 
    ok(!$err->{err}, "undef");
    $err->{err} = "foo";
    is($err->{err}, "foo", "assign to undef");
}

t/perl-driver-api/collection.t  view on Meta::CPAN

ok($id  = $coll->insert({ data => 'null', none => undef }), 'inserting undefined data');
ok($obj = $coll->find_one({ data => 'null' }), 'finding undefined row');
ok(exists $obj->{none}, 'got null field');
ok(!defined $obj->{none}, 'null field is undefined');

$coll->drop;

# ord("\x9F") is 159
$coll->insert({foo => "\x9F" });
my $utfblah = $coll->find_one;
is(ord($utfblah->{'foo'}), 159, 'translate non-utf8 to utf8 char');

$coll->drop;
$coll->insert({"\x9F" => "hi"});
$utfblah = $coll->find_one;
is($utfblah->{chr(159)}, "hi", 'translate non-utf8 key');


$coll->drop;
my $keys = tie(my %idx, 'Tie::IxHash');
%idx = ('sn' => 1, 'ts' => -1);

$coll->ensure_index($keys);

my @tied = $coll->get_indexes;
is(scalar @tied, 2, 'num indexes');

t/perl-driver-api/collection.t  view on Meta::CPAN

# # autoload
SKIP: {
    skip 'Autoload not support anymore, skip',2 if 1;
    my $coll1 = $conn->foo->bar->baz;
    is($coll1->name, "bar.baz");
    is($coll1->full_name, "foo.bar.baz");
}

# ns hack
# check insert utf8
{
    my $coll = $db->get_collection('test_collection');
    $coll->drop;
    # turn off utf8 flag now
    $MongoDB::BSON::utf8_flag_on = 0;
    $coll->insert({ foo => "\x{4e2d}\x{56fd}"});
    $utfblah = $coll->find_one;
    $coll->drop;
    $coll->insert({foo2 => $utfblah->{foo}});
    $utfblah = $coll->find_one;
    # use utf8;
    my $utfv2 = encode('utf8',"\x{4e2d}\x{56fd}");
    # my $utfv2 = encode('utf8',"中国");
    # diag(Dumper(\$utfv2));
    is($utfblah->{foo2},$utfv2,'turn utf8 flag off,return perl internal form(bytes)');
    # restore;
    $MongoDB::BSON::utf8_flag_on = 1;
    $coll->drop;
}


END {
    if ($db) {
        $db->drop;
    }
}