Koha/Report.pm

   1 package Koha::Report;
   2
   3 # This file is part of Koha.
   4 #
   5 # Koha is free software; you can redistribute it and/or modify it
   6 # under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # Koha is distributed in the hope that it will be useful, but
  11 # WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13 # GNU General Public License for more details.
  14 #
  15 # 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
  18 use Modern::Perl;
  19
  20 use Carp;
  21
  22 use Koha::Database;
  23 use JSON;
  24 use Koha::Reports;
  25 use Koha::DateUtils qw( dt_from_string output_pref );
  26
  27 use base qw(Koha::Object);
  28 #
  29 # FIXME We could only return an error code instead of the arrayref
  30 # Only 1 error is returned
  31 # TODO Koha::Report->store should check this before saving
  32
  33 =head1 NAME
  34
  35 Koha::Report - Koha Report Object class
  36
  37 =head1 API
  38
  39 =head2 Class Methods
  40
  41 =head3 is_sql_valid
  42
  43 my ( $is_sql_valid, $errors ) = $report->is_sql_valid;
  44
  45 $errors is a arrayref of hashrefs, keys can be sqlerr or queryerr.
  46
  47 Validate SQL query string so it only contains a select,
  48 not any of the harmful queries.
  49
  50 =cut
  51
  52 sub is_sql_valid {
  53     my ($self) = @_;
  54
  55     my $sql = $self->savedsql;
  56     $sql //= '';
  57     my @errors = ();
  58
  59     if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
  60         push @errors, { sqlerr => $1 };
  61     } elsif ($sql !~ /^\s*SELECT\b\s*/i) {
  62         push @errors, { queryerr => 'Missing SELECT' };
  63     }
  64
  65     return ( @errors ? 0 : 1, \@errors );
  66 }
  67
  68 =head3 get_search_info
  69
  70 Return search info
  71
  72 =cut
  73
  74 sub get_search_info {
  75     my $self = shift;
  76     my $sub_mana_info = { 'query' => shift };
  77     return $sub_mana_info;
  78 }
  79
  80 =head3 get_sharable_info
  81
  82 Return properties that can be shared.
  83
  84 =cut
  85
  86 sub get_sharable_info {
  87     my $self             = shift;
  88     my $shared_report_id = shift;
  89     my $report           = Koha::Reports->find($shared_report_id);
  90     my $sub_mana_info    = {
  91         'savedsql'     => $report->savedsql,
  92         'report_name'  => $report->report_name,
  93         'notes'        => $report->notes,
  94         'report_group' => $report->report_group,
  95         'type'         => $report->type,
  96     };
  97     return $sub_mana_info;
  98 }
  99
 100 =head3 new_from_mana
 101
 102 Clear a Mana report to be imported in Koha?
 103
 104 =cut
 105
 106 sub new_from_mana {
 107     my $self = shift;
 108     my $data = shift;
 109
 110     $data->{mana_id} = $data->{id};
 111
 112     delete $data->{exportemail};
 113     delete $data->{kohaversion};
 114     delete $data->{creationdate};
 115     delete $data->{lastimport};
 116     delete $data->{id};
 117     delete $data->{nbofusers};
 118     delete $data->{language};
 119
 120     Koha::Report->new($data)->store;
 121 }
 122
 123 =head3 prep_report
 124
 125 Prep the report and return executable sql with parameters embedded and a list of header types
 126 for building batch action links in the template
 127
 128 =cut
 129
 130 sub prep_report {
 131     my ( $self, $param_names, $sql_params ) = @_;
 132     my $sql = $self->savedsql;
 133
 134     # First we split out the placeholders
 135     # This part of the code supports using [[ table.field | alias ]] in the
 136     # query and replaces it by table.field AS alias. This is used to build
 137     # the batch action links foir cardnumbers, itemnumbers, and biblionumbers in the template
 138     # while allowing the library to alter the column names
 139     my @split = split /\[\[|\]\]/, $sql;
 140     my $headers;
 141     for ( my $i = 0 ; $i < $#split / 2 ; $i++ )
 142     {    #The placeholders are always the odd elements of the array
 143         my ( $type, $name ) = split /\|/,
 144           $split[ $i * 2 + 1 ];    # We split them on '|'
 145         $headers->{$name} = $type; # Store as a lookup for the template
 146         $headers->{$name} =~
 147           s/^\w*\.//;    # strip the table name just as in $sth->{NAME} array
 148         $split[ $i * 2 + 1 ] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g
 149           ;    #Quote any special characters so we can replace the placeholders
 150         $name = C4::Context->dbh->quote($name);
 151         $sql =~ s/\[\[$split[$i*2+1]\]\]/$type AS $name/
 152           ;    # Remove placeholders from SQL
 153     }
 154
 155     my %lookup;
 156     @lookup{@$param_names} = @$sql_params;
 157     @split = split /<<|>>/, $sql;
 158     for ( my $i = 0 ; $i < $#split / 2 ; $i++ ) {
 159         my $quoted =
 160           @$param_names ? $lookup{ $split[ $i * 2 + 1 ] } : @$sql_params[$i];
 161
 162         # if there are special regexp chars, we must \ them
 163         $split[ $i * 2 + 1 ] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
 164         if ( $split[ $i * 2 + 1 ] =~ /\|\s*date\s*$/ ) {
 165             $quoted = output_pref(
 166                 {
 167                     dt         => dt_from_string($quoted),
 168                     dateformat => 'iso',
 169                     dateonly   => 1
 170                 }
 171             ) if $quoted;
 172         }
 173         unless ( $split[ $i * 2 + 1 ] =~ /\|\s*list\s*$/ && $quoted ) {
 174             $quoted = C4::Context->dbh->quote($quoted);
 175         }
 176         else {
 177             my @list = split /\n/, $quoted;
 178             my @quoted_list;
 179             foreach my $item (@list) {
 180                 $item =~ s/\r//;
 181                 push @quoted_list, C4::Context->dbh->quote($item);
 182             }
 183             $quoted = "(" . join( ",", @quoted_list ) . ")";
 184         }
 185         $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
 186     }
 187     return $sql, $headers;
 188 }
 189
 190 =head3 _type
 191
 192 Returns name of corresponding DBIC resultset
 193
 194 =cut
 195
 196 sub _type {
 197     return 'SavedSql';
 198 }
 199
 200 1;