#!/usr/bin/perl -w -T
# +=======================================================================+
# || cipux_rpc_test_repetition                                           ||
# ||                                                                     ||
# || Repeats a single RPC test for an amount of time.                    ||
# ||                                                                     ||
# || Copyright (C) 2009 by Christian Kuelker. All rights reserved!       ||
# ||                                                                     ||
# || License: GNU GPL version 2 or any later version                     ||
# ||                                                                     ||
# +=======================================================================+
# ID:       $Id$
# Revision: $Revision$
# Head URL: $HeadURL$
# Date:     $Date$
# Source:   $Source$

package cipux_rpc_test_repetition;

use 5.008001;
use strict;
use warnings;
use Carp;
use CipUX::RPC;
use Data::Dumper;
use Date::Manip;
use English qw( -no_match_vars);
use Frontier::Client;
use Getopt::Long;
use Log::Log4perl qw(get_logger :levels);
use Pod::Usage;
use Readonly;

use version; our $VERSION = qv('3.4.0.0');
delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};    # Make %ENV safer

# +==========================================================================+
# || CONST                                                                  ||
# +==========================================================================+
Readonly::Scalar my $EMPTY_STRING => q{};

Readonly::Scalar my $L4P_CONF => ( -e '/etc/cipux/log4perl.conf' )
    ? '/etc/cipux/log4perl.conf'
    : $EMPTY_STRING;

# +==========================================================================+
# || GLOBAL                                                                 ||
# +==========================================================================+
my $login     = 'dummy';
my $password  = undef;
my $ticket    = 'dummy';
my $host      = 'localhost';
my $port      = 8001;
my $proto     = 'http';
my $url       = $proto . q{://} . $host . q{:} . $port . q{/RPC2};
my %opt       = ();
my $starttime = UnixDate( 'today', '%O' );
my $startsec  = time();
my $stopsec   = $startsec;

# +==========================================================================+
# || ENV                                                                    ||
# +==========================================================================+
Getopt::Long::Configure('bundling');
GetOptions(
    \%opt,    'debug|D', 'help|h|?', 'host=s', 'time=i', 'port=i',
    'no-ssl', 'ssl',     'version|V',
    )
    or pod2usage(
    -exitstatus => 2,
    -msg        => "Problems parsing command line!\n"
    );

if ( exists $opt{help} ) {
    pod2usage( -exitstatus => 0, -verbose => 0 );
}

if ( exists $opt{version} ) {
    print "$0 $VERSION\n";
    exit 0;
}

if ( exists $opt{debug} and defined $opt{debug} ) {
    Log::Log4perl::init_once($L4P_CONF);
}

if ( not exists $opt{time} and not defined $opt{time} ) {
    pod2usage(
        -exitstatus => 32,
        -msg        => "Mandatory option --time is missing!\n"
    );

}
else {

    $stopsec += $opt{time};
}

my $logger = get_logger(__PACKAGE__);
$logger->debug('BEGIN');
$logger->debug("url      $url");
$logger->debug("L4P_CONF $L4P_CONF");

# +==========================================================================+
# || MAIN                                                                   ||
# +==========================================================================+

my $rpc = CipUX::RPC->new();
$login = $rpc->login_prompt( { prompt => 'Login: ' } );
$password = $rpc->password_prompt( { prompt => 'Password: ' } );

my $answer_hr = xmlrpc(
    {
        type     => 'login',
        cmd      => 'login',
        param_hr => { password => $password, }
    }
);
print "login status: $answer_hr->{status}\n";

print "start at: $startsec\n";
print "stop  at: $stopsec\n";

my $sec      = $startsec;
my $true     = 0;
my $false    = 0;
my $cmd      = 'cipux_task_list_user_accounts';
my $param_hr = {};

while ( $sec < $stopsec ) {
    print '=' x 76, "\n";
    $answer_hr
        = xmlrpc( { type => 'task', cmd => $cmd, param_hr => $param_hr } );
    print "$cmd at $sec status $answer_hr->{status} ($ticket)\n";
    $sec = time();
    if ( $answer_hr->{status} eq 'TRUE' ) {
        $true++;
    }
    else {
        $false++;
        print Dumper($answer_hr);

        exit 1;
    }

    # simple renew session always
    $answer_hr
        = xmlrpc( { type => 'session', cmd => 'session', param_hr => {} } );
}

print "Summary:\n";
print "start at: $startsec\n";
print "stop  at: $stopsec\n";
print "seconds:  $opt{time}\n";
print "true    : $true\n";
print "false   : $false\n";

exit 0;

sub xmlrpc {

    my ($arg_r) = @_;

    my $type     = $arg_r->{type};
    my $cmd      = $arg_r->{cmd};
    my $param_hr = $arg_r->{param_hr};

    my $logger = get_logger(__PACKAGE__);
    $logger->debug("type: $type");
    $logger->debug("cmd: $cmd");

    my $HEADER_HREF = {
        'cipux_version'  => '3.4.0.0',
        'client_name'    => 'cipux_rpc_test_client',
        'client_version' => '3.4.0.0',
        'rpc_version'    => '2.0',
        'client_key'     => $EMPTY_STRING,
        'client_cred'    => $EMPTY_STRING,
        'gmt_time'       => time(),
    };

    print "pay ticket $ticket\n";
    my $pay_hr = {
        header_hr => $HEADER_HREF,
        login     => $login,
        ticket    => $ticket,
        cmd       => $cmd,
        param_hr  => $param_hr
    };

    my $socket = Frontier::Client->new( url => $url );

    my $answer_hr = $socket->call( $type, $pay_hr );

    $logger->debug( 'answer_hr: ',
        { filter => \&Dumper, value => $answer_hr } );

    my $status = $answer_hr->{status} || 'UNKNOWN';

    # remember, if we got new ticket on the default channel
    if ( defined $answer_hr->{ticket}
        and $answer_hr->{ticket} ne $EMPTY_STRING )
    {
        $ticket = $answer_hr->{ticket};
        print "default channel ticket $ticket\n";
    }

    # but if we got a ticket explcit: eq. login or session
    # we should use this of course
    if (    ref( $answer_hr->{cmdres_r} ) eq 'HASH'
        and defined $answer_hr->{cmdres_r}->{ticket}
        and $answer_hr->{cmdres_r}->{ticket} ne $EMPTY_STRING )
    {
        $ticket = $answer_hr->{cmdres_r}->{ticket};
        print "explicit channel ticket $ticket\n";
    }

    return $answer_hr;

}

__END__


=pod

=head1 NAME

cipux_rpc_test_repetition

=head1 VERSION

version 3.4.0.0

=head1 SYNOPSIS

 cipux_rpc_test_repetition [OPTIONS] --time <SECONDS>
 cipux_rpc_test_repetition --help|-h
 cipux_rpc_test_repetition --version|-V

 Options:
 --debug           : prints debug messages to cipux-test.log
 --host <NAME>     : rpc server address, examples: localhost, 127.0.0.1, ldap
 --no-ssl          : rpc server use no SSL
 --port <NUMBER>   : rpc server port, example: 8001
 --ssl             : rpc server use SSL

=head1 DESCRIPTION

This is a test script for users admins or packages to test if the cipux-RPC
server is working.

=head1 REQUIRED ARGUMENTS

None.

=head1 OPTIONS

=over 4

I<--debug>

Prints debug messages to according /etc/cipux/log4perl.conf

I<-h>

See --help

I<--help>

Prints short usage message.

I<--host NAME>

Address of the RPC server. For example localhost, 127.0.0.1, ldap or other
names.

I<--no-ssl>

Access CipUX XML-RPC server only over http, not https.

I<--port NUMBER>

Port number of the XML RPC server. For example 8001.

I<--ssl>

Access CipUX XML-RPC server over SSL aka https.

I<--time SECONDS>

Executes test up to this amount of time.

=back


=head1 DIAGNOSTICS

=over

=item C<< Problems parsing command line! >>

If Getopt::Long has a non specified problem. See Getopt::Long for details. Most
probable reason is: you provide wrong command line switches or values.

=item C<< Mandatory option --time is missing! >>

The CLI option --time was not given. Give the option '--time <SECONDS>' where
you replace the <SECONDS> with an integer number of seconds > 0. This is the
time you would like to run the test in seconds.

=back


=head1 EXIT STATUS

 1 on failure

 0 on success

 other from XML-RPC server

=head1 CONFIGURATION

Not needed.

=head1 DEPENDENCIES

 Carp
 CipUX::RPC
 Data::Dumper
 Date::Manip
 English
 Frontier::Client
 Getopt::Long
 Log::Log4perl
 Pod::Usage
 Readonly

=head1 INCOMPATIBILITIES

Not known.

=head1 BUGS AND LIMITATIONS

Not known.

=head1 AUTHOR

Christian Kuelker  E<lt>christian.kuelker@cipworx.orgE<gt>

=head1 LICENSE AND COPYRIGHT

Copyright (C) 2009 by Christian Kuelker

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2, or (at
your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
02111-1307 USA


=cut

