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         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( 'save_successful' => 1, );
 517     }
 518 }
 519
 520 elsif ($phase eq 'Run this report'){
 521     # execute a saved report
 522     my $limit      = 20; # page size. # TODO: move to DB or syspref?
 523     my $offset     = 0;
 524     my $report_id  = $input->param('reports');
 525     my @sql_params = $input->param('sql_params');
 526     # offset algorithm
 527     if ($input->param('page')) {
 528         $offset = ($input->param('page') - 1) * $limit;
 529     }
 530
 531     my ( $sql, $type, $name, $notes );
 532     if (my $report = get_saved_report($report_id)) {
 533         $sql   = $report->{savedsql};
 534         $name  = $report->{report_name};
 535         $notes = $report->{notes};
 536
 537         my @rows = ();
 538         # if we have at least 1 parameter, and it's not filled, then don't execute but ask for parameters
 539         if ($sql =~ /<</ && !@sql_params) {
 540             # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
 541             my @split = split /<<|>>/,$sql;
 542             my @tmpl_parameters;
 543             for(my $i=0;$i<($#split/2);$i++) {
 544                 my ($text,$authorised_value) = split /\|/,$split[$i*2+1];
 545                 my $input;
 546                 my $labelid;
 547                 if ($authorised_value eq "date") {
 548                    $input = 'date';
 549                 }
 550                 elsif ($authorised_value) {
 551                     my $dbh=C4::Context->dbh;
 552                     my @authorised_values;
 553                     my %authorised_lib;
 554                     # builds list, depending on authorised value...
 555                     if ( $authorised_value eq "branches" ) {
 556                         my $branches = GetBranchesLoop();
 557                         foreach my $thisbranch (@$branches) {
 558                             push @authorised_values, $thisbranch->{value};
 559                             $authorised_lib{$thisbranch->{value}} = $thisbranch->{branchname};
 560                         }
 561                     }
 562                     elsif ( $authorised_value eq "itemtypes" ) {
 563                         my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes ORDER BY description");
 564                         $sth->execute;
 565                         while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
 566                             push @authorised_values, $itemtype;
 567                             $authorised_lib{$itemtype} = $description;
 568                         }
 569                     }
 570                     elsif ( $authorised_value eq "cn_source" ) {
 571                         my $class_sources = GetClassSources();
 572                         my $default_source = C4::Context->preference("DefaultClassificationSource");
 573                         foreach my $class_source (sort keys %$class_sources) {
 574                             next unless $class_sources->{$class_source}->{'used'} or
 575                                         ($class_source eq $default_source);
 576                             push @authorised_values, $class_source;
 577                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
 578                         }
 579                     }
 580                     elsif ( $authorised_value eq "categorycode" ) {
 581                         my $sth = $dbh->prepare("SELECT categorycode, description FROM categories ORDER BY description");
 582                         $sth->execute;
 583                         while ( my ( $categorycode, $description ) = $sth->fetchrow_array ) {
 584                             push @authorised_values, $categorycode;
 585                             $authorised_lib{$categorycode} = $description;
 586                         }
 587
 588                         #---- "true" authorised value
 589                     }
 590                     else {
 591                         my $authorised_values_sth = $dbh->prepare("SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib");
 592
 593                         $authorised_values_sth->execute( $authorised_value);
 594
 595                         while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
 596                             push @authorised_values, $value;
 597                             $authorised_lib{$value} = $lib;
 598                             # For item location, we show the code and the libelle
 599                             $authorised_lib{$value} = $lib;
 600                         }
 601                     }
 602                     $labelid = $text;
 603                     $labelid =~ s/\W//g;
 604                     $input =CGI::scrolling_list(      # FIXME: factor out scrolling_list
 605                         -name     => "sql_params",
 606                         -id       => "sql_params_".$labelid,
 607                         -values   => \@authorised_values,
 608 #                     -default  => $value,
 609                         -labels   => \%authorised_lib,
 610                         -override => 1,
 611                         -size     => 1,
 612                         -multiple => 0,
 613                         -tabindex => 1,
 614                     );
 615                 } else {
 616                     $input = "text";
 617                 }
 618                 push @tmpl_parameters, {'entry' => $text, 'input' => $input, 'labelid' => $labelid };
 619             }
 620             $template->param('sql'         => $sql,
 621                             'name'         => $name,
 622                             'sql_params'   => \@tmpl_parameters,
 623                             'enter_params' => 1,
 624                             'reports'      => $report_id,
 625                             );
 626         } else {
 627             # OK, we have parameters, or there are none, we run the report
 628             # if there were parameters, replace before running
 629             # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
 630             my @split = split /<<|>>/,$sql;
 631             my @tmpl_parameters;
 632             for(my $i=0;$i<$#split/2;$i++) {
 633                 my $quoted = C4::Context->dbh->quote($sql_params[$i]);
 634                 # if there are special regexp chars, we must \ them
 635                 $split[$i*2+1] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
 636                 $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
 637             }
 638             my ($sth, $errors) = execute_query($sql, $offset, $limit);
 639             my $total = nb_rows($sql) || 0;
 640             unless ($sth) {
 641                 die "execute_query failed to return sth for report $report_id: $sql";
 642             } else {
 643                 my $headref = $sth->{NAME} || [];
 644                 my @headers = map { +{ cell => $_ } } @$headref;
 645                 $template->param(header_row => \@headers);
 646                 while (my $row = $sth->fetchrow_arrayref()) {
 647                     my @cells = map { +{ cell => $_ } } @$row;
 648                     push @rows, { cells => \@cells };
 649                 }
 650             }
 651
 652             my $totpages = int($total/$limit) + (($total % $limit) > 0 ? 1 : 0);
 653             my $url = "/cgi-bin/koha/reports/guided_reports.pl?reports=$report_id&amp;phase=Run%20this%20report";
 654             if (@sql_params) {
 655                 $url = join('&amp;sql_params=', $url, map { URI::Escape::uri_escape($_) } @sql_params);
 656             }
 657             $template->param(
 658                 'results' => \@rows,
 659                 'sql'     => $sql,
 660                 'id'      => $report_id,
 661                 'execute' => 1,
 662                 'name'    => $name,
 663                 'notes'   => $notes,
 664                 'errors'  => $errors,
 665                 'pagination_bar'  => pagination_bar($url, $totpages, $input->param('page')),
 666                 'unlimited_total' => $total,
 667             );
 668         }
 669     }
 670     else {
 671         push @errors, { no_sql_for_id => $report_id };
 672     }
 673 }
 674
 675 elsif ($phase eq 'Export'){
 676     binmode STDOUT, ':encoding(UTF-8)';
 677
 678         # export results to tab separated text or CSV
 679         my $sql    = $input->param('sql');  # FIXME: use sql from saved report ID#, not new user-supplied SQL!
 680     my $format = $input->param('format');
 681         my ($sth, $q_errors) = execute_query($sql);
 682     unless ($q_errors and @$q_errors) {
 683         print $input->header(       -type => 'application/octet-stream',
 684                                     -attachment=>"reportresults.$format"
 685                             );
 686         if ($format eq 'tab') {
 687             print join("\t", header_cell_values($sth)), "\n";
 688             while (my $row = $sth->fetchrow_arrayref()) {
 689                 print join("\t", @$row), "\n";
 690             }
 691         } else {
 692             my $csv = Text::CSV->new({binary => 1});
 693             $csv or die "Text::CSV->new({binary => 1}) FAILED: " . Text::CSV->error_diag();
 694             if ($csv->combine(header_cell_values($sth))) {
 695                 print $csv->string(), "\n";
 696             } else {
 697                 push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
 698             }
 699             while (my $row = $sth->fetchrow_arrayref()) {
 700                 if ($csv->combine(@$row)) {
 701                     print $csv->string(), "\n";
 702                 } else {
 703                     push @$q_errors, { combine => $csv->error_diag() } ;
 704                 }
 705             }
 706         }
 707         foreach my $err (@$q_errors, @errors) {
 708             print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
 709         }   # here we print all the non-fatal errors at the end.  Not super smooth, but better than nothing.
 710         exit;
 711     }
 712     $template->param(
 713         'sql'           => $sql,
 714         'execute'       => 1,
 715         'name'          => 'Error exporting report!',
 716         'notes'         => '',
 717         'errors'        => $q_errors,
 718     );
 719 }
 720
 721 elsif ( $phase eq 'Create report from SQL' ) {
 722
 723     my ($group, $subgroup);
 724     # allow the user to paste in sql
 725     if ( $input->param('sql') ) {
 726         $group = $input->param('report_group');
 727         $subgroup  = $input->param('report_subgroup');
 728         $template->param(
 729             'sql'           => $input->param('sql'),
 730             'reportname'    => $input->param('reportname'),
 731             'notes'         => $input->param('notes'),
 732         );
 733     }
 734     $template->param(
 735         'create' => 1,
 736         'groups_with_subgroups' => groups_with_subgroups($group, $subgroup),
 737         'public' => '0',
 738         'cache_expiry' => 300,
 739         'usecache' => $usecache,
 740     );
 741 }
 742
 743 elsif ($phase eq 'Create Compound Report'){
 744         $template->param( 'savedreports' => get_saved_reports(),
 745                 'compound' => 1,
 746         );
 747 }
 748
 749 elsif ($phase eq 'Save Compound'){
 750     my $master    = $input->param('master');
 751         my $subreport = $input->param('subreport');
 752         my ($mastertables,$subtables) = create_compound($master,$subreport);
 753         $template->param( 'save_compound' => 1,
 754                 master=>$mastertables,
 755                 subsql=>$subtables
 756         );
 757 }
 758
 759 # pass $sth, get back an array of names for the column headers
 760 sub header_cell_values {
 761     my $sth = shift or return ();
 762     return @{$sth->{NAME}};
 763 }
 764
 765 # pass $sth, get back a TMPL_LOOP-able set of names for the column headers
 766 sub header_cell_loop {
 767     my @headers = map { +{ cell => $_ } } header_cell_values (shift);
 768     return \@headers;
 769 }
 770
 771 foreach (1..6) {
 772      $template->{VARS}->{'build' . $_} and $template->{VARS}->{'buildx' . $_} and last;
 773 }
 774 $template->param(   'referer' => $input->referer(),
 775                     'DHTMLcalendar_dateformat' => C4::Dates->DHTMLcalendar(),
 776                 );
 777
 778 output_html_with_http_headers $input, $cookie, $template->output;
 779
 780 sub groups_with_subgroups {
 781     my ($group, $subgroup) = @_;
 782
 783     my $groups_with_subgroups = get_report_groups();
 784     my @g_sg;
 785     while (my ($g_id, $v) = each %$groups_with_subgroups) {
 786         my @subgroups;
 787         if (my $sg = $v->{subgroups}) {
 788             while (my ($sg_id, $n) = each %$sg) {
 789                 push @subgroups, {
 790                     id => $sg_id,
 791                     name => $n,
 792                     selected => ($group && $g_id eq $group && $subgroup && $sg_id eq $subgroup ),
 793                 };
 794             }
 795         }
 796         push @g_sg, {
 797             id => $g_id,
 798             name => $v->{name},
 799             selected => ($group && $g_id eq $group),
 800             subgroups => \@subgroups,
 801         };
 802     }
 803     return \@g_sg;
 804 }