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 strict;
  21 #use warnings; FIXME - Bug 2505
  22 use CGI;
  23 use Text::CSV;
  24 use C4::Reports::Guided;
  25 use C4::Auth qw/:DEFAULT get_session/;
  26 use C4::Output;
  27 use C4::Dates;
  28 use C4::Debug;
  29 use C4::Branch; # XXX subfield_is_koha_internal_p
  30
  31 =head1 NAME
  32
  33 guided_reports.pl
  34
  35 =head1 DESCRIPTION
  36
  37 Script to control the guided report creation
  38
  39 =cut
  40
  41 my $input = new CGI;
  42
  43 my $phase = $input->param('phase');
  44 my $flagsrequired;
  45 if ( $phase eq 'Build new' or $phase eq 'Delete Saved' ) {
  46     $flagsrequired = 'create_reports';
  47 }
  48 elsif ( $phase eq 'Use saved' ) {
  49     $flagsrequired = 'execute_reports';
  50 } else {
  51     $flagsrequired = '*';
  52 }
  53
  54 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
  55     {
  56         template_name   => "reports/guided_reports_start.tmpl",
  57         query           => $input,
  58         type            => "intranet",
  59         authnotrequired => 0,
  60         flagsrequired   => { reports => $flagsrequired },
  61         debug           => 1,
  62     }
  63 );
  64 my $session = $cookie ? get_session($cookie->value) : undef;
  65
  66 my $filter;
  67 if ( $input->param("filter_set") ) {
  68     $filter = {};
  69     $filter->{$_} = $input->param("filter_$_") foreach qw/date author keyword/;
  70     $session->param('report_filter', $filter) if $session;
  71     $template->param( 'filter_set' => 1 );
  72 }
  73 elsif ($session) {
  74     $filter = $session->param('report_filter');
  75 }
  76
  77
  78 my @errors = ();
  79 if ( !$phase ) {
  80     $template->param( 'start' => 1 );
  81     # show welcome page
  82 }
  83 elsif ( $phase eq 'Build new' ) {
  84     # build a new report
  85     $template->param( 'build1' => 1 );
  86     $template->param( 'areas' => get_report_areas() );
  87 }
  88 elsif ( $phase eq 'Use saved' ) {
  89     # use a saved report
  90     # get list of reports and display them
  91     $template->param(
  92         'saved1' => 1,
  93         'savedreports' => get_saved_reports($filter),
  94     );
  95     if ($filter) {
  96         while ( my ($k, $v) = each %$filter ) {
  97             $template->param( "filter_$k" => $v ) if $v;
  98         }
  99     }
 100 }
 101
 102 elsif ( $phase eq 'Delete Saved') {
 103
 104         # delete a report from the saved reports list
 105         my $id = $input->param('reports');
 106         delete_report($id);
 107     print $input->redirect("/cgi-bin/koha/reports/guided_reports.pl?phase=Use%20saved");
 108         exit;
 109 }
 110
 111 elsif ( $phase eq 'Show SQL'){
 112
 113         my $id = $input->param('reports');
 114         my $sql = get_sql($id);
 115         $template->param(
 116                 'sql' => $sql,
 117                 'showsql' => 1,
 118     );
 119 }
 120
 121 elsif ( $phase eq 'Edit SQL'){
 122
 123     my $id = $input->param('reports');
 124     my ($sql,$type,$reportname,$notes) = get_saved_report($id);
 125     $template->param(
 126             'sql'        => $sql,
 127             'reportname' => $reportname,
 128         'notes'      => $notes,
 129         'id'         => $id,
 130             'editsql'    => 1,
 131     );
 132 }
 133
 134 elsif ( $phase eq 'Update SQL'){
 135     my $id         = $input->param('id');
 136     my $sql        = $input->param('sql');
 137     my $reportname = $input->param('reportname');
 138     my $notes      = $input->param('notes');
 139     my @errors;
 140     if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
 141         push @errors, {sqlerr => $1};
 142     }
 143     elsif ($sql !~ /^(SELECT)/i) {
 144         push @errors, {queryerr => 1};
 145     }
 146     if (@errors) {
 147         $template->param(
 148             'errors'    => \@errors,
 149             'sql'       => $sql,
 150         );
 151     }
 152     else {
 153         update_sql( $id, $sql, $reportname, $notes );
 154         $template->param(
 155             'save_successful'       => 1,
 156             'id'                    => $id,
 157         );
 158     }
 159
 160 }
 161
 162 elsif ($phase eq 'retrieve results') {
 163         my $id = $input->param('id');
 164         my ($results,$name,$notes) = format_results($id);
 165         # do something
 166         $template->param(
 167                 'retresults' => 1,
 168                 'results' => $results,
 169                 'name' => $name,
 170                 'notes' => $notes,
 171     );
 172 }
 173
 174 elsif ( $phase eq 'Report on this Area' ) {
 175
 176     # they have choosen a new report and the area to report on
 177     $template->param(
 178         'build2' => 1,
 179         'area'   => $input->param('areas'),
 180         'types'  => get_report_types(),
 181     );
 182 }
 183
 184 elsif ( $phase eq 'Choose this type' ) {
 185
 186     # they have chosen type and area
 187     # get area and type and pass them to the template
 188     my $area = $input->param('area');
 189     my $type = $input->param('types');
 190     $template->param(
 191         'build3' => 1,
 192         'area'   => $area,
 193         'type'   => $type,
 194         columns  => get_columns($area,$input),
 195     );
 196 }
 197
 198 elsif ( $phase eq 'Choose these columns' ) {
 199
 200     # we now know type, area, and columns
 201     # next step is the constraints
 202     my $area    = $input->param('area');
 203     my $type    = $input->param('type');
 204     my @columns = $input->param('columns');
 205     my $column  = join( ',', @columns );
 206     $template->param(
 207         'build4' => 1,
 208         'area'   => $area,
 209         'type'   => $type,
 210         'column' => $column,
 211         definitions => get_from_dictionary($area),
 212         criteria    => get_criteria($area,$input),
 213     );
 214 }
 215
 216 elsif ( $phase eq 'Choose these criteria' ) {
 217     my $area     = $input->param('area');
 218     my $type     = $input->param('type');
 219     my $column   = $input->param('column');
 220         my @definitions = $input->param('definition');
 221         my $definition = join (',',@definitions);
 222     my @criteria = $input->param('criteria_column');
 223         my $query_criteria;
 224     foreach my $crit (@criteria) {
 225         my $value = $input->param( $crit . "_value" );
 226
 227         # If value is not defined, then it may be range values
 228         if (!defined $value) {
 229
 230             my $fromvalue = $input->param( "from_" . $crit . "_value" );
 231             my $tovalue   = $input->param( "to_"   . $crit . "_value" );
 232
 233             # If the range values are dates
 234             if ($fromvalue =~ C4::Dates->regexp('syspref') && $tovalue =~ C4::Dates->regexp('syspref')) {
 235                 $fromvalue = C4::Dates->new($fromvalue)->output("iso");
 236                 $tovalue = C4::Dates->new($tovalue)->output("iso");
 237             }
 238
 239             if ($fromvalue && $tovalue) {
 240                 $query_criteria .= " AND $crit >= '$fromvalue' AND $crit <= '$tovalue'";
 241             }
 242
 243         } else {
 244
 245             # If value is a date
 246             if ($value =~ C4::Dates->regexp('syspref')) {
 247                 $value = C4::Dates->new($value)->output("iso");
 248             }
 249         # don't escape runtime parameters, they'll be at runtime
 250         if ($value =~ /<<.*>>/) {
 251             $query_criteria .= " AND $crit=$value";
 252         } else {
 253             $query_criteria .= " AND $crit='$value'";
 254         }
 255         }
 256     }
 257
 258     $template->param(
 259         'build5'         => 1,
 260         'area'           => $area,
 261         'type'           => $type,
 262         'column'         => $column,
 263         'definition'     => $definition,
 264         'criteriastring' => $query_criteria,
 265     );
 266
 267     # get columns
 268     my @columns = split( ',', $column );
 269     my @total_by;
 270
 271     # build structue for use by tmpl_loop to choose columns to order by
 272     # need to do something about the order of the order :)
 273         # we also want to use the %columns hash to get the plain english names
 274     foreach my $col (@columns) {
 275         my %total = (name => $col);
 276         my @selects = map {+{ value => $_ }} (qw(sum min max avg count));
 277         $total{'select'} = \@selects;
 278         push @total_by, \%total;
 279     }
 280
 281     $template->param( 'total_by' => \@total_by );
 282 }
 283
 284 elsif ( $phase eq 'Choose These Operations' ) {
 285     my $area     = $input->param('area');
 286     my $type     = $input->param('type');
 287     my $column   = $input->param('column');
 288     my $criteria = $input->param('criteria');
 289         my $definition = $input->param('definition');
 290     my @total_by = $input->param('total_by');
 291     my $totals;
 292     foreach my $total (@total_by) {
 293         my $value = $input->param( $total . "_tvalue" );
 294         $totals .= "$value($total),";
 295     }
 296
 297     $template->param(
 298         'build6'         => 1,
 299         'area'           => $area,
 300         'type'           => $type,
 301         'column'         => $column,
 302         'criteriastring' => $criteria,
 303         'totals'         => $totals,
 304         'definition'     => $definition,
 305     );
 306
 307     # get columns
 308     my @columns = split( ',', $column );
 309     my @order_by;
 310
 311     # build structue for use by tmpl_loop to choose columns to order by
 312     # need to do something about the order of the order :)
 313     foreach my $col (@columns) {
 314         my %order = (name => $col);
 315         my @selects = map {+{ value => $_ }} (qw(asc desc));
 316         $order{'select'} = \@selects;
 317         push @order_by, \%order;
 318     }
 319
 320     $template->param( 'order_by' => \@order_by );
 321 }
 322
 323 elsif ( $phase eq 'Build Report' ) {
 324
 325     # now we have all the info we need and can build the sql
 326     my $area     = $input->param('area');
 327     my $type     = $input->param('type');
 328     my $column   = $input->param('column');
 329     my $crit     = $input->param('criteria');
 330     my $totals   = $input->param('totals');
 331     my $definition = $input->param('definition');
 332     my $query_criteria=$crit;
 333     # split the columns up by ,
 334     my @columns = split( ',', $column );
 335     my @order_by = $input->param('order_by');
 336
 337     my $query_orderby;
 338     foreach my $order (@order_by) {
 339         my $value = $input->param( $order . "_ovalue" );
 340         if ($query_orderby) {
 341             $query_orderby .= ",$order $value";
 342         }
 343         else {
 344             $query_orderby = " ORDER BY $order $value";
 345         }
 346     }
 347
 348     # get the sql
 349     my $sql =
 350       build_query( \@columns, $query_criteria, $query_orderby, $area, $totals, $definition );
 351     $template->param(
 352         'showreport' => 1,
 353         'sql'        => $sql,
 354         'type'       => $type
 355     );
 356 }
 357
 358 elsif ( $phase eq 'Save' ) {
 359         # Save the report that has just been built
 360     my $sql  = $input->param('sql');
 361     my $type = $input->param('type');
 362     $template->param(
 363         'save' => 1,
 364         'sql'  => $sql,
 365         'type' => $type
 366     );
 367 }
 368
 369 elsif ( $phase eq 'Save Report' ) {
 370     # save the sql pasted in by a user
 371     my $sql  = $input->param('sql');
 372     my $name = $input->param('reportname');
 373     my $type = $input->param('types');
 374     my $notes = $input->param('notes');
 375     if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
 376         push @errors, {sqlerr => $1};
 377     }
 378     elsif ($sql !~ /^(SELECT)/i) {
 379         push @errors, {queryerr => 1};
 380     }
 381     if (@errors) {
 382         $template->param(
 383             'errors'    => \@errors,
 384             'sql'       => $sql,
 385             'reportname'=> $name,
 386             'type'      => $type,
 387             'notes'     => $notes,
 388         );
 389     }
 390     else {
 391         my $id = save_report( $borrowernumber, $sql, $name, $type, $notes );
 392         $template->param(
 393             'save_successful'       => 1,
 394             'id'                    => $id,
 395         );
 396     }
 397 }
 398
 399 elsif ($phase eq 'Run this report'){
 400     # execute a saved report
 401     my $limit  = 20;    # page size. # TODO: move to DB or syspref?
 402     my $offset = 0;
 403     my $report = $input->param('reports');
 404     my @sql_params = $input->param('sql_params');
 405     # offset algorithm
 406     if ($input->param('page')) {
 407         $offset = ($input->param('page') - 1) * $limit;
 408     }
 409     my ($sql,$type,$name,$notes) = get_saved_report($report);
 410     unless ($sql) {
 411         push @errors, {no_sql_for_id=>$report};
 412     }
 413     my @rows = ();
 414     # if we have at least 1 parameter, and it's not filled, then don't execute but ask for parameters
 415     if ($sql =~ /<</ && !@sql_params) {
 416         # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
 417         my @split = split /<<|>>/,$sql;
 418         my @tmpl_parameters;
 419         for(my $i=0;$i<($#split/2);$i++) {
 420             my ($text,$authorised_value) = split /\|/,$split[$i*2+1];
 421             my $input;
 422             if ($authorised_value) {
 423                 my $dbh=C4::Context->dbh;
 424                 my @authorised_values;
 425                 my %authorised_lib;
 426                 # builds list, depending on authorised value...
 427                 if ( $authorised_value eq "branches" ) {
 428                     my $branches = GetBranchesLoop();
 429                     foreach my $thisbranch (@$branches) {
 430                         push @authorised_values, $thisbranch->{value};
 431                         $authorised_lib{$thisbranch->{value}} = $thisbranch->{branchname};
 432                     }
 433                 }
 434                 elsif ( $authorised_value eq "itemtypes" ) {
 435                     my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes ORDER BY description");
 436                     $sth->execute;
 437                     while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
 438                         push @authorised_values, $itemtype;
 439                         $authorised_lib{$itemtype} = $description;
 440                     }
 441                 }
 442                 elsif ( $authorised_value eq "cn_source" ) {
 443                     my $class_sources = GetClassSources();
 444                     my $default_source = C4::Context->preference("DefaultClassificationSource");
 445                     foreach my $class_source (sort keys %$class_sources) {
 446                         next unless $class_sources->{$class_source}->{'used'} or
 447                                     ($class_source eq $default_source);
 448                         push @authorised_values, $class_source;
 449                         $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
 450                     }
 451                 }
 452                 elsif ( $authorised_value eq "categorycode" ) {
 453                     my $sth = $dbh->prepare("SELECT categorycode, description FROM categories ORDER BY description");
 454                     $sth->execute;
 455                     while ( my ( $categorycode, $description ) = $sth->fetchrow_array ) {
 456                         push @authorised_values, $categorycode;
 457                         $authorised_lib{$categorycode} = $description;
 458                     }
 459
 460                     #---- "true" authorised value
 461                 }
 462                 else {
 463                     my $authorised_values_sth = $dbh->prepare("SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib");
 464
 465                     $authorised_values_sth->execute( $authorised_value);
 466
 467                     while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
 468                         push @authorised_values, $value;
 469                         $authorised_lib{$value} = $lib;
 470                         # For item location, we show the code and the libelle
 471                         $authorised_lib{$value} = $lib;
 472                     }
 473                 }
 474                 $input =CGI::scrolling_list(      # FIXME: factor out scrolling_list
 475                     -name     => "sql_params",
 476                     -values   => \@authorised_values,
 477 #                     -default  => $value,
 478                     -labels   => \%authorised_lib,
 479                     -override => 1,
 480                     -size     => 1,
 481                     -multiple => 0,
 482                     -tabindex => 1,
 483                 );
 484
 485             } else {
 486                 $input = "<input type='text' name='sql_params'/>";
 487             }
 488             push @tmpl_parameters, {'entry' => $text, 'input' => $input };
 489         }
 490         $template->param('sql'         => $sql,
 491                         'name'         => $name,
 492                         'sql_params'   => \@tmpl_parameters,
 493                         'enter_params' => 1,
 494                         'reports'      => $report,
 495                         );
 496     } else {
 497         # OK, we have parameters, or there are none, we run the report
 498         # if there were parameters, replace before running
 499         # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
 500         my @split = split /<<|>>/,$sql;
 501         my @tmpl_parameters;
 502         for(my $i=0;$i<$#split/2;$i++) {
 503             my $quoted = C4::Context->dbh->quote($sql_params[$i]);
 504             # if there are special regexp chars, we must \ them
 505             $split[$i*2+1] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
 506             $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
 507         }
 508         my ($sth, $errors) = execute_query($sql, $offset, $limit);
 509         my $total = nb_rows($sql) || 0;
 510         unless ($sth) {
 511             die "execute_query failed to return sth for report $report: $sql";
 512         } else {
 513             my $headref = $sth->{NAME} || [];
 514             my @headers = map { +{ cell => $_ } } @$headref;
 515             $template->param(header_row => \@headers);
 516             while (my $row = $sth->fetchrow_arrayref()) {
 517                 my @cells = map { +{ cell => $_ } } @$row;
 518                 push @rows, { cells => \@cells };
 519             }
 520         }
 521
 522         my $totpages = int($total/$limit) + (($total % $limit) > 0 ? 1 : 0);
 523         my $url = "/cgi-bin/koha/reports/guided_reports.pl?reports=$report&amp;phase=Run%20this%20report";
 524         $template->param(
 525             'results' => \@rows,
 526             'sql'     => $sql,
 527             'execute' => 1,
 528             'name'    => $name,
 529             'notes'   => $notes,
 530             'errors'  => $errors,
 531             'pagination_bar'  => pagination_bar($url, $totpages, $input->param('page')),
 532             'unlimited_total' => $total,
 533         );
 534     }
 535 }
 536
 537 elsif ($phase eq 'Export'){
 538     binmode STDOUT, ':utf8';
 539
 540         # export results to tab separated text or CSV
 541         my $sql    = $input->param('sql');  # FIXME: use sql from saved report ID#, not new user-supplied SQL!
 542     my $format = $input->param('format');
 543         my ($sth, $q_errors) = execute_query($sql);
 544     unless ($q_errors and @$q_errors) {
 545         print $input->header(       -type => 'application/octet-stream',
 546                                     -attachment=>"reportresults.$format"
 547                             );
 548         if ($format eq 'tab') {
 549             print join("\t", header_cell_values($sth)), "\n";
 550             while (my $row = $sth->fetchrow_arrayref()) {
 551                 print join("\t", @$row), "\n";
 552             }
 553         } else {
 554             my $csv = Text::CSV->new({binary => 1});
 555             $csv or die "Text::CSV->new({binary => 1}) FAILED: " . Text::CSV->error_diag();
 556             if ($csv->combine(header_cell_values($sth))) {
 557                 print $csv->string(), "\n";
 558             } else {
 559                 push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
 560             }
 561             while (my $row = $sth->fetchrow_arrayref()) {
 562                 if ($csv->combine(@$row)) {
 563                     print $csv->string(), "\n";
 564                 } else {
 565                     push @$q_errors, { combine => $csv->error_diag() } ;
 566                 }
 567             }
 568         }
 569         foreach my $err (@$q_errors, @errors) {
 570             print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
 571         }   # here we print all the non-fatal errors at the end.  Not super smooth, but better than nothing.
 572         exit;
 573     }
 574     $template->param(
 575         'sql'           => $sql,
 576         'execute'       => 1,
 577         'name'          => 'Error exporting report!',
 578         'notes'         => '',
 579         'errors'        => $q_errors,
 580     );
 581 }
 582
 583 elsif ($phase eq 'Create report from SQL') {
 584         # allow the user to paste in sql
 585     if ($input->param('sql')) {
 586         $template->param(
 587             'sql'           => $input->param('sql'),
 588             'reportname'    => $input->param('reportname'),
 589             'notes'         => $input->param('notes'),
 590         );
 591     }
 592         $template->param('create' => 1);
 593 }
 594
 595 elsif ($phase eq 'Create Compound Report'){
 596         $template->param( 'savedreports' => get_saved_reports(),
 597                 'compound' => 1,
 598         );
 599 }
 600
 601 elsif ($phase eq 'Save Compound'){
 602     my $master    = $input->param('master');
 603         my $subreport = $input->param('subreport');
 604         my ($mastertables,$subtables) = create_compound($master,$subreport);
 605         $template->param( 'save_compound' => 1,
 606                 master=>$mastertables,
 607                 subsql=>$subtables
 608         );
 609 }
 610
 611 # pass $sth, get back an array of names for the column headers
 612 sub header_cell_values {
 613     my $sth = shift or return ();
 614     return @{$sth->{NAME}};
 615 }
 616
 617 # pass $sth, get back a TMPL_LOOP-able set of names for the column headers
 618 sub header_cell_loop {
 619     my @headers = map { +{ cell => $_ } } header_cell_values (shift);
 620     return \@headers;
 621 }
 622
 623 foreach (1..6) {
 624     $template->param('build' . $_) and $template->param(buildx => $_) and last;
 625 }
 626 $template->param(   'referer' => $input->referer(),
 627                     'DHTMLcalendar_dateformat' => C4::Dates->DHTMLcalendar(),
 628                 );
 629
 630 output_html_with_http_headers $input, $cookie, $template->output;