File Coverage

blib/lib/Mango/Database.pm

Criterion	Covered	Total	%
statement	15	66	22.7
branch	0	22	0.0
condition	0	3	0.0
subroutine	5	17	29.4
pod	8	8	100.0
total	28	116	24.1

package Mango::Database;
use Mojo::Base -base;

use Carp 'croak';
use Mango::BSON qw(bson_code bson_doc);
use Mango::Collection;
use Mango::GridFS;

has [qw(mango name)];

sub build_write_concern {
  my $mango = shift->mango;
  return {
    j => $mango->j ? \1 : \0,
    w => $mango->w,
    wtimeout => $mango->wtimeout
  };
}

sub collection {
  my ($self, $name) = @_;
  return Mango::Collection->new(db => $self, name => $name);
}

sub collection_names {
  my $self = shift;
  my $cb = ref $_[-1] eq 'CODE' ? pop : undef;

  # Non-blocking
  return $self->list_collections(@_ => sub {
    my ($self, $err, $cursor) = @_;
    return $self->$cb($err, []) if $err;
    $cursor->all(sub {
      my ($cursor, $err, $docs) = @_;
      @$docs = map { $_->{name} } @$docs;
      $self->$cb($err, $docs);
    });
  }) if $cb;

  # Blocking
  my $docs = $self->list_collections(@_)->all;
  @$docs = map { $_->{name} } @$docs;
  return $docs;
}

sub command {
  my ($self, $command) = (shift, shift);
  my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
  $command = ref $command ? $command : bson_doc($command => 1, @_);

  # Non-blocking
  my $mango    = $self->mango;
  my $name     = $self->name;
  my $protocol = $mango->protocol;
  return $mango->query(
    ("$name.\$cmd", {}, 0, -1, $command, {}) => sub {
      my ($collection, $err, $reply) = @_;
      my $doc = $reply->{docs}[0];
      $err ||= $protocol->command_error($doc);
      $self->$cb($err, $doc);
    }
  ) if $cb;

  # Blocking
  my $doc = $mango->query("$name.\$cmd", {}, 0, -1, $command, {})->{docs}[0];
  if (my $err = $protocol->command_error($doc)) { croak $err }
  return $doc;
}

sub dereference {
  my ($self, $dbref, $cb) = @_;

  # Non-blocking
  my $collection = $self->collection($dbref->{'$ref'});
  return $collection->find_one($dbref->{'$id'} => sub { shift; $self->$cb(@_) }
  ) if $cb;

  # Blocking
  return $collection->find_one($dbref->{'$id'});
}

sub gridfs { Mango::GridFS->new(db => shift) }

sub list_collections {
  my $self = shift;
  my $cb = ref $_[-1] eq 'CODE' ? pop : undef;

  my $command = bson_doc(listCollections => 1, @_);

  # Non-blocking
  return $self->command($command => sub {
    my ($self, $err, $res) = @_;
    $res = $res->{cursor};
    my $cursor = Mango::Cursor->new(collection => $self->collection,
      id => $res->{id}, ns => $res->{ns})->add_batch($res->{firstBatch});
    $self->$cb($err, $cursor);
  }) if $cb;

  # Blocking
  my $cursor = $self->command($command)->{cursor};
  return Mango::Cursor->new(collection => $self->collection,
    id => $cursor->{id}, ns => $cursor->{ns})
    ->add_batch($cursor->{firstBatch});
}

sub stats { shift->command(bson_doc(dbstats => 1), @_) }

1;

=encoding utf8

=head1 NAME

Mango::Database - MongoDB database

=head1 SYNOPSIS

  use Mango::Database;

  my $db = Mango::Database->new(mango => $mango);
  my $collection = $db->collection('foo');
  my $gridfs     = $db->gridfs;

=head1 DESCRIPTION

L is a container for MongoDB databases used by L.

=head1 ATTRIBUTES

L implements the following attributes.

=head2 mango

  my $mango = $db->mango;
  $db       = $db->mango(Mango->new);

L object this database belongs to. Note that this reference is usually
weakened, so the L object needs to be referenced elsewhere as well.

=head2 name

  my $name = $db->name;
  $db      = $db->name('bar');

Name of this database.

=head1 METHODS

L inherits all methods from L and implements the
following new ones.

=head2 build_write_concern

  my $concern = $db->build_write_concern;

Build write concern based on l settings.

=head2 collection

  my $collection = $db->collection('foo');

Build L object for collection.

=head2 collection_names

  my $names = $db->collection_names;

Names of all collections in this database. You can filter the results by using
the same arguments as for C. You can also append a callback
to perform operation non-blocking.

  $db->collection_names(sub {
    my ($db, $err, $names) = @_;
    ...
  });
  Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

=head2 command

  my $doc = $db->command(bson_doc(text => 'foo.bar', search => 'test'));
  my $doc = $db->command(bson_doc(getLastError => 1, w => 2));
  my $doc = $db->command('getLastError', w => 2);

Run command against database. You can also append a callback to run command
non-blocking.

  $db->command(('getLastError', w => 2) => sub {
    my ($db, $err, $doc) = @_;
    ...
  });
  Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

=head2 dereference

  my $doc = $db->dereference($dbref);

Resolve database reference. You can also append a callback to perform
operation non-blocking.

  $db->dereference($dbref => sub {
    my ($db, $err, $doc) = @_;
    ...
  });
  Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

=head2 gridfs

  my $gridfs = $db->gridfs;

Build L object.

=head2 list_collections

  # return a cursor for all collections
  my $cursor = $db->list_collections;
  # only collections which name matchs a regex
  my $cursor = $db->list_collections(filter => { name => qr{^prefix} });
  # only capped collections
  my $cursor = $db->list_collections(filter => { 'options.capped' => 1 });
  # only the first 10 collections
  my $cursor = $db->list_collections(cursor => { batchSize => 10 });

Returns a L of all collections in this database. Each collection
is represented by a document containing at least the keys C and
C. You can also append a callback to perform operation non-blocking.

  $db->list_collections(sub {
    my ($db, $err, $cursor) = @_;
    ...
  });
  Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

=head2 stats

  my $stats = $db->stats;

Get database statistics. You can also append a callback to perform operation
non-blocking.

  $db->stats(sub {
    my ($db, $err, $stats) = @_;
    ...
  });
  Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

=head1 SEE ALSO

L, L, L.

=cut