# ************************************************************************* 
# Copyright (c) 2014-2015, SUSE LLC
# 
# All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# 
# 1. Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# 
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# 
# 3. Neither the name of SUSE LLC nor the names of its contributors may be
# used to endorse or promote products derived from this software without
# specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# ************************************************************************* 

# ------------------------
# Test helper functions module
# ------------------------

package App::Dochazka::REST::Test;

use strict;
use warnings;

use App::CELL qw( $CELL $log $meta $site );
use App::Dochazka::Common;
use App::Dochazka::REST;
use App::Dochazka::REST::Dispatch;
use App::Dochazka::REST::ConnBank qw( $dbix_conn conn_up );
use App::Dochazka::REST::Util qw( hash_the_password );
use App::Dochazka::REST::Model::Activity;
use App::Dochazka::REST::Model::Component;
use App::Dochazka::REST::Model::Privhistory qw( get_privhistory );
use App::Dochazka::REST::Model::Schedhistory qw( get_schedhistory );
use App::Dochazka::REST::Model::Shared qw( cud_generic noof select_single );
use Authen::Passphrase::SaltedDigest;
use Data::Dumper;
use HTTP::Request::Common qw( GET PUT POST DELETE );
use JSON;
use Params::Validate qw( :all );
use Test::JSON;
use Test::More;
use Try::Tiny;
use Web::MREST;



=head1 NAME

App::Dochazka::REST::Test - Test helper functions





=head1 DESCRIPTION

This module provides helper code for unit tests.

=cut




=head1 EXPORTS

=cut

use Exporter qw( import );
our @EXPORT = qw( 
    initialize_regression_test $faux_context
    req dbi_err docu_check 
    create_testing_employee create_active_employee create_inactive_employee
    delete_testing_employee delete_employee_by_nick
    create_testing_activity delete_testing_activity
    create_testing_component delete_testing_component
    create_testing_schedule delete_testing_schedule delete_all_attendance_data
    gen_activity gen_employee gen_interval gen_lock
    gen_privhistory gen_schedhistory gen_schedule
    test_sql_success test_sql_failure do_select_single
    test_employee_list get_aid_by_code test_schedule_model
);




=head1 PACKAGE VARIABLES

=cut

# faux context
our $faux_context;

# dispatch table with references to HTTP::Request::Common functions
my %methods = ( 
    GET => \&GET,
    PUT => \&PUT,
    POST => \&POST,
    DELETE => \&DELETE,
);




=head1 FUNCTIONS

=cut


=head2 initialize_regression_test

Perform the boilerplate tasks that have to be done at the beginning of every
test file that communicates with the Web::MREST server and/or the PostgreSQL
database. Since both Web::MREST and PostgreSQL are external resources,
tests that make use of them are more than mere unit tests

While some test files do not need *all* of these initialization steps,
there is no harm in running them.

The t/unit/ subdirectory is reserved for test files that need *none* of
these initialization steps. Having them in a separate subdirectory enables
them to be run separately.

=cut

sub initialize_regression_test {

    require App::Dochazka::REST;

    my $status = Web::MREST::init( 
        distro => 'App-Dochazka-REST', 
        sitedir => '/etc/dochazka-rest', 
    );
    plan skip_all => "Web::MREST::init failed: " . $status->text unless $status->ok;

    note( "Set log level" );
    $log->init( 
        ident => $site->MREST_APPNAME, 
        debug_mode => 1,
    );

    note( "Initialize" );
    try {
        App::Dochazka::REST::Dispatch::init();
    } catch {
        $status = $CELL->status_crit( 'DOCHAZKA_MASON_INIT_FAIL', args => [ $_ ] );
    };
    plan skip_all => $status->text unless $status->ok;

    note( "Check status of database server connection" );
    plan skip_all => "PostgreSQL server is unreachable" unless conn_up();

    my $eids = App::Dochazka::REST::get_eid_of( $dbix_conn, "root", "demo" );
    $site->set( 'DOCHAZKA_EID_OF_ROOT', $eids->{'root'} );
    $site->set( 'DOCHAZKA_EID_OF_DEMO', $eids->{'demo'} );

    is( $status->level, 'OK' );
    ok( $site->DOCHAZKA_EID_OF_ROOT );
    ok( $site->DOCHAZKA_EID_OF_DEMO );
    ok( $site->DOCHAZKA_TIMEZONE );

    $faux_context = { 'dbix_conn' => $dbix_conn, 'current' => { 'eid' => 1 } };
    $meta->set( 'META_DOCHAZKA_UNIT_TESTING' => 1 );

    note( "instantiate Web::Machine object for this application" );
    my $app = Web::Machine->new( resource => 'App::Dochazka::REST::Dispatch', )->to_app;

    note( "A PSGI application is a Perl code reference. It takes exactly " .
    "one argument, the environment and returns an array reference of exactly " .
    "three values." );
    is( ref($app), 'CODE' );

    note( 'initialize App::Dochazka::Common package variables $t, $today, etc.' );
    App::Dochazka::Common::init_timepiece();

    return $app;
}


=head2 status_from_json

L<App::Dochazka::REST> is designed to return status objects in the HTTP
response body. These, of course, are sent in JSON format. This simple routine
takes a JSON string and blesses it, thereby converting it back into a status
object.

FIXME: There may be some encoding issues here!

=cut

sub status_from_json {
    my ( $json ) = @_;
    bless from_json( $json ), 'App::CELL::Status';
}


=head2 req

Assemble and process a HTTP request. Takes the following positional arguments:

    * Plack::Test object
    * expected HTTP result code
    * user to authenticate with (can be 'root', 'demo', or 'active')
    * HTTP method
    * resource string
    * optional JSON string

If the HTTP result code is 200, the return value will be a status object, undef
otherwise.

=cut

sub req {
    my ( $test, $code, $user, $method, $resource, $json ) = validate_pos( @_, 1, 1, 1, 1, 1, 0 );

    if ( ref( $test ) ne 'Plack::Test::MockHTTP' ) {
        diag( "Plack::Test::MockHTTP object not passed to 'req' from " . (caller)[1] . " line " . (caller)[2] );
        BAIL_OUT(0);
    }

    # assemble request
    my %pl = (
        Accept => 'application/json',
        Content_Type => 'application/json',
    );
    if ( $json ) {
        $pl{'Content'} = $json;
    } 
    my $r = $methods{$method}->( $resource, %pl ); 

    my $pass;
    if ( $user eq 'root' ) {
        $pass = 'immutable';
    } elsif ( $user eq 'inactive' ) {
        $pass = 'inactive';
    } elsif ( $user eq 'active' ) {
        $pass = 'active';
    } elsif ( $user eq 'demo' ) {
        $pass = 'demo';
    } else {
        #diag( "Unusual user $user - trying password $user" );
        $pass = $user;
    }

    $r->authorization_basic( $user, $pass );
    note( "About to send request $method $resource as $user " . ( $json ? "with $json" : "" ) );
    my $res = $test->request( $r );
    $code += 0;
    if ( $code != $res->code ) {
        diag( Dumper $res );
        BAIL_OUT(0);
    }
    is( $res->code, $code, "Response code is $code" );
    my $content = $res->content;
    if ( $content ) {
        #diag( Dumper $content );
        is_valid_json( $res->content, "Response entity is valid JSON" );
        my $status = status_from_json( $content );
        if ( my $location_header = $res->header( 'Location' ) ) {
            $status->{'location_header'} = $location_header;
        }
        return $status;
    }
    return;
}


=head2 dbi_err

Wrapper for 'req' intended to eliminate duplicated code on tests that are
expected to return DOCHAZKA_DBI_ERR. In addition to the arguments expected
by 'req', takes one additional argument, which should be:

    qr/error message subtext/

(i.e. a regex quote by which to test the $status->text)

=cut

sub dbi_err {
    my ( $test, $code, $user, $method, $resource, $json, $qr ) = validate_pos( @_, 1, 1, 1, 1, 1, 1, 1 );
    my $status = req( $test, $code, $user, $method, $resource, $json );
    is( $status->level, 'ERR' );
    ok( $status->text );
    if ( ! ( $status->text =~ $qr ) ) {
        diag( "$user $method $resource\n$json" );
        diag( $status->text . " does not match $qr" );
        BAIL_OUT(0);
    }
    like( $status->text, $qr );
}


=head2 docu_check

Check that the resource has on-line documentation (takes Plack::Test object
and resource name without quotes)

=cut

sub docu_check {
    my ( $test, $resource ) = @_;
    #diag( "Entering " . __PACKAGE__ . "::docu_check with argument $resource" );

    if ( ref( $test ) ne 'Plack::Test::MockHTTP' ) {
        diag( "Plack::Test::MockHTTP object not passed to 'req' from " . (caller)[1] . " line " . (caller)[2] );
        BAIL_OUT(0);
    }

    my $tn = "docu_check $resource ";
    my $t = 0;
    my ( $docustr, $docustr_len );
    #
    # - straight 'docu/pod' resource
    my $status = req( $test, 200, 'demo', 'POST', '/docu/pod', "\"$resource\"" );
    is( $status->level, 'OK', $tn . ++$t );
    is( $status->code, 'DISPATCH_ONLINE_DOCUMENTATION', $tn . ++$t );
    if ( exists $status->{'payload'} ) {
        ok( exists $status->payload->{'resource'}, $tn . ++$t );
        is( $status->payload->{'resource'}, $resource, $tn . ++$t );
        ok( exists $status->payload->{'documentation'}, $tn . ++$t );
        $docustr = $status->payload->{'documentation'};
        $docustr_len = length( $docustr );
        ok( $docustr_len > 10, $tn . ++$t );
        isnt( $docustr, 'NOT WRITTEN YET', $tn . ++$t );
    }
    #
    # - not a very thorough examination of the 'docu/html' version
    $status = req( $test, 200, 'demo', 'POST', '/docu/html', "\"$resource\"" );
    is( $status->level, 'OK', $tn . ++$t );
    is( $status->code, 'DISPATCH_ONLINE_DOCUMENTATION', $tn . ++$t );
    if ( exists $status->{'payload'} ) {
        ok( exists $status->payload->{'resource'}, $tn . ++$t );
        is( $status->payload->{'resource'}, $resource, $tn . ++$t );
        ok( exists $status->payload->{'documentation'}, $tn . ++$t );
        $docustr = $status->payload->{'documentation'};
        $docustr_len = length( $docustr );
        ok( $docustr_len > 10, $tn . ++$t );
        isnt( $docustr, 'NOT WRITTEN YET', $tn . ++$t );
    }
}


=head2 create_testing_employee

Tests will need to set up and tear down testing employees

=cut

sub create_testing_employee {
    my ( $PROPS ) = validate_pos( @_,
        { type => HASHREF },
    );

    hash_the_password( $PROPS );

    my $emp = App::Dochazka::REST::Model::Employee->spawn( $PROPS );
    is( ref($emp), 'App::Dochazka::REST::Model::Employee', 'create_testing_employee 1' );

    my $status = $emp->insert( $faux_context );
    if ( $status->not_ok ) {
        diag( Dumper $status );
        BAIL_OUT(0);
    }

    is( $status->level, "OK", 'create_testing_employee 2' );
    is( ref( $status->payload ), 'App::Dochazka::REST::Model::Employee' );
    return $status->payload;
}


=head2 create_active_employee

Create testing employee with 'active' privilege

=cut

sub create_active_employee {
    my ( $test ) = @_;
    note('create active employee');
    my $eid_of_active = create_testing_employee( { nick => 'active', password => 'active' } )->eid;
    my $status = req( $test, 201, 'root', 'POST', "priv/history/eid/$eid_of_active", 
        '{ "effective":"1892-01-01", "priv":"active" }' );
    ok( $status->ok, "Create active employee 2" );
    is( $status->code, 'DOCHAZKA_CUD_OK', "Create active employee 3" );
    return $eid_of_active;
}


=head2 create_inactive_employee

Create testing employee with 'active' privilege

=cut

sub create_inactive_employee {
    my ( $test ) = @_;
    note( 'create inactive employee' );
    my $eid_of_inactive = create_testing_employee( { nick => 'inactive', password => 'inactive' } )->eid;
    my $status = req( $test, 201, 'root', 'POST', "priv/history/eid/$eid_of_inactive", 
        '{ "effective":"1892-01-01", "priv":"inactive" }' );
    ok( $status->ok, "Create inactive employee 2" );
    is( $status->code, 'DOCHAZKA_CUD_OK', "Create inactive employee 3" );
    return $eid_of_inactive; 
}


=head2 delete_testing_employee

Tests will need to set up and tear down testing employees (takes EID)

=cut

sub delete_testing_employee {
    my $eid = shift;  
    note( "delete testing employee with EID $eid" );
    my $status = App::Dochazka::REST::Model::Employee->load_by_eid( $dbix_conn, $eid );
    if ( $status->not_ok ) {
        diag( Dumper $status );
        BAIL_OUT(0);
    }
    is( $status->level, 'OK', 'delete_testing_employee 1' );
    my $emp = $status->payload;
    $status = $emp->delete( $faux_context );
    if ( $status->not_ok ) {
        diag( Dumper $status );
        BAIL_OUT(0);
    }
    is( $status->level, 'OK', 'delete_testing_employee 2' );
    return;
}


=head2 delete_employee_by_nick

Delete testing employee (takes Plack::Test object and nick)

=cut

sub delete_employee_by_nick {
    my ( $test, $nick ) = @_;
    my ( $res, $status );

    # get and delete privhistory
    $status = get_privhistory( $faux_context, nick => $nick );
    if ( $status->level eq 'OK' and $status->code eq 'DISPATCH_RECORDS_FOUND' ) {
        my $ph = $status->payload->{'history'};
        # delete the privhistory records one by one
        foreach my $phrec ( @$ph ) {
            my $phid = $phrec->{phid};
            $status = req( $test, 200, 'root', 'DELETE', "priv/history/phid/$phid" );
            ok( $status->ok, "Delete employee by nick 2" );
            is( $status->code, 'DOCHAZKA_CUD_OK', "Delete employee by nick 3" );
        }
    } else {
        diag( "Unexpected return value from get_privhistory: " . Dumper( $status ) );
        BAIL_OUT(0);
    }

    # get and delete schedhistory
    $status = get_schedhistory( $faux_context, nick => $nick );
    if ( $status->level eq 'OK' and $status->code eq 'DISPATCH_RECORDS_FOUND' ) {
        my $sh = $status->payload->{'history'};
        # delete the schedhistory records one by one
        foreach my $shrec ( @$sh ) {
            my $shid = $shrec->{shid};
            $status = req( $test, 200, 'root', 'DELETE', "schedule/history/shid/$shid" );
            ok( $status->ok, "Delete employee by nick 5" );
            is( $status->code, 'DOCHAZKA_CUD_OK', "Delete employee by nick 5" );
        }
    } elsif ( $status->level eq 'NOTICE' and $status->code eq 'DISPATCH_NO_RECORDS_FOUND' ) {
        ok( 1, "$nick has no schedule history" );
    } else {
        diag( "Unexpected return value from get_schedhistory: " . Dumper( $status ) );
        BAIL_OUT(0);
    }

    # delete the employee record
    $status = req( $test, 200, 'root', 'DELETE', "employee/nick/$nick" );
    BAIL_OUT($status->text) unless $status->ok;
    is( $status->level, 'OK', "Delete employee by nick 6" );
    is( $status->code, 'DOCHAZKA_CUD_OK', "Delete employee by nick 7" );

    return;
}


=head2 create_testing_activity

Tests will need to set up and tear down testing activities

=cut

sub create_testing_activity {
    my %PROPS = @_;  # must be at least code

    my $act = App::Dochazka::REST::Model::Activity->spawn( \%PROPS );
    is( ref($act), 'App::Dochazka::REST::Model::Activity', 'create_testing_activity 1' );
    my $status = $act->insert( $faux_context );
    if ( $status->not_ok ) {
        BAIL_OUT( $status->code . " " . $status->text );
    }
    is( $status->level, "OK", 'create_testing_activity 2' );
    return $status->payload;
}


=head2 delete_testing_activity

Tests will need to set up and tear down testing activities

=cut

sub delete_testing_activity {
    my $aid = shift;

    my $status = App::Dochazka::REST::Model::Activity->load_by_aid( $dbix_conn, $aid );
    is( $status->level, 'OK', 'delete_testing_activity 1' );
    my $act = $status->payload;
    $status = $act->delete( $faux_context );
    is( $status->level, 'OK', 'delete_testing_activity 2' );
    return;
}


=head2 create_testing_component

Tests will need to set up and tear down testing components

=cut

sub create_testing_component {
    my %PROPS = @_;  # must be at least path

    my $comp = App::Dochazka::REST::Model::Component->spawn( \%PROPS );
    is( ref($comp), 'App::Dochazka::REST::Model::Component', 'create_testing_component 1' );
    my $status = $comp->insert( $faux_context );
    if ( $status->not_ok ) {
        BAIL_OUT( $status->code . " " . $status->text );
    }
    is( $status->level, "OK", 'create_testing_component 2' );
    return $status->payload;
}


=head2 delete_testing_component

Tests will need to set up and tear down testing components

=cut

sub delete_testing_component {
    my $cid = shift;

    my $status = App::Dochazka::REST::Model::Component->load_by_cid( $dbix_conn, $cid );
    is( $status->level, 'OK', 'delete_testing_component 1' );
    my $act = $status->payload;
    $status = $act->delete( $faux_context );
    is( $status->level, 'OK', 'delete_testing_component 2' );
    return;
}


=head2 test_schedule_model

Creates and returns a testing schedule without needing a L<Plack::Test> object.

=cut

sub test_schedule_model {
    my $intvls = shift;

    note('create an arbitrary schedule' );
    note('at the beginning, count of schedintvls should be 0');
    is( noof( $dbix_conn, 'schedintvls' ), 0 );

    note('spawn a schedintvls ("scratch schedule") object');
    my $schedintvls = App::Dochazka::REST::Model::Schedintvls->spawn;
    ok( ref($schedintvls), "object is a reference" );
    isa_ok( $schedintvls, 'App::Dochazka::REST::Model::Schedintvls' );
    ok( defined( $schedintvls->{ssid} ), "Scratch SID is defined" ); 
    ok( $schedintvls->{ssid} > 0, "Scratch SID is > 0" ); 

    note('insert a schedule (i.e. a list of schedintvls)');
    $schedintvls->{intvls} = $intvls; 

    note('insert all the schedintvls in one go');
    my $status = $schedintvls->insert( $dbix_conn );
    diag( $status->text ) unless $status->ok;
    ok( $status->ok, "OK scratch intervals inserted OK" );
    ok( $schedintvls->ssid, "OK there is a scratch SID" );
    my $count = scalar @{ $schedintvls->{intvls} };
    ok( $count );

    note("after insert, count of schedintvls should be $count");
    is( noof( $dbix_conn, 'schedintvls' ), $count );

    note('load the schedintvls, translating them as we go');
    $status = $schedintvls->load( $dbix_conn );
    ok( $status->ok, "OK scratch intervals translated OK" );
    is( scalar @{ $schedintvls->{intvls} }, $count, "Still have $count intervals" );
    is( scalar @{ $schedintvls->{schedule} }, $count, "And now have $count translated intervals as well" );
    like( $status->code, qr/$count rows/, "status code says $count rows" );
    like( $status->text, qr/$count rows/, "status code says $count rows" );
    ok( exists $schedintvls->{schedule}->[0]->{high_time}, "Conversion to hash OK" );
    is_valid_json( $schedintvls->json );

    note('insert the JSON into the schedules table');
    my $schedule = App::Dochazka::REST::Model::Schedule->spawn(
        schedule => $schedintvls->json,
        scode => 'test1',
        remark => 'TESTING',
    );
    $status = $schedule->insert( $faux_context );
    ok( $status->ok, "Schedule insert OK" );
    ok( $schedule->sid > 0, "There is an SID" );
    is( $schedule->scode, 'test1', "scode accessor returns correct value" );
    is_valid_json( $schedule->schedule );
    is( $schedule->remark, 'TESTING' );

    note( 'delete the schedintvls' );
    $status = $schedintvls->delete( $dbix_conn );
    ok( $status->ok, "scratch intervals deleted" );
    like( $status->text, qr/$count record/, "$count records deleted" );
    is( noof( $dbix_conn, 'schedintvls' ), 0 );

    return $schedule;
}


=head2 create_testing_schedule

Tests will need to set up and tear down testing schedules. Takes a Plack::Test
object as its only argument.

=cut

sub create_testing_schedule {
    my ( $test ) = @_;

    note( "Create a testing schedule" );

    my $intvls = { "schedule" => [
        "[2000-01-02 12:30, 2000-01-02 16:30)",
        "[2000-01-02 08:00, 2000-01-02 12:00)",
        "[2000-01-01 12:30, 2000-01-01 16:30)",
        "[2000-01-01 08:00, 2000-01-01 12:00)",
        "[1999-12-31 12:30, 1999-12-31 16:30)",
        "[1999-12-31 08:00, 1999-12-31 12:00)",
    ], "scode" => 'KOBOLD' };
    my $intvls_json = JSON->new->utf8->canonical(1)->encode( $intvls );
    #
    # - request as root 
    my $status = req( $test, 201, 'root', 'POST', "schedule/new", $intvls_json );
    is( $status->level, 'OK', 'POST schedule/new returned OK status' );
    is( $status->code, 'DISPATCH_SCHEDULE_INSERT_OK', "POST schedule/new code " . $status->code );
    ok( exists $status->{'payload'} );
    ok( exists $status->payload->{'sid'}, 'there is a SID' );
    ok( exists $status->payload->{'scode'}, 'there is an scode' );

    return $status->payload->{'sid'};
}


=head2 delete_testing_schedule

Tests will need to set up and tear down testing schedule. Takes a SID as its
only argument.

=cut

sub delete_testing_schedule {
    my ( $sid ) = @_;

    note( "delete testing schedule (SID $sid)" );

    my $status = App::Dochazka::REST::Model::Schedule->load_by_sid( $dbix_conn, $sid );
    is( $status->level, 'OK', 'delete_testing_schedule: load OK' );
    if ( $status->not_ok ) {
        diag( Dumper $status );
        BAIL_OUT(0);
    }

    my $sched = $status->payload;
    $status = $sched->delete( $faux_context );
    is( $status->level, 'OK', 'delete_testing_schedule: delete OK' );
    if ( $status->not_ok ) {
        diag( Dumper $status );
        BAIL_OUT(0);
    }
    return;
}


=head2 delete_all_attendance_data

Wipe out all attendance data by deleting all rows from all tables (in the correct
order).

To be called like this:

    $status = delete_all_attendance_data();
    BAIL_OUT(0) unless $status->ok;

=cut

sub delete_all_attendance_data {

    note( 'delete locks' );
    my $status = cud_generic(
        conn => $dbix_conn, 
        eid => $site->DOCHAZKA_EID_OF_ROOT,
        sql => 'DELETE FROM locks',
    );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
    return $status unless $status->ok;

    note( 'delete intervals' );
    $status = cud_generic(
        conn => $dbix_conn, 
        eid => $site->DOCHAZKA_EID_OF_ROOT,
        sql => 'DELETE FROM intervals',
    );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
    return $status unless $status->ok;

    note( 'delete activities' );
    $status = cud_generic(
        conn => $dbix_conn, 
        eid => $site->DOCHAZKA_EID_OF_ROOT,
        sql => 'DELETE FROM activities',
    );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
    return $status unless $status->ok;

    note( 're-initialize activities table' );
    $status = App::Dochazka::REST::initialize_activities_table( $dbix_conn );
    return $status unless $status->ok;

    note( 'delete schedhistory' );
    $status = cud_generic(
        conn => $dbix_conn, 
        eid => $site->DOCHAZKA_EID_OF_ROOT,
        sql => 'DELETE FROM schedhistory',
    );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
    return $status unless $status->ok;

    note( 'delete privhistory' );
    $status = cud_generic(
        conn => $dbix_conn, 
        eid => $site->DOCHAZKA_EID_OF_ROOT,
        sql => 'DELETE FROM privhistory WHERE eid != ?',
        bind_params => [ $site->DOCHAZKA_EID_OF_ROOT ],
    );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
    return $status unless $status->ok;

    note( 'delete schedules' );
    $status = cud_generic(
        conn => $dbix_conn, 
        eid => $site->DOCHAZKA_EID_OF_ROOT,
        sql => 'DELETE FROM schedules',
    );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
    return $status unless $status->ok;

    note( 'delete tempintvls' );
    $status = cud_generic(
        conn => $dbix_conn, 
        eid => $site->DOCHAZKA_EID_OF_ROOT,
        sql => 'DELETE FROM tempintvls',
    );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );
    return $status unless $status->ok;

    note( 'delete employees' );
    $status = cud_generic(
        conn => $dbix_conn, 
        eid => $site->DOCHAZKA_EID_OF_ROOT,
        sql => 'DELETE FROM employees WHERE eid != ? AND eid != ?',
        bind_params => [ $site->DOCHAZKA_EID_OF_ROOT, $site->DOCHAZKA_EID_OF_DEMO ],
    );
    is( $status->level, 'OK' );
    is( $status->code, 'DOCHAZKA_CUD_OK' );

    return $status;
}


#
# functions to perform class-specific 'create', 'retrieve', 'delete', etc. actions
#

sub gen_activity {
    my $dis = shift;
    my $code = 'FOOBAR';

    if ( $dis eq 'create' ) {

        # create 'FOOBAR' activity
        my $act = App::Dochazka::REST::Model::Activity->spawn( code => $code );
        my $status = $act->insert( $faux_context );
        if( $status->level ne 'OK' ) {
            diag( Dumper $status );
            BAIL_OUT(0);
        }
        is( $status->level, 'OK' );
        $act = $status->payload;
        is( $act->code, $code );
        ok( $act->aid > 5 );
        return $act;

    } elsif ( $dis eq 'retrieve' ) {

        my $status = App::Dochazka::REST::Model::Activity->load_by_code( $dbix_conn, $code );
        return $status;

    } elsif ( $dis eq 'delete' ) {

        my $status = App::Dochazka::REST::Model::Activity->load_by_code( $dbix_conn, $code );
        is( $status->level, 'OK' );
        my $act = $status->payload;
        $status = $act->delete( $faux_context );
        is( $status->level, 'OK' );
        return;
        
    }
    diag( "gen_activity: AAAAAAHHHHH@@@!! \$dis " . Dumper( $dis ) );
    BAIL_OUT(0);
}

sub gen_employee {
    my $dis = shift;
    my $nick = 'bubbaTheCat';

    if ( $dis eq 'create' ) {

        # create bubbaTheCat employee
        my $emp = App::Dochazka::REST::Model::Employee->spawn( nick => $nick );
        my $status = $emp->insert( $faux_context );
        is( $status->level, 'OK' );
        $emp = $status->payload;
        is( $emp->nick, $nick );
        ok( $emp->eid > 2 );  # root is 1, demo is 2
        return $emp;

    } elsif ( $dis eq 'retrieve' ) {

        my $status = App::Dochazka::REST::Model::Employee->load_by_nick( $dbix_conn, $nick );
        return $status;

    } elsif ( $dis eq 'delete' ) {

        my $status = App::Dochazka::REST::Model::Employee->load_by_nick( $dbix_conn, $nick );
        is( $status->level, 'OK' );
        my $emp = $status->payload;
        $status = $emp->delete( $faux_context );
        is( $status->level, 'OK' );
        return;
        
    }
    diag( "gen_employee: AAAAAAHHHHH@@@!! \$dis " . Dumper( $dis ) );
    BAIL_OUT(0);
}

sub gen_interval {
    my $dis = shift;
    if ( $dis eq 'create' ) {

    } elsif ( $dis eq 'retrieve' ) {

    }
    diag( "gen_interval: AAAAAAHHHHH@@@!! \$dis " . Dumper( $dis ) );
    BAIL_OUT(0);
}

sub gen_lock {
    my $dis = shift;
    if ( $dis eq 'create' ) {

    } elsif ( $dis eq 'retrieve' ) {

    } elsif ( $dis eq 'delete' ) {
    
    }
    diag( "gen_lock: AAAAAAHHHHH@@@!! \$dis " . Dumper( $dis ) );
    BAIL_OUT(0);
}

sub gen_privhistory {
    my $dis = shift;
    if ( $dis eq 'create' ) {

    } elsif ( $dis eq 'retrieve' ) {

    } elsif ( $dis eq 'delete' ) {
    
    }
    diag( "gen_privhistory: AAAAAAHHHHH@@@!! \$dis " . Dumper( $dis ) );
    BAIL_OUT(0);
}

sub gen_schedhistory {
    my $dis = shift;
    if ( $dis eq 'create' ) {

    } elsif ( $dis eq 'retrieve' ) {
    
    } elsif ( $dis eq 'delete' ) {
    
    }
    diag( "gen_schedhistory: AAAAAAHHHHH@@@!! \$dis " . Dumper( $dis ) );
    BAIL_OUT(0);
}

sub gen_schedule {
    my $dis = shift;
    if ( $dis eq 'create' ) {

    } elsif ( $dis eq 'retrieve' ) {

    } elsif ( $dis eq 'delete' ) {
    
    }
    diag( "gen_schedule: AAAAAAHHHHH@@@!! \$dis " . Dumper( $dis ) );
    BAIL_OUT(0);
}

sub test_sql_success {
    my ( $conn, $expected_rv, $sql ) = @_;
    my ( $rv, $errstr );
    try {
        $conn->run( fixup => sub {
            $rv = $_->do($sql);
        });
    } catch {
        $errstr = $_;
    };
    if ( $errstr ) {
        diag( "Unexpected error in test_sql_success: $errstr" );
        diag( "Called from " . (caller)[1] . " line " . (caller)[2] );
        BAIL_OUT(0);
    }
    is( $rv, $expected_rv, "successfully executed $sql" );
}

sub test_sql_failure {
    my ( $conn, $expected_err, $sql ) = @_;
    my ( $rv, $errstr );
    try {
        $conn->run( fixup => sub {
            $rv = $_->do($sql);
        });
    } catch {
        $errstr = $_;
    };
    is( $rv, undef, "DBI returned undef" );
    like( $errstr, $expected_err, "DBI errstr is as expected" );
}

sub do_select_single {
    my ( $conn, $sql, @keys ) = @_;
    #diag( "do_select_single: connection OK" ) if ref( $conn ) eq 'DBIx::Connector';
    #diag( "do_select_single: SQL statement is $sql" ) if $sql;
    #diag( "do_select_single: keys are ", join(', ', @keys) ) if @keys;
    my $status = select_single( conn => $conn, sql => $sql, keys => \@keys );
    #diag( Dumper $status );
    is( $status->level, 'OK' );
    is( $status->code, 'DISPATCH_RECORDS_FOUND' );
    ok( $status->payload );
    is( ref( $status->payload ), 'ARRAY' );
    return @{ $status->payload };
}
    
sub test_employee_list {
    my ( $status, $nicks ) = @_;
    is( $status->level, 'OK' );
    is( $status->code, 'DISPATCH_LIST_EMPLOYEE_NICKS' );
    is_deeply( $status->payload, $nicks );
}

sub get_aid_by_code {
    my ( $test, $code ) = @_;
    my $status = req( $test, 200, 'root', 'GET', "activity/code/$code" );
    is( $status->level, 'OK' );
    is( $status->code, 'DISPATCH_ACTIVITY_FOUND' );
    ok( $status->{'payload'} );
    ok( $status->{'payload'}->{'aid'} );
    is( $status->{'payload'}->{'code'}, uc( $code ) );
    return $status->{'payload'}->{'aid'};
}

1;
