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