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