t/db_dependent/Reports/Guided.t

   1 # Copyright 2012 Catalyst IT Ltd.
   2 # Copyright 2015 Koha Development team
   3 #
   4 # This file is part of Koha.
   5 #
   6 # Koha is free software; you can redistribute it and/or modify it
   7 # under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # Koha is distributed in the hope that it will be useful, but
  12 # WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  18
  19 use Modern::Perl;
  20
  21 use Test::More tests => 11;
  22 use Test::Warn;
  23
  24 use t::lib::TestBuilder;
  25 use C4::Context;
  26 use Koha::Database;
  27 use Koha::Items;
  28 use Koha::Reports;
  29 use Koha::Notice::Messages;
  30
  31 use_ok('C4::Reports::Guided');
  32 can_ok(
  33     'C4::Reports::Guided',
  34     qw(save_report delete_report execute_query)
  35 );
  36
  37 my $schema = Koha::Database->new->schema;
  38 $schema->storage->txn_begin;
  39 my $builder = t::lib::TestBuilder->new;
  40
  41 subtest 'strip_limit' => sub {
  42     # This is the query I found that triggered bug 8594.
  43     my $sql = "SELECT aqorders.ordernumber, biblio.title, biblio.biblionumber, items.homebranch,
  44         aqorders.entrydate, aqorders.datereceived,
  45         (SELECT DATE(datetime) FROM statistics
  46             WHERE itemnumber=items.itemnumber AND
  47                 (type='return' OR type='issue') LIMIT 1)
  48         AS shelvedate,
  49         DATEDIFF(COALESCE(
  50             (SELECT DATE(datetime) FROM statistics
  51                 WHERE itemnumber=items.itemnumber AND
  52                 (type='return' OR type='issue') LIMIT 1),
  53         aqorders.datereceived), aqorders.entrydate) AS totaldays
  54     FROM aqorders
  55     LEFT JOIN biblio USING (biblionumber)
  56     LEFT JOIN items ON (items.biblionumber = biblio.biblionumber
  57         AND dateaccessioned=aqorders.datereceived)
  58     WHERE (entrydate >= '2011-01-01' AND (datereceived < '2011-02-01' OR datereceived IS NULL))
  59         AND items.homebranch LIKE 'INFO'
  60     ORDER BY title";
  61
  62     my ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($sql);
  63     is($res_sql, $sql, "Not breaking subqueries");
  64     is($res_lim1, 0, "Returns correct default offset");
  65     is($res_lim2, undef, "Returns correct default LIMIT");
  66
  67     # Now the same thing, but we want it to remove the LIMIT from the end
  68
  69     my $test_sql = $res_sql . " LIMIT 242";
  70     ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql);
  71     # The replacement drops a ' ' where the limit was
  72     is(trim($res_sql), $sql, "Correctly removes only final LIMIT");
  73     is($res_lim1, 0, "Returns correct default offset");
  74     is($res_lim2, 242, "Returns correct extracted LIMIT");
  75
  76     $test_sql = $res_sql . " LIMIT 13,242";
  77     ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql);
  78     # The replacement drops a ' ' where the limit was
  79     is(trim($res_sql), $sql, "Correctly removes only final LIMIT (with offset)");
  80     is($res_lim1, 13, "Returns correct extracted offset");
  81     is($res_lim2, 242, "Returns correct extracted LIMIT");
  82
  83     # After here is the simpler case, where there isn't a WHERE clause to worry
  84     # about.
  85
  86     # First case with nothing to change
  87     $sql = "SELECT * FROM items";
  88     ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($sql);
  89     is($res_sql, $sql, "Not breaking simple queries");
  90     is($res_lim1, 0, "Returns correct default offset");
  91     is($res_lim2, undef, "Returns correct default LIMIT");
  92
  93     $test_sql = $sql . " LIMIT 242";
  94     ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql);
  95     is(trim($res_sql), $sql, "Correctly removes LIMIT in simple case");
  96     is($res_lim1, 0, "Returns correct default offset");
  97     is($res_lim2, 242, "Returns correct extracted LIMIT");
  98
  99     $test_sql = $sql . " LIMIT 13,242";
 100     ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql);
 101     is(trim($res_sql), $sql, "Correctly removes LIMIT in simple case (with offset)");
 102     is($res_lim1, 13, "Returns correct extracted offset");
 103     is($res_lim2, 242, "Returns correct extracted LIMIT");
 104 };
 105
 106 $_->delete for Koha::AuthorisedValues->search({ category => 'XXX' });
 107 Koha::AuthorisedValue->new({category => 'LOC'})->store;
 108
 109 subtest 'GetReservedAuthorisedValues' => sub {
 110     plan tests => 1;
 111     # This one will catch new reserved words not added
 112     # to GetReservedAuthorisedValues
 113     my %test_authval = (
 114         'date' => 1,
 115         'branches' => 1,
 116         'itemtypes' => 1,
 117         'cn_source' => 1,
 118         'categorycode' => 1,
 119         'biblio_framework' => 1,
 120     );
 121
 122     my $reserved_authorised_values = GetReservedAuthorisedValues();
 123     is_deeply(\%test_authval, $reserved_authorised_values,
 124                 'GetReservedAuthorisedValues returns a fixed list');
 125 };
 126
 127 subtest 'IsAuthorisedValueValid' => sub {
 128     plan tests => 8;
 129     ok( IsAuthorisedValueValid('LOC'),
 130         'User defined authorised value category is valid');
 131
 132     ok( ! IsAuthorisedValueValid('XXX'),
 133         'Not defined authorised value category is invalid');
 134
 135     # Loop through the reserved authorised values
 136     foreach my $authorised_value ( keys %{GetReservedAuthorisedValues()} ) {
 137         ok( IsAuthorisedValueValid($authorised_value),
 138             '\''.$authorised_value.'\' is a reserved word, and thus a valid authorised value');
 139     }
 140 };
 141
 142 subtest 'GetParametersFromSQL+ValidateSQLParameters' => sub  {
 143     plan tests => 3;
 144     my $test_query_1 = "
 145         SELECT date_due
 146         FROM old_issues
 147         WHERE YEAR(timestamp) = <<Year|custom_list>> AND
 148               branchcode = <<Branch|branches>> AND
 149               borrowernumber = <<Borrower>> AND
 150               itemtype = <<Item type|itemtypes:all>>
 151     ";
 152
 153     my @test_parameters_with_custom_list = (
 154         { 'name' => 'Year', 'authval' => 'custom_list' },
 155         { 'name' => 'Branch', 'authval' => 'branches' },
 156         { 'name' => 'Borrower', 'authval' => undef },
 157         { 'name' => 'Item type', 'authval' => 'itemtypes' }
 158     );
 159
 160     is_deeply( GetParametersFromSQL($test_query_1), \@test_parameters_with_custom_list,
 161         'SQL params are correctly parsed');
 162
 163     my @problematic_parameters = ();
 164     push @problematic_parameters, { 'name' => 'Year', 'authval' => 'custom_list' };
 165     is_deeply( ValidateSQLParameters( $test_query_1 ),
 166                \@problematic_parameters,
 167                '\'custom_list\' not a valid category' );
 168
 169     my $test_query_2 = "
 170         SELECT date_due
 171         FROM old_issues
 172         WHERE YEAR(timestamp) = <<Year|date>> AND
 173               branchcode = <<Branch|branches>> AND
 174               borrowernumber = <<Borrower|LOC>>
 175     ";
 176
 177     is_deeply( ValidateSQLParameters( $test_query_2 ),
 178         [],
 179         'All parameters valid, empty problematic authvals list'
 180     );
 181 };
 182
 183 subtest 'get_saved_reports' => sub {
 184     plan tests => 16;
 185     my $dbh = C4::Context->dbh;
 186     $dbh->do(q|DELETE FROM saved_sql|);
 187     $dbh->do(q|DELETE FROM saved_reports|);
 188
 189     #Test save_report
 190     my $count = scalar @{ get_saved_reports() };
 191     is( $count, 0, "There is no report" );
 192
 193     my @report_ids;
 194     foreach my $ii ( 1..3 ) {
 195         my $id = $builder->build({ source => 'Borrower' })->{ borrowernumber };
 196         push @report_ids, save_report({
 197             borrowernumber => $id,
 198             sql            => "SQL$id",
 199             name           => "Name$id",
 200             area           => "area$ii", # ii vs id area is varchar(6)
 201             group          => "group$id",
 202             subgroup       => "subgroup$id",
 203             type           => "type$id",
 204             notes          => "note$id",
 205             cache_expiry   => undef,
 206             public         => 0,
 207         });
 208         $count++;
 209     }
 210     like( $report_ids[0], '/^\d+$/', "Save_report returns an id for first" );
 211     like( $report_ids[1], '/^\d+$/', "Save_report returns an id for second" );
 212     like( $report_ids[2], '/^\d+$/', "Save_report returns an id for third" );
 213
 214     is( scalar @{ get_saved_reports() },
 215         $count, "$count reports have been added" );
 216
 217     ok( 0 < scalar @{ get_saved_reports( $report_ids[0] ) }, "filter takes report id" );
 218
 219     #Test delete_report
 220     is (delete_report(),undef, "Without id delete_report returns undef");
 221
 222     is( delete_report( $report_ids[0] ), 1, "report 1 is deleted" );
 223     $count--;
 224
 225     is( scalar @{ get_saved_reports() }, $count, "Report1 has been deleted" );
 226
 227     is( delete_report( $report_ids[1], $report_ids[2] ), 2, "report 2 and 3 are deleted" );
 228     $count -= 2;
 229
 230     is( scalar @{ get_saved_reports() },
 231         $count, "Report2 and report3 have been deleted" );
 232
 233     my $sth = execute_query('SELECT COUNT(*) FROM systempreferences', 0, 10);
 234     my $results = $sth->fetchall_arrayref;
 235     is(scalar @$results, 1, 'running a query returned a result');
 236
 237     my $version = C4::Context->preference('Version');
 238     $sth = execute_query(
 239         'SELECT value FROM systempreferences WHERE variable = ?',
 240         0,
 241         10,
 242         [ 'Version' ],
 243     );
 244     $results = $sth->fetchall_arrayref;
 245     is_deeply(
 246         $results,
 247         [ [ $version ] ],
 248         'running a query with a parameter returned the expected result'
 249     );
 250
 251     # for next test, we want to let execute_query capture any SQL errors
 252     $dbh->{RaiseError} = 0;
 253     my $errors;
 254     warning_like { ($sth, $errors) = execute_query(
 255             'SELECT surname FRM borrowers',  # error in the query is intentional
 256             0, 10 ) }
 257             qr/^DBD::mysql::st execute failed: You have an error in your SQL syntax;/,
 258             "Wrong SQL syntax raises warning";
 259     ok(
 260         defined($errors) && exists($errors->{queryerr}),
 261         'attempting to run a report with an SQL syntax error returns error message (Bug 12214)'
 262     );
 263
 264     is_deeply( get_report_areas(), [ 'CIRC', 'CAT', 'PAT', 'ACQ', 'ACC', 'SER' ],
 265         "get_report_areas returns the correct array of report areas");
 266 };
 267
 268 subtest 'Ensure last_run is populated' => sub {
 269     plan tests => 3;
 270
 271     my $rs = Koha::Database->new()->schema()->resultset('SavedSql');
 272
 273     my $report = $rs->new(
 274         {
 275             report_name => 'Test Report',
 276             savedsql    => 'SELECT * FROM branches',
 277             notes       => undef,
 278         }
 279     )->insert();
 280
 281     is( $report->last_run, undef, 'Newly created report has null last_run ' );
 282
 283     execute_query( $report->savedsql, undef, undef, undef, $report->id );
 284     $report->discard_changes();
 285
 286     isnt( $report->last_run, undef, 'First run of report populates last_run' );
 287
 288     my $previous_last_run = $report->last_run;
 289     sleep(1); # last_run is stored to the second, so we need to ensure at least one second has passed between runs
 290     execute_query( $report->savedsql, undef, undef, undef, $report->id );
 291     $report->discard_changes();
 292
 293     isnt( $report->last_run, $previous_last_run, 'Second run of report updates last_run' );
 294 };
 295
 296 subtest 'convert_sql' => sub {
 297     plan tests => 4;
 298
 299     my $sql = q|
 300     SELECT biblionumber, ExtractValue(marcxml,
 301 'count(//datafield[@tag="505"])') AS count505
 302     FROM biblioitems
 303     HAVING count505 > 1|;
 304     my $expected_converted_sql = q|
 305     SELECT biblionumber, ExtractValue(metadata,
 306 'count(//datafield[@tag="505"])') AS count505
 307     FROM biblio_metadata
 308     HAVING count505 > 1|;
 309
 310     is( C4::Reports::Guided::convert_sql( $sql ), $expected_converted_sql, "Simple query should have been correctly converted");
 311
 312     $sql = q|
 313     SELECT biblionumber, substring(
 314 ExtractValue(marcxml,'//controlfield[@tag="008"]'), 8,4 ) AS 'PUB DATE',
 315 title
 316     FROM biblioitems
 317     INNER JOIN biblio USING (biblionumber)
 318     WHERE biblionumber = 14|;
 319
 320     $expected_converted_sql = q|
 321     SELECT biblionumber, substring(
 322 ExtractValue(metadata,'//controlfield[@tag="008"]'), 8,4 ) AS 'PUB DATE',
 323 title
 324     FROM biblio_metadata
 325     INNER JOIN biblio USING (biblionumber)
 326     WHERE biblionumber = 14|;
 327     is( C4::Reports::Guided::convert_sql( $sql ), $expected_converted_sql, "Query with biblio info should have been correctly converted");
 328
 329     $sql = q|
 330     SELECT concat(b.title, ' ', ExtractValue(m.marcxml,
 331 '//datafield[@tag="245"]/subfield[@code="b"]')) AS title, b.author,
 332 count(h.reservedate) AS 'holds'
 333     FROM biblio b
 334     LEFT JOIN biblioitems m USING (biblionumber)
 335     LEFT JOIN reserves h ON (b.biblionumber=h.biblionumber)
 336     GROUP BY b.biblionumber
 337     HAVING count(h.reservedate) >= 42|;
 338
 339     $expected_converted_sql = q|
 340     SELECT concat(b.title, ' ', ExtractValue(m.metadata,
 341 '//datafield[@tag="245"]/subfield[@code="b"]')) AS title, b.author,
 342 count(h.reservedate) AS 'holds'
 343     FROM biblio b
 344     LEFT JOIN biblio_metadata m USING (biblionumber)
 345     LEFT JOIN reserves h ON (b.biblionumber=h.biblionumber)
 346     GROUP BY b.biblionumber
 347     HAVING count(h.reservedate) >= 42|;
 348     is( C4::Reports::Guided::convert_sql( $sql ), $expected_converted_sql, "Query with 2 joins should have been correctly converted");
 349
 350     $sql = q|
 351     SELECT t1.marcxml AS first, t2.marcxml AS second,
 352     FROM biblioitems t1
 353     LEFT JOIN biblioitems t2 USING ( biblionumber )|;
 354
 355     $expected_converted_sql = q|
 356     SELECT t1.metadata AS first, t2.metadata AS second,
 357     FROM biblio_metadata t1
 358     LEFT JOIN biblio_metadata t2 USING ( biblionumber )|;
 359     is( C4::Reports::Guided::convert_sql( $sql ), $expected_converted_sql, "Query with multiple instances of marcxml and biblioitems should have them all replaced");
 360 };
 361
 362 subtest 'Email report test' => sub {
 363
 364     plan tests => 8;
 365
 366     my $id1 = $builder->build({ source => 'Borrower',value => { surname => 'mailer', email => 'a@b.com' } })->{ borrowernumber };
 367     my $id2 = $builder->build({ source => 'Borrower',value => { surname => 'nomailer', email => undef } })->{ borrowernumber };
 368     my $report1 = $builder->build({ source => 'SavedSql', value => { savedsql => "SELECT surname,borrowernumber,email FROM borrowers WHERE borrowernumber IN ($id1,$id2)" } })->{ id };
 369     my $report2 = $builder->build({ source => 'SavedSql', value => { savedsql => "SELECT potato FROM mashed" } })->{ id };
 370
 371     my $letter1 = $builder->build({
 372             source => 'Letter',
 373             value => {
 374                 content => "[% surname %]",
 375                 branchcode => "",
 376                 message_transport_type => 'email'
 377             }
 378         });
 379     my $letter2 = $builder->build({
 380             source => 'Letter',
 381             value => {
 382                 content => "[% firstname %]",
 383                 branchcode => "",
 384                 message_transport_type => 'email'
 385             }
 386         });
 387
 388     my $message_count = Koha::Notice::Messages->search({})->count;
 389
 390     my ( $emails, $errors ) = C4::Reports::Guided::EmailReport();
 391     is( $errors->[0]{FATAL}, 'MISSING_PARAMS', "Need to enter required params");
 392
 393     ($emails, $errors ) = C4::Reports::Guided::EmailReport({report_id => $report1, module => $letter1->{module}, code => $letter2->{code}});
 394     is( $errors->[0]{FATAL}, 'NO_LETTER', "Must have a letter that exists");
 395
 396     warning_like { ($emails, $errors ) = C4::Reports::Guided::EmailReport({report_id => $report2, module => $letter1->{module} , code => $letter1->{code} }) }
 397         qr/^DBD::mysql::st execute failed/,
 398         'Error from bad report';
 399     is( $errors->[0]{FATAL}, 'REPORT_FAIL', "Bad report returns failure");
 400
 401     ($emails, $errors ) = C4::Reports::Guided::EmailReport({report_id => $report1, module => $letter1->{module} , code => $letter1->{code} });
 402     is( $errors->[0]{NO_FROM_COL} == 1 && $errors->[1]{NO_EMAIL_COL} == 2  && $errors->[2]{NO_FROM_COL} == 2, 1, "Correct warnings from the routine");
 403
 404     ($emails, $errors ) = C4::Reports::Guided::EmailReport({report_id => $report1, module => $letter1->{module} , code => $letter1->{code}, from => 'the@future.ooh' });
 405     is( $errors->[0]{NO_EMAIL_COL}, 2, "Warning only for patron with no email");
 406
 407     is( $message_count,  Koha::Notice::Messages->search({})->count, "Messages not added without commit");
 408
 409     ($emails, $errors ) = C4::Reports::Guided::EmailReport({report_id => $report1, module => $letter1->{module} , code => $letter1->{code}, from => 'the@future.ooh' });
 410     is( $emails->[0]{letter}->{content}, "mailer", "Message has expected content");
 411
 412 };
 413
 414 $schema->storage->txn_rollback;
 415
 416 subtest 'nb_rows() tests' => sub {
 417
 418     plan tests => 3;
 419
 420     $schema->storage->txn_begin;
 421
 422     my $items_count = Koha::Items->search->count;
 423     $builder->build_object({ class => 'Koha::Items' });
 424     $builder->build_object({ class => 'Koha::Items' });
 425     $items_count += 2;
 426
 427     my $query = q{
 428         SELECT * FROM items xxx
 429     };
 430
 431     my $nb_rows = nb_rows( $query );
 432
 433     is( $nb_rows, $items_count, 'nb_rows returns the right value' );
 434
 435     my $bad_query = q{
 436         SELECT * items xxx
 437     };
 438
 439     warning_like
 440         { $nb_rows = nb_rows( $bad_query ) }
 441         qr/^DBD::mysql::st execute failed:/,
 442         'Bad queries raise a warning';
 443
 444     is( $nb_rows, 0, 'nb_rows returns 0 on bad queries' );
 445
 446     $schema->storage->txn_rollback;
 447 };
 448
 449 sub trim {
 450     my ($s) = @_;
 451     $s =~ s/^\s*(.*?)\s*$/$1/s;
 452     return $s;
 453 }