reports/guided_reports.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright 2007 Liblime ltd
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along
  17 # with Koha; if not, write to the Free Software Foundation, Inc.,
  18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19
  20 use strict;
  21 use warnings;
  22
  23 use CGI;
  24 use Text::CSV;
  25 use URI::Escape;
  26 use C4::Reports::Guided;
  27 use C4::Auth qw/:DEFAULT get_session/;
  28 use C4::Output;
  29 use C4::Dates qw/format_date/;
  30 use C4::Debug;
  31 use C4::Branch; # XXX subfield_is_koha_internal_p
  32
  33 =head1 NAME
  34
  35 guided_reports.pl
  36
  37 =head1 DESCRIPTION
  38
  39 Script to control the guided report creation
  40
  41 =cut
  42
  43 my $input = new CGI;
  44 my $usecache = C4::Context->ismemcached;
  45
  46 my $phase = $input->param('phase');
  47 my $flagsrequired;
  48 if ( $phase eq 'Build new' or $phase eq 'Delete Saved' ) {
  49     $flagsrequired = 'create_reports';
  50 }
  51 elsif ( $phase eq 'Use saved' ) {
  52     $flagsrequired = 'execute_reports';
  53 } else {
  54     $flagsrequired = '*';
  55 }
  56
  57 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
  58     {
  59         template_name   => "reports/guided_reports_start.tmpl",
  60         query           => $input,
  61         type            => "intranet",
  62         authnotrequired => 0,
  63         flagsrequired   => { reports => $flagsrequired },
  64         debug           => 1,
  65     }
  66 );
  67 my $session = $cookie ? get_session($cookie->value) : undef;
  68
  69 my $filter;
  70 if ( $input->param("filter_set") ) {
  71     $filter = {};
  72     $filter->{$_} = $input->param("filter_$_") foreach qw/date author keyword group subgroup/;
  73     $session->param('report_filter', $filter) if $session;
  74     $template->param( 'filter_set' => 1 );
  75 }
  76 elsif ($session) {
  77     $filter = $session->param('report_filter');
  78 }
  79
  80
  81 my @errors = ();
  82 if ( !$phase ) {
  83     $template->param( 'start' => 1 );
  84     # show welcome page
  85 }
  86 elsif ( $phase eq 'Build new' ) {
  87     # build a new report
  88     $template->param( 'build1' => 1 );
  89     my $areas = get_report_areas();
  90     $template->param(
  91         'areas' => [map { id => $_->[0], name => $_->[1] }, @$areas],
  92         'usecache' => $usecache,
  93         'cache_expiry' => 300,
  94         'public' => '0',
  95     );
  96 } elsif ( $phase eq 'Use saved' ) {
  97
  98     # use a saved report
  99     # get list of reports and display them
 100     my $group = $input->param('group');
 101     my $subgroup = $input->param('subgroup');
 102     $filter->{group} = $group;
 103     $filter->{subgroup} = $subgroup;
 104     $template->param(
 105         'saved1' => 1,
 106         'savedreports' => get_saved_reports($filter),
 107         'usecache' => $usecache,
 108         'groups_with_subgroups'=> groups_with_subgroups($group, $subgroup),
 109     );
 110 }
 111
 112 elsif ( $phase eq 'Delete Saved') {
 113
 114         # delete a report from the saved reports list
 115         my $id = $input->param('reports');
 116         delete_report($id);
 117     print $input->redirect("/cgi-bin/koha/reports/guided_reports.pl?phase=Use%20saved");
 118         exit;
 119 }
 120
 121 elsif ( $phase eq 'Show SQL'){
 122
 123     my $id = $input->param('reports');
 124     my $report = get_saved_report($id);
 125     $template->param(
 126         'id'      => $id,
 127         'reportname' => $report->{report_name},
 128         'notes'      => $report->{notes},
 129         'sql'     => $report->{savedsql},
 130         'showsql' => 1,
 131     );
 132 }
 133
 134 elsif ( $phase eq 'Edit SQL'){
 135
 136     my $id = $input->param('reports');
 137     my $report = get_saved_report($id);
 138     my $group = $report->{report_group};
 139     my $subgroup  = $report->{report_subgroup};
 140     $template->param(
 141         'sql'        => $report->{savedsql},
 142         'reportname' => $report->{report_name},
 143         'groups_with_subgroups' => groups_with_subgroups($group, $subgroup),
 144         'notes'      => $report->{notes},
 145         'id'         => $id,
 146         'cache_expiry' => $report->{cache_expiry},
 147         'public' => $report->{public},
 148         'usecache' => $usecache,
 149         'editsql'    => 1,
 150     );
 151 }
 152
 153 elsif ( $phase eq 'Update SQL'){
 154     my $id         = $input->param('id');
 155     my $sql        = $input->param('sql');
 156     my $reportname = $input->param('reportname');
 157     my $group      = $input->param('group');
 158     my $subgroup   = $input->param('subgroup');
 159     my $notes      = $input->param('notes');
 160     my $cache_expiry = $input->param('cache_expiry');
 161     my $cache_expiry_units = $input->param('cache_expiry_units');
 162     my $public = $input->param('public');
 163
 164     my @errors;
 165
 166     # if we have the units, then we came from creating a report from SQL and thus need to handle converting units
 167     if( $cache_expiry_units ){
 168       if( $cache_expiry_units eq "minutes" ){
 169         $cache_expiry *= 60;
 170       } elsif( $cache_expiry_units eq "hours" ){
 171         $cache_expiry *= 3600; # 60 * 60
 172       } elsif( $cache_expiry_units eq "days" ){
 173         $cache_expiry *= 86400; # 60 * 60 * 24
 174       }
 175     }
 176     # check $cache_expiry isnt too large, Memcached::set requires it to be less than 30 days or it will be treated as if it were an absolute time stamp
 177     if( $cache_expiry >= 2592000 ){
 178       push @errors, {cache_expiry => $cache_expiry};
 179     }
 180
 181     if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
 182         push @errors, {sqlerr => $1};
 183     }
 184     elsif ($sql !~ /^(SELECT)/i) {
 185         push @errors, {queryerr => 1};
 186     }
 187     if (@errors) {
 188         $template->param(
 189             'errors'    => \@errors,
 190             'sql'       => $sql,
 191         );
 192     } else {
 193         update_sql( $id, {
 194                 sql => $sql,
 195                 name => $reportname,
 196                 group => $group,
 197                 subgroup => $subgroup,
 198                 notes => $notes,
 199                 cache_expiry => $cache_expiry,
 200                 public => $public,
 201         } );
 202         $template->param(
 203             'save_successful'       => 1,
 204             'reportname'            => $reportname,
 205             'id'                    => $id,
 206         );
 207     }
 208 }
 209
 210 elsif ($phase eq 'retrieve results') {
 211         my $id = $input->param('id');
 212         my ($results,$name,$notes) = format_results($id);
 213         # do something
 214         $template->param(
 215                 'retresults' => 1,
 216                 'results' => $results,
 217                 'name' => $name,
 218                 'notes' => $notes,
 219     );
 220 }
 221
 222 elsif ( $phase eq 'Report on this Area' ) {
 223     my $cache_expiry_units = $input->param('cache_expiry_units'),
 224     my $cache_expiry = $input->param('cache_expiry');
 225
 226     # we need to handle converting units
 227     if( $cache_expiry_units eq "minutes" ){
 228       $cache_expiry *= 60;
 229     } elsif( $cache_expiry_units eq "hours" ){
 230       $cache_expiry *= 3600; # 60 * 60
 231     } elsif( $cache_expiry_units eq "days" ){
 232       $cache_expiry *= 86400; # 60 * 60 * 24
 233     }
 234     # check $cache_expiry isnt too large, Memcached::set requires it to be less than 30 days or it will be treated as if it were an absolute time stamp
 235     if( $cache_expiry >= 2592000 ){ # oops, over the limit of 30 days
 236       # report error to user
 237       $template->param(
 238         'cache_error' => 1,
 239         'build1' => 1,
 240         'areas'   => get_report_areas(),
 241         'cache_expiry' => $cache_expiry,
 242         'usecache' => $usecache,
 243         'public' => $input->param('public'),
 244       );
 245     } else {
 246       # they have choosen a new report and the area to report on
 247       $template->param(
 248           'build2' => 1,
 249           'area'   => $input->param('area'),
 250           'types'  => get_report_types(),
 251           'cache_expiry' => $cache_expiry,
 252           'public' => $input->param('public'),
 253       );
 254     }
 255 }
 256
 257 elsif ( $phase eq 'Choose this type' ) {
 258     # they have chosen type and area
 259     # get area and type and pass them to the template
 260     my $area = $input->param('area');
 261     my $type = $input->param('types');
 262     $template->param(
 263         'build3' => 1,
 264         'area'   => $area,
 265         'type'   => $type,
 266         columns  => get_columns($area,$input),
 267         'cache_expiry' => $input->param('cache_expiry'),
 268         'public' => $input->param('public'),
 269     );
 270 }
 271
 272 elsif ( $phase eq 'Choose these columns' ) {
 273     # we now know type, area, and columns
 274     # next step is the constraints
 275     my $area    = $input->param('area');
 276     my $type    = $input->param('type');
 277     my @columns = $input->param('columns');
 278     my $column  = join( ',', @columns );
 279     $template->param(
 280         'build4' => 1,
 281         'area'   => $area,
 282         'type'   => $type,
 283         'column' => $column,
 284         definitions => get_from_dictionary($area),
 285         criteria    => get_criteria($area,$input),
 286         'cache_expiry' => $input->param('cache_expiry'),
 287         'cache_expiry_units' => $input->param('cache_expiry_units'),
 288         'public' => $input->param('public'),
 289     );
 290 }
 291
 292 elsif ( $phase eq 'Choose these criteria' ) {
 293     my $area     = $input->param('area');
 294     my $type     = $input->param('type');
 295     my $column   = $input->param('column');
 296     my @definitions = $input->param('definition');
 297     my $definition = join (',',@definitions);
 298     my @criteria = $input->param('criteria_column');
 299     my $query_criteria;
 300     foreach my $crit (@criteria) {
 301         my $value = $input->param( $crit . "_value" );
 302
 303         # If value is not defined, then it may be range values
 304         if (!defined $value) {
 305
 306             my $fromvalue = $input->param( "from_" . $crit . "_value" );
 307             my $tovalue   = $input->param( "to_"   . $crit . "_value" );
 308
 309             # If the range values are dates
 310             if ($fromvalue =~ C4::Dates->regexp('syspref') && $tovalue =~ C4::Dates->regexp('syspref')) {
 311                 $fromvalue = C4::Dates->new($fromvalue)->output("iso");
 312                 $tovalue = C4::Dates->new($tovalue)->output("iso");
 313             }
 314
 315             if ($fromvalue && $tovalue) {
 316                 $query_criteria .= " AND $crit >= '$fromvalue' AND $crit <= '$tovalue'";
 317             }
 318
 319         } else {
 320
 321             # If value is a date
 322             if ($value =~ C4::Dates->regexp('syspref')) {
 323                 $value = C4::Dates->new($value)->output("iso");
 324             }
 325             # don't escape runtime parameters, they'll be at runtime
 326             if ($value =~ /<<.*>>/) {
 327                 $query_criteria .= " AND $crit=$value";
 328             } else {
 329                 $query_criteria .= " AND $crit='$value'";
 330             }
 331         }
 332     }
 333     $template->param(
 334         'build5'         => 1,
 335         'area'           => $area,
 336         'type'           => $type,
 337         'column'         => $column,
 338         'definition'     => $definition,
 339         'criteriastring' => $query_criteria,
 340         'cache_expiry' => $input->param('cache_expiry'),
 341         'cache_expiry_units' => $input->param('cache_expiry_units'),
 342         'public' => $input->param('public'),
 343     );
 344
 345     # get columns
 346     my @columns = split( ',', $column );
 347     my @total_by;
 348
 349     # build structue for use by tmpl_loop to choose columns to order by
 350     # need to do something about the order of the order :)
 351         # we also want to use the %columns hash to get the plain english names
 352     foreach my $col (@columns) {
 353         my %total = (name => $col);
 354         my @selects = map {+{ value => $_ }} (qw(sum min max avg count));
 355         $total{'select'} = \@selects;
 356         push @total_by, \%total;
 357     }
 358
 359     $template->param( 'total_by' => \@total_by );
 360 }
 361
 362 elsif ( $phase eq 'Choose these operations' ) {
 363     my $area     = $input->param('area');
 364     my $type     = $input->param('type');
 365     my $column   = $input->param('column');
 366     my $criteria = $input->param('criteria');
 367         my $definition = $input->param('definition');
 368     my @total_by = $input->param('total_by');
 369     my $totals;
 370     foreach my $total (@total_by) {
 371         my $value = $input->param( $total . "_tvalue" );
 372         $totals .= "$value($total),";
 373     }
 374
 375     $template->param(
 376         'build6'         => 1,
 377         'area'           => $area,
 378         'type'           => $type,
 379         'column'         => $column,
 380         'criteriastring' => $criteria,
 381         'totals'         => $totals,
 382         'definition'     => $definition,
 383         'cache_expiry' => $input->param('cache_expiry'),
 384         'public' => $input->param('public'),
 385     );
 386
 387     # get columns
 388     my @columns = split( ',', $column );
 389     my @order_by;
 390
 391     # build structue for use by tmpl_loop to choose columns to order by
 392     # need to do something about the order of the order :)
 393     foreach my $col (@columns) {
 394         my %order = (name => $col);
 395         my @selects = map {+{ value => $_ }} (qw(asc desc));
 396         $order{'select'} = \@selects;
 397         push @order_by, \%order;
 398     }
 399
 400     $template->param( 'order_by' => \@order_by );
 401 }
 402
 403 elsif ( $phase eq 'Build report' ) {
 404
 405     # now we have all the info we need and can build the sql
 406     my $area     = $input->param('area');
 407     my $type     = $input->param('type');
 408     my $column   = $input->param('column');
 409     my $crit     = $input->param('criteria');
 410     my $totals   = $input->param('totals');
 411     my $definition = $input->param('definition');
 412     my $query_criteria=$crit;
 413     # split the columns up by ,
 414     my @columns = split( ',', $column );
 415     my @order_by = $input->param('order_by');
 416
 417     my $query_orderby;
 418     foreach my $order (@order_by) {
 419         my $value = $input->param( $order . "_ovalue" );
 420         if ($query_orderby) {
 421             $query_orderby .= ",$order $value";
 422         }
 423         else {
 424             $query_orderby = " ORDER BY $order $value";
 425         }
 426     }
 427
 428     # get the sql
 429     my $sql =
 430       build_query( \@columns, $query_criteria, $query_orderby, $area, $totals, $definition );
 431     $template->param(
 432         'showreport' => 1,
 433         'area'       => $area,
 434         'sql'        => $sql,
 435         'type'       => $type,
 436         'cache_expiry' => $input->param('cache_expiry'),
 437         'public' => $input->param('public'),
 438     );
 439 }
 440
 441 elsif ( $phase eq 'Save' ) {
 442     # Save the report that has just been built
 443     my $area           = $input->param('area');
 444     my $sql  = $input->param('sql');
 445     my $type = $input->param('type');
 446     $template->param(
 447         'save' => 1,
 448         'area'  => $area,
 449         'sql'  => $sql,
 450         'type' => $type,
 451         'cache_expiry' => $input->param('cache_expiry'),
 452         'public' => $input->param('public'),
 453         'groups_with_subgroups' => groups_with_subgroups($area), # in case we have a report group that matches area
 454     );
 455 }
 456
 457 elsif ( $phase eq 'Save Report' ) {
 458     # save the sql pasted in by a user
 459     my $area  = $input->param('area');
 460     my $group = $input->param('group');
 461     my $subgroup = $input->param('subgroup');
 462     my $sql   = $input->param('sql');
 463     my $name  = $input->param('reportname');
 464     my $type  = $input->param('types');
 465     my $notes = $input->param('notes');
 466     my $cache_expiry = $input->param('cache_expiry');
 467     my $cache_expiry_units = $input->param('cache_expiry_units');
 468     my $public = $input->param('public');
 469
 470
 471     # if we have the units, then we came from creating a report from SQL and thus need to handle converting units
 472     if( $cache_expiry_units ){
 473       if( $cache_expiry_units eq "minutes" ){
 474         $cache_expiry *= 60;
 475       } elsif( $cache_expiry_units eq "hours" ){
 476         $cache_expiry *= 3600; # 60 * 60
 477       } elsif( $cache_expiry_units eq "days" ){
 478         $cache_expiry *= 86400; # 60 * 60 * 24
 479       }
 480     }
 481     # check $cache_expiry isnt too large, Memcached::set requires it to be less than 30 days or it will be treated as if it were an absolute time stamp
 482     if( $cache_expiry && $cache_expiry >= 2592000 ){
 483       push @errors, {cache_expiry => $cache_expiry};
 484     }
 485     ## FIXME this is AFTER entering a name to save the report under
 486     if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
 487         push @errors, {sqlerr => $1};
 488     }
 489     elsif ($sql !~ /^(SELECT)/i) {
 490         push @errors, {queryerr => "No SELECT"};
 491     }
 492     if (@errors) {
 493         $template->param(
 494             'errors'    => \@errors,
 495             'sql'       => $sql,
 496             'reportname'=> $name,
 497             'type'      => $type,
 498             'notes'     => $notes,
 499             'cache_expiry' => $cache_expiry,
 500             'public'    => $public,
 501         );
 502     }
 503     else {
 504         my $id = save_report( {
 505                 borrowernumber => $borrowernumber,
 506                 sql            => $sql,
 507                 name           => $name,
 508                 area           => $area,
 509                 group          => $group,
 510                 subgroup       => $subgroup,
 511                 type           => $type,
 512                 notes          => $notes,
 513                 cache_expiry   => $cache_expiry,
 514                 public         => $public,
 515             } );
 516         $template->param(
 517             'save_successful' => 1,
 518             'reportname'      => $name,
 519             'id'              => $id,
 520         );
 521     }
 522 }
 523
 524 elsif ($phase eq 'Run this report'){
 525     # execute a saved report
 526     my $limit      = 20; # page size. # TODO: move to DB or syspref?
 527     my $offset     = 0;
 528     my $report_id  = $input->param('reports');
 529     my @sql_params = $input->param('sql_params');
 530     # offset algorithm
 531     if ($input->param('page')) {
 532         $offset = ($input->param('page') - 1) * $limit;
 533     }
 534
 535     my ( $sql, $type, $name, $notes );
 536     if (my $report = get_saved_report($report_id)) {
 537         $sql   = $report->{savedsql};
 538         $name  = $report->{report_name};
 539         $notes = $report->{notes};
 540
 541         my @rows = ();
 542         # if we have at least 1 parameter, and it's not filled, then don't execute but ask for parameters
 543         if ($sql =~ /<</ && !@sql_params) {
 544             # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
 545             my @split = split /<<|>>/,$sql;
 546             my @tmpl_parameters;
 547             for(my $i=0;$i<($#split/2);$i++) {
 548                 my ($text,$authorised_value) = split /\|/,$split[$i*2+1];
 549                 my $input;
 550                 my $labelid;
 551                 if ($authorised_value eq "date") {
 552                    $input = 'date';
 553                 }
 554                 elsif ($authorised_value) {
 555                     my $dbh=C4::Context->dbh;
 556                     my @authorised_values;
 557                     my %authorised_lib;
 558                     # builds list, depending on authorised value...
 559                     if ( $authorised_value eq "branches" ) {
 560                         my $branches = GetBranchesLoop();
 561                         foreach my $thisbranch (@$branches) {
 562                             push @authorised_values, $thisbranch->{value};
 563                             $authorised_lib{$thisbranch->{value}} = $thisbranch->{branchname};
 564                         }
 565                     }
 566                     elsif ( $authorised_value eq "itemtypes" ) {
 567                         my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes ORDER BY description");
 568                         $sth->execute;
 569                         while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
 570                             push @authorised_values, $itemtype;
 571                             $authorised_lib{$itemtype} = $description;
 572                         }
 573                     }
 574                     elsif ( $authorised_value eq "cn_source" ) {
 575                         my $class_sources = GetClassSources();
 576                         my $default_source = C4::Context->preference("DefaultClassificationSource");
 577                         foreach my $class_source (sort keys %$class_sources) {
 578                             next unless $class_sources->{$class_source}->{'used'} or
 579                                         ($class_source eq $default_source);
 580                             push @authorised_values, $class_source;
 581                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
 582                         }
 583                     }
 584                     elsif ( $authorised_value eq "categorycode" ) {
 585                         my $sth = $dbh->prepare("SELECT categorycode, description FROM categories ORDER BY description");
 586                         $sth->execute;
 587                         while ( my ( $categorycode, $description ) = $sth->fetchrow_array ) {
 588                             push @authorised_values, $categorycode;
 589                             $authorised_lib{$categorycode} = $description;
 590                         }
 591
 592                         #---- "true" authorised value
 593                     }
 594                     else {
 595                         my $authorised_values_sth = $dbh->prepare("SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib");
 596
 597                         $authorised_values_sth->execute( $authorised_value);
 598
 599                         while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
 600                             push @authorised_values, $value;
 601                             $authorised_lib{$value} = $lib;
 602                             # For item location, we show the code and the libelle
 603                             $authorised_lib{$value} = $lib;
 604                         }
 605                     }
 606                     $labelid = $text;
 607                     $labelid =~ s/\W//g;
 608                     $input =CGI::scrolling_list(      # FIXME: factor out scrolling_list
 609                         -name     => "sql_params",
 610                         -id       => "sql_params_".$labelid,
 611                         -values   => \@authorised_values,
 612 #                     -default  => $value,
 613                         -labels   => \%authorised_lib,
 614                         -override => 1,
 615                         -size     => 1,
 616                         -multiple => 0,
 617                         -tabindex => 1,
 618                     );
 619                 } else {
 620                     $input = "text";
 621                 }
 622                 push @tmpl_parameters, {'entry' => $text, 'input' => $input, 'labelid' => $labelid };
 623             }
 624             $template->param('sql'         => $sql,
 625                             'name'         => $name,
 626                             'sql_params'   => \@tmpl_parameters,
 627                             'enter_params' => 1,
 628                             'reports'      => $report_id,
 629                             );
 630         } else {
 631             # OK, we have parameters, or there are none, we run the report
 632             # if there were parameters, replace before running
 633             # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
 634             my @split = split /<<|>>/,$sql;
 635             my @tmpl_parameters;
 636             for(my $i=0;$i<$#split/2;$i++) {
 637                 my $quoted = C4::Context->dbh->quote($sql_params[$i]);
 638                 # if there are special regexp chars, we must \ them
 639                 $split[$i*2+1] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
 640                 $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
 641             }
 642             my ($sth, $errors) = execute_query($sql, $offset, $limit);
 643             my $total = nb_rows($sql) || 0;
 644             unless ($sth) {
 645                 die "execute_query failed to return sth for report $report_id: $sql";
 646             } else {
 647                 my $headref = $sth->{NAME} || [];
 648                 my @headers = map { +{ cell => $_ } } @$headref;
 649                 $template->param(header_row => \@headers);
 650                 while (my $row = $sth->fetchrow_arrayref()) {
 651                     my @cells = map { +{ cell => $_ } } @$row;
 652                     push @rows, { cells => \@cells };
 653                 }
 654             }
 655
 656             my $totpages = int($total/$limit) + (($total % $limit) > 0 ? 1 : 0);
 657             my $url = "/cgi-bin/koha/reports/guided_reports.pl?reports=$report_id&amp;phase=Run%20this%20report";
 658             if (@sql_params) {
 659                 $url = join('&amp;sql_params=', $url, map { URI::Escape::uri_escape($_) } @sql_params);
 660             }
 661             $template->param(
 662                 'results' => \@rows,
 663                 'sql'     => $sql,
 664                 'id'      => $report_id,
 665                 'execute' => 1,
 666                 'name'    => $name,
 667                 'notes'   => $notes,
 668                 'errors'  => $errors,
 669                 'pagination_bar'  => pagination_bar($url, $totpages, $input->param('page')),
 670                 'unlimited_total' => $total,
 671             );
 672         }
 673     }
 674     else {
 675         push @errors, { no_sql_for_id => $report_id };
 676     }
 677 }
 678
 679 elsif ($phase eq 'Export'){
 680     binmode STDOUT, ':encoding(UTF-8)';
 681
 682         # export results to tab separated text or CSV
 683         my $sql    = $input->param('sql');  # FIXME: use sql from saved report ID#, not new user-supplied SQL!
 684     my $format = $input->param('format');
 685         my ($sth, $q_errors) = execute_query($sql);
 686     unless ($q_errors and @$q_errors) {
 687         print $input->header(       -type => 'application/octet-stream',
 688                                     -attachment=>"reportresults.$format"
 689                             );
 690         if ($format eq 'tab') {
 691             print join("\t", header_cell_values($sth)), "\n";
 692             while (my $row = $sth->fetchrow_arrayref()) {
 693                 print join("\t", @$row), "\n";
 694             }
 695         } else {
 696             my $csv = Text::CSV->new({binary => 1});
 697             $csv or die "Text::CSV->new({binary => 1}) FAILED: " . Text::CSV->error_diag();
 698             if ($csv->combine(header_cell_values($sth))) {
 699                 print $csv->string(), "\n";
 700             } else {
 701                 push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
 702             }
 703             while (my $row = $sth->fetchrow_arrayref()) {
 704                 if ($csv->combine(@$row)) {
 705                     print $csv->string(), "\n";
 706                 } else {
 707                     push @$q_errors, { combine => $csv->error_diag() } ;
 708                 }
 709             }
 710         }
 711         foreach my $err (@$q_errors, @errors) {
 712             print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
 713         }   # here we print all the non-fatal errors at the end.  Not super smooth, but better than nothing.
 714         exit;
 715     }
 716     $template->param(
 717         'sql'           => $sql,
 718         'execute'       => 1,
 719         'name'          => 'Error exporting report!',
 720         'notes'         => '',
 721         'errors'        => $q_errors,
 722     );
 723 }
 724
 725 elsif ( $phase eq 'Create report from SQL' ) {
 726
 727     my ($group, $subgroup);
 728     # allow the user to paste in sql
 729     if ( $input->param('sql') ) {
 730         $group = $input->param('report_group');
 731         $subgroup  = $input->param('report_subgroup');
 732         $template->param(
 733             'sql'           => $input->param('sql'),
 734             'reportname'    => $input->param('reportname'),
 735             'notes'         => $input->param('notes'),
 736         );
 737     }
 738     $template->param(
 739         'create' => 1,
 740         'groups_with_subgroups' => groups_with_subgroups($group, $subgroup),
 741         'public' => '0',
 742         'cache_expiry' => 300,
 743         'usecache' => $usecache,
 744     );
 745 }
 746
 747 elsif ($phase eq 'Create Compound Report'){
 748         $template->param( 'savedreports' => get_saved_reports(),
 749                 'compound' => 1,
 750         );
 751 }
 752
 753 elsif ($phase eq 'Save Compound'){
 754     my $master    = $input->param('master');
 755         my $subreport = $input->param('subreport');
 756         my ($mastertables,$subtables) = create_compound($master,$subreport);
 757         $template->param( 'save_compound' => 1,
 758                 master=>$mastertables,
 759                 subsql=>$subtables
 760         );
 761 }
 762
 763 # pass $sth, get back an array of names for the column headers
 764 sub header_cell_values {
 765     my $sth = shift or return ();
 766     return @{$sth->{NAME}};
 767 }
 768
 769 # pass $sth, get back a TMPL_LOOP-able set of names for the column headers
 770 sub header_cell_loop {
 771     my @headers = map { +{ cell => $_ } } header_cell_values (shift);
 772     return \@headers;
 773 }
 774
 775 foreach (1..6) {
 776      $template->{VARS}->{'build' . $_} and $template->{VARS}->{'buildx' . $_} and last;
 777 }
 778 $template->param(   'referer' => $input->referer(),
 779                     'DHTMLcalendar_dateformat' => C4::Dates->DHTMLcalendar(),
 780                 );
 781
 782 output_html_with_http_headers $input, $cookie, $template->output;
 783
 784 sub groups_with_subgroups {
 785     my ($group, $subgroup) = @_;
 786
 787     my $groups_with_subgroups = get_report_groups();
 788     my @g_sg;
 789     while (my ($g_id, $v) = each %$groups_with_subgroups) {
 790         my @subgroups;
 791         if (my $sg = $v->{subgroups}) {
 792             while (my ($sg_id, $n) = each %$sg) {
 793                 push @subgroups, {
 794                     id => $sg_id,
 795                     name => $n,
 796                     selected => ($group && $g_id eq $group && $subgroup && $sg_id eq $subgroup ),
 797                 };
 798             }
 799         }
 800         push @g_sg, {
 801             id => $g_id,
 802             name => $v->{name},
 803             selected => ($group && $g_id eq $group),
 804             subgroups => \@subgroups,
 805         };
 806     }
 807     return \@g_sg;
 808 }