1package Mango::Database; 2use Mojo::Base -base; 3 4use Carp 'croak'; 5use Mango::BSON qw(bson_code bson_doc); 6use Mango::Collection; 7use Mango::GridFS; 8 9has [qw(mango name)]; 10 11sub build_write_concern { 12 my $mango = shift->mango; 13 return { 14 j => $mango->j ? \1 : \0, 15 w => $mango->w, 16 wtimeout => $mango->wtimeout 17 }; 18} 19 20sub collection { 21 my ($self, $name) = @_; 22 return Mango::Collection->new(db => $self, name => $name); 23} 24 25sub collection_names { 26 my $self = shift; 27 my $cb = ref $_[-1] eq 'CODE' ? pop : undef; 28 29 # Non-blocking 30 return $self->list_collections(@_ => sub { 31 my ($self, $err, $cursor) = @_; 32 return $self->$cb($err, []) if $err; 33 $cursor->all(sub { 34 my ($cursor, $err, $docs) = @_; 35 @$docs = map { $_->{name} } @$docs; 36 $self->$cb($err, $docs); 37 }); 38 }) if $cb; 39 40 # Blocking 41 my $docs = $self->list_collections(@_)->all; 42 @$docs = map { $_->{name} } @$docs; 43 return $docs; 44} 45 46sub command { 47 my ($self, $command) = (shift, shift); 48 my $cb = ref $_[-1] eq 'CODE' ? pop : undef; 49 $command = ref $command ? $command : bson_doc($command => 1, @_); 50 51 # Non-blocking 52 my $mango = $self->mango; 53 my $name = $self->name; 54 my $protocol = $mango->protocol; 55 return $mango->query( 56 ("$name.\$cmd", {}, 0, -1, $command, {}) => sub { 57 my ($collection, $err, $reply) = @_; 58 my $doc = $reply->{docs}[0]; 59 $err ||= $protocol->command_error($doc); 60 $self->$cb($err, $doc); 61 } 62 ) if $cb; 63 64 # Blocking 65 my $doc = $mango->query("$name.\$cmd", {}, 0, -1, $command, {})->{docs}[0]; 66 if (my $err = $protocol->command_error($doc)) { croak $err } 67 return $doc; 68} 69 70sub dereference { 71 my ($self, $dbref, $cb) = @_; 72 73 # Non-blocking 74 my $collection = $self->collection($dbref->{'$ref'}); 75 return $collection->find_one($dbref->{'$id'} => sub { shift; $self->$cb(@_) } 76 ) if $cb; 77 78 # Blocking 79 return $collection->find_one($dbref->{'$id'}); 80} 81 82sub gridfs { Mango::GridFS->new(db => shift) } 83 84sub list_collections { 85 my $self = shift; 86 my $cb = ref $_[-1] eq 'CODE' ? pop : undef; 87 88 my $command = bson_doc(listCollections => 1, @_); 89 90 # Non-blocking 91 return $self->command($command => sub { 92 my ($self, $err, $res) = @_; 93 $res = $res->{cursor}; 94 my $cursor = Mango::Cursor->new(collection => $self->collection, 95 id => $res->{id}, ns => $res->{ns})->add_batch($res->{firstBatch}); 96 $self->$cb($err, $cursor); 97 }) if $cb; 98 99 # Blocking 100 my $cursor = $self->command($command)->{cursor}; 101 return Mango::Cursor->new(collection => $self->collection, 102 id => $cursor->{id}, ns => $cursor->{ns}) 103 ->add_batch($cursor->{firstBatch}); 104} 105 106sub stats { shift->command(bson_doc(dbstats => 1), @_) } 107 1081; 109 110=encoding utf8 111 112=head1 NAME 113 114Mango::Database - MongoDB database 115 116=head1 SYNOPSIS 117 118 use Mango::Database; 119 120 my $db = Mango::Database->new(mango => $mango); 121 my $collection = $db->collection('foo'); 122 my $gridfs = $db->gridfs; 123 124=head1 DESCRIPTION 125 126L<Mango::Database> is a container for MongoDB databases used by L<Mango>. 127 128=head1 ATTRIBUTES 129 130L<Mango::Database> implements the following attributes. 131 132=head2 mango 133 134 my $mango = $db->mango; 135 $db = $db->mango(Mango->new); 136 137L<Mango> object this database belongs to. Note that this reference is usually 138weakened, so the L<Mango> object needs to be referenced elsewhere as well. 139 140=head2 name 141 142 my $name = $db->name; 143 $db = $db->name('bar'); 144 145Name of this database. 146 147=head1 METHODS 148 149L<Mango::Database> inherits all methods from L<Mojo::Base> and implements the 150following new ones. 151 152=head2 build_write_concern 153 154 my $concern = $db->build_write_concern; 155 156Build write concern based on l</"mango"> settings. 157 158=head2 collection 159 160 my $collection = $db->collection('foo'); 161 162Build L<Mango::Collection> object for collection. 163 164=head2 collection_names 165 166 my $names = $db->collection_names; 167 168Names of all collections in this database. You can filter the results by using 169the same arguments as for C<list_collections>. You can also append a callback 170to perform operation non-blocking. 171 172 $db->collection_names(sub { 173 my ($db, $err, $names) = @_; 174 ... 175 }); 176 Mojo::IOLoop->start unless Mojo::IOLoop->is_running; 177 178=head2 command 179 180 my $doc = $db->command(bson_doc(text => 'foo.bar', search => 'test')); 181 my $doc = $db->command(bson_doc(getLastError => 1, w => 2)); 182 my $doc = $db->command('getLastError', w => 2); 183 184Run command against database. You can also append a callback to run command 185non-blocking. 186 187 $db->command(('getLastError', w => 2) => sub { 188 my ($db, $err, $doc) = @_; 189 ... 190 }); 191 Mojo::IOLoop->start unless Mojo::IOLoop->is_running; 192 193=head2 dereference 194 195 my $doc = $db->dereference($dbref); 196 197Resolve database reference. You can also append a callback to perform 198operation non-blocking. 199 200 $db->dereference($dbref => sub { 201 my ($db, $err, $doc) = @_; 202 ... 203 }); 204 Mojo::IOLoop->start unless Mojo::IOLoop->is_running; 205 206=head2 gridfs 207 208 my $gridfs = $db->gridfs; 209 210Build L<Mango::GridFS> object. 211 212=head2 list_collections 213 214 # return a cursor for all collections 215 my $cursor = $db->list_collections; 216 # only collections which name matchs a regex 217 my $cursor = $db->list_collections(filter => { name => qr{^prefix} }); 218 # only capped collections 219 my $cursor = $db->list_collections(filter => { 'options.capped' => 1 }); 220 # only the first 10 collections 221 my $cursor = $db->list_collections(cursor => { batchSize => 10 }); 222 223Returns a L<Mango::Cursor> of all collections in this database. Each collection 224is represented by a document containing at least the keys C<name> and 225C<options>. You can also append a callback to perform operation non-blocking. 226 227 $db->list_collections(sub { 228 my ($db, $err, $cursor) = @_; 229 ... 230 }); 231 Mojo::IOLoop->start unless Mojo::IOLoop->is_running; 232 233=head2 stats 234 235 my $stats = $db->stats; 236 237Get database statistics. You can also append a callback to perform operation 238non-blocking. 239 240 $db->stats(sub { 241 my ($db, $err, $stats) = @_; 242 ... 243 }); 244 Mojo::IOLoop->start unless Mojo::IOLoop->is_running; 245 246=head1 SEE ALSO 247 248L<Mango>, L<Mojolicious::Guides>, L<http://mojolicio.us>. 249 250=cut 251