|
Lines 1-4
Link Here
|
| 1 |
# Copyright 2012 Catalyst IT Ltd. |
1 |
# Copyright 2012 Catalyst IT Ltd. |
|
|
2 |
# Copyright 2015 Koha Development team |
| 2 |
# |
3 |
# |
| 3 |
# This file is part of Koha. |
4 |
# This file is part of Koha. |
| 4 |
# |
5 |
# |
|
Lines 15-89
Link Here
|
| 15 |
# You should have received a copy of the GNU General Public License |
16 |
# You should have received a copy of the GNU General Public License |
| 16 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
17 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
| 17 |
|
18 |
|
| 18 |
use strict; |
19 |
use Modern::Perl; |
| 19 |
use warnings; |
|
|
| 20 |
|
20 |
|
| 21 |
use Test::More tests => 19; # last test to print |
21 |
use Test::More tests => 7; |
|
|
22 |
use Test::Warn; |
| 23 |
|
| 24 |
use t::lib::TestBuilder; |
| 25 |
use C4::Context; |
| 26 |
use Koha::Database; |
| 22 |
|
27 |
|
| 23 |
use_ok('C4::Reports::Guided'); |
28 |
use_ok('C4::Reports::Guided'); |
|
|
29 |
can_ok( |
| 30 |
'C4::Reports::Guided', |
| 31 |
qw(save_report delete_report execute_query) |
| 32 |
); |
| 33 |
|
| 34 |
my $schema = Koha::Database->new->schema; |
| 35 |
$schema->storage->txn_begin; |
| 36 |
my $builder = t::lib::TestBuilder->new; |
| 24 |
|
37 |
|
| 25 |
# This is the query I found that triggered bug 8594. |
38 |
subtest 'strip_limit' => sub { |
| 26 |
my $sql = "SELECT aqorders.ordernumber, biblio.title, biblio.biblionumber, items.homebranch, |
39 |
# This is the query I found that triggered bug 8594. |
| 27 |
aqorders.entrydate, aqorders.datereceived, |
40 |
my $sql = "SELECT aqorders.ordernumber, biblio.title, biblio.biblionumber, items.homebranch, |
| 28 |
(SELECT DATE(datetime) FROM statistics |
41 |
aqorders.entrydate, aqorders.datereceived, |
| 29 |
WHERE itemnumber=items.itemnumber AND |
|
|
| 30 |
(type='return' OR type='issue') LIMIT 1) |
| 31 |
AS shelvedate, |
| 32 |
DATEDIFF(COALESCE( |
| 33 |
(SELECT DATE(datetime) FROM statistics |
42 |
(SELECT DATE(datetime) FROM statistics |
| 34 |
WHERE itemnumber=items.itemnumber AND |
43 |
WHERE itemnumber=items.itemnumber AND |
| 35 |
(type='return' OR type='issue') LIMIT 1), |
44 |
(type='return' OR type='issue') LIMIT 1) |
| 36 |
aqorders.datereceived), aqorders.entrydate) AS totaldays |
45 |
AS shelvedate, |
| 37 |
FROM aqorders |
46 |
DATEDIFF(COALESCE( |
| 38 |
LEFT JOIN biblio USING (biblionumber) |
47 |
(SELECT DATE(datetime) FROM statistics |
| 39 |
LEFT JOIN items ON (items.biblionumber = biblio.biblionumber |
48 |
WHERE itemnumber=items.itemnumber AND |
| 40 |
AND dateaccessioned=aqorders.datereceived) |
49 |
(type='return' OR type='issue') LIMIT 1), |
| 41 |
WHERE (entrydate >= '2011-01-01' AND (datereceived < '2011-02-01' OR datereceived IS NULL)) |
50 |
aqorders.datereceived), aqorders.entrydate) AS totaldays |
| 42 |
AND items.homebranch LIKE 'INFO' |
51 |
FROM aqorders |
| 43 |
ORDER BY title"; |
52 |
LEFT JOIN biblio USING (biblionumber) |
| 44 |
|
53 |
LEFT JOIN items ON (items.biblionumber = biblio.biblionumber |
| 45 |
my ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($sql); |
54 |
AND dateaccessioned=aqorders.datereceived) |
| 46 |
is($res_sql, $sql, "Not breaking subqueries"); |
55 |
WHERE (entrydate >= '2011-01-01' AND (datereceived < '2011-02-01' OR datereceived IS NULL)) |
| 47 |
is($res_lim1, 0, "Returns correct default offset"); |
56 |
AND items.homebranch LIKE 'INFO' |
| 48 |
is($res_lim2, undef, "Returns correct default LIMIT"); |
57 |
ORDER BY title"; |
| 49 |
|
58 |
|
| 50 |
# Now the same thing, but we want it to remove the LIMIT from the end |
59 |
my ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($sql); |
| 51 |
|
60 |
is($res_sql, $sql, "Not breaking subqueries"); |
| 52 |
my $test_sql = $res_sql . " LIMIT 242"; |
61 |
is($res_lim1, 0, "Returns correct default offset"); |
| 53 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql); |
62 |
is($res_lim2, undef, "Returns correct default LIMIT"); |
| 54 |
# The replacement drops a ' ' where the limit was |
63 |
|
| 55 |
is(trim($res_sql), $sql, "Correctly removes only final LIMIT"); |
64 |
# Now the same thing, but we want it to remove the LIMIT from the end |
| 56 |
is($res_lim1, 0, "Returns correct default offset"); |
65 |
|
| 57 |
is($res_lim2, 242, "Returns correct extracted LIMIT"); |
66 |
my $test_sql = $res_sql . " LIMIT 242"; |
| 58 |
|
67 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql); |
| 59 |
$test_sql = $res_sql . " LIMIT 13,242"; |
68 |
# The replacement drops a ' ' where the limit was |
| 60 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql); |
69 |
is(trim($res_sql), $sql, "Correctly removes only final LIMIT"); |
| 61 |
# The replacement drops a ' ' where the limit was |
70 |
is($res_lim1, 0, "Returns correct default offset"); |
| 62 |
is(trim($res_sql), $sql, "Correctly removes only final LIMIT (with offset)"); |
71 |
is($res_lim2, 242, "Returns correct extracted LIMIT"); |
| 63 |
is($res_lim1, 13, "Returns correct extracted offset"); |
72 |
|
| 64 |
is($res_lim2, 242, "Returns correct extracted LIMIT"); |
73 |
$test_sql = $res_sql . " LIMIT 13,242"; |
| 65 |
|
74 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql); |
| 66 |
# After here is the simpler case, where there isn't a WHERE clause to worry |
75 |
# The replacement drops a ' ' where the limit was |
| 67 |
# about. |
76 |
is(trim($res_sql), $sql, "Correctly removes only final LIMIT (with offset)"); |
| 68 |
|
77 |
is($res_lim1, 13, "Returns correct extracted offset"); |
| 69 |
# First case with nothing to change |
78 |
is($res_lim2, 242, "Returns correct extracted LIMIT"); |
| 70 |
$sql = "SELECT * FROM items"; |
79 |
|
| 71 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($sql); |
80 |
# After here is the simpler case, where there isn't a WHERE clause to worry |
| 72 |
is($res_sql, $sql, "Not breaking simple queries"); |
81 |
# about. |
| 73 |
is($res_lim1, 0, "Returns correct default offset"); |
82 |
|
| 74 |
is($res_lim2, undef, "Returns correct default LIMIT"); |
83 |
# First case with nothing to change |
| 75 |
|
84 |
$sql = "SELECT * FROM items"; |
| 76 |
$test_sql = $sql . " LIMIT 242"; |
85 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($sql); |
| 77 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql); |
86 |
is($res_sql, $sql, "Not breaking simple queries"); |
| 78 |
is(trim($res_sql), $sql, "Correctly removes LIMIT in simple case"); |
87 |
is($res_lim1, 0, "Returns correct default offset"); |
| 79 |
is($res_lim1, 0, "Returns correct default offset"); |
88 |
is($res_lim2, undef, "Returns correct default LIMIT"); |
| 80 |
is($res_lim2, 242, "Returns correct extracted LIMIT"); |
89 |
|
| 81 |
|
90 |
$test_sql = $sql . " LIMIT 242"; |
| 82 |
$test_sql = $sql . " LIMIT 13,242"; |
91 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql); |
| 83 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql); |
92 |
is(trim($res_sql), $sql, "Correctly removes LIMIT in simple case"); |
| 84 |
is(trim($res_sql), $sql, "Correctly removes LIMIT in simple case (with offset)"); |
93 |
is($res_lim1, 0, "Returns correct default offset"); |
| 85 |
is($res_lim1, 13, "Returns correct extracted offset"); |
94 |
is($res_lim2, 242, "Returns correct extracted LIMIT"); |
| 86 |
is($res_lim2, 242, "Returns correct extracted LIMIT"); |
95 |
|
|
|
96 |
$test_sql = $sql . " LIMIT 13,242"; |
| 97 |
($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql); |
| 98 |
is(trim($res_sql), $sql, "Correctly removes LIMIT in simple case (with offset)"); |
| 99 |
is($res_lim1, 13, "Returns correct extracted offset"); |
| 100 |
is($res_lim2, 242, "Returns correct extracted LIMIT"); |
| 101 |
}; |
| 102 |
|
| 103 |
$_->delete for Koha::AuthorisedValues->search({ category => 'XXX' }); |
| 104 |
Koha::AuthorisedValue->new({category => 'LOC'})->store; |
| 105 |
|
| 106 |
subtest 'GetReservedAuthorisedValues' => sub { |
| 107 |
plan tests => 1; |
| 108 |
# This one will catch new reserved words not added |
| 109 |
# to GetReservedAuthorisedValues |
| 110 |
my %test_authval = ( |
| 111 |
'date' => 1, |
| 112 |
'branches' => 1, |
| 113 |
'itemtypes' => 1, |
| 114 |
'cn_source' => 1, |
| 115 |
'categorycode' => 1, |
| 116 |
'biblio_framework' => 1, |
| 117 |
); |
| 118 |
|
| 119 |
my $reserved_authorised_values = GetReservedAuthorisedValues(); |
| 120 |
is_deeply(\%test_authval, $reserved_authorised_values, |
| 121 |
'GetReservedAuthorisedValues returns a fixed list'); |
| 122 |
}; |
| 123 |
|
| 124 |
subtest 'IsAuthorisedValueValid' => sub { |
| 125 |
plan tests => 8; |
| 126 |
ok( IsAuthorisedValueValid('LOC'), |
| 127 |
'User defined authorised value category is valid'); |
| 128 |
|
| 129 |
ok( ! IsAuthorisedValueValid('XXX'), |
| 130 |
'Not defined authorised value category is invalid'); |
| 131 |
|
| 132 |
# Loop through the reserved authorised values |
| 133 |
foreach my $authorised_value ( keys %{GetReservedAuthorisedValues()} ) { |
| 134 |
ok( IsAuthorisedValueValid($authorised_value), |
| 135 |
'\''.$authorised_value.'\' is a reserved word, and thus a valid authorised value'); |
| 136 |
} |
| 137 |
}; |
| 138 |
|
| 139 |
subtest 'GetParametersFromSQL+ValidateSQLParameters' => sub { |
| 140 |
plan tests => 3; |
| 141 |
my $test_query_1 = " |
| 142 |
SELECT date_due |
| 143 |
FROM old_issues |
| 144 |
WHERE YEAR(timestamp) = <<Year|custom_list>> AND |
| 145 |
branchcode = <<Branch|branches>> AND |
| 146 |
borrowernumber = <<Borrower>> |
| 147 |
"; |
| 148 |
|
| 149 |
my @test_parameters_with_custom_list = ( |
| 150 |
{ 'name' => 'Year', 'authval' => 'custom_list' }, |
| 151 |
{ 'name' => 'Branch', 'authval' => 'branches' }, |
| 152 |
{ 'name' => 'Borrower', 'authval' => undef } |
| 153 |
); |
| 154 |
|
| 155 |
is_deeply( GetParametersFromSQL($test_query_1), \@test_parameters_with_custom_list, |
| 156 |
'SQL params are correctly parsed'); |
| 157 |
|
| 158 |
my @problematic_parameters = (); |
| 159 |
push @problematic_parameters, { 'name' => 'Year', 'authval' => 'custom_list' }; |
| 160 |
is_deeply( ValidateSQLParameters( $test_query_1 ), |
| 161 |
\@problematic_parameters, |
| 162 |
'\'custom_list\' not a valid category' ); |
| 163 |
|
| 164 |
my $test_query_2 = " |
| 165 |
SELECT date_due |
| 166 |
FROM old_issues |
| 167 |
WHERE YEAR(timestamp) = <<Year|date>> AND |
| 168 |
branchcode = <<Branch|branches>> AND |
| 169 |
borrowernumber = <<Borrower|LOC>> |
| 170 |
"; |
| 171 |
|
| 172 |
is_deeply( ValidateSQLParameters( $test_query_2 ), |
| 173 |
[], |
| 174 |
'All parameters valid, empty problematic authvals list' |
| 175 |
); |
| 176 |
}; |
| 177 |
|
| 178 |
subtest 'get_saved_reports' => sub { |
| 179 |
plan tests => 16; |
| 180 |
my $dbh = C4::Context->dbh; |
| 181 |
$dbh->do(q|DELETE FROM saved_sql|); |
| 182 |
$dbh->do(q|DELETE FROM saved_reports|); |
| 183 |
|
| 184 |
#Test save_report |
| 185 |
my $count = scalar @{ get_saved_reports() }; |
| 186 |
is( $count, 0, "There is no report" ); |
| 187 |
|
| 188 |
my @report_ids; |
| 189 |
foreach ( 1..3 ) { |
| 190 |
my $id = $builder->build({ source => 'Borrower' })->{ borrowernumber }; |
| 191 |
push @report_ids, save_report({ |
| 192 |
borrowernumber => $id, |
| 193 |
sql => "SQL$id", |
| 194 |
name => "Name$id", |
| 195 |
area => "area$id", |
| 196 |
group => "group$id", |
| 197 |
subgroup => "subgroup$id", |
| 198 |
type => "type$id", |
| 199 |
notes => "note$id", |
| 200 |
cache_expiry => "null", |
| 201 |
public => "null" |
| 202 |
}); |
| 203 |
$count++; |
| 204 |
} |
| 205 |
like( $report_ids[0], '/^\d+$/', "Save_report returns an id for first" ); |
| 206 |
like( $report_ids[1], '/^\d+$/', "Save_report returns an id for second" ); |
| 207 |
like( $report_ids[2], '/^\d+$/', "Save_report returns an id for third" ); |
| 208 |
|
| 209 |
is( scalar @{ get_saved_reports() }, |
| 210 |
$count, "$count reports have been added" ); |
| 211 |
|
| 212 |
is( scalar @{ get_saved_reports( $report_ids[0] ) }, |
| 213 |
1, "filter takes report id" ); |
| 214 |
|
| 215 |
#Test delete_report |
| 216 |
is (delete_report(),undef, "Without id delete_report returns undef"); |
| 217 |
|
| 218 |
is( delete_report( $report_ids[0] ), 1, "report 1 is deleted" ); |
| 219 |
$count--; |
| 220 |
|
| 221 |
is( scalar @{ get_saved_reports() }, $count, "Report1 has been deleted" ); |
| 222 |
|
| 223 |
is( delete_report( $report_ids[1], $report_ids[2] ), 2, "report 2 and 3 are deleted" ); |
| 224 |
$count -= 2; |
| 225 |
|
| 226 |
is( scalar @{ get_saved_reports() }, |
| 227 |
$count, "Report2 and report3 have been deleted" ); |
| 228 |
|
| 229 |
my $sth = execute_query('SELECT COUNT(*) FROM systempreferences', 0, 10); |
| 230 |
my $results = $sth->fetchall_arrayref; |
| 231 |
is(scalar @$results, 1, 'running a query returned a result'); |
| 232 |
|
| 233 |
my $version = C4::Context->preference('Version'); |
| 234 |
$sth = execute_query( |
| 235 |
'SELECT value FROM systempreferences WHERE variable = ?', |
| 236 |
0, |
| 237 |
10, |
| 238 |
[ 'Version' ], |
| 239 |
); |
| 240 |
$results = $sth->fetchall_arrayref; |
| 241 |
is_deeply( |
| 242 |
$results, |
| 243 |
[ [ $version ] ], |
| 244 |
'running a query with a parameter returned the expected result' |
| 245 |
); |
| 246 |
|
| 247 |
# for next test, we want to let execute_query capture any SQL errors |
| 248 |
$dbh->{RaiseError} = 0; |
| 249 |
my $errors; |
| 250 |
warning_like { ($sth, $errors) = execute_query( |
| 251 |
'SELECT surname FRM borrowers', # error in the query is intentional |
| 252 |
0, 10 ) } |
| 253 |
qr/^DBD::mysql::st execute failed: You have an error in your SQL syntax;/, |
| 254 |
"Wrong SQL syntax raises warning"; |
| 255 |
ok( |
| 256 |
defined($errors) && exists($errors->{queryerr}), |
| 257 |
'attempting to run a report with an SQL syntax error returns error message (Bug 12214)' |
| 258 |
); |
| 259 |
|
| 260 |
is_deeply( get_report_areas(), [ 'CIRC', 'CAT', 'PAT', 'ACQ', 'ACC', 'SER' ], |
| 261 |
"get_report_areas returns the correct array of report areas"); |
| 262 |
}; |
| 263 |
|
| 264 |
$schema->storage->txn_rollback; |
| 87 |
|
265 |
|
| 88 |
sub trim { |
266 |
sub trim { |
| 89 |
my ($s) = @_; |
267 |
my ($s) = @_; |