#
#  Copyright 2014 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.
#
package MongoDB::_Server;
use version;
our $VERSION = 'v0.999.999.6'; # TRIAL
use Moo;
use MongoDB::_Types qw(
    NonNegNum
    HostAddress
    ServerType
    HostAddressList
);
use Types::Standard qw(
    Bool
    InstanceOf
    HashRef
    Str
    Num
);
use List::Util qw/first/;
use Time::HiRes qw/time/;
use namespace::clean -except => 'meta';
# address: the hostname or IP, and the port number, that the client connects
# to. Note that this is not the server's ismaster.me field, in the case that
# the server reports an address different from the address the client uses.
has address => (
    is       => 'ro',
    isa      => HostAddress,
    coerce   => HostAddress->coercion,
    required => 1,
);
# lastUpdateTime: when this server was last checked. Default "infinity ago".
has last_update_time => (
    is       => 'ro',
    isa      => Num, # floating point time
    required => 1,
);
# error: information about the last error related to this server. Default null.
has error => (
    is      => 'ro',
    isa     => Str,
    default => '',
);
# roundTripTime: the duration of the ismaster call. Default null.
has rtt_sec => (
    is      => 'ro',
    isa     => NonNegNum,
    default => 0,
);
# is_master: hashref returned from an is_master command
has is_master => (
    is      => 'ro',
    isa     => HashRef,
    default => sub { {} },
);
# type: a ServerType enum value. Default Unknown.  Definitions from the Server
# Discovery and Monitoring Spec:
# - Unknown     Initial, or after a network error or failed ismaster call, or "ok: 1"
#   not in ismaster response.
# - Standalone  No "msg: isdbgrid", no setName, and no "isreplicaset: true".
# - Mongos      "msg: isdbgrid".
# - RSPrimary   "ismaster: true", "setName" in response.
# - RSSecondary "secondary: true", "setName" in response.
# - RSArbiter   "arbiterOnly: true", "setName" in response.
# - RSOther     "setName" in response, "hidden: true" or not primary, secondary, nor arbiter.
# - RSGhost     "isreplicaset: true" in response.
# - PossiblePrimary     Not yet checked, but another member thinks it is the primary.
has type => (
    is      => 'lazy',
    isa     => ServerType,
    builder => '_build_type',
    writer  => '_set_type',
);
sub _build_type {
    my ($self) = @_;
    my $is_master = $self->is_master;
    if ( !$is_master->{ok} ) {
        return 'Unknown';
    }
    elsif ( $is_master->{msg} && $is_master->{msg} eq 'isdbgrid' ) {
        return 'Mongos';
    }
    elsif ( $is_master->{isreplicaset} ) {
        return 'RSGhost';
    }
    elsif ( exists $is_master->{setName} ) {
        return
            $is_master->{ismaster}    ? return 'RSPrimary'
          : $is_master->{hidden}      ? return 'RSOther'
          : $is_master->{secondary}   ? return 'RSSecondary'
          : $is_master->{arbiterOnly} ? return 'RSArbiter'
          :                             'RSOther';
    }
    else {
        return 'Standalone';
    }
}
# hosts, passives, arbiters: Sets of addresses. This server's opinion of the
# replica set's members, if any. Default empty. The client monitors all three
# types of servers in a replica set.
for my $s (qw/hosts passives arbiters/) {
    has $s => (
        is      => 'lazy',
        isa     => HostAddressList,
        builder => "_build_$s",
        coerce  => HostAddressList->coercion,
    );
    no strict 'refs';
    *{"_build_$s"} = sub { $_[0]->is_master->{$s} || [] };
}
# address configured as part of replica set: string or null. Default null.
has me => (
    is      => 'lazy',
    isa     => Str,
    builder => "_build_me",
);
sub _build_me {
    my ($self) = @_;
    return $self->is_master->{me} || '';
}
# setName: string or null. Default null.
has set_name => (
    is      => 'lazy',
    isa     => Str,
    builder => "_build_set_name",
);
sub _build_set_name {
    my ($self) = @_;
    return $self->is_master->{setName} || '';
}
# primary: an address. This server's opinion of who the primary is. Default
# null.
has primary => (
    is      => 'lazy',
    isa     => Str,           # not HostAddress -- might be empty string
    builder => "_build_primary",
);
sub _build_primary {
    my ($self) = @_;
    return $self->is_master->{primary} || '';
}
# tags: (a tag set) map from string to string. Default empty.
has tags => (
    is      => 'lazy',
    isa     => HashRef,
    builder => "_build_tags",
);
sub _build_tags {
    my ($self) = @_;
    return $self->is_master->{tags} || {};
}
has is_available => (
    is      => 'lazy',
    isa     => Bool,
    builder => "_build_is_available",
);
sub _build_is_available {
    my ($self) = @_;
    return $self->type ne 'Unknown' && $self->type ne 'PossiblePrimary';
}
has is_readable => (
    is      => 'lazy',
    isa     => Bool,
    builder => "_build_is_readable",
);
# any of these can take reads. Topologies will screen inappropriate
# ones out. E.g. "Standalone" won't be found in a replica set topology.
sub _build_is_readable {
    my ($self) = @_;
    my $type = $self->type;
    return !! grep { $type eq $_ } qw/Standalone RSPrimary RSSecondary Mongos/;
}
has is_writable => (
    is      => 'lazy',
    isa     => Bool,
    builder => "_build_is_writable",
);
# any of these can take writes. Topologies will screen inappropriate
# ones out. E.g. "Standalone" won't be found in a replica set topology.
sub _build_is_writable {
    my ($self) = @_;
    my $type = $self->type;
    return !! grep { $type eq $_ } qw/Standalone RSPrimary Mongos/;
}
sub updated_since {
    my ( $self, $time ) = @_;
    return( ($self->last_update_time - $time) > 0 );
}
# check if server matches a single tag set (NOT a tag set list)
sub matches_tag_set {
    my ( $self, $ts ) = @_;
    no warnings 'uninitialized'; # let undef equal empty string without complaint
    my $tg = $self->tags;
    # check if ts is a subset of tg: if any tags in ts that aren't in tg or where
    # the tag values aren't equal mean ts is NOT a subset
    if ( !defined first { !exists( $tg->{$_} ) || $tg->{$_} ne $ts->{$_} } keys %$ts ) {
        return 1;
    }
    return;
}
sub status_string {
    my ($self) = @_;
    if ( my $err = $self->error ) {
        $err =~ tr[\n][ ];
        return
          sprintf( "%s (type: %s, error: %s)", $self->{address}, $self->{type}, $err);
    }
    else {
        return sprintf( "%s (type: %s)", map { $self->$_ } qw/address type/ );
    }
}
sub status_struct {
    my ($self) = @_;
    my $info = {
        address          => $self->address,
        type             => $self->type,
        last_update_time => $self->last_update_time,
    };
    $info->{error} = $self->error         if $self->error;
    $info->{tags}  = { %{ $self->tags } } if %{ $self->tags };
    return $info;
}
1;
# vim: ts=4 sts=4 sw=4 et: