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
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use Modern::Perl;
  21 use CGI qw/-utf8/;
  22 use Text::CSV::Encoded;
  23 use Encode qw( decode );
  24 use URI::Escape;
  25 use File::Temp;
  26 use File::Basename qw( dirname );
  27 use C4::Reports::Guided;
  28 use C4::Auth qw/:DEFAULT get_session/;
  29 use C4::Output;
  30 use C4::Dates qw/format_date/;
  31 use C4::Debug;
  32 use C4::Branch; # XXX subfield_is_koha_internal_p
  33 use C4::Koha qw/IsAuthorisedValueCategory GetFrameworksLoop/;
  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.tt",
  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     $template->param(
  92         'areas'        => get_report_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         filters => $filter,
 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 => "No SELECT"};
 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 "biblio_framework" ) {
 667                         my $frameworks = GetFrameworksLoop();
 668                         my $default_source = '';
 669                         push @authorised_values,$default_source;
 670                         $authorised_lib{$default_source} = 'Default';
 671                         foreach my $framework (@$frameworks) {
 672                             push @authorised_values, $framework->{value};
 673                             $authorised_lib{$framework->{value}} = $framework->{description};
 674                         }
 675                     }
 676                     elsif ( $authorised_value eq "cn_source" ) {
 677                         my $class_sources = GetClassSources();
 678                         my $default_source = C4::Context->preference("DefaultClassificationSource");
 679                         foreach my $class_source (sort keys %$class_sources) {
 680                             next unless $class_sources->{$class_source}->{'used'} or
 681                                         ($class_source eq $default_source);
 682                             push @authorised_values, $class_source;
 683                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
 684                         }
 685                     }
 686                     elsif ( $authorised_value eq "categorycode" ) {
 687                         my $sth = $dbh->prepare("SELECT categorycode, description FROM categories ORDER BY description");
 688                         $sth->execute;
 689                         while ( my ( $categorycode, $description ) = $sth->fetchrow_array ) {
 690                             push @authorised_values, $categorycode;
 691                             $authorised_lib{$categorycode} = $description;
 692                         }
 693
 694                         #---- "true" authorised value
 695                     }
 696                     else {
 697                         if ( IsAuthorisedValueCategory($authorised_value) ) {
 698                             my $query = '
 699                             SELECT authorised_value,lib
 700                             FROM authorised_values
 701                             WHERE category=?
 702                             ORDER BY lib
 703                             ';
 704                             my $authorised_values_sth = $dbh->prepare($query);
 705                             $authorised_values_sth->execute( $authorised_value);
 706
 707                             while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
 708                                 push @authorised_values, $value;
 709                                 $authorised_lib{$value} = $lib;
 710                                 # For item location, we show the code and the libelle
 711                                 $authorised_lib{$value} = $lib;
 712                             }
 713                         } else {
 714                             # not exists $authorised_value_categories{$authorised_value})
 715                             push @authval_errors, {'entry' => $text,
 716                                                    'auth_val' => $authorised_value };
 717                             # tell the template there's an error
 718                             $template->param( auth_val_error => 1 );
 719                             # skip scrolling list creation and params push
 720                             next;
 721                         }
 722                     }
 723                     $labelid = $text;
 724                     $labelid =~ s/\W//g;
 725                     $input =CGI::scrolling_list(      # FIXME: factor out scrolling_list
 726                         -name     => "sql_params",
 727                         -id       => "sql_params_".$labelid,
 728                         -values   => \@authorised_values,
 729 #                     -default  => $value,
 730                         -labels   => \%authorised_lib,
 731                         -override => 1,
 732                         -size     => 1,
 733                         -multiple => 0,
 734                         -tabindex => 1,
 735                     );
 736                 }
 737
 738                 push @tmpl_parameters, {'entry' => $text, 'input' => $input, 'labelid' => $labelid };
 739             }
 740             $template->param('sql'         => $sql,
 741                             'name'         => $name,
 742                             'sql_params'   => \@tmpl_parameters,
 743                             'auth_val_errors'  => \@authval_errors,
 744                             'enter_params' => 1,
 745                             'reports'      => $report_id,
 746                             );
 747         } else {
 748             # OK, we have parameters, or there are none, we run the report
 749             # if there were parameters, replace before running
 750             # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
 751             my @split = split /<<|>>/,$sql;
 752             my @tmpl_parameters;
 753             for(my $i=0;$i<$#split/2;$i++) {
 754                 my $quoted = C4::Context->dbh->quote($sql_params[$i]);
 755                 # if there are special regexp chars, we must \ them
 756                 $split[$i*2+1] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
 757                 $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
 758             }
 759             my ($sth, $errors) = execute_query($sql, $offset, $limit);
 760             my $total = nb_rows($sql) || 0;
 761             unless ($sth) {
 762                 die "execute_query failed to return sth for report $report_id: $sql";
 763             } else {
 764                 my $headers= header_cell_loop($sth);
 765                 $template->param(header_row => $headers);
 766                 while (my $row = $sth->fetchrow_arrayref()) {
 767                     my @cells = map { +{ cell => $_ } } @$row;
 768                     push @rows, { cells => \@cells };
 769                 }
 770             }
 771
 772             my $totpages = int($total/$limit) + (($total % $limit) > 0 ? 1 : 0);
 773             my $url = "/cgi-bin/koha/reports/guided_reports.pl?reports=$report_id&amp;phase=Run%20this%20report&amp;limit=$limit";
 774             if (@sql_params) {
 775                 $url = join('&amp;sql_params=', $url, map { URI::Escape::uri_escape_utf8($_) } @sql_params);
 776             }
 777             $template->param(
 778                 'results' => \@rows,
 779                 'sql'     => $sql,
 780                 'id'      => $report_id,
 781                 'execute' => 1,
 782                 'name'    => $name,
 783                 'notes'   => $notes,
 784                 'errors'  => defined($errors) ? [ $errors ] : undef,
 785                 'pagination_bar'  => pagination_bar($url, $totpages, $input->param('page')),
 786                 'unlimited_total' => $total,
 787                 'sql_params'      => \@sql_params,
 788             );
 789         }
 790     }
 791     else {
 792         push @errors, { no_sql_for_id => $report_id };
 793     }
 794 }
 795
 796 elsif ($phase eq 'Export'){
 797
 798         # export results to tab separated text or CSV
 799         my $sql    = $input->param('sql');  # FIXME: use sql from saved report ID#, not new user-supplied SQL!
 800     my $format = $input->param('format');
 801     my $reportname = $input->param('reportname');
 802     my $reportfilename = $reportname ? "$reportname-reportresults.$format" : "reportresults.$format" ;
 803         my ($sth, $q_errors) = execute_query($sql);
 804     unless ($q_errors and @$q_errors) {
 805         my ( $type, $content );
 806         if ($format eq 'tab') {
 807             $type = 'application/octet-stream';
 808             $content .= join("\t", header_cell_values($sth)) . "\n";
 809             while (my $row = $sth->fetchrow_arrayref()) {
 810                 $content .= join("\t", @$row) . "\n";
 811             }
 812         } else {
 813             my $delimiter = C4::Context->preference('delimiter') || ',';
 814             if ( $format eq 'csv' ) {
 815                 $type = 'application/csv';
 816                 my $csv = Text::CSV::Encoded->new({ encoding_out => 'utf8', sep_char => $delimiter});
 817                 $csv or die "Text::CSV::Encoded->new({binary => 1}) FAILED: " . Text::CSV::Encoded->error_diag();
 818                 if ($csv->combine(header_cell_values($sth))) {
 819                     $content .= $csv->string(). "\n";
 820                 } else {
 821                     push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
 822                 }
 823                 while (my $row = $sth->fetchrow_arrayref()) {
 824                     if ($csv->combine(@$row)) {
 825                         $content .= $csv->string() . "\n";
 826                     } else {
 827                         push @$q_errors, { combine => $csv->error_diag() } ;
 828                     }
 829                 }
 830             }
 831             elsif ( $format eq 'ods' ) {
 832                 $type = 'application/vnd.oasis.opendocument.spreadsheet';
 833                 my $ods_fh = File::Temp->new( UNLINK => 0 );
 834                 my $ods_filepath = $ods_fh->filename;
 835
 836                 use OpenOffice::OODoc;
 837                 my $tmpdir = dirname $ods_filepath;
 838                 odfWorkingDirectory( $tmpdir );
 839                 my $container = odfContainer( $ods_filepath, create => 'spreadsheet' );
 840                 my $doc = odfDocument (
 841                     container => $container,
 842                     part      => 'content'
 843                 );
 844                 my $table = $doc->getTable(0);
 845                 my @headers = header_cell_values( $sth );
 846                 my $rows = $sth->fetchall_arrayref();
 847                 my ( $nb_rows, $nb_cols ) = ( 0, 0 );
 848                 $nb_rows = @$rows;
 849                 $nb_cols = @headers;
 850                 $doc->expandTable( $table, $nb_rows + 1, $nb_cols );
 851
 852                 my $row = $doc->getRow( $table, 0 );
 853                 my $j = 0;
 854                 for my $header ( @headers ) {
 855                     $doc->cellValue( $row, $j, $header );
 856                     $j++;
 857                 }
 858                 my $i = 1;
 859                 for ( @$rows ) {
 860                     $row = $doc->getRow( $table, $i );
 861                     for ( my $j = 0 ; $j < $nb_cols ; $j++ ) {
 862                         my $value = Encode::encode( 'UTF8', $rows->[$i - 1][$j] );
 863                         $doc->cellValue( $row, $j, $value );
 864                     }
 865                     $i++;
 866                 }
 867                 $doc->save();
 868                 binmode(STDOUT);
 869                 open $ods_fh, '<', $ods_filepath;
 870                 $content .= $_ while <$ods_fh>;
 871                 unlink $ods_filepath;
 872             }
 873         }
 874         print $input->header(
 875             -type => $type,
 876             -attachment=> $reportfilename
 877         );
 878         print $content;
 879
 880         foreach my $err (@$q_errors, @errors) {
 881             print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
 882         }   # here we print all the non-fatal errors at the end.  Not super smooth, but better than nothing.
 883         exit;
 884     }
 885     $template->param(
 886         'sql'           => $sql,
 887         'execute'       => 1,
 888         'name'          => 'Error exporting report!',
 889         'notes'         => '',
 890         'errors'        => $q_errors,
 891     );
 892 }
 893
 894 elsif ( $phase eq 'Create report from SQL' ) {
 895
 896     my ($group, $subgroup);
 897     # allow the user to paste in sql
 898     if ( $input->param('sql') ) {
 899         $group = $input->param('report_group');
 900         $subgroup  = $input->param('report_subgroup');
 901         $template->param(
 902             'sql'           => $input->param('sql') // '',
 903             'reportname'    => $input->param('reportname') // '',
 904             'notes'         => $input->param('notes') // '',
 905         );
 906     }
 907     $template->param(
 908         'create' => 1,
 909         'groups_with_subgroups' => groups_with_subgroups($group, $subgroup),
 910         'public' => '0',
 911         'cache_expiry' => 300,
 912         'usecache' => $usecache,
 913     );
 914 }
 915
 916 elsif ($phase eq 'Create Compound Report'){
 917         $template->param( 'savedreports' => get_saved_reports(),
 918                 'compound' => 1,
 919         );
 920 }
 921
 922 elsif ($phase eq 'Save Compound'){
 923     my $master    = $input->param('master');
 924         my $subreport = $input->param('subreport');
 925         my ($mastertables,$subtables) = create_compound($master,$subreport);
 926         $template->param( 'save_compound' => 1,
 927                 master=>$mastertables,
 928                 subsql=>$subtables
 929         );
 930 }
 931
 932 # pass $sth, get back an array of names for the column headers
 933 sub header_cell_values {
 934     my $sth = shift or return ();
 935     return '' unless ($sth->{NAME});
 936     return @{$sth->{NAME}};
 937 }
 938
 939 # pass $sth, get back a TMPL_LOOP-able set of names for the column headers
 940 sub header_cell_loop {
 941     my @headers = map { +{ cell => $_ } } header_cell_values (shift);
 942     return \@headers;
 943 }
 944
 945 foreach (1..6) {
 946      $template->{VARS}->{'build' . $_} and $template->{VARS}->{'buildx' . $_} and last;
 947 }
 948 $template->param(   'referer' => $input->referer(),
 949                 );
 950
 951 output_html_with_http_headers $input, $cookie, $template->output;
 952
 953 sub groups_with_subgroups {
 954     my ($group, $subgroup) = @_;
 955
 956     my $groups_with_subgroups = get_report_groups();
 957     my @g_sg;
 958     my @sorted_keys = sort {
 959         $groups_with_subgroups->{$a}->{name} cmp $groups_with_subgroups->{$b}->{name}
 960     } keys %$groups_with_subgroups;
 961     foreach my $g_id (@sorted_keys) {
 962         my $v = $groups_with_subgroups->{$g_id};
 963         my @subgroups;
 964         if (my $sg = $v->{subgroups}) {
 965             foreach my $sg_id (sort { $sg->{$a} cmp $sg->{$b} } keys %$sg) {
 966                 push @subgroups, {
 967                     id => $sg_id,
 968                     name => $sg->{$sg_id},
 969                     selected => ($group && $g_id eq $group && $subgroup && $sg_id eq $subgroup ),
 970                 };
 971             }
 972         }
 973         push @g_sg, {
 974             id => $g_id,
 975             name => $v->{name},
 976             selected => ($group && $g_id eq $group),
 977             subgroups => \@subgroups,
 978         };
 979     }
 980     return \@g_sg;
 981 }
 982
 983 sub create_non_existing_group_and_subgroup {
 984     my ($input, $group, $subgroup) = @_;
 985
 986     if (defined $group and $group ne '') {
 987         my $report_groups = C4::Reports::Guided::get_report_groups;
 988         if (not exists $report_groups->{$group}) {
 989             my $groupdesc = $input->param('groupdesc') // $group;
 990             C4::Koha::AddAuthorisedValue('REPORT_GROUP', $group, $groupdesc);
 991         }
 992         if (defined $subgroup and $subgroup ne '') {
 993             if (not exists $report_groups->{$group}->{subgroups}->{$subgroup}) {
 994                 my $subgroupdesc = $input->param('subgroupdesc') // $subgroup;
 995                 C4::Koha::AddAuthorisedValue('REPORT_SUBGROUP', $subgroup, $subgroupdesc, $group);
 996             }
 997         }
 998     }
 999 }