3 # Copyright 2007 Liblime ltd
5 # This file is part of Koha.
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
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.
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.
21 #use warnings; FIXME - Bug 2505
25 use C4::Reports::Guided;
26 use C4::Auth qw/:DEFAULT get_session/;
30 use C4::Branch; # XXX subfield_is_koha_internal_p
39 Script to control the guided report creation
44 my $usecache = Koha::Cache->is_cache_active();
46 my $phase = $input->param('phase');
48 if ( $phase eq 'Build new' or $phase eq 'Delete Saved' ) {
49 $flagsrequired = 'create_reports';
51 elsif ( $phase eq 'Use saved' ) {
52 $flagsrequired = 'execute_reports';
57 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
59 template_name => "reports/guided_reports_start.tmpl",
63 flagsrequired => { reports => $flagsrequired },
67 my $session = $cookie ? get_session($cookie->value) : undef;
70 if ( $input->param("filter_set") ) {
72 $filter->{$_} = $input->param("filter_$_") foreach qw/date author keyword/;
73 $session->param('report_filter', $filter) if $session;
74 $template->param( 'filter_set' => 1 );
77 $filter = $session->param('report_filter');
83 $template->param( 'start' => 1 );
86 elsif ( $phase eq 'Build new' ) {
88 $template->param( 'build1' => 1 );
89 $template->param( 'areas' => get_report_areas(), 'usecache' => $usecache, 'cache_expiry' => 300, 'public' => '0' );
91 elsif ( $phase eq 'Use saved' ) {
93 # get list of reports and display them
96 'savedreports' => get_saved_reports($filter),
97 'usecache' => $usecache,
100 while ( my ($k, $v) = each %$filter ) {
101 $template->param( "filter_$k" => $v ) if $v;
106 elsif ( $phase eq 'Delete Saved') {
108 # delete a report from the saved reports list
109 my $id = $input->param('reports');
111 print $input->redirect("/cgi-bin/koha/reports/guided_reports.pl?phase=Use%20saved");
115 elsif ( $phase eq 'Show SQL'){
117 my $id = $input->param('reports');
118 my ($sql,$type,$reportname,$notes) = get_saved_report($id);
121 'reportname' => $reportname,
128 elsif ( $phase eq 'Edit SQL'){
130 my $id = $input->param('reports');
131 my ($sql,$type,$reportname,$notes, $cache_expiry, $public) = get_saved_report($id);
134 'reportname' => $reportname,
137 'cache_expiry' => $cache_expiry,
139 'usecache' => $usecache,
144 elsif ( $phase eq 'Update SQL'){
145 my $id = $input->param('id');
146 my $sql = $input->param('sql');
147 my $reportname = $input->param('reportname');
148 my $notes = $input->param('notes');
149 my $cache_expiry = $input->param('cache_expiry');
150 my $cache_expiry_units = $input->param('cache_expiry_units');
151 my $public = $input->param('public');
155 # if we have the units, then we came from creating a report from SQL and thus need to handle converting units
156 if( $cache_expiry_units ){
157 if( $cache_expiry_units eq "minutes" ){
159 } elsif( $cache_expiry_units eq "hours" ){
160 $cache_expiry *= 3600; # 60 * 60
161 } elsif( $cache_expiry_units eq "days" ){
162 $cache_expiry *= 86400; # 60 * 60 * 24
165 # 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
166 if( $cache_expiry >= 2592000 ){
167 push @errors, {cache_expiry => $cache_expiry};
170 if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
171 push @errors, {sqlerr => $1};
173 elsif ($sql !~ /^(SELECT)/i) {
174 push @errors, {queryerr => 1};
178 'errors' => \@errors,
183 update_sql( $id, $sql, $reportname, $notes, $cache_expiry, $public );
185 'save_successful' => 1,
186 'reportname' => $reportname,
193 elsif ($phase eq 'retrieve results') {
194 my $id = $input->param('id');
195 my ($results,$name,$notes) = format_results($id);
199 'results' => $results,
205 elsif ( $phase eq 'Report on this Area' ) {
206 my $cache_expiry_units = $input->param('cache_expiry_units'),
207 my $cache_expiry = $input->param('cache_expiry');
209 # we need to handle converting units
210 if( $cache_expiry_units eq "minutes" ){
212 } elsif( $cache_expiry_units eq "hours" ){
213 $cache_expiry *= 3600; # 60 * 60
214 } elsif( $cache_expiry_units eq "days" ){
215 $cache_expiry *= 86400; # 60 * 60 * 24
217 # 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
218 if( $cache_expiry >= 2592000 ){ # oops, over the limit of 30 days
219 # report error to user
223 'areas' => get_report_areas(),
224 'cache_expiry' => $cache_expiry,
225 'usecache' => $usecache,
226 'public' => $input->param('public'),
229 # they have choosen a new report and the area to report on
232 'area' => $input->param('areas'),
233 'types' => get_report_types(),
234 'cache_expiry' => $cache_expiry,
235 'public' => $input->param('public'),
240 elsif ( $phase eq 'Choose this type' ) {
241 # they have chosen type and area
242 # get area and type and pass them to the template
243 my $area = $input->param('area');
244 my $type = $input->param('types');
249 columns => get_columns($area,$input),
250 'cache_expiry' => $input->param('cache_expiry'),
251 'public' => $input->param('public'),
255 elsif ( $phase eq 'Choose these columns' ) {
256 # we now know type, area, and columns
257 # next step is the constraints
258 my $area = $input->param('area');
259 my $type = $input->param('type');
260 my @columns = $input->param('columns');
261 my $column = join( ',', @columns );
267 definitions => get_from_dictionary($area),
268 criteria => get_criteria($area,$input),
269 'cache_expiry' => $input->param('cache_expiry'),
270 'cache_expiry_units' => $input->param('cache_expiry_units'),
271 'public' => $input->param('public'),
275 elsif ( $phase eq 'Choose these criteria' ) {
276 my $area = $input->param('area');
277 my $type = $input->param('type');
278 my $column = $input->param('column');
279 my @definitions = $input->param('definition');
280 my $definition = join (',',@definitions);
281 my @criteria = $input->param('criteria_column');
283 foreach my $crit (@criteria) {
284 my $value = $input->param( $crit . "_value" );
286 # If value is not defined, then it may be range values
287 if (!defined $value) {
289 my $fromvalue = $input->param( "from_" . $crit . "_value" );
290 my $tovalue = $input->param( "to_" . $crit . "_value" );
292 # If the range values are dates
293 if ($fromvalue =~ C4::Dates->regexp('syspref') && $tovalue =~ C4::Dates->regexp('syspref')) {
294 $fromvalue = C4::Dates->new($fromvalue)->output("iso");
295 $tovalue = C4::Dates->new($tovalue)->output("iso");
298 if ($fromvalue && $tovalue) {
299 $query_criteria .= " AND $crit >= '$fromvalue' AND $crit <= '$tovalue'";
305 if ($value =~ C4::Dates->regexp('syspref')) {
306 $value = C4::Dates->new($value)->output("iso");
308 # don't escape runtime parameters, they'll be at runtime
309 if ($value =~ /<<.*>>/) {
310 $query_criteria .= " AND $crit=$value";
312 $query_criteria .= " AND $crit='$value'";
321 'definition' => $definition,
322 'criteriastring' => $query_criteria,
323 'cache_expiry' => $input->param('cache_expiry'),
324 'cache_expiry_units' => $input->param('cache_expiry_units'),
325 'public' => $input->param('public'),
329 my @columns = split( ',', $column );
332 # build structue for use by tmpl_loop to choose columns to order by
333 # need to do something about the order of the order :)
334 # we also want to use the %columns hash to get the plain english names
335 foreach my $col (@columns) {
336 my %total = (name => $col);
337 my @selects = map {+{ value => $_ }} (qw(sum min max avg count));
338 $total{'select'} = \@selects;
339 push @total_by, \%total;
342 $template->param( 'total_by' => \@total_by );
345 elsif ( $phase eq 'Choose these operations' ) {
346 my $area = $input->param('area');
347 my $type = $input->param('type');
348 my $column = $input->param('column');
349 my $criteria = $input->param('criteria');
350 my $definition = $input->param('definition');
351 my @total_by = $input->param('total_by');
353 foreach my $total (@total_by) {
354 my $value = $input->param( $total . "_tvalue" );
355 $totals .= "$value($total),";
363 'criteriastring' => $criteria,
365 'definition' => $definition,
366 'cache_expiry' => $input->param('cache_expiry'),
367 'public' => $input->param('public'),
371 my @columns = split( ',', $column );
374 # build structue for use by tmpl_loop to choose columns to order by
375 # need to do something about the order of the order :)
376 foreach my $col (@columns) {
377 my %order = (name => $col);
378 my @selects = map {+{ value => $_ }} (qw(asc desc));
379 $order{'select'} = \@selects;
380 push @order_by, \%order;
383 $template->param( 'order_by' => \@order_by );
386 elsif ( $phase eq 'Build report' ) {
388 # now we have all the info we need and can build the sql
389 my $area = $input->param('area');
390 my $type = $input->param('type');
391 my $column = $input->param('column');
392 my $crit = $input->param('criteria');
393 my $totals = $input->param('totals');
394 my $definition = $input->param('definition');
395 my $query_criteria=$crit;
396 # split the columns up by ,
397 my @columns = split( ',', $column );
398 my @order_by = $input->param('order_by');
401 foreach my $order (@order_by) {
402 my $value = $input->param( $order . "_ovalue" );
403 if ($query_orderby) {
404 $query_orderby .= ",$order $value";
407 $query_orderby = " ORDER BY $order $value";
413 build_query( \@columns, $query_criteria, $query_orderby, $area, $totals, $definition );
418 'cache_expiry' => $input->param('cache_expiry'),
419 'public' => $input->param('public'),
423 elsif ( $phase eq 'Save' ) {
424 # Save the report that has just been built
425 my $sql = $input->param('sql');
426 my $type = $input->param('type');
431 'cache_expiry' => $input->param('cache_expiry'),
432 'public' => $input->param('public'),
436 elsif ( $phase eq 'Save Report' ) {
437 # save the sql pasted in by a user
438 my $sql = $input->param('sql');
439 my $name = $input->param('reportname');
440 my $type = $input->param('types');
441 my $notes = $input->param('notes');
442 my $cache_expiry = $input->param('cache_expiry');
443 my $cache_expiry_units = $input->param('cache_expiry_units');
444 my $public = $input->param('public');
447 # if we have the units, then we came from creating a report from SQL and thus need to handle converting units
448 if( $cache_expiry_units ){
449 if( $cache_expiry_units eq "minutes" ){
451 } elsif( $cache_expiry_units eq "hours" ){
452 $cache_expiry *= 3600; # 60 * 60
453 } elsif( $cache_expiry_units eq "days" ){
454 $cache_expiry *= 86400; # 60 * 60 * 24
457 # 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
458 if( $cache_expiry >= 2592000 ){
459 push @errors, {cache_expiry => $cache_expiry};
461 ## FIXME this is AFTER entering a name to save the report under
462 if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
463 push @errors, {sqlerr => $1};
465 elsif ($sql !~ /^(SELECT)/i) {
466 push @errors, {queryerr => 1};
470 'errors' => \@errors,
472 'reportname'=> $name,
475 'cache_expiry' => $cache_expiry,
480 my $id = save_report( $borrowernumber, $sql, $name, $type, $notes, $cache_expiry, $public );
482 'save_successful' => 1,
483 'reportname' => $name,
489 elsif ($phase eq 'Run this report'){
490 # execute a saved report
491 my $limit = 20; # page size. # TODO: move to DB or syspref?
493 my $report = $input->param('reports');
494 my @sql_params = $input->param('sql_params');
496 if ($input->param('page')) {
497 $offset = ($input->param('page') - 1) * $limit;
499 my ($sql,$type,$name,$notes) = get_saved_report($report);
501 push @errors, {no_sql_for_id=>$report};
504 # if we have at least 1 parameter, and it's not filled, then don't execute but ask for parameters
505 if ($sql =~ /<</ && !@sql_params) {
506 # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
507 my @split = split /<<|>>/,$sql;
509 for(my $i=0;$i<($#split/2);$i++) {
510 my ($text,$authorised_value) = split /\|/,$split[$i*2+1];
513 if ($authorised_value eq "date") {
516 elsif ($authorised_value) {
517 my $dbh=C4::Context->dbh;
518 my @authorised_values;
520 # builds list, depending on authorised value...
521 if ( $authorised_value eq "branches" ) {
522 my $branches = GetBranchesLoop();
523 foreach my $thisbranch (@$branches) {
524 push @authorised_values, $thisbranch->{value};
525 $authorised_lib{$thisbranch->{value}} = $thisbranch->{branchname};
528 elsif ( $authorised_value eq "itemtypes" ) {
529 my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes ORDER BY description");
531 while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
532 push @authorised_values, $itemtype;
533 $authorised_lib{$itemtype} = $description;
536 elsif ( $authorised_value eq "cn_source" ) {
537 my $class_sources = GetClassSources();
538 my $default_source = C4::Context->preference("DefaultClassificationSource");
539 foreach my $class_source (sort keys %$class_sources) {
540 next unless $class_sources->{$class_source}->{'used'} or
541 ($class_source eq $default_source);
542 push @authorised_values, $class_source;
543 $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
546 elsif ( $authorised_value eq "categorycode" ) {
547 my $sth = $dbh->prepare("SELECT categorycode, description FROM categories ORDER BY description");
549 while ( my ( $categorycode, $description ) = $sth->fetchrow_array ) {
550 push @authorised_values, $categorycode;
551 $authorised_lib{$categorycode} = $description;
554 #---- "true" authorised value
557 my $authorised_values_sth = $dbh->prepare("SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib");
559 $authorised_values_sth->execute( $authorised_value);
561 while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
562 push @authorised_values, $value;
563 $authorised_lib{$value} = $lib;
564 # For item location, we show the code and the libelle
565 $authorised_lib{$value} = $lib;
570 $input =CGI::scrolling_list( # FIXME: factor out scrolling_list
571 -name => "sql_params",
572 -id => "sql_params_".$labelid,
573 -values => \@authorised_values,
574 # -default => $value,
575 -labels => \%authorised_lib,
585 push @tmpl_parameters, {'entry' => $text, 'input' => $input, 'labelid' => $labelid };
587 $template->param('sql' => $sql,
589 'sql_params' => \@tmpl_parameters,
591 'reports' => $report,
594 # OK, we have parameters, or there are none, we run the report
595 # if there were parameters, replace before running
596 # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
597 my @split = split /<<|>>/,$sql;
599 for(my $i=0;$i<$#split/2;$i++) {
600 my $quoted = C4::Context->dbh->quote($sql_params[$i]);
601 # if there are special regexp chars, we must \ them
602 $split[$i*2+1] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
603 $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
605 my ($sth, $errors) = execute_query($sql, $offset, $limit);
606 my $total = nb_rows($sql) || 0;
608 die "execute_query failed to return sth for report $report: $sql";
610 my $headref = $sth->{NAME} || [];
611 my @headers = map { +{ cell => $_ } } @$headref;
612 $template->param(header_row => \@headers);
613 while (my $row = $sth->fetchrow_arrayref()) {
614 my @cells = map { +{ cell => $_ } } @$row;
615 push @rows, { cells => \@cells };
619 my $totpages = int($total/$limit) + (($total % $limit) > 0 ? 1 : 0);
620 my $url = "/cgi-bin/koha/reports/guided_reports.pl?reports=$report&phase=Run%20this%20report";
622 $url = join('&sql_params=', $url, map { URI::Escape::uri_escape($_) } @sql_params);
632 'pagination_bar' => pagination_bar($url, $totpages, $input->param('page')),
633 'unlimited_total' => $total,
638 elsif ($phase eq 'Export'){
639 binmode STDOUT, ':encoding(UTF-8)';
641 # export results to tab separated text or CSV
642 my $sql = $input->param('sql'); # FIXME: use sql from saved report ID#, not new user-supplied SQL!
643 my $format = $input->param('format');
644 my ($sth, $q_errors) = execute_query($sql);
645 unless ($q_errors and @$q_errors) {
646 print $input->header( -type => 'application/octet-stream',
647 -attachment=>"reportresults.$format"
649 if ($format eq 'tab') {
650 print join("\t", header_cell_values($sth)), "\n";
651 while (my $row = $sth->fetchrow_arrayref()) {
652 print join("\t", @$row), "\n";
655 my $csv = Text::CSV->new({binary => 1});
656 $csv or die "Text::CSV->new({binary => 1}) FAILED: " . Text::CSV->error_diag();
657 if ($csv->combine(header_cell_values($sth))) {
658 print $csv->string(), "\n";
660 push @$q_errors, { combine => 'HEADER ROW: ' . $csv->error_diag() } ;
662 while (my $row = $sth->fetchrow_arrayref()) {
663 if ($csv->combine(@$row)) {
664 print $csv->string(), "\n";
666 push @$q_errors, { combine => $csv->error_diag() } ;
670 foreach my $err (@$q_errors, @errors) {
671 print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
672 } # here we print all the non-fatal errors at the end. Not super smooth, but better than nothing.
678 'name' => 'Error exporting report!',
680 'errors' => $q_errors,
684 elsif ($phase eq 'Create report from SQL') {
685 # allow the user to paste in sql
686 if ($input->param('sql')) {
688 'sql' => $input->param('sql'),
689 'reportname' => $input->param('reportname'),
690 'notes' => $input->param('notes'),
693 $template->param('create' => 1, 'public' => '0', 'cache_expiry' => 300, 'usecache' => $usecache);
696 elsif ($phase eq 'Create Compound Report'){
697 $template->param( 'savedreports' => get_saved_reports(),
702 elsif ($phase eq 'Save Compound'){
703 my $master = $input->param('master');
704 my $subreport = $input->param('subreport');
705 my ($mastertables,$subtables) = create_compound($master,$subreport);
706 $template->param( 'save_compound' => 1,
707 master=>$mastertables,
712 # pass $sth, get back an array of names for the column headers
713 sub header_cell_values {
714 my $sth = shift or return ();
715 return @{$sth->{NAME}};
718 # pass $sth, get back a TMPL_LOOP-able set of names for the column headers
719 sub header_cell_loop {
720 my @headers = map { +{ cell => $_ } } header_cell_values (shift);
725 $template->{VARS}->{'build' . $_} and $template->{VARS}->{'buildx' . $_} and last;
727 $template->param( 'referer' => $input->referer(),
728 'DHTMLcalendar_dateformat' => C4::Dates->DHTMLcalendar(),
731 output_html_with_http_headers $input, $cookie, $template->output;