The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
###############################################################################
#
#   Sub Name:       status
#
#   Description:    Create a status-reporting struct and returns it.
#
#   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
#                   $srv      in      ref       Server object instance
#                   $no_inc   in      boolean   A true/false value that tells
#                                                 whether to count this call
#                                                 in the total_requests field.
#
#   Returns:        hashref
#
###############################################################################
sub status
{
    use strict;

    my $srv = shift;
    my $no_inc = shift || 0;

    my $status = {};
    my $time = time;
    my $URI;

    require URI;

    $status->{name} = ref($srv);
    $status->{version} = RPC::XML::string->new($srv->version);
    $status->{host} = $srv->host || $srv->{host} || '';
    $status->{port} = $srv->port || $srv->{port} || '';
    $status->{path} = RPC::XML::string->new($srv->path);
    $status->{date} = RPC::XML::datetime_iso8601
        ->new(RPC::XML::time2iso8601($time));
    $status->{started} = RPC::XML::datetime_iso8601
        ->new(RPC::XML::time2iso8601($srv->started));
    $status->{date_int} = $time;
    $status->{started_int} = $srv->started;
    $status->{total_requests} = $srv->requests();
    # In special cases where the call to system.status is not going to incr
    # the total, don't add the extra here, either...
    $status->{total_requests}++ unless $no_inc;
    $status->{methods_known} = scalar($srv->list_methods);

    $status;
}