The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package t::Elive;
use warnings; use strict;

=head1 NAME

t::Elive

=head1 DESCRIPTION

Testing support package for Elive

=cut

=head2 auth

locate test authorization from the environment

=cut

use URI;

sub test_connection {
    my $class = shift;
    my %opt = @_;

    my $suffix = $opt{suffix} || '';
    my %result;

    my $user = $ENV{'ELIVE_TEST_USER'.$suffix};
    my $pass = $ENV{'ELIVE_TEST_PASS'.$suffix};
    my $url  = $ENV{'ELIVE_TEST_URL'.$suffix};

    if (!$opt{only} || $opt{only} eq 'real') {

	if ($url) {
	    my $uri_obj = URI->new($url, 'http');
	    my $userinfo = $uri_obj->userinfo; # credentials supplied in URI

	    if ($userinfo) {
		my ($uri_user, $uri_pass) = split(':', $userinfo, 2);
		$user ||= URI::Escape::uri_unescape($uri_user);
		$pass ||= URI::Escape::uri_unescape($uri_pass)
		    if $uri_pass;
	    }

	    if ($user && $pass && $url !~ m{^mock:}i) {

		if ($url =~ m{/v[1-9](/(webservice\.event)?)?$}) {
		    $result{reason} = '$ELIVE_TEST_URL path is SAS specific ([/instance]/vN[/webservice.event])';
		}
		else {

		    $result{auth} = [$url, $user, $pass];

		    unless ($opt{noload}) {
			#
			# don't give our test a helping hand, We're
			# testing self load of this module by Elive
			#
			eval {require Elive::Connection::SDK}; die $@ if $@;
		    }
		    $result{class} = 'Elive::Connection::SDK';
		}
	    }
	}
	else {
	    $result{reason} = 'skipping live tests (set $ELIVE_TEST_URL'.$suffix.' to enable)';
	}
    }

    if (!$result{auth} && (!$opt{only} || $opt{only} eq 'mock')) {

	if ($opt{only} && $opt{only} eq 'mock') {
	    delete $result{reason};
	}

	unless ($user && $pass && $url && $url =~ m{^mock:}i) {

	    $user = 'test_user'.$suffix;
	    $pass = 'test_pass'.$suffix;
	    $url  = 'mock://elive_test_connection'.$suffix;
	}

	$result{auth} = [$url, $user, $pass];
	eval {require t::Elive::MockConnection}; die $@ if $@;
	$result{class} = 't::Elive::MockConnection';
    }

    if ($result{auth}) {

	foreach (@{ $result{auth} }) {
	    #
	    # untaint
	    #
	    m{(.*)};
	    $_ = $1;
	}

	push (@{$result{auth}}, debug => Elive->debug)
	    if Elive->debug;

	push(@{$result{auth}}, timeout => $opt{timeout})
	    if $opt{timeout};
    }

    return %result;
}

sub generate_id {
    my @chars = ('a' .. 'z', 'A' .. 'Z', '0' .. '9',  '_');
    my @p = map {$chars[ sprintf("%d", rand(scalar @chars)) ]} (1.. 6);

    return join('', @p);
}

=head2 a_week_between

    ok(t::Elive::a_week_between($last_week_t, $this_week_t)

A rough test of times being about a week apart. Anything more
precise is going to require time-zone aware date/time calculations
and will introduce some pretty fat build dependencies.

=cut

sub a_week_between {
    my $start = shift;
    my $end = shift;

    my $seconds_in_a_week = 7 * 24 * 60 * 60;
    #
    # just test that the dates are a week apart to within an hour and a
    # half, or so. This should accomodate daylight savings and other
    # adjustments of up to 1.5 hours.
    #
    my $drift = 1.6 * 60 * 60; # a little over 1.5 hours
    my $ok = abs ($end - $start - $seconds_in_a_week) < $drift;

    return $ok;
}

=head2 a_day_between

    ok(t::Elive::a_day_between($yesterday, $today)

A rough test of times being about a day apart

=cut

sub a_day_between {
    my $start = shift;
    my $end = shift;

    my $seconds_in_a_day = 24 * 60 * 60;
    #
    # just test that the dates are a week apart to within an hour and a
    # half, or so. This should accomodate daylight savings and other
    # adjustments of up to 1.5 hours.
    #
    my $drift = 1.6 * 60 * 60; # a little over 1.5 hours
    my $ok = abs ($end - $start - $seconds_in_a_day) < $drift;

    return $ok;
}

1;