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 => 8;
  22 use Test::Warn;
  23
  24 use t::lib::TestBuilder;
  25 use C4::Context;
  26 use Koha::Database;
  27
  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;
  37
  38 subtest 'strip_limit' => sub {
  39     # This is the query I found that triggered bug 8594.
  40     my $sql = "SELECT aqorders.ordernumber, biblio.title, biblio.biblionumber, items.homebranch,
  41         aqorders.entrydate, aqorders.datereceived,
  42         (SELECT DATE(datetime) FROM statistics
  43             WHERE itemnumber=items.itemnumber AND
  44                 (type='return' OR type='issue') LIMIT 1)
  45         AS shelvedate,
  46         DATEDIFF(COALESCE(
  47             (SELECT DATE(datetime) FROM statistics
  48                 WHERE itemnumber=items.itemnumber AND
  49                 (type='return' OR type='issue') LIMIT 1),
  50         aqorders.datereceived), aqorders.entrydate) AS totaldays
  51     FROM aqorders
  52     LEFT JOIN biblio USING (biblionumber)
  53     LEFT JOIN items ON (items.biblionumber = biblio.biblionumber
  54         AND dateaccessioned=aqorders.datereceived)
  55     WHERE (entrydate >= '2011-01-01' AND (datereceived < '2011-02-01' OR datereceived IS NULL))
  56         AND items.homebranch LIKE 'INFO'
  57     ORDER BY title";
  58
  59     my ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($sql);
  60     is($res_sql, $sql, "Not breaking subqueries");
  61     is($res_lim1, 0, "Returns correct default offset");
  62     is($res_lim2, undef, "Returns correct default LIMIT");
  63
  64     # Now the same thing, but we want it to remove the LIMIT from the end
  65
  66     my $test_sql = $res_sql . " LIMIT 242";
  67     ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql);
  68     # The replacement drops a ' ' where the limit was
  69     is(trim($res_sql), $sql, "Correctly removes only final LIMIT");
  70     is($res_lim1, 0, "Returns correct default offset");
  71     is($res_lim2, 242, "Returns correct extracted LIMIT");
  72
  73     $test_sql = $res_sql . " LIMIT 13,242";
  74     ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($test_sql);
  75     # The replacement drops a ' ' where the limit was
  76     is(trim($res_sql), $sql, "Correctly removes only final LIMIT (with offset)");
  77     is($res_lim1, 13, "Returns correct extracted offset");
  78     is($res_lim2, 242, "Returns correct extracted LIMIT");
  79
  80     # After here is the simpler case, where there isn't a WHERE clause to worry
  81     # about.
  82
  83     # First case with nothing to change
  84     $sql = "SELECT * FROM items";
  85     ($res_sql, $res_lim1, $res_lim2) = C4::Reports::Guided::strip_limit($sql);
  86     is($res_sql, $sql, "Not breaking simple queries");
  87     is($res_lim1, 0, "Returns correct default offset");
  88     is($res_lim2, undef, "Returns correct default LIMIT");
  89
  90     $test_sql = $sql . " LIMIT 242";
  91     ($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");
  93     is($res_lim1, 0, "Returns correct default offset");
  94     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     ok( 0 < scalar @{ get_saved_reports( $report_ids[0] ) }, "filter takes report id" );
 213
 214     #Test delete_report
 215     is (delete_report(),undef, "Without id delete_report returns undef");
 216
 217     is( delete_report( $report_ids[0] ), 1, "report 1 is deleted" );
 218     $count--;
 219
 220     is( scalar @{ get_saved_reports() }, $count, "Report1 has been deleted" );
 221
 222     is( delete_report( $report_ids[1], $report_ids[2] ), 2, "report 2 and 3 are deleted" );
 223     $count -= 2;
 224
 225     is( scalar @{ get_saved_reports() },
 226         $count, "Report2 and report3 have been deleted" );
 227
 228     my $sth = execute_query('SELECT COUNT(*) FROM systempreferences', 0, 10);
 229     my $results = $sth->fetchall_arrayref;
 230     is(scalar @$results, 1, 'running a query returned a result');
 231
 232     my $version = C4::Context->preference('Version');
 233     $sth = execute_query(
 234         'SELECT value FROM systempreferences WHERE variable = ?',
 235         0,
 236         10,
 237         [ 'Version' ],
 238     );
 239     $results = $sth->fetchall_arrayref;
 240     is_deeply(
 241         $results,
 242         [ [ $version ] ],
 243         'running a query with a parameter returned the expected result'
 244     );
 245
 246     # for next test, we want to let execute_query capture any SQL errors
 247     $dbh->{RaiseError} = 0;
 248     my $errors;
 249     warning_like { ($sth, $errors) = execute_query(
 250             'SELECT surname FRM borrowers',  # error in the query is intentional
 251             0, 10 ) }
 252             qr/^DBD::mysql::st execute failed: You have an error in your SQL syntax;/,
 253             "Wrong SQL syntax raises warning";
 254     ok(
 255         defined($errors) && exists($errors->{queryerr}),
 256         'attempting to run a report with an SQL syntax error returns error message (Bug 12214)'
 257     );
 258
 259     is_deeply( get_report_areas(), [ 'CIRC', 'CAT', 'PAT', 'ACQ', 'ACC', 'SER' ],
 260         "get_report_areas returns the correct array of report areas");
 261 };
 262
 263 subtest 'Ensure last_run is populated' => sub {
 264     plan tests => 3;
 265
 266     my $rs = Koha::Database->new()->schema()->resultset('SavedSql');
 267
 268     my $report = $rs->new(
 269         {
 270             report_name => 'Test Report',
 271             savedsql    => 'SELECT * FROM branches',
 272             notes       => undef,
 273         }
 274     )->insert();
 275
 276     is( $report->last_run, undef, 'Newly created report has null last_run ' );
 277
 278     execute_query( $report->savedsql, undef, undef, undef, $report->id );
 279     $report->discard_changes();
 280
 281     isnt( $report->last_run, undef, 'First run of report populates last_run' );
 282
 283     my $previous_last_run = $report->last_run;
 284     sleep(1); # last_run is stored to the second, so we need to ensure at least one second has passed between runs
 285     execute_query( $report->savedsql, undef, undef, undef, $report->id );
 286     $report->discard_changes();
 287
 288     isnt( $report->last_run, $previous_last_run, 'Second run of report updates last_run' );
 289 };
 290
 291 $schema->storage->txn_rollback;
 292
 293 sub trim {
 294     my ($s) = @_;
 295     $s =~ s/^\s*(.*?)\s*$/$1/s;
 296     return $s;
 297 }