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