diff --git a/Changes b/Changes
index 24c80f72..1366e3ba 100644
--- a/Changes
+++ b/Changes
@@ -2,6 +2,24 @@
{{ $NEXT }}
+ [Enhancements]
+
+ - PERL-130 improved support for connection string URI; added support for
+ options: ssl, connectTimeoutMS, w, wtimeoutMS, and journal
+
+ [Bug fixes]
+
+ - PERL-130 fixed parsing of connection string to allow for usernames containing :
+ and passwords containing @ if they are percent encoded (RFC 3986)
+
+ [Documentation]
+
+ - PERL-130 documented supported connection string options
+
+ [Testing]
+
+ - PERL-130 added tests for connection string options and percent encoded username/password
+
v0.704.2.0 2014-07-08 12:04:02-04:00 America/New_York
[Bug fixes]
diff --git a/lib/MongoDB/MongoClient.pm b/lib/MongoDB/MongoClient.pm
index 4fb791e0..ed39f279 100644
--- a/lib/MongoDB/MongoClient.pm
+++ b/lib/MongoDB/MongoClient.pm
@@ -139,7 +139,7 @@ has auto_connect => (
);
has timeout => (
- is => 'ro',
+ is => 'rw',
isa => 'Int',
required => 1,
default => 20000,
@@ -210,7 +210,7 @@ has _is_mongos => (
);
has ssl => (
- is => 'ro',
+ is => 'rw',
isa => 'Bool',
required => 1,
default => 0,
@@ -315,14 +315,23 @@ sub BUILD {
if (%parsed_connection) {
@pairs = @{$parsed_connection{hostpairs}};
- my $options = $parsed_connection{options};
# we add these things to $opts as well as self so that they get propagated when we recurse for multiple servers
for my $k ( qw/username password db_name/ ) {
$self->$k($opts->{$k} = $parsed_connection{$k}) if exists $parsed_connection{$k};
}
- # TODO handle standard options from $options
+ # Process options
+ my %options = %{$parsed_connection{options}} if defined $parsed_connection{options};
+
+ # Add connection options
+ $self->ssl($opts->{ssl} = _str_to_bool($options{ssl})) if exists $options{ssl};
+ $self->timeout($opts->{timeout} = $options{connectTimeoutMS}) if exists $options{connectTimeoutMS};
+
+ # Add write concern options
+ $self->w($opts->{w} = $options{w}) if exists $options{w};
+ $self->wtimeout($opts->{wtimeout} = $options{wtimeoutMS}) if exists $options{wtimeoutMS};
+ $self->j($opts->{j} = _str_to_bool($options{journal})) if exists $options{journal};
}
# deprecated syntax
else {
@@ -399,6 +408,20 @@ sub BUILD {
$self->_init_conn_holder($master);
}
+sub _str_to_bool {
+ my $str = shift;
+ confess "cannot convert undef to bool" unless defined $str;
+ my $ret = $str eq "true" ? 1 : $str eq "false" ? 0 : undef;
+ return $ret unless !defined $ret;
+ confess "expected boolean string 'true' or 'false' but instead received '$str'";
+}
+
+sub _unescape_all {
+ my $str = shift;
+ $str =~ s/%([0-9a-f]{2})/chr(hex($1))/ieg;
+ return $str;
+}
+
sub _parse_connection_string {
my ($host) = @_;
@@ -416,15 +439,29 @@ sub _parse_connection_string {
($result{username}, $result{password}, $result{hostpairs}, $result{db_name}, $result{options}) = ($1, $2, $3, $4, $5);
+ # Decode components
+ for my $subcomponent ( qw/username password db_name/ ) {
+ $result{$subcomponent} = _unescape_all($result{$subcomponent}) unless !(defined $result{$subcomponent});
+ }
+
$result{hostpairs} = 'localhost' unless $result{hostpairs};
- my @pairs = map { $_ .= ':27017' unless $_ =~ /:/ ; $_ } split ',', $result{hostpairs};
- $result{hostpairs} = \@pairs;
+ $result{hostpairs} = [
+ map { @_ = split ':', $_; _unescape_all($_[0]).":"._unescape_all($_[1]) }
+ map { $_ .= ':27017' unless $_ =~ /:/ ; $_ } split ',', $result{hostpairs}
+ ];
+
+ $result{options} =
+ { map {
+ my @kv = split '=', $_;
+ confess 'expected key value pair' unless @kv == 2;
+ ($kv[0], $kv[1]) = (_unescape_all($kv[0]), _unescape_all($kv[1]));
+ @kv;
+ } split '&', $result{options}
+ } if defined $result{options};
delete $result{username} unless defined $result{username} && length $result{username};
delete $result{password} unless defined $result{password}; # can be empty string
delete $result{db_name} unless defined $result{db_name} && length $result{db_name};
-
- # TODO parse options
}
return %result;
@@ -1021,6 +1058,8 @@ is true, then connections will be re-established as needed.
Core documentation on connections: L.
+The currently supported connection string options are ssl, connectTimeoutMS, w, wtimeoutMS, and journal.
+
=attr host
Server or servers to connect to. Defaults to C.
diff --git a/t/connection.t b/t/connection.t
index faa59bb4..a3d29630 100644
--- a/t/connection.t
+++ b/t/connection.t
@@ -131,6 +131,40 @@ SKIP: {
$testdb->drop;
}
+subtest "options" => sub {
+
+ subtest "connection" => sub {
+
+ my $ssl = "true";
+ my $timeout = 40000;
+ my $client = MongoDB::MongoClient->new({host => "mongodb://localhost/?ssl=$ssl&connectTimeoutMS=$timeout"});
+
+ is( $client->ssl, 1, "connect with ssl set" );
+ is( $client->timeout, $timeout, "connection timeout set" );
+ };
+
+ subtest "invalid option value" => sub {
+
+ like(
+ exception { MongoDB::MongoClient->new({host => "mongodb://localhost/?ssl="}) },
+ qr/expected key value pair/,
+ 'key should have value'
+ );
+ };
+
+ subtest "write concern" => sub {
+
+ my $w = 2;
+ my $wtimeout = 200;
+ my $j = "true";
+ my $client = MongoDB::MongoClient->new({host => "mongodb://localhost/?w=$w&wtimeoutMS=$wtimeout&journal=$j"});
+
+ is( $client->w, $w, "write acknowledgement set" );
+ is( $client->wtimeout, $wtimeout, "write acknowledgement timeout set" );
+ is( $client->j, 1, "sync to journal" );
+ };
+};
+
# query_timeout
{
diff --git a/t/connection_string.t b/t/connection_string.t
index 8aed75c4..e49b5a24 100644
--- a/t/connection_string.t
+++ b/t/connection_string.t
@@ -122,4 +122,14 @@ subtest "multiple hostnames (localhost/domain)" => sub {
is_deeply($parsed_connection{hostpairs}, \@hostpairs);
};
+subtest "percent encoded username and password" => sub {
+
+ my %parsed_connection = MongoDB::MongoClient::_parse_connection_string('mongodb://dog%3Adogston:p%40ssword@localhost');
+ my @hostpairs = ('localhost:27017');
+
+ is($parsed_connection{username}, 'dog:dogston');
+ is($parsed_connection{password}, 'p@ssword');
+ is_deeply($parsed_connection{hostpairs}, \@hostpairs);
+};
+
done_testing;