PERL-805 Implement database enumeration spec

lib/MongoDB/MongoClient.pm

@@ -1516,24 +1516,35 @@ sub send_read_op {
 # database helper methods
 #--------------------------------------------------------------------------#
 
-=method database_names
+=method list_databases
 
-    my @dbs = $client->database_names;
+    # get all information on all databases
+    my @dbs = $client->list_databases;
+
+    # get only the foo databases
+    my @foo_dbs = $client->list_databases({ filter => { name => qr/^foo/ } });
 
-Lists all databases on the MongoDB server.
+Lists all databases with information on each database. Supports filtering by
+any of the output fields under the C<filter> argument, such as:
+
+=for :list
+* C<name>
+* C<sizeOnDisk>
+* C<empty>
+* C<shards>
 
 =cut
 
-sub database_names {
-    my ($self) = @_;
+sub list_databases {
+    my ( $self, $args ) = @_;
 
     my @databases;
     my $max_tries = 3;
     for my $try ( 1 .. $max_tries ) {
         last if try {
-            my $output = $self->send_admin_command([ listDatabases => 1 ])->output;
+            my $output = $self->send_admin_command([ listDatabases => 1, ( $args ? %$args : () ) ])->output;
             if (ref($output) eq 'HASH' && exists $output->{databases}) {
-                @databases = map { $_->{name} } @{ $output->{databases} };
+                @databases = @{ $output->{databases} };
             }
             return 1;
         } catch {
@@ -1547,6 +1558,30 @@ sub database_names {
     return @databases;
 }
 
+=method database_names
+
+    my @dbs = $client->database_names;
+
+    # get only the foo database names
+    my @foo_dbs = $client->database_names({ filter => { name => qr/^foo/ } });
+
+List of all database names on the MongoDB server. Supports filters in the same
+way as L</"list_databases">.
+
+=cut
+
+sub database_names {
+    my ( $self, $args ) = @_;
+
+    $args ||= {};
+    $args->{nameOnly} = 1;
+    my @output = $self->list_databases($args);
+
+    my @databases = map { $_->{name} } @output;
+
+    return @databases;
+}
+
 =method get_database, db
 
     my $database = $client->get_database('foo');

t/enumerate_databases.t

@@ -0,0 +1,104 @@
+#
+#  Copyright 2009-2013 MongoDB, Inc.
+#
+#  Licensed under the Apache License, Version 2.0 (the "License");
+#  you may not use this file except in compliance with the License.
+#  You may obtain a copy of the License at
+#
+#  http://www.apache.org/licenses/LICENSE-2.0
+#
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under the License is distributed on an "AS IS" BASIS,
+#  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+#  See the License for the specific language governing permissions and
+#  limitations under the License.
+#
+
+use strict;
+use warnings;
+use Test::More 0.96;
+use Test::Fatal;
+use Test::Deep qw/!blessed/;
+
+use utf8;
+use Tie::IxHash;
+use MongoDB::Timestamp; # needed if db is being run as master
+use MongoDB::Error;
+use MongoDB::Code;
+
+use MongoDB;
+
+use lib "t/lib";
+use MongoDBTest qw/
+    skip_unless_mongod
+    build_client
+    get_test_db
+    server_version
+    server_type
+    get_unique_collection
+/;
+
+skip_unless_mongod();
+
+my $conn = build_client();
+my $testdb = get_test_db($conn);
+my $server_version = server_version($conn);
+my $server_type = server_type($conn);
+
+subtest 'list databases' => sub {
+    my @test_dbs;
+    my $time_prefix = time();
+
+    for my $prefix ( qw/ foo bar baz / ) {
+        my $db1 = get_test_db( $conn, $prefix . $time_prefix );
+        my $db2 = get_test_db( $conn, $prefix . $time_prefix );
+        # getting a new db is not enough, must insert something into them first
+        get_unique_collection( $db1, 'test' )->insert_one({ _id => 1 });
+        get_unique_collection( $db2, 'test' )->insert_one({ _id => 1 });
+        push @test_dbs, $db1, $db2;
+    }
+    my @all_dbs = $conn->list_databases;
+
+    ok( scalar( @all_dbs ) >= 6, "Found at least 6 databases" );
+
+    my @foo_dbs = $conn->list_databases({ filter => { name => qr/^foo${\$time_prefix}/ } });
+
+    is( scalar( @foo_dbs ), 2, "Found two foo databases" );
+
+    for my $foo_db ( @foo_dbs ) {
+        ok( exists $foo_db->{empty}, "Database has empty attribute" );
+        ok( $foo_db->{name} =~ /^foo${\$time_prefix}/, "Database has correct name" );
+        ok( exists $foo_db->{sizeOnDisk}, "Database has sizeOnDisk attribute" );
+    }
+
+    for my $db ( @test_dbs ) {
+        $db->drop;
+    }
+};
+
+subtest 'list database names' => sub {
+    my @test_dbs;
+    my @test_db_names;
+    my $time_prefix = time();
+
+    for my $prefix ( qw/ foo bar baz / ) {
+        my $db1 = get_test_db( $conn, $prefix . $time_prefix );
+        my $db2 = get_test_db( $conn, $prefix . $time_prefix );
+        # getting a new db is not enough, must insert something into them first
+        get_unique_collection( $db1, 'test' )->insert_one({ _id => 1 });
+        get_unique_collection( $db2, 'test' )->insert_one({ _id => 1 });
+        push @test_dbs, $db1, $db2;
+        push @test_db_names, $db1->{name}, $db2->{name};
+    }
+
+    my @all_names = $conn->database_names({ filter => { name => qr/^(foo|bar|baz)${\$time_prefix}/ } });
+
+    my @sorted_test_db_names = sort @test_db_names;
+    is_deeply( \@all_names, \@sorted_test_db_names, "Got expected set of names" );
+
+    for my $db ( @test_dbs ) {
+        $db->drop;
+    }
+};
+
+done_testing;

t/lib/MongoDBTest.pm

@@ -68,9 +68,9 @@ sub build_client {
 }
 
 sub get_test_db {
-
     my $conn = shift;
-    my $testdb = 'testdb' . int(rand(2**31));
+    my $prefix = shift || 'testdb';
+    my $testdb = $prefix . int(rand(2**31));
     my $db = $conn->get_database($testdb) or die "Can't get database\n";
     push(@testdbs, $db);
     return  $db;