App-Dochazka-REST

 view release on metacpan or  search on metacpan

lib/App/Dochazka/REST/Test.pm  view on Meta::CPAN


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

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


=head2 delete_testing_interval

Tests will need to set up and tear down testing intervals

=cut

sub delete_testing_interval {
    my $iid = shift;

    my $status = App::Dochazka::REST::Model::Interval->load_by_iid( $dbix_conn, $iid );
    is( $status->level, 'OK', 'delete_testing_interval 1' );
    my $int = $status->payload;
    $status = $int->delete( $faux_context );
    is( $status->level, 'OK', 'delete_testing_interval 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" );



( run in 0.925 second using v1.01-cache-2.11-cpan-39bf76dae61 )