File Coverage

blib/lib/MongoDB/Op/_ListCollections.pm
Criterion Covered Total %
statement 39 65 60.0
branch 0 8 0.0
condition 0 6 0.0
subroutine 13 17 76.4
pod 0 1 0.0
total 52 97 53.6


line stmt bran cond sub pod time code
1             # Copyright 2014 - present MongoDB, Inc.
2             #
3             # Licensed under the Apache License, Version 2.0 (the "License");
4             # you may not use this file except in compliance with the License.
5             # You may obtain a copy of the License at
6             #
7             # http://www.apache.org/licenses/LICENSE-2.0
8             #
9             # Unless required by applicable law or agreed to in writing, software
10             # distributed under the License is distributed on an "AS IS" BASIS,
11             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12             # See the License for the specific language governing permissions and
13             # limitations under the License.
14              
15 59     59   437 use strict;
  59         141  
  59         1847  
16 59     59   314 use warnings;
  59         135  
  59         2128  
17             package MongoDB::Op::_ListCollections;
18              
19             # Encapsulate collection list operations; returns arrayref of collection
20             # names
21              
22 59     59   312 use version;
  59         134  
  59         326  
23             our $VERSION = 'v2.2.1';
24              
25 59     59   4530 use Moo;
  59         141  
  59         313  
26              
27 59     59   18905 use MongoDB::Op::_Command;
  59         184  
  59         1631  
28 59     59   431 use MongoDB::Op::_Query;
  59         139  
  59         1603  
29 59     59   368 use MongoDB::ReadConcern;
  59         144  
  59         1581  
30 59     59   349 use MongoDB::ReadPreference;
  59         141  
  59         1924  
31 59         424 use MongoDB::_Types qw(
32             Document
33             ReadPreference
34 59     59   411 );
  59         150  
35 59         423 use Types::Standard qw(
36             HashRef
37             InstanceOf
38             Str
39 59     59   41241 );
  59         146  
40 59     59   55857 use Tie::IxHash;
  59         147  
  59         1278  
41 59     59   306 use boolean;
  59         124  
  59         515  
42              
43 59     59   4440 use namespace::clean;
  59         141  
  59         360  
44              
45             has client => (
46             is => 'ro',
47             required => 1,
48             isa => InstanceOf['MongoDB::MongoClient'],
49             );
50              
51             has filter => (
52             is => 'ro',
53             required => 1,
54             isa => Document,
55             );
56              
57             has options => (
58             is => 'ro',
59             required => 1,
60             isa => HashRef,
61             );
62              
63             has read_preference => (
64             is => 'rw', # rw for Op::_Query which can be modified by Cursor
65             required => 1,
66             isa => ReadPreference,
67             );
68              
69             with $_ for qw(
70             MongoDB::Role::_PrivateConstructor
71             MongoDB::Role::_DatabaseOp
72             MongoDB::Role::_CommandCursorOp
73             );
74              
75             sub execute {
76 0     0 0   my ( $self, $link, $topology ) = @_;
77              
78 0 0         my $res =
79             $link->supports_list_commands
80             ? $self->_command_list_colls( $link, $topology )
81             : $self->_legacy_list_colls( $link, $topology );
82              
83 0           return $res;
84             }
85              
86             sub _command_list_colls {
87 0     0     my ( $self, $link, $topology ) = @_;
88              
89 0           my $options = $self->options;
90              
91             # batchSize is not a command parameter itself like other options
92 0           my $batchSize = delete $options->{batchSize};
93              
94 0 0         if ( defined $batchSize ) {
95 0           $options->{cursor} = { batchSize => $batchSize };
96             }
97             else {
98 0           $options->{cursor} = {};
99             }
100              
101             # Normalize or delete 'nameOnly'
102 0 0         if ($options->{nameOnly}) {
103 0           $options->{nameOnly} = true;
104             }
105             else {
106 0           delete $options->{nameOnly};
107             }
108              
109             my $filter =
110             ref( $self->filter ) eq 'ARRAY'
111 0 0         ? { @{ $self->filter } }
  0            
112             : $self->filter;
113              
114             my $cmd = Tie::IxHash->new(
115             listCollections => 1,
116             filter => $filter,
117             nameOnly => false,
118 0           %{$self->options},
  0            
119             );
120              
121 0           my $op = MongoDB::Op::_Command->_new(
122             db_name => $self->db_name,
123             query => $cmd,
124             query_flags => {},
125             bson_codec => $self->bson_codec,
126             session => $self->session,
127             monitoring_callback => $self->monitoring_callback,
128             read_preference => $self->read_preference,
129             );
130              
131 0           my $res = $op->execute( $link, $topology );
132              
133 0           return $self->_build_result_from_cursor( $res );
134             }
135              
136             sub _legacy_list_colls {
137 0     0     my ( $self, $link, $topology ) = @_;
138              
139 0   0       my $op = MongoDB::Op::_Query->_new(
140             filter => $self->filter,
141             options => MongoDB::Op::_Query->precondition_options($self->options),
142             db_name => $self->db_name,
143             coll_name => 'system.namespaces',
144             full_name => $self->db_name . ".system.namespaces",
145             bson_codec => $self->bson_codec,
146             client => $self->client,
147             read_preference => $self->read_preference || MongoDB::ReadPreference->new,
148             read_concern => MongoDB::ReadConcern->new,
149             post_filter => \&__filter_legacy_names,
150             monitoring_callback => $self->monitoring_callback,
151             );
152              
153 0           return $op->execute( $link, $topology );
154             }
155              
156             # exclude names with '$' except oplog.$
157             # XXX why do we include oplog.$?
158             sub __filter_legacy_names {
159 0     0     my $doc = shift;
160             # remove leading database name for compatibility with listCollections
161 0           $doc->{name} =~ s/^[^.]+\.//;
162 0           my $name = $doc->{name};
163 0   0       return !( index( $name, '$' ) >= 0 && index( $name, '.oplog.$' ) < 0 );
164             }
165              
166             1;