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 Modern::Perl;
  21 use CGI qw/-utf8/;
  22 use Text::CSV::Encoded;
  23 use URI::Escape;
  24 use File::Temp;
  25 use File::Basename qw( dirname );
  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 use C4::Koha qw/IsAuthorisedValueCategory/;
  33
  34 =head1 NAME
  35
  36 guided_reports.pl
  37
  38 =head1 DESCRIPTION
  39
  40 Script to control the guided report creation
  41
  42 =cut
  43
  44 my $input = new CGI;
  45 my $usecache = C4::Context->ismemcached;
  46
  47 my $phase = $input->param('phase');
  48 my $flagsrequired;
  49 if ( $phase eq 'Build new' or $phase eq 'Delete Saved' ) {
  50     $flagsrequired = 'create_reports';
  51 }
  52 elsif ( $phase eq 'Use saved' ) {
  53     $flagsrequired = 'execute_reports';
  54 } else {
  55     $flagsrequired = '*';
  56 }
  57
  58 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
  59     {
  60         template_name   => "reports/guided_reports_start.tmpl",
  61         query           => $input,
  62         type            => "intranet",
  63         authnotrequired => 0,
  64         flagsrequired   => { reports => $flagsrequired },
  65         debug           => 1,
  66     }
  67 );
  68 my $session = $cookie ? get_session($cookie->value) : undef;
  69
  70 my $filter;
  71 if ( $input->param("filter_set") ) {
  72     $filter = {};
  73     $filter->{$_} = $input->param("filter_$_") foreach qw/date author keyword group subgroup/;
  74     $session->param('report_filter', $filter) if $session;
  75     $template->param( 'filter_set' => 1 );
  76 }
  77 elsif ($session) {
  78     $filter = $session->param('report_filter');
  79 }
  80
  81
  82 my @errors = ();
  83 if ( !$phase ) {
  84     $template->param( 'start' => 1 );
  85     # show welcome page
  86 }
  87 elsif ( $phase eq 'Build new' ) {
  88     # build a new report
  89     $template->param( 'build1' => 1 );
  90     my $areas = get_report_areas();
  91     $template->param(
  92         'areas' => [map { id => $_->[0], name => $_->[1] }, @$areas],
  93         'usecache' => $usecache,
  94         'cache_expiry' => 300,
  95         'public' => '0',
  96     );
  97 } elsif ( $phase eq 'Use saved' ) {
  98
  99     # use a saved report
 100     # get list of reports and display them
 101     my $group = $input->param('group');
 102     my $subgroup = $input->param('subgroup');
 103     $filter->{group} = $group;
 104     $filter->{subgroup} = $subgroup;
 105     $template->param(
 106         'saved1' => 1,
 107         'savedreports' => get_saved_reports($filter),
 108         'usecache' => $usecache,
 109         'groups_with_subgroups'=> groups_with_subgroups($group, $subgroup),
 110     );
 111 }
 112
 113 elsif ( $phase eq 'Delete Multiple') {
 114     my @ids = $input->param('ids');
 115     delete_report( @ids );
 116     print $input->redirect("/cgi-bin/koha/reports/guided_reports.pl?phase=Use%20saved");
 117     exit;
 118 }
 119
 120 elsif ( $phase eq 'Delete Saved') {
 121
 122         # delete a report from the saved reports list
 123     my $ids = $input->param('reports');
 124     delete_report($ids);
 125     print $input->redirect("/cgi-bin/koha/reports/guided_reports.pl?phase=Use%20saved");
 126         exit;
 127 }
 128
 129 elsif ( $phase eq 'Show SQL'){
 130
 131     my $id = $input->param('reports');
 132     my $report = get_saved_report($id);
 133     $template->param(
 134         'id'      => $id,
 135         'reportname' => $report->{report_name},
 136         'notes'      => $report->{notes},
 137         'sql'     => $report->{savedsql},
 138         'showsql' => 1,
 139     );
 140 }
 141
 142 elsif ( $phase eq 'Edit SQL'){
 143     my $id = $input->param('reports');
 144     my $report = get_saved_report($id);
 145     my $group = $report->{report_group};
 146     my $subgroup  = $report->{report_subgroup};
 147     $template->param(
 148         'sql'        => $report->{savedsql},
 149         'reportname' => $report->{report_name},
 150         'groups_with_subgroups' => groups_with_subgroups($group, $subgroup),
 151         'notes'      => $report->{notes},
 152         'id'         => $id,
 153         'cache_expiry' => $report->{cache_expiry},
 154         'public' => $report->{public},
 155         'usecache' => $usecache,
 156         'editsql'    => 1,
 157     );
 158 }
 159
 160 elsif ( $phase eq 'Update SQL'){
 161     my $id         = $input->param('id');
 162     my $sql        = $input->param('sql');
 163     my $reportname = $input->param('reportname');
 164     my $group      = $input->param('group');
 165     my $subgroup   = $input->param('subgroup');
 166     my $notes      = $input->param('notes');
 167     my $cache_expiry = $input->param('cache_expiry');
 168     my $cache_expiry_units = $input->param('cache_expiry_units');
 169     my $public = $input->param('public');
 170     my $save_anyway = $input->param('save_anyway');
 171
 172     my @errors;
 173
 174     # if we have the units, then we came from creating a report from SQL and thus need to handle converting units
 175     if( $cache_expiry_units ){
 176       if( $cache_expiry_units eq "minutes" ){
 177         $cache_expiry *= 60;
 178       } elsif( $cache_expiry_units eq "hours" ){
 179         $cache_expiry *= 3600; # 60 * 60
 180       } elsif( $cache_expiry_units eq "days" ){
 181         $cache_expiry *= 86400; # 60 * 60 * 24
 182       }
 183     }
 184     # 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
 185     if( $cache_expiry >= 2592000 ){
 186       push @errors, {cache_expiry => $cache_expiry};
 187     }
 188
 189     create_non_existing_group_and_subgroup($input, $group, $subgroup);
 190
 191     if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
 192         push @errors, {sqlerr => $1};
 193     }
 194     elsif ($sql !~ /^(SELECT)/i) {
 195         push @errors, {queryerr => 1};
 196     }
 197
 198     if (@errors) {
 199         $template->param(
 200             'errors'    => \@errors,
 201             'sql'       => $sql,
 202         );
 203     } else {
 204
 205         # Check defined SQL parameters for authorised value validity
 206         my $problematic_authvals = ValidateSQLParameters($sql);
 207
 208         if ( scalar @$problematic_authvals > 0 && not $save_anyway ) {
 209             # There's at least one problematic parameter, report to the
 210             # GUI and provide all user input for further actions
 211             $template->param(
 212                 'id' => $id,
 213                 'sql' => $sql,
 214                 'reportname' => $reportname,
 215                 'group' => $group,
 216                 'subgroup' => $subgroup,
 217                 'notes' => $notes,
 218                 'cache_expiry' => $cache_expiry,
 219                 'cache_expiry_units' => $cache_expiry_units,
 220                 'public' => $public,
 221                 'problematic_authvals' => $problematic_authvals,
 222                 'warn_authval_problem' => 1,
 223                 'phase_update' => 1
 224             );
 225
 226         } else {
 227             # No params problem found or asked to save anyway
 228             update_sql( $id, {
 229                     sql => $sql,
 230                     name => $reportname,
 231                     group => $group,
 232                     subgroup => $subgroup,
 233                     notes => $notes,
 234                     cache_expiry => $cache_expiry,
 235                     public => $public,
 236                 } );
 237             $template->param(
 238                 'save_successful'       => 1,
 239                 'reportname'            => $reportname,
 240                 'id'                    => $id,
 241             );
 242         }
 243     }
 244 }
 245
 246 elsif ($phase eq 'retrieve results') {
 247         my $id = $input->param('id');
 248         my ($results,$name,$notes) = format_results($id);
 249         # do something
 250         $template->param(
 251                 'retresults' => 1,
 252                 'results' => $results,
 253                 'name' => $name,
 254                 'notes' => $notes,
 255     );
 256 }
 257
 258 elsif ( $phase eq 'Report on this Area' ) {
 259     my $cache_expiry_units = $input->param('cache_expiry_units'),
 260     my $cache_expiry = $input->param('cache_expiry');
 261
 262     # we need to handle converting units
 263     if( $cache_expiry_units eq "minutes" ){
 264       $cache_expiry *= 60;
 265     } elsif( $cache_expiry_units eq "hours" ){
 266       $cache_expiry *= 3600; # 60 * 60
 267     } elsif( $cache_expiry_units eq "days" ){
 268       $cache_expiry *= 86400; # 60 * 60 * 24
 269     }
 270     # 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
 271     if( $cache_expiry >= 2592000 ){ # oops, over the limit of 30 days
 272       # report error to user
 273       $template->param(
 274         'cache_error' => 1,
 275         'build1' => 1,
 276         'areas'   => get_report_areas(),
 277         'cache_expiry' => $cache_expiry,
 278         'usecache' => $usecache,
 279         'public' => $input->param('public'),
 280       );
 281     } else {
 282       # they have choosen a new report and the area to report on
 283       $template->param(
 284           'build2' => 1,
 285           'area'   => $input->param('area'),
 286           'types'  => get_report_types(),
 287           'cache_expiry' => $cache_expiry,
 288           'public' => $input->param('public'),
 289       );
 290     }
 291 }
 292
 293 elsif ( $phase eq 'Choose this type' ) {
 294     # they have chosen type and area
 295     # get area and type and pass them to the template
 296     my $area = $input->param('area');
 297     my $type = $input->param('types');
 298     $template->param(
 299         'build3' => 1,
 300         'area'   => $area,
 301         'type'   => $type,
 302         columns  => get_columns($area,$input),
 303         'cache_expiry' => $input->param('cache_expiry'),
 304         'public' => $input->param('public'),
 305     );
 306 }
 307
 308 elsif ( $phase eq 'Choose these columns' ) {
 309     # we now know type, area, and columns
 310     # next step is the constraints
 311     my $area    = $input->param('area');
 312     my $type    = $input->param('type');
 313     my @columns = $input->param('columns');
 314     my $column  = join( ',', @columns );
 315     $template->param(
 316         'build4' => 1,
 317         'area'   => $area,
 318         'type'   => $type,
 319         'column' => $column,
 320         definitions => get_from_dictionary($area),
 321         criteria    => get_criteria($area,$input),
 322         'cache_expiry' => $input->param('cache_expiry'),
 323         'cache_expiry_units' => $input->param('cache_expiry_units'),
 324         'public' => $input->param('public'),
 325     );
 326 }
 327
 328 elsif ( $phase eq 'Choose these criteria' ) {
 329     my $area     = $input->param('area');
 330     my $type     = $input->param('type');
 331     my $column   = $input->param('column');
 332     my @definitions = $input->param('definition');
 333     my $definition = join (',',@definitions);
 334     my @criteria = $input->param('criteria_column');
 335     my $query_criteria;
 336     foreach my $crit (@criteria) {
 337         my $value = $input->param( $crit . "_value" );
 338
 339         # If value is not defined, then it may be range values
 340         if (!defined $value) {
 341
 342             my $fromvalue = $input->param( "from_" . $crit . "_value" );
 343             my $tovalue   = $input->param( "to_"   . $crit . "_value" );
 344
 345             # If the range values are dates
 346             if ($fromvalue =~ C4::Dates->regexp('syspref') && $tovalue =~ C4::Dates->regexp('syspref')) {
 347                 $fromvalue = C4::Dates->new($fromvalue)->output("iso");
 348                 $tovalue = C4::Dates->new($tovalue)->output("iso");
 349             }
 350
 351             if ($fromvalue && $tovalue) {
 352                 $query_criteria .= " AND $crit >= '$fromvalue' AND $crit <= '$tovalue'";
 353             }
 354
 355         } else {
 356
 357             # If value is a date
 358             if ($value =~ C4::Dates->regexp('syspref')) {
 359                 $value = C4::Dates->new($value)->output("iso");
 360             }
 361             # don't escape runtime parameters, they'll be at runtime
 362             if ($value =~ /<<.*>>/) {
 363                 $query_criteria .= " AND $crit=$value";
 364             } else {
 365                 $query_criteria .= " AND $crit='$value'";
 366             }
 367         }
 368     }
 369     $template->param(
 370         'build5'         => 1,
 371         'area'           => $area,
 372         'type'           => $type,
 373         'column'         => $column,
 374         'definition'     => $definition,
 375         'criteriastring' => $query_criteria,
 376         'cache_expiry' => $input->param('cache_expiry'),
 377         'cache_expiry_units' => $input->param('cache_expiry_units'),
 378         'public' => $input->param('public'),
 379     );
 380
 381     # get columns
 382     my @columns = split( ',', $column );
 383     my @total_by;
 384
 385     # build structue for use by tmpl_loop to choose columns to order by
 386     # need to do something about the order of the order :)
 387         # we also want to use the %columns hash to get the plain english names
 388     foreach my $col (@columns) {
 389         my %total = (name => $col);
 390         my @selects = map {+{ value => $_ }} (qw(sum min max avg count));
 391         $total{'select'} = \@selects;
 392         push @total_by, \%total;
 393     }
 394
 395     $template->param( 'total_by' => \@total_by );
 396 }
 397
 398 elsif ( $phase eq 'Choose these operations' ) {
 399     my $area     = $input->param('area');
 400     my $type     = $input->param('type');
 401     my $column   = $input->param('column');
 402     my $criteria = $input->param('criteria');
 403         my $definition = $input->param('definition');
 404     my @total_by = $input->param('total_by');
 405     my $totals;
 406     foreach my $total (@total_by) {
 407         my $value = $input->param( $total . "_tvalue" );
 408         $totals .= "$value($total),";
 409     }
 410
 411     $template->param(
 412         'build6'         => 1,
 413         'area'           => $area,
 414         'type'           => $type,
 415         'column'         => $column,
 416         'criteriastring' => $criteria,
 417         'totals'         => $totals,
 418         'definition'     => $definition,
 419         'cache_expiry' => $input->param('cache_expiry'),
 420         'public' => $input->param('public'),
 421     );
 422
 423     # get columns
 424     my @columns = split( ',', $column );
 425     my @order_by;
 426
 427     # build structue for use by tmpl_loop to choose columns to order by
 428     # need to do something about the order of the order :)
 429     foreach my $col (@columns) {
 430         my %order = (name => $col);
 431         my @selects = map {+{ value => $_ }} (qw(asc desc));
 432         $order{'select'} = \@selects;
 433         push @order_by, \%order;
 434     }
 435
 436     $template->param( 'order_by' => \@order_by );
 437 }
 438
 439 elsif ( $phase eq 'Build report' ) {
 440
 441     # now we have all the info we need and can build the sql
 442     my $area     = $input->param('area');
 443     my $type     = $input->param('type');
 444     my $column   = $input->param('column');
 445     my $crit     = $input->param('criteria');
 446     my $totals   = $input->param('totals');
 447     my $definition = $input->param('definition');
 448     my $query_criteria=$crit;
 449     # split the columns up by ,
 450     my @columns = split( ',', $column );
 451     my @order_by = $input->param('order_by');
 452
 453     my $query_orderby;
 454     foreach my $order (@order_by) {
 455         my $value = $input->param( $order . "_ovalue" );
 456         if ($query_orderby) {
 457             $query_orderby .= ",$order $value";
 458         }
 459         else {
 460             $query_orderby = " ORDER BY $order $value";
 461         }
 462     }
 463
 464     # get the sql
 465     my $sql =
 466       build_query( \@columns, $query_criteria, $query_orderby, $area, $totals, $definition );
 467     $template->param(
 468         'showreport' => 1,
 469         'area'       => $area,
 470         'sql'        => $sql,
 471         'type'       => $type,
 472         'cache_expiry' => $input->param('cache_expiry'),
 473         'public' => $input->param('public'),
 474     );
 475 }
 476
 477 elsif ( $phase eq 'Save' ) {
 478     # Save the report that has just been built
 479     my $area           = $input->param('area');
 480     my $sql  = $input->param('sql');
 481     my $type = $input->param('type');
 482     $template->param(
 483         'save' => 1,
 484         'area'  => $area,
 485         'sql'  => $sql,
 486         'type' => $type,
 487         'cache_expiry' => $input->param('cache_expiry'),
 488         'public' => $input->param('public'),
 489         'groups_with_subgroups' => groups_with_subgroups($area), # in case we have a report group that matches area
 490     );
 491 }
 492
 493 elsif ( $phase eq 'Save Report' ) {
 494     # save the sql pasted in by a user
 495     my $area  = $input->param('area');
 496     my $group = $input->param('group');
 497     my $subgroup = $input->param('subgroup');
 498     my $sql   = $input->param('sql');
 499     my $name  = $input->param('reportname');
 500     my $type  = $input->param('types');
 501     my $notes = $input->param('notes');
 502     my $cache_expiry = $input->param('cache_expiry');
 503     my $cache_expiry_units = $input->param('cache_expiry_units');
 504     my $public = $input->param('public');
 505     my $save_anyway = $input->param('save_anyway');
 506
 507
 508     # if we have the units, then we came from creating a report from SQL and thus need to handle converting units
 509     if( $cache_expiry_units ){
 510       if( $cache_expiry_units eq "minutes" ){
 511         $cache_expiry *= 60;
 512       } elsif( $cache_expiry_units eq "hours" ){
 513         $cache_expiry *= 3600; # 60 * 60
 514       } elsif( $cache_expiry_units eq "days" ){
 515         $cache_expiry *= 86400; # 60 * 60 * 24
 516       }
 517     }
 518     # 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
 519     if( $cache_expiry && $cache_expiry >= 2592000 ){
 520       push @errors, {cache_expiry => $cache_expiry};
 521     }
 522
 523     create_non_existing_group_and_subgroup($input, $group, $subgroup);
 524
 525     ## FIXME this is AFTER entering a name to save the report under
 526     if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
 527         push @errors, {sqlerr => $1};
 528     }
 529     elsif ($sql !~ /^(SELECT)/i) {
 530         push @errors, {queryerr => "No SELECT"};
 531     }
 532
 533     if (@errors) {
 534         $template->param(
 535             'errors'    => \@errors,
 536             'sql'       => $sql,
 537             'reportname'=> $name,
 538             'type'      => $type,
 539             'notes'     => $notes,
 540             'cache_expiry' => $cache_expiry,
 541             'public'    => $public,
 542         );
 543     } else {
 544         # Check defined SQL parameters for authorised value validity
 545         my $problematic_authvals = ValidateSQLParameters($sql);
 546
 547         if ( scalar @$problematic_authvals > 0 && not $save_anyway ) {
 548             # There's at least one problematic parameter, report to the
 549             # GUI and provide all user input for further actions
 550             $template->param(
 551                 'area' => $area,
 552                 'group' =>  $group,
 553                 'subgroup' => $subgroup,
 554                 'sql' => $sql,
 555                 'reportname' => $name,
 556                 'type' => $type,
 557                 'notes' => $notes,
 558                 'cache_expiry' => $cache_expiry,
 559                 'cache_expiry_units' => $cache_expiry_units,
 560                 'public' => $public,
 561                 'problematic_authvals' => $problematic_authvals,
 562                 'warn_authval_problem' => 1,
 563                 'phase_save' => 1
 564             );
 565         } else {
 566             # No params problem found or asked to save anyway
 567             my $id = save_report( {
 568                     borrowernumber => $borrowernumber,
 569                     sql            => $sql,
 570                     name           => $name,
 571                     area           => $area,
 572                     group          => $group,
 573                     subgroup       => $subgroup,
 574                     type           => $type,
 575                     notes          => $notes,
 576                     cache_expiry   => $cache_expiry,
 577                     public         => $public,
 578                 } );
 579             $template->param(
 580                 'save_successful' => 1,
 581                 'reportname'      => $name,
 582                 'id'              => $id,
 583             );
 584         }
 585     }
 586 }
 587
 588 elsif ($phase eq 'Run this report'){
 589     # execute a saved report
 590     my $limit      = $input->param('limit') || 20;
 591     my $offset     = 0;
 592     my $report_id  = $input->param('reports');
 593     my @sql_params = $input->param('sql_params');
 594     # offset algorithm
 595     if ($input->param('page')) {
 596         $offset = ($input->param('page') - 1) * $limit;
 597     }
 598
 599     $template->param(
 600         'limit'   => $limit,
 601         'report_id' => $report_id,
 602     );
 603
 604     my ( $sql, $type, $name, $notes );
 605     if (my $report = get_saved_report($report_id)) {
 606         $sql   = $report->{savedsql};
 607         $name  = $report->{report_name};
 608         $notes = $report->{notes};
 609
 610         my @rows = ();
 611         # if we have at least 1 parameter, and it's not filled, then don't execute but ask for parameters
 612         if ($sql =~ /<</ && !@sql_params) {
 613             # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
 614             my @split = split /<<|>>/,$sql;
 615             my @tmpl_parameters;
 616             my @authval_errors;
 617             for(my $i=0;$i<($#split/2);$i++) {
 618                 my ($text,$authorised_value) = split /\|/,$split[$i*2+1];
 619                 my $input;
 620                 my $labelid;
 621                 if ( not defined $authorised_value ) {
 622                     # no authorised value input, provide a text box
 623                     $input = "text";
 624                 } elsif ( $authorised_value eq "date" ) {
 625                     # require a date, provide a date picker
 626                     $input = 'date';
 627                 } else {
 628                     # defined $authorised_value, and not 'date'
 629                     my $dbh=C4::Context->dbh;
 630                     my @authorised_values;
 631                     my %authorised_lib;
 632                     # builds list, depending on authorised value...
 633                     if ( $authorised_value eq "branches" ) {
 634                         my $branches = GetBranchesLoop();
 635                         foreach my $thisbranch (@$branches) {
 636                             push @authorised_values, $thisbranch->{value};
 637                             $authorised_lib{$thisbranch->{value}} = $thisbranch->{branchname};
 638                         }
 639                     }
 640                     elsif ( $authorised_value eq "itemtypes" ) {
 641                         my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes ORDER BY description");
 642                         $sth->execute;
 643                         while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
 644                             push @authorised_values, $itemtype;
 645                             $authorised_lib{$itemtype} = $description;
 646                         }
 647                     }
 648                     elsif ( $authorised_value eq "cn_source" ) {
 649                         my $class_sources = GetClassSources();
 650                         my $default_source = C4::Context->preference("DefaultClassificationSource");
 651                         foreach my $class_source (sort keys %$class_sources) {
 652                             next unless $class_sources->{$class_source}->{'used'} or
 653                                         ($class_source eq $default_source);
 654                             push @authorised_values, $class_source;
 655                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
 656                         }
 657                     }
 658                     elsif ( $authorised_value eq "categorycode" ) {
 659                         my $sth = $dbh->prepare("SELECT categorycode, description FROM categories ORDER BY description");
 660                         $sth->execute;
 661                         while ( my ( $categorycode, $description ) = $sth->fetchrow_array ) {
 662                             push @authorised_values, $categorycode;
 663                             $authorised_lib{$categorycode} = $description;
 664                         }
 665
 666                         #---- "true" authorised value
 667                     }
 668                     else {
 669                         if ( IsAuthorisedValueCategory($authorised_value) ) {
 670                             my $query = '
 671                             SELECT authorised_value,lib
 672                             FROM authorised_values
 673                             WHERE category=?
 674                             ORDER BY lib
 675                             ';
 676                             my $authorised_values_sth = $dbh->prepare($query);
 677                             $authorised_values_sth->execute( $authorised_value);
 678
 679                             while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
 680                                 push @authorised_values, $value;
 681                                 $authorised_lib{$value} = $lib;
 682                                 # For item location, we show the code and the libelle
 683                                 $authorised_lib{$value} = $lib;
 684                             }
 685                         } else {
 686                             # not exists $authorised_value_categories{$authorised_value})
 687                             push @authval_errors, {'entry' => $text,
 688                                                    'auth_val' => $authorised_value };
 689                             # tell the template there's an error
 690                             $template->param( auth_val_error => 1 );
 691                             # skip scrolling list creation and params push
 692                             next;
 693                         }
 694                     }
 695                     $labelid = $text;
 696                     $labelid =~ s/\W//g;
 697                     $input =CGI::scrolling_list(      # FIXME: factor out scrolling_list
 698                         -name     => "sql_params",
 699                         -id       => "sql_params_".$labelid,
 700                         -values   => \@authorised_values,
 701 #                     -default  => $value,
 702                         -labels   => \%authorised_lib,
 703                         -override => 1,
 704                         -size     => 1,
 705                         -multiple => 0,
 706                         -tabindex => 1,
 707                     );
 708                 }
 709
 710                 push @tmpl_parameters, {'entry' => $text, 'input' => $input, 'labelid' => $labelid };
 711             }
 712             $template->param('sql'         => $sql,
 713                             'name'         => $name,
 714                             'sql_params'   => \@tmpl_parameters,
 715                             'auth_val_errors'  => \@authval_errors,
 716                             'enter_params' => 1,
 717                             'reports'      => $report_id,
 718                             );
 719         } else {
 720             # OK, we have parameters, or there are none, we run the report
 721             # if there were parameters, replace before running
 722             # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
 723             my @split = split /<<|>>/,$sql;
 724             my @tmpl_parameters;
 725             for(my $i=0;$i<$#split/2;$i++) {
 726                 my $quoted = C4::Context->dbh->quote($sql_params[$i]);
 727                 # if there are special regexp chars, we must \ them
 728                 $split[$i*2+1] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
 729                 $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
 730             }
 731             my ($sth, $errors) = execute_query($sql, $offset, $limit);
 732             my $total = nb_rows($sql) || 0;
 733             unless ($sth) {
 734                 die "execute_query failed to return sth for report $report_id: $sql";
 735             } else {
 736                 my $headers= header_cell_loop($sth);
 737                 $template->param(header_row => $headers);
 738                 while (my $row = $sth->fetchrow_arrayref()) {
 739                     my @cells = map { +{ cell => $_ } } @$row;
 740                     push @rows, { cells => \@cells };
 741                 }
 742             }
 743
 744             my $totpages = int($total/$limit) + (($total % $limit) > 0 ? 1 : 0);
 745             my $url = "/cgi-bin/koha/reports/guided_reports.pl?reports=$report_id&amp;phase=Run%20this%20report&amp;limit=$limit";
 746             if (@sql_params) {
 747                 $url = join('&amp;sql_params=', $url, map { URI::Escape::uri_escape($_) } @sql_params);
 748             }
 749             $template->param(
 750                 'results' => \@rows,
 751                 'sql'     => $sql,
 752                 'id'      => $report_id,
 753                 'execute' => 1,
 754                 'name'    => $name,
 755                 'notes'   => $notes,
 756                 'errors'  => $errors,
 757                 'pagination_bar'  => pagination_bar($url, $totpages, $input->param('page')),
 758                 'unlimited_total' => $total,
 759                 'sql_params'      => \@sql_params,
 760             );
 761         }
 762     }
 763     else {
 764         push @errors, { no_sql_for_id => $report_id };
 765     }
 766 }
 767
 768 elsif ($phase eq 'Export'){
 769
 770         # export results to tab separated text or CSV
 771         my $sql    = $input->param('sql');  # FIXME: use sql from saved report ID#, not new user-supplied SQL!
 772     my $format = $input->param('format');
 773         my ($sth, $q_errors) = execute_query($sql);
 774     unless ($q_errors and @$q_errors) {
 775         my ( $type, $content );
 776         if ($format eq 'tab') {
 777             $type = 'application/octet-stream';
 778             $content .= join("\t", header_cell_values($sth)) . "\n";
 779             while (my $row = $sth->fetchrow_arrayref()) {
 780                 $content .= join("\t", @$row) . "\n";
 781             }
 782         } else {
 783             my $delimiter = C4::Context->preference('delimiter') || ',';
 784             if ( $format eq 'csv' ) {
 785                 $type = 'application/csv';
 786                 my $csv = Text::CSV::Encoded->new({ encoding_out => 'utf8', sep_char => $delimiter});
 787                 $csv or die "Text::CSV::Encoded->new({binary => 1}) FAILED: " . Text::CSV::Encoded->error_diag();
 788                 if ($csv->combine(header_cell_values($sth))) {
 789                     $content .= $csv->string(). "\n";
 790                 } else {
 791                     push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
 792                 }
 793                 while (my $row = $sth->fetchrow_arrayref()) {
 794                     if ($csv->combine(@$row)) {
 795                         $content .= $csv->string() . "\n";
 796                     } else {
 797                         push @$q_errors, { combine => $csv->error_diag() } ;
 798                     }
 799                 }
 800             }
 801             elsif ( $format eq 'ods' ) {
 802                 $type = 'application/vnd.oasis.opendocument.spreadsheet';
 803                 my $ods_fh = File::Temp->new( UNLINK => 0 );
 804                 my $ods_filepath = $ods_fh->filename;
 805
 806                 use OpenOffice::OODoc;
 807                 my $tmpdir = dirname $ods_filepath;
 808                 odfWorkingDirectory( $tmpdir );
 809                 my $container = odfContainer( $ods_filepath, create => 'spreadsheet' );
 810                 my $doc = odfDocument (
 811                     container => $container,
 812                     part      => 'content'
 813                 );
 814                 my $table = $doc->getTable(0);
 815                 my @headers = header_cell_values( $sth );
 816                 my $rows = $sth->fetchall_arrayref();
 817                 my ( $nb_rows, $nb_cols ) = ( scalar(@$rows), scalar(@{$rows->[0]}) );
 818                 $doc->expandTable( $table, $nb_rows, $nb_cols );
 819
 820                 my $row = $doc->getRow( $table, 0 );
 821                 my $j = 0;
 822                 for my $header ( @headers ) {
 823                     $doc->cellValue( $row, $j, $header );
 824                     $j++;
 825                 }
 826                 for ( my $i = 1; $i < $nb_rows +1 ; $i++ ) {
 827                     $row = $doc->getRow( $table, $i );
 828                     for ( my $j = 0 ; $j < $nb_cols ; $j++ ) {
 829                         # FIXME Bug 11944
 830                         my $value = Encode::encode( 'UTF8', $rows->[$i - 1][$j] );
 831                         $doc->cellValue( $row, $j, $value );
 832                     }
 833                 }
 834                 $doc->save();
 835                 binmode(STDOUT);
 836                 open $ods_fh, '<', $ods_filepath;
 837                 $content .= $_ while <$ods_fh>;
 838                 unlink $ods_filepath;
 839             }
 840         }
 841         print $input->header(
 842             -type => $type,
 843             -attachment=>"reportresults.$format"
 844         );
 845         print $content;
 846
 847         foreach my $err (@$q_errors, @errors) {
 848             print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
 849         }   # here we print all the non-fatal errors at the end.  Not super smooth, but better than nothing.
 850         exit;
 851     }
 852     $template->param(
 853         'sql'           => $sql,
 854         'execute'       => 1,
 855         'name'          => 'Error exporting report!',
 856         'notes'         => '',
 857         'errors'        => $q_errors,
 858     );
 859 }
 860
 861 elsif ( $phase eq 'Create report from SQL' ) {
 862
 863     my ($group, $subgroup);
 864     # allow the user to paste in sql
 865     if ( $input->param('sql') ) {
 866         $group = $input->param('report_group');
 867         $subgroup  = $input->param('report_subgroup');
 868         $template->param(
 869             'sql'           => $input->param('sql') // '',
 870             'reportname'    => $input->param('reportname') // '',
 871             'notes'         => $input->param('notes') // '',
 872         );
 873     }
 874     $template->param(
 875         'create' => 1,
 876         'groups_with_subgroups' => groups_with_subgroups($group, $subgroup),
 877         'public' => '0',
 878         'cache_expiry' => 300,
 879         'usecache' => $usecache,
 880     );
 881 }
 882
 883 elsif ($phase eq 'Create Compound Report'){
 884         $template->param( 'savedreports' => get_saved_reports(),
 885                 'compound' => 1,
 886         );
 887 }
 888
 889 elsif ($phase eq 'Save Compound'){
 890     my $master    = $input->param('master');
 891         my $subreport = $input->param('subreport');
 892         my ($mastertables,$subtables) = create_compound($master,$subreport);
 893         $template->param( 'save_compound' => 1,
 894                 master=>$mastertables,
 895                 subsql=>$subtables
 896         );
 897 }
 898
 899 # pass $sth, get back an array of names for the column headers
 900 sub header_cell_values {
 901     my $sth = shift or return ();
 902     my @cols;
 903     foreach my $c (@{$sth->{NAME}}) {
 904         # TODO in Bug 11944
 905         #FIXME apparently DBI still needs a utf8 fix for this?
 906         utf8::decode($c);
 907         push @cols, $c;
 908     }
 909     return @cols;
 910 }
 911
 912 # pass $sth, get back a TMPL_LOOP-able set of names for the column headers
 913 sub header_cell_loop {
 914     my @headers = map { +{ cell => $_ } } header_cell_values (shift);
 915     return \@headers;
 916 }
 917
 918 foreach (1..6) {
 919      $template->{VARS}->{'build' . $_} and $template->{VARS}->{'buildx' . $_} and last;
 920 }
 921 $template->param(   'referer' => $input->referer(),
 922                 );
 923
 924 output_html_with_http_headers $input, $cookie, $template->output;
 925
 926 sub groups_with_subgroups {
 927     my ($group, $subgroup) = @_;
 928
 929     my $groups_with_subgroups = get_report_groups();
 930     my @g_sg;
 931     my @sorted_keys = sort {
 932         $groups_with_subgroups->{$a}->{name} cmp $groups_with_subgroups->{$b}->{name}
 933     } keys %$groups_with_subgroups;
 934     foreach my $g_id (@sorted_keys) {
 935         my $v = $groups_with_subgroups->{$g_id};
 936         my @subgroups;
 937         if (my $sg = $v->{subgroups}) {
 938             foreach my $sg_id (sort { $sg->{$a} cmp $sg->{$b} } keys %$sg) {
 939                 push @subgroups, {
 940                     id => $sg_id,
 941                     name => $sg->{$sg_id},
 942                     selected => ($group && $g_id eq $group && $subgroup && $sg_id eq $subgroup ),
 943                 };
 944             }
 945         }
 946         push @g_sg, {
 947             id => $g_id,
 948             name => $v->{name},
 949             selected => ($group && $g_id eq $group),
 950             subgroups => \@subgroups,
 951         };
 952     }
 953     return \@g_sg;
 954 }
 955
 956 sub create_non_existing_group_and_subgroup {
 957     my ($input, $group, $subgroup) = @_;
 958
 959     if (defined $group and $group ne '') {
 960         my $report_groups = C4::Reports::Guided::get_report_groups;
 961         if (not exists $report_groups->{$group}) {
 962             my $groupdesc = $input->param('groupdesc') // $group;
 963             C4::Koha::AddAuthorisedValue('REPORT_GROUP', $group, $groupdesc);
 964         }
 965         if (defined $subgroup and $subgroup ne '') {
 966             if (not exists $report_groups->{$group}->{subgroups}->{$subgroup}) {
 967                 my $subgroupdesc = $input->param('subgroupdesc') // $subgroup;
 968                 C4::Koha::AddAuthorisedValue('REPORT_SUBGROUP', $subgroup, $subgroupdesc, $group);
 969             }
 970         }
 971     }
 972 }