"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/svc/report" (23 Feb 2021, 2841 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl
    2 
    3 # This file is part of Koha.
    4 #
    5 # Copyright (C) 2011  Chris Cormack <chris@bigballofwax.co.nz>
    6 # Copyright (C) 2013  Mark Tompsett
    7 #
    8 # Koha is free software; you can redistribute it and/or modify it
    9 # under the terms of the GNU General Public License as published by
   10 # the Free Software Foundation; either version 3 of the License, or
   11 # (at your option) any later version.
   12 #
   13 # Koha is distributed in the hope that it will be useful, but
   14 # WITHOUT ANY WARRANTY; without even the implied warranty of
   15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
   16 # GNU General Public License for more details.
   17 #
   18 # You should have received a copy of the GNU General Public License
   19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
   20 
   21 use Modern::Perl;
   22 
   23 use C4::Auth;
   24 use C4::Reports::Guided;
   25 use Koha::Reports;
   26 use JSON;
   27 use CGI qw ( -utf8 );
   28 
   29 use Koha::Caches;
   30 
   31 
   32 my $query  = CGI->new();
   33 my $report_id = $query->param('id');
   34 my $report_name = $query->param('name');
   35 my $report_annotation = $query->param('annotated');
   36 
   37 my $report_recs = Koha::Reports->search( $report_name ? { 'report_name' => $report_name } : { 'id' => $report_id } );
   38 if (!$report_recs || $report_recs->count == 0 ) { die "There is no such report.\n"; }
   39 my $report_rec = $report_recs->next();
   40 
   41 my @sql_params  = $query->multi_param('sql_params');
   42 
   43 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
   44     {
   45         template_name   => "intranet-main.tt",
   46         query           => $query,
   47         type            => "intranet",
   48         flagsrequired   => { catalogue => 1, },
   49     }
   50 );
   51 
   52 my $cache = Koha::Caches->get_instance();
   53 my $cache_active = $cache->is_cache_active;
   54 my ($cache_key, $json_text);
   55 if ($cache_active) {
   56     $cache_key = "intranet:report:".($report_name ? "report_name:$report_name:" : "id:$report_id:")
   57     . join( '-', @sql_params );
   58     $json_text = $cache->get_from_cache($cache_key);
   59 }
   60 
   61 unless ($json_text) {
   62     my $offset = 0;
   63     my $limit  = C4::Context->preference("SvcMaxReportRows") || 10;
   64     my $sql = $report_rec->savedsql;
   65 
   66     # convert SQL parameters to placeholders
   67     $sql =~ s/(<<.*?>>)/\?/g;
   68     $sql =~ s/\[\[(.*?)\|(.*?)\]\]/$1 AS $2/g;
   69 
   70     my ( $sth, $errors ) = execute_query( $sql, $offset, $limit, \@sql_params, $report_id );
   71     if ($sth) {
   72         my $lines;
   73         if ($report_annotation) {
   74             $lines = $sth->fetchall_arrayref({});
   75         }
   76         else {
   77             $lines = $sth->fetchall_arrayref;
   78         }
   79         $json_text = encode_json($lines);
   80 
   81         if ($cache_active) {
   82             $cache->set_in_cache( $cache_key, $json_text, { expiry => $report_rec->cache_expiry } );
   83         }
   84     }
   85     else {
   86         $json_text = encode_json($errors);
   87     }
   88 }
   89 
   90 print $query->header(
   91     -charset    => 'UTF-8',
   92     -type       => 'application/json'
   93 );
   94 print $json_text;