Skip to content

Instantly share code, notes, and snippets.

@rjbs
Created November 19, 2014 17:49
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save rjbs/880f8528cca301688031 to your computer and use it in GitHub Desktop.
Save rjbs/880f8528cca301688031 to your computer and use it in GitHub Desktop.
* build a spider
* build a megaspider
* build a registry of megaspider
$s = Spider->new({
bson_type => BSON_INT32,
perl_type => [ typetype => 'name1' ],
from_perl => [
[ typetype => name1 => sub { ... } ],
[ typetype => name2 => sub { ... } ],
[ typetype => name3 => sub { ... } ],
[ typetype => name4 => sub { ... } ],
# from DateTime -> BSON array [ y, m, d ]
[ class => DateTime => sub {
my ($v, $ctx) = @_;
# Option 1: Trust the registry to get the right type:
$ctx->registry->to_bson([ $v->year, $v->month, $v->day ]);
# Option 2: We know better.
$r->bson_array([
$r->to_typed_bson('int32', $v->year),
$r->to_typed_bson('int32', $v->month),
$r->to_typed_bson('int64', $v->day),
]);
# Option 3: We have many registries:
$other_registry->to_bson([ ... ]);
} ],
# Concrete examples:
[ core => number => sub { $_ } ],
[ class => 'DateType' => sub { $_->epoch } ],
[ private => name => sub { $_->epoch } ],
],
to_perl => sub { ... }, # or some inlineable thingy someday
});
$m = MegaSpider->new({
spiders => \@spiders,
});
$r = SpiderWeb->new({
private_types => {
name => sub { ... },
},
megaspiders => [
[ Foo => $m0 ],
[ Bar => $m1 ],
[ Baz => $m2 ],
],
});
$r->to_bson($perl_value)
$muxer = SpiderWeb::Muxer->new({
private_types => {
name => sub { ... },
},
registries => \@webs,
});
sub SpiderWeb::to_bson {
my ($self, $perl_value) = @_;
for my $spider ($self->spiders->@*) {
my $res = $spider->to_bson($perl_value, $self);
next if is_NO($res);
return $res;
}
return NO;
}
sub SpiderWeb::Muxer::to_bson {
my ($self, $perl_value) = @_;
for my $web ($self->registries->@*) {
my $res = $web->to_bson($perl_value);
next if is_NO($res);
return $res;
}
return NO;
}
sub Spider::to_bson {
my ($self, $perl_value, $r) = @_;
for my $cond ($self->from_perl->@*) {
my ($typetype, $typename, $code) = @$cond;
my $check = $self->resolve_type($typetype, $typename);
next unless $check->($perl_value);
return $code->($perl_value);
}
return NO;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment