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