File Coverage

blib/lib/Mandel/Relationship/HasOne.pm
Criterion Covered Total %
statement 34 47 72.3
branch 6 18 33.3
condition 1 6 16.6
subroutine 9 10 90.0
pod 1 1 100.0
total 51 82 62.2


line stmt bran cond sub pod time code
1             package Mandel::Relationship::HasOne;
2              
3             =head1 NAME
4              
5             Mandel::Relationship::HasOne - A field relates to another mongodb document
6              
7             =head1 DESCRIPTION
8              
9             L is a class used to describe the relationship
10             between one document that has a relationship to one other documents.
11             The connection between the documents is described in the database using
12             L.
13              
14             =head1 DATABASE STRUCTURE
15              
16             A "dinosaur" that I "cat" will look like this in the database:
17              
18             mongodb# db.dinosaurs.find({ })
19             { "_id" : ObjectId("5352b4d8c5483e4502010000") }
20              
21             mongodb# db.cats.find({ "dinosaur.$id": ObjectId("53529f28c5483e4977020000") })
22             {
23             "_id" : ObjectId("5352b4d8c5483e4502040000"),
24             "dinosaur" : DBRef("dinosaurs", ObjectId("5352b4d8c5483e4502010000"))
25             }
26              
27             =head1 SYNOPSIS
28              
29             =head2 Using DSL
30              
31             package MyModel::Dinosaur;
32             use Mandel::Document;
33             has_one cat => 'MyModel::Cat';
34              
35             =head2 Using object oriented interface
36              
37             MyModel::Dinosaur->model->relationship(
38             "has_one",
39             "cat",
40             "MyModel::Cat",
41             );
42              
43             =head2 Methods generated
44              
45             $cat = MyModel::Dinosaur->new->cat(\%args, $cb);
46             $cat = MyModel::Dinosaur->new->cat($person_obj, $cb);
47              
48             $person_obj = MyModel::Dinosaur->new->cat(\%args);
49             $person_obj = MyModel::Dinosaur->new->cat($person_obj);
50              
51             $person = MyModel::Dinosaur->new->cat;
52             $self = MyModel::Dinosaur->new->cat(sub { my($self, $err, $person) = @_; });
53              
54             See also L.
55              
56             =cut
57              
58 1     1   707 use Mojo::Base 'Mandel::Relationship';
  1         2  
  1         5  
59 1     1   130 use Mojo::Util;
  1         2  
  1         35  
60 1     1   5 use Mango::BSON 'bson_dbref';
  1         2  
  1         1180  
61              
62             =head1 METHODS
63              
64             =head2 monkey_patch
65              
66             Add methods to L.
67              
68             =cut
69              
70             sub monkey_patch {
71 1     1 1 26 my $self = shift;
72 1         8 my $foreign_field = $self->foreign_field;
73 1         12 my $accessor = $self->accessor;
74              
75             Mojo::Util::monkey_patch(
76             $self->document_class,
77             $accessor,
78             sub {
79 1 50   1   23 my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
        1      
80 1         2 my $doc = shift;
81 1         1 my $obj = shift;
82 1         7 my $related_model = $self->_related_model;
83 1         8 my $related_collection = $related_model->new_collection($doc->connection);
84              
85 1 50 0     21 if ($obj) { # set ===========================================================
    0          
86 1 50       4 if (ref $obj eq 'HASH') {
87 1         4 $obj = $related_collection->create($obj);
88             }
89              
90 1         25 $obj->data->{$foreign_field} = bson_dbref $doc->model->collection_name, $doc->id;
91              
92             # Blocking
93 1 50       85 unless ($cb) {
94 0         0 $related_collection->search({sprintf('%s.$id', $foreign_field), $doc->id})->remove();
95 0         0 $obj->save;
96 0         0 $doc->save;
97 0         0 $doc->_cache($accessor => $obj);
98 0         0 return $obj;
99             }
100              
101             # Non-blocking
102             Mojo::IOLoop->delay(
103             sub {
104 1     1   134 my ($delay) = @_;
105 1         6 $related_collection->search({sprintf('%s.$id', $foreign_field), $doc->id})->remove($delay->begin);
106             },
107             sub {
108 1     1   142 my ($delay, $err) = @_;
109 1 50       5 return $delay->begin(0)->($err) if $err;
110 0         0 $doc->save($delay->begin);
111 0         0 $obj->save($delay->begin);
112             },
113             sub {
114 1     1   80 my ($delay, $o_err, $d_err) = @_;
115 1   33     5 my $err = $o_err || $d_err;
116 1 50       4 $doc->_cache($accessor => $obj) unless $err;
117 1         2 $doc->$cb($err, $obj);
118             },
119 1         13 );
120             }
121             elsif (!delete $doc->{fresh} and my $cached = $doc->_cache($accessor)) { # get cached
122 0 0       0 return $cached unless $cb;
123 0         0 $self->$cb('', $cached);
124             }
125             else { # get =============================================================
126 0         0 my $cursor = $related_collection->search({sprintf('%s.$id', $foreign_field), $doc->id});
127 0 0       0 return $cursor->single unless $cb;
128 0     0   0 $cursor->single(sub { $doc->$cb(@_[1, 2]) });
  0         0  
129             }
130              
131 1         180 return $doc;
132             }
133 1         7 );
134              
135 1         34 return $self;
136             }
137              
138             =head1 SEE ALSO
139              
140             L, L, L
141              
142             =head1 AUTHOR
143              
144             Jan Henning Thorsen - C
145              
146             =cut
147              
148             1;