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 )