=head1 NAME
Mandel::Relationship::ListOf - A field points to many other MongoDB documents
=head1 DESCRIPTION
L<Mandel::Relationship::ListOf> is a class used to describe the relationship
where one document has a list of DBRefs that point to other documents.
The connection between the documents is described in the database using
This relationship is EXPERIMENTAL. Let me of you are using it or don't like it.
=head1 DATABASE STRUCTURE
A "person" that has I<list of> "cats" will look like this in the database:
mongodb> db.persons.find();
{
"_id" : ObjectId("5353ab13800fac3a0a8d5049"),
"kittens" : [
DBRef("cats", ObjectId("5353ab13c5483e16a1010000")),
DBRef("cats", ObjectId("5353ab13c5483e16a1020000"))
]
}
mongodb> db.cats.find();
{ "_id" : ObjectId("5353ab13c5483e16a1010000") }
{ "_id" : ObjectId("5353ab13c5483e16a1020000") }
=head1 SYNOPSIS
=head2 Using DSL
package MyModel::Person;
use Mandel::Document;
list_of cats => 'MyModel::Cat';
=head2 Using object oriented interface
MyModel::Person->model->relationship(
"list_of",
"cats",
"MyModel::Cat",
);
See also L<Mandel::Model/relationship>.
=head2 Methods generated
# non-blocking
$person = MyModel::Person->new->push_cats($bson_oid, $pos, sub {
my($person, $err, $cat_obj) = @_;
# Note! This $cat_obj has only "id()" set
# ...
});
Add the C<$bson_oid> to the "cats" list in C<$person>.
$person = MyModel::Person->new->push_cats(\%constructor_args, $pos, sub {
my($person, $err, $cat_obj) = @_;
# ...
});
Pushing a new cat with C<%constructor_args> will also insert a new cat object
into the database.
$person = MyModel::Person->new->push_cats($cat_obj, $pos, sub {
my($person, $err, $cat_obj) = @_;
# ...
});
C<$pos> is optional. When omitted, C<push_cats()> will add the new element
to the end of list. See
for details.
$person = MyModel::Cat->new->remove_cats($bson_oid, sub {
my($self, $err) = @_;
# Note! This $cat_obj has only "id()" set
});
$person = MyModel::Cat->new->remove_cats($cat_obj, sub {
my($self, $err) = @_;
# ...
});
Calling C<remove_cats()> will only remove the link, and not the related
object.
$person = MyModel::Cat->new->cats(sub {
my($self, $err, $array_of_cats) = @_;
# ...
});
Retrieve all the related cat objects.
# blocking
$cat_obj = MyModel::Person->new->push_cats($bson_oid);
$cat_obj = MyModel::Person->new->push_cats(\%args);
$cat_obj = MyModel::Person->new->push_cats($cat_obj);
$person = MyModel::Person->new->remove_cats($bson_oid);
$person = MyModel::Person->new->remove_cats($cat_obj);
$array_of_cats = MyModel::Person->new->cats;
$cat_collection = MyModel::Person->new->search_cats;
Note! C<search()> does not guaranty the order of the results, like C<cats()>
does.
=cut
use Mango::BSON 'bson_dbref';
=head1 ATTRIBUTES
L<Mandel::Relationship::ListOf> inherits all attributes from
L<Mandel::Relationship> and implements the following new ones.
=head2 push_method_name
The name of the method used to add another document to the relationship.
=head2 remove_method_name
The name of the method used to remove an item from the list.
=head2 search_method_name
The name of the method used to search related documents.
=cut
has push_method_name => sub { sprintf 'push_%s', shift->accessor };
has remove_method_name => sub { sprintf 'remove_%s', shift->accessor };
has search_method_name => sub { sprintf 'search_%s', shift->accessor };
=head1 METHODS
L<Mandel::Relationship::ListOf> inherits all methods from
L<Mandel::Relationship> and implements the following new ones.
=head2 monkey_patch
Add methods to L<Mandel::Relationship/document_class>.
=cut
sub monkey_patch {
shift->_monkey_patch_all_method->_monkey_patch_push_method->_monkey_patch_remove_method->_monkey_patch_search_method;
}
sub _monkey_patch_all_method {
my $self = shift;
my $accessor = $self->accessor;
my $search = $self->search_method_name;
Mojo::Util::monkey_patch(
$self->document_class,
$self->accessor,
sub {
my ($doc, $cb) = @_;
# Blocking
unless ($cb) {
my $objs = $doc->$search->all;
my %lookup = map { $_->id, $_ } @$objs;
return [map { $lookup{$_->{'$id'}} } @{$doc->data->{$accessor} || []}];
}
# Non-blocking
$doc->$search->all(
sub {
my ($collection, $err, $objs) = @_;
my %lookup = map { $_->id, $_ } @$objs;
$doc->$cb($err, [map { $lookup{$_->{'$id'}} } @{$doc->data->{$accessor} || []}],);
}
);
return $doc;
}
);
return $self;
}
sub _monkey_patch_push_method {
my $self = shift;
my $accessor = $self->accessor;
Mojo::Util::monkey_patch(
$self->document_class,
$self->push_method_name,
sub {
my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
my ($doc, $obj, $pos) = @_;
my ($dbref, $list, @update);
if (ref $obj eq 'HASH') {
$obj = $self->_related_model->new_collection($doc->connection)->create($obj);
}
elsif (UNIVERSAL::isa($obj, 'Mango::BSON::ObjectID')) {
$obj = $self->_related_model->new_collection($doc->connection)->create({id => $obj});
$obj->_mark_stored_clean; # prevent save() from actually doing something below
}
$dbref = bson_dbref $obj->model->collection_name, $obj->id;
$list = $doc->data->{$accessor} ||= [];
@update = (
$doc->data,
{'$push' => {$accessor => {'$each' => [$dbref], defined $pos ? ('$position' => $pos) : (),},},},
{upsert => 1,},
);
# Blocking
unless ($cb) {
$obj->save;
$doc->_storage_collection->update(@update);
$doc->in_storage(1);
if (defined $pos and $pos < @$list) {
splice @$list, $pos, 0, $dbref;
}
else {
push @$list, $dbref;
}
return $obj;
}
# Non-blocking
Mojo::IOLoop->delay(
sub {
my ($delay) = @_;
$obj->save($delay->begin);
$doc->_storage_collection->update(@update, $delay->begin);
},
sub {
my ($delay, $o_err, $d_err, $updated) = @_;
my $err = $o_err || $d_err;
$err ||= 'Document was not stored. Unknown error' unless $updated and $updated->{n};
unless ($err) {
$doc->in_storage(1);
if (defined $pos and $pos < @$list) {
splice @$list, $pos, 0, $dbref;
}
else {
push @$list, $dbref;
}
}
$doc->$cb($err // '', $obj);
},
);
return $doc;
}
);
return $self;
}
sub _monkey_patch_remove_method {
my $self = shift;
my $accessor = $self->accessor;
Mojo::Util::monkey_patch(
$self->document_class,
$self->remove_method_name,
sub {
my ($doc, $obj, $cb) = @_;
my @update;
unless (UNIVERSAL::isa($obj, 'Mandel::Document')) {
$obj = $self->_related_model->new_collection($doc->connection)->create({_id => $obj});
}
@update = ({_id => $doc->id}, {'$pull' => {$accessor => bson_dbref($obj->model->collection_name, $obj->id),},},);
# Blocking
unless ($cb) {
$doc->_storage_collection->update(@update);
$doc->data->{$accessor} = [grep { $_->{'$id'} ne $obj->id } @{$doc->data->{$accessor} || []}];
return $doc;
}
# Non-blocking
Mojo::IOLoop->delay(
sub {
my ($delay) = @_;
$doc->_storage_collection->update(@update, $delay->begin);
},
sub {
my ($delay, $err, $updated) = @_;
$doc->data->{$accessor} = [grep { $_->{'$id'} ne $obj->id } @{$doc->data->{$accessor} || []}] unless $err;
$doc->$cb($err);
},
);
return $obj;
}
);
return $self;
}
sub _monkey_patch_search_method {
my $self = shift;
my $accessor = $self->accessor;
Mojo::Util::monkey_patch(
$self->document_class,
$self->search_method_name,
sub {
my ($doc, $query, $extra) = @_;
my $related_model = $self->_related_model;
return $related_model->new_collection(
$doc->connection,
extra => $extra || {},
query => {%{$query || {}}, _id => {'$in' => [map { $_->{'$id'} } @{$doc->data->{$accessor} || []}],},},
);
}
);
return $self;
}
=head1 SEE ALSO
L<Mojolicious>, L<Mango>, L<Mandel::Relationship>
=head1 AUTHOR
Jan Henning Thorsen - C<jhthorsen@cpan.org>
=cut
1;