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