From: Jason Stephenson Date: Fri, 9 Apr 2021 20:31:57 +0000 (-0400) Subject: LP1923076: Add Perl live test X-Git-Url: https://old-git.evergreen-ils.org/?a=commitdiff_plain;h=518f9a2f7a383c0cff780bdf9fc33e7e90ffe5bc;p=evergreen%2Fpines.git LP1923076: Add Perl live test Add lp1923076-test-perl-scalar-return.t to the Perl live tests to test a couple of back end calls affected by the changes in this branch. These backend calls are those that are easily testable with Concerto data. Signed-off-by: Jason Stephenson Signed-off-by: Michele Morgan Signed-off-by: Mike Rylander --- diff --git a/Open-ILS/src/perlmods/live_t/lp1923076-test-perl-scalar-return.t b/Open-ILS/src/perlmods/live_t/lp1923076-test-perl-scalar-return.t new file mode 100755 index 0000000000..dd69944c9c --- /dev/null +++ b/Open-ILS/src/perlmods/live_t/lp1923076-test-perl-scalar-return.t @@ -0,0 +1,103 @@ +#!perl +use strict; use warnings; +use Test::More; +use OpenILS::Utils::TestUtils; +use OpenILS::Const qw(:const); +use B qw(svref_2object SVf_IOK); + +my $script = OpenILS::Utils::TestUtils->new(); +my $U = 'OpenILS::Application::AppUtils'; + +# Setup some useful values for later: +use constant { + WORKSTATION => 'LP1923076-Test-Scalar-Return-Type', + USERNAME => 'br1mtownsend', + PASSWORD => 'maryt1234', + BR1_ID => 4 +}; + +my $credentials = { + username => USERNAME, + password => PASSWORD, + type => 'staff' +}; + +diag('LP1923076 Test Scalar Return Type'); + +# Skip tests if Perl version older than 5.28.0 +if ($] lt '5.028000') { + plan skip_all => "Tests irrelevant on Perl version $]"; +} else { + plan tests => 6; +} + +# Login and register workstation +my $authtoken = $script->authenticate($credentials); +BAIL_OUT('Must log in') unless ($authtoken); +my $ws = $script->find_or_register_workstation(WORKSTATION, BR1_ID); +BAIL_OUT('Need workstation') if (ref $ws); +$script->logout(); +undef($authtoken); + +# Login again for remaining tests. +$credentials->{password} = PASSWORD; +$credentials->{workstation} = WORKSTATION; +$authtoken = $script->authenticate($credentials); +BAIL_OUT('Need to log in') unless ($authtoken); +END { + $script->logout() if $authtoken; +} + +# Initial smoke tests. +ok( + is_integer(0), + '0 is integer' +); + +ok( + !is_integer("0"), + '"0" is not a integer' +); + +# Check open-ils.actor.user.hold_requests.count. +my $result = $U->simplereq( + 'open-ils.actor', + 'open-ils.actor.user.hold_requests.count', + $authtoken, + 1, + BR1_ID +); + +ok( + is_integer($result->{total}), + $result->{total} . ' is integer' +); + +ok( + is_integer($result->{ready}), + $result->{ready} . ' is integer' +); + +ok( + is_integer($result->{behind_desk}), + $result->{behind_desk} . ' is integer' +); + +# Check open-ils.storage.action.live_holds.wide_hash +$result = $U->simplereq( + 'open-ils.storage', + 'open-ils.storage.action.live_holds.wide_hash', + {pickup_lib=>0} +); + +ok( + is_integer($result), + $result . ' is integer' +); + +# Check if argument is integer. +sub is_integer { + my $x = shift; + my $sv = svref_2object(\$x); + return $sv->FLAGS & SVf_IOK; +}