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 =head1 NAME
  30
  31 Koha::Report - Koha Report Object class
  32
  33 =head1 API
  34
  35 =head2 Class Methods
  36
  37 =cut
  38
  39 =head3 get_search_info
  40
  41 Return search info
  42
  43 =cut
  44
  45 sub get_search_info {
  46     my $self = shift;
  47     my $sub_mana_info = { 'query' => shift };
  48     return $sub_mana_info;
  49 }
  50
  51 =head3 get_sharable_info
  52
  53 Return properties that can be shared.
  54
  55 =cut
  56
  57 sub get_sharable_info {
  58     my $self             = shift;
  59     my $shared_report_id = shift;
  60     my $report           = Koha::Reports->find($shared_report_id);
  61     my $sub_mana_info    = {
  62         'savedsql'     => $report->savedsql,
  63         'report_name'  => $report->report_name,
  64         'notes'        => $report->notes,
  65         'report_group' => $report->report_group,
  66         'type'         => $report->type,
  67     };
  68     return $sub_mana_info;
  69 }
  70
  71 =head3 new_from_mana
  72
  73 Clear a Mana report to be imported in Koha?
  74
  75 =cut
  76
  77 sub new_from_mana {
  78     my $self = shift;
  79     my $data = shift;
  80
  81     $data->{mana_id} = $data->{id};
  82
  83     delete $data->{exportemail};
  84     delete $data->{kohaversion};
  85     delete $data->{creationdate};
  86     delete $data->{lastimport};
  87     delete $data->{id};
  88     delete $data->{nbofusers};
  89     delete $data->{language};
  90
  91     Koha::Report->new($data)->store;
  92 }
  93
  94 =head3 prep_report
  95
  96 Prep the report and return executable sql with parameters embedded and a list of header types
  97 for building batch action links in the template
  98
  99 =cut
 100
 101 sub prep_report {
 102     my ( $self, $param_names, $sql_params ) = @_;
 103     my $sql = $self->savedsql;
 104
 105     # First we split out the placeholders
 106     # This part of the code supports using [[ table.field | alias ]] in the
 107     # query and replaces it by table.field AS alias. This is used to build
 108     # the batch action links foir cardnumbers, itemnumbers, and biblionumbers in the template
 109     # while allowing the library to alter the column names
 110     my @split = split /\[\[|\]\]/, $sql;
 111     my $headers;
 112     for ( my $i = 0 ; $i < $#split / 2 ; $i++ )
 113     {    #The placeholders are always the odd elements of the array
 114         my ( $type, $name ) = split /\|/,
 115           $split[ $i * 2 + 1 ];    # We split them on '|'
 116         $headers->{$name} = $type; # Store as a lookup for the template
 117         $headers->{$name} =~
 118           s/^\w*\.//;    # strip the table name just as in $sth->{NAME} array
 119         $split[ $i * 2 + 1 ] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g
 120           ;    #Quote any special characters so we can replace the placeholders
 121         $name = C4::Context->dbh->quote($name);
 122         $sql =~ s/\[\[$split[$i*2+1]\]\]/$type AS $name/
 123           ;    # Remove placeholders from SQL
 124     }
 125
 126     my %lookup;
 127     @lookup{@$param_names} = @$sql_params;
 128     @split = split /<<|>>/, $sql;
 129     for ( my $i = 0 ; $i < $#split / 2 ; $i++ ) {
 130         my $quoted =
 131           @$param_names ? $lookup{ $split[ $i * 2 + 1 ] } : @$sql_params[$i];
 132
 133         # if there are special regexp chars, we must \ them
 134         $split[ $i * 2 + 1 ] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
 135         if ( $split[ $i * 2 + 1 ] =~ /\|\s*date\s*$/ ) {
 136             $quoted = output_pref(
 137                 {
 138                     dt         => dt_from_string($quoted),
 139                     dateformat => 'iso',
 140                     dateonly   => 1
 141                 }
 142             ) if $quoted;
 143         }
 144         unless ( $split[ $i * 2 + 1 ] =~ /\|\s*list\s*$/ && $quoted ) {
 145             $quoted = C4::Context->dbh->quote($quoted);
 146         }
 147         else {
 148             my @list = split /\n/, $quoted;
 149             my @quoted_list;
 150             foreach my $item (@list) {
 151                 $item =~ s/\r//;
 152                 push @quoted_list, C4::Context->dbh->quote($item);
 153             }
 154             $quoted = "(" . join( ",", @quoted_list ) . ")";
 155         }
 156         $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
 157     }
 158     return $sql, $headers;
 159 }
 160
 161 =head3 _type
 162
 163 Returns name of corresponding DBIC resultset
 164
 165 =cut
 166
 167 sub _type {
 168     return 'SavedSql';
 169 }
 170
 171 1;