diff --git a/lib/MongoDB/_URI.pm b/lib/MongoDB/_URI.pm index 7abcd11e..7d845fef 100644 --- a/lib/MongoDB/_URI.pm +++ b/lib/MongoDB/_URI.pm @@ -30,6 +30,7 @@ use Types::Standard qw( HashRef Str Int + Num ); use namespace::clean -except => 'meta'; use Scalar::Util qw/looks_like_number/; @@ -95,7 +96,7 @@ has valid_options => ( has expires => ( is => 'ro', - isa => Int, + isa => Num, writer => '_set_expires', ); @@ -442,6 +443,14 @@ sub _parse_srv_uri { %{ $result{options} || {} }, }; + # Reset str to bool options to string value, as _parse_options changes it to 0/1 if it exists during parsing + # means we get the correct value when re-building the uri below. + for my $stb_key ( keys %{ $self->_valid_str_to_bool_options } ) { + # use exists just in case + next unless exists $options->{ $stb_key }; + $options->{ $stb_key } = ($options->{ $stb_key } || $options->{ $stb_key } eq 'true') ? 'true' : 'false'; + } + my $auth = ""; if ( defined $result{username} || defined $result{password} ) { $auth = join(":", map { $_ // "" } $result{username}, $result{password}); diff --git a/t/unit/uri_srv.t b/t/unit/uri_srv.t new file mode 100644 index 00000000..df8ca977 --- /dev/null +++ b/t/unit/uri_srv.t @@ -0,0 +1,96 @@ +# Copyright 2019 - present 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; + +{ + package Test::MongoDB::_URI; + use Moo; + extends 'MongoDB::_URI'; + + has _test_seedlist_args => ( + is => 'rw', + ); + + has _test_seedlist_return => ( + is => 'rw', + default => sub {[]}, + ); + + # Net::DNS is an optional dependency, so the original cannot + # actually be run in the general test instance. + # Doesnt stop us from stringing it up for tests though! + sub _fetch_dns_seedlist { + my ( $self, @args ) = @_; + $self->_test_seedlist_args([@args]); + return @{ $self->_test_seedlist_return }; + } +} + +my $class = 'Test::MongoDB::_URI'; + +subtest "boolean params unchanged" => sub { + my $uri = new_ok( $class, [ + uri => 'mongodb+srv://testmongo.example.com/?ssl=true', + _test_seedlist_return => [ + [{ target => 'localhost', port => 27017 }], + { + retryWrites => 'true', + retryReads => 'false', + }, + 0 + ] + ]); + + is_deeply $uri->_test_seedlist_args, [ 'testmongo.example.com', 'init' ], + 'fetch_dns_seedlist called correctly'; + + is_deeply $uri->hostids, [ 'localhost:27017' ], + "hostids correct"; + + is_deeply $uri->options, + { ssl => 1, retrywrites => 1, retryreads => 0 }, + "options correct"; + + subtest "force call srv parsing" => sub { + $uri->_test_seedlist_return([ + [{ target => 'localhost', port => 27019 }], + { + retryWrites => 'false', + retryReads => 'true', + }, + 1 + ]); + my ( $new_uri, $expires ) = $uri->_parse_srv_uri( 'mongodb+srv://testmongo2.example.com/?ssl=true', 'init' ); + + is_deeply $uri->_test_seedlist_args, [ 'testmongo2.example.com', 'init' ], + 'fetch_dns_seedlist called correctly'; + + like $new_uri, qr!^mongodb://localhost:27019/?!, 'URI Host correct'; + + # Cannot use straight comparison as options are hash shuffled + my ($readsVal) = $new_uri =~ qr/retryReads=(\w*)/; + is $readsVal, 'true', 'Retry Reads true'; + my ($writesVal) = $new_uri =~ qr/retryWrites=(\w*)/; + is $writesVal, 'false', 'Retry Writes false'; + my ($sslVal) = $new_uri =~ qr/ssl=(\w*)/; + is $sslVal, 'true', 'SSL true'; + + is $expires, 1, 'expires as expected'; + } +}; + +done_testing; \ No newline at end of file