App-Dochazka-REST
view release on metacpan or search on metacpan
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
=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 {
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;
#diag( "DOCHAZKA_STATE_DIR is set to " . $site->DOCHAZKA_STATE_DIR );
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_not_ok;
};
plan skip_all => 'Integration testing environment not detected' 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
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
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_bare_employee
For use in tests only. Spawns an employee object and inserts it into the
database.
Takes PROPLIST which is passed through unmunged to the employee spawn method.
Returns the new Employee object.
=cut
sub create_bare_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_bare_employee 1' );
my $status = $emp->insert( $faux_context );
if ( $status->not_ok ) {
diag( "Employee insert method returned NOT_OK status in create_bare_employee" );
diag( "test automation function, which was called from " . (caller)[1] . " line " . (caller)[2] );
diag( "with arguments: " . Dumper( $PROPS ) );
diag( "Full status returned by employee insert method:" );
diag( Dumper $status );
BAIL_OUT(0);
}
is( $status->level, "OK", 'create_bare_employee 2' );
my $employee_object = $status->payload;
is( ref( $employee_object ), 'App::Dochazka::REST::Model::Employee' );
return $employee_object;
}
=head2 delete_bare_employee
Takes a single argument: the EID.
Loads the EID into a new Employee object and calls that object's delete method.
=cut
sub delete_bare_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( "Employee load_by_eid method returned NOT_OK status in delete_bare_employee" );
diag( "test automation function, which was called from " . (caller)[1] . " line " . (caller)[2] );
diag( "with EID $eid" );
diag( "Full status returned by Employee load_by_eid method:" );
diag( Dumper $status );
BAIL_OUT(0);
}
is( $status->level, 'OK', 'delete_bare_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_bare_employee 2' );
return;
}
sub _create_employee {
my ( $test, $privspec ) = @_;
note("create $privspec employee");
my $eid = create_bare_employee( { nick => $privspec, password => $privspec } )->eid;
my $status = req( $test, 201, 'root', 'POST', "priv/history/eid/$eid",
"{ \"effective\":\"1892-01-01\", \"priv\":\"$privspec\" }" );
ok( $status->ok, "Create $privspec employee 2" );
is( $status->code, 'DOCHAZKA_CUD_OK', "Create $privspec employee 3" );
return $eid;
}
=head2 create_active_employee
Create a testing employee with 'active' privilege. The employee will get an
'active' privhistory record with date 1892-01-01.
=cut
sub create_active_employee {
my ( $test ) = @_;
return _create_employee( $test, "active" );
}
=head2 create_inactive_employee
Create a testing employee with 'inactive' privilege. The employee will get an
'inactive' privhistory record with date 1892-01-01.
=cut
sub create_inactive_employee {
my ( $test ) = @_;
return _create_employee( $test, "inactive" );
}
=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_interval
Tests will need to set up and tear down testing intervals
=cut
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');
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
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',
( run in 0.403 second using v1.01-cache-2.11-cpan-d7f47b0818f )