our
$VERSION
=
'v0.999.998.6'
;
has
db_name
=> (
is
=>
'ro'
,
isa
=> Str,
required
=> 1,
);
has
client
=> (
is
=>
'ro'
,
isa
=> InstanceOf[
'MongoDB::MongoClient'
],
required
=> 1,
);
with
$_
for
qw(
MongoDB::Role::_ReadOp
MongoDB::Role::_CommandCursorOp
)
;
sub
execute {
my
(
$self
,
$link
,
$topology
) =
@_
;
my
$res
=
$link
->accepts_wire_version(3)
?
$self
->_command_list_colls(
$link
,
$topology
)
:
$self
->_legacy_list_colls(
$link
,
$topology
);
return
$res
;
}
sub
_command_list_colls {
my
(
$self
,
$link
,
$topology
) =
@_
;
my
$op
= MongoDB::Op::_Command->new(
db_name
=>
$self
->db_name,
query
=> Tie::IxHash->new(
listCollections
=> 1,
cursor
=> {} ),
read_preference
=>
$self
->read_preference,
bson_codec
=>
$self
->bson_codec,
);
my
$res
=
$op
->execute(
$link
,
$topology
);
return
$self
->_build_result_from_cursor(
$res
);
}
sub
_legacy_list_colls {
my
(
$self
,
$link
,
$topology
) =
@_
;
my
$db_name
=
$self
->db_name;
my
$op
= MongoDB::Op::_Query->new(
db_name
=>
$self
->db_name,
coll_name
=>
'system.namespaces'
,
client
=>
$self
->client,
bson_codec
=>
$self
->bson_codec,
query
=> Tie::IxHash->new(),
read_preference
=>
$self
->read_preference,
post_filter
=> \
&__filter_legacy_names
,
);
return
$op
->execute(
$link
,
$topology
);
}
sub
__filter_legacy_names {
my
$doc
=
shift
;
$doc
->{name} =~ s/^[^.]+\.//;
my
$name
=
$doc
->{name};
return
!(
index
(
$name
,
'$'
) >= 0 &&
index
(
$name
,
'.oplog.$'
) < 0 );
}
1;