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.
24 use C4
::Reports
::Guided
;
25 use C4
::Auth qw
/:DEFAULT get_session/;
27 use C4
::Dates qw
/format_date/;
29 use C4
::Branch
; # XXX subfield_is_koha_internal_p
37 Script to control the guided report creation
42 my $usecache = C4
::Context
->ismemcached;
44 my $phase = $input->param('phase');
46 if ( $phase eq 'Build new' or $phase eq 'Delete Saved' ) {
47 $flagsrequired = 'create_reports';
49 elsif ( $phase eq 'Use saved' ) {
50 $flagsrequired = 'execute_reports';
55 my ( $template, $borrowernumber, $cookie ) = get_template_and_user
(
57 template_name
=> "reports/guided_reports_start.tmpl",
61 flagsrequired
=> { reports
=> $flagsrequired },
65 my $session = $cookie ? get_session
($cookie->value) : undef;
68 if ( $input->param("filter_set") ) {
70 $filter->{$_} = $input->param("filter_$_") foreach qw
/date author keyword group subgroup/;
71 $session->param('report_filter', $filter) if $session;
72 $template->param( 'filter_set' => 1 );
75 $filter = $session->param('report_filter');
81 $template->param( 'start' => 1 );
84 elsif ( $phase eq 'Build new' ) {
86 $template->param( 'build1' => 1 );
87 my $areas = get_report_areas
();
89 'areas' => [map { id
=> $_->[0], name
=> $_->[1] }, @
$areas],
90 'usecache' => $usecache,
91 'cache_expiry' => 300,
94 } elsif ( $phase eq 'Use saved' ) {
97 # get list of reports and display them
98 my $group = $input->param('group');
99 my $subgroup = $input->param('subgroup');
100 $filter->{group
} = $group;
101 $filter->{subgroup
} = $subgroup;
104 'savedreports' => get_saved_reports
($filter),
105 'usecache' => $usecache,
106 'groups_with_subgroups'=> groups_with_subgroups
($group, $subgroup),
107 dateformat
=> C4
::Context
->preference('dateformat'),
111 elsif ( $phase eq 'Delete Saved') {
113 # delete a report from the saved reports list
114 my $id = $input->param('reports');
116 print $input->redirect("/cgi-bin/koha/reports/guided_reports.pl?phase=Use%20saved");
120 elsif ( $phase eq 'Show SQL'){
122 my $id = $input->param('reports');
123 my $report = get_saved_report
($id);
126 'reportname' => $report->{report_name
},
127 'notes' => $report->{notes
},
128 'sql' => $report->{savedsql
},
133 elsif ( $phase eq 'Edit SQL'){
135 my $id = $input->param('reports');
136 my $report = get_saved_report
($id);
137 my $group = $report->{report_group
};
138 my $subgroup = $report->{report_subgroup
};
140 'sql' => $report->{savedsql
},
141 'reportname' => $report->{report_name
},
142 'groups_with_subgroups' => groups_with_subgroups
($group, $subgroup),
143 'notes' => $report->{notes
},
145 'cache_expiry' => $report->{cache_expiry
},
146 'public' => $report->{public
},
147 'usecache' => $usecache,
152 elsif ( $phase eq 'Update SQL'){
153 my $id = $input->param('id');
154 my $sql = $input->param('sql');
155 my $reportname = $input->param('reportname');
156 my $group = $input->param('group');
157 my $subgroup = $input->param('subgroup');
158 my $notes = $input->param('notes');
159 my $cache_expiry = $input->param('cache_expiry');
160 my $cache_expiry_units = $input->param('cache_expiry_units');
161 my $public = $input->param('public');
165 # if we have the units, then we came from creating a report from SQL and thus need to handle converting units
166 if( $cache_expiry_units ){
167 if( $cache_expiry_units eq "minutes" ){
169 } elsif( $cache_expiry_units eq "hours" ){
170 $cache_expiry *= 3600; # 60 * 60
171 } elsif( $cache_expiry_units eq "days" ){
172 $cache_expiry *= 86400; # 60 * 60 * 24
175 # 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
176 if( $cache_expiry >= 2592000 ){
177 push @errors, {cache_expiry
=> $cache_expiry};
180 create_non_existing_group_and_subgroup
($input, $group, $subgroup);
182 if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
183 push @errors, {sqlerr
=> $1};
185 elsif ($sql !~ /^(SELECT)/i) {
186 push @errors, {queryerr
=> 1};
190 'errors' => \
@errors,
198 subgroup
=> $subgroup,
200 cache_expiry
=> $cache_expiry,
204 'save_successful' => 1,
205 'reportname' => $reportname,
211 elsif ($phase eq 'retrieve results') {
212 my $id = $input->param('id');
213 my ($results,$name,$notes) = format_results
($id);
217 'results' => $results,
223 elsif ( $phase eq 'Report on this Area' ) {
224 my $cache_expiry_units = $input->param('cache_expiry_units'),
225 my $cache_expiry = $input->param('cache_expiry');
227 # we need to handle converting units
228 if( $cache_expiry_units eq "minutes" ){
230 } elsif( $cache_expiry_units eq "hours" ){
231 $cache_expiry *= 3600; # 60 * 60
232 } elsif( $cache_expiry_units eq "days" ){
233 $cache_expiry *= 86400; # 60 * 60 * 24
235 # 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
236 if( $cache_expiry >= 2592000 ){ # oops, over the limit of 30 days
237 # report error to user
241 'areas' => get_report_areas
(),
242 'cache_expiry' => $cache_expiry,
243 'usecache' => $usecache,
244 'public' => $input->param('public'),
247 # they have choosen a new report and the area to report on
250 'area' => $input->param('area'),
251 'types' => get_report_types
(),
252 'cache_expiry' => $cache_expiry,
253 'public' => $input->param('public'),
258 elsif ( $phase eq 'Choose this type' ) {
259 # they have chosen type and area
260 # get area and type and pass them to the template
261 my $area = $input->param('area');
262 my $type = $input->param('types');
267 columns
=> get_columns
($area,$input),
268 'cache_expiry' => $input->param('cache_expiry'),
269 'public' => $input->param('public'),
273 elsif ( $phase eq 'Choose these columns' ) {
274 # we now know type, area, and columns
275 # next step is the constraints
276 my $area = $input->param('area');
277 my $type = $input->param('type');
278 my @columns = $input->param('columns');
279 my $column = join( ',', @columns );
285 definitions
=> get_from_dictionary
($area),
286 criteria
=> get_criteria
($area,$input),
287 'cache_expiry' => $input->param('cache_expiry'),
288 'cache_expiry_units' => $input->param('cache_expiry_units'),
289 'public' => $input->param('public'),
293 elsif ( $phase eq 'Choose these criteria' ) {
294 my $area = $input->param('area');
295 my $type = $input->param('type');
296 my $column = $input->param('column');
297 my @definitions = $input->param('definition');
298 my $definition = join (',',@definitions);
299 my @criteria = $input->param('criteria_column');
301 foreach my $crit (@criteria) {
302 my $value = $input->param( $crit . "_value" );
304 # If value is not defined, then it may be range values
305 if (!defined $value) {
307 my $fromvalue = $input->param( "from_" . $crit . "_value" );
308 my $tovalue = $input->param( "to_" . $crit . "_value" );
310 # If the range values are dates
311 if ($fromvalue =~ C4
::Dates
->regexp('syspref') && $tovalue =~ C4
::Dates
->regexp('syspref')) {
312 $fromvalue = C4
::Dates
->new($fromvalue)->output("iso");
313 $tovalue = C4
::Dates
->new($tovalue)->output("iso");
316 if ($fromvalue && $tovalue) {
317 $query_criteria .= " AND $crit >= '$fromvalue' AND $crit <= '$tovalue'";
323 if ($value =~ C4
::Dates
->regexp('syspref')) {
324 $value = C4
::Dates
->new($value)->output("iso");
326 # don't escape runtime parameters, they'll be at runtime
327 if ($value =~ /<<.*>>/) {
328 $query_criteria .= " AND $crit=$value";
330 $query_criteria .= " AND $crit='$value'";
339 'definition' => $definition,
340 'criteriastring' => $query_criteria,
341 'cache_expiry' => $input->param('cache_expiry'),
342 'cache_expiry_units' => $input->param('cache_expiry_units'),
343 'public' => $input->param('public'),
347 my @columns = split( ',', $column );
350 # build structue for use by tmpl_loop to choose columns to order by
351 # need to do something about the order of the order :)
352 # we also want to use the %columns hash to get the plain english names
353 foreach my $col (@columns) {
354 my %total = (name
=> $col);
355 my @selects = map {+{ value
=> $_ }} (qw(sum min max avg count));
356 $total{'select'} = \
@selects;
357 push @total_by, \
%total;
360 $template->param( 'total_by' => \
@total_by );
363 elsif ( $phase eq 'Choose these operations' ) {
364 my $area = $input->param('area');
365 my $type = $input->param('type');
366 my $column = $input->param('column');
367 my $criteria = $input->param('criteria');
368 my $definition = $input->param('definition');
369 my @total_by = $input->param('total_by');
371 foreach my $total (@total_by) {
372 my $value = $input->param( $total . "_tvalue" );
373 $totals .= "$value($total),";
381 'criteriastring' => $criteria,
383 'definition' => $definition,
384 'cache_expiry' => $input->param('cache_expiry'),
385 'public' => $input->param('public'),
389 my @columns = split( ',', $column );
392 # build structue for use by tmpl_loop to choose columns to order by
393 # need to do something about the order of the order :)
394 foreach my $col (@columns) {
395 my %order = (name
=> $col);
396 my @selects = map {+{ value
=> $_ }} (qw(asc desc));
397 $order{'select'} = \
@selects;
398 push @order_by, \
%order;
401 $template->param( 'order_by' => \
@order_by );
404 elsif ( $phase eq 'Build report' ) {
406 # now we have all the info we need and can build the sql
407 my $area = $input->param('area');
408 my $type = $input->param('type');
409 my $column = $input->param('column');
410 my $crit = $input->param('criteria');
411 my $totals = $input->param('totals');
412 my $definition = $input->param('definition');
413 my $query_criteria=$crit;
414 # split the columns up by ,
415 my @columns = split( ',', $column );
416 my @order_by = $input->param('order_by');
419 foreach my $order (@order_by) {
420 my $value = $input->param( $order . "_ovalue" );
421 if ($query_orderby) {
422 $query_orderby .= ",$order $value";
425 $query_orderby = " ORDER BY $order $value";
431 build_query
( \
@columns, $query_criteria, $query_orderby, $area, $totals, $definition );
437 'cache_expiry' => $input->param('cache_expiry'),
438 'public' => $input->param('public'),
442 elsif ( $phase eq 'Save' ) {
443 # Save the report that has just been built
444 my $area = $input->param('area');
445 my $sql = $input->param('sql');
446 my $type = $input->param('type');
452 'cache_expiry' => $input->param('cache_expiry'),
453 'public' => $input->param('public'),
454 'groups_with_subgroups' => groups_with_subgroups
($area), # in case we have a report group that matches area
458 elsif ( $phase eq 'Save Report' ) {
459 # save the sql pasted in by a user
460 my $area = $input->param('area');
461 my $group = $input->param('group');
462 my $subgroup = $input->param('subgroup');
463 my $sql = $input->param('sql');
464 my $name = $input->param('reportname');
465 my $type = $input->param('types');
466 my $notes = $input->param('notes');
467 my $cache_expiry = $input->param('cache_expiry');
468 my $cache_expiry_units = $input->param('cache_expiry_units');
469 my $public = $input->param('public');
472 # if we have the units, then we came from creating a report from SQL and thus need to handle converting units
473 if( $cache_expiry_units ){
474 if( $cache_expiry_units eq "minutes" ){
476 } elsif( $cache_expiry_units eq "hours" ){
477 $cache_expiry *= 3600; # 60 * 60
478 } elsif( $cache_expiry_units eq "days" ){
479 $cache_expiry *= 86400; # 60 * 60 * 24
482 # 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
483 if( $cache_expiry && $cache_expiry >= 2592000 ){
484 push @errors, {cache_expiry
=> $cache_expiry};
487 create_non_existing_group_and_subgroup
($input, $group, $subgroup);
489 ## FIXME this is AFTER entering a name to save the report under
490 if ($sql =~ /;?\W?(UPDATE|DELETE|DROP|INSERT|SHOW|CREATE)\W/i) {
491 push @errors, {sqlerr
=> $1};
493 elsif ($sql !~ /^(SELECT)/i) {
494 push @errors, {queryerr
=> "No SELECT"};
498 'errors' => \
@errors,
500 'reportname'=> $name,
503 'cache_expiry' => $cache_expiry,
508 my $id = save_report
( {
509 borrowernumber
=> $borrowernumber,
514 subgroup
=> $subgroup,
517 cache_expiry
=> $cache_expiry,
521 'save_successful' => 1,
522 'reportname' => $name,
528 elsif ($phase eq 'Run this report'){
529 # execute a saved report
530 my $limit = $input->param('limit') || 20;
532 my $report_id = $input->param('reports');
533 my @sql_params = $input->param('sql_params');
535 if ($input->param('page')) {
536 $offset = ($input->param('page') - 1) * $limit;
541 'report_id' => $report_id,
544 my ( $sql, $type, $name, $notes );
545 if (my $report = get_saved_report
($report_id)) {
546 $sql = $report->{savedsql
};
547 $name = $report->{report_name
};
548 $notes = $report->{notes
};
551 # if we have at least 1 parameter, and it's not filled, then don't execute but ask for parameters
552 if ($sql =~ /<</ && !@sql_params) {
553 # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
554 my @split = split /<<|>>/,$sql;
556 for(my $i=0;$i<($#split/2);$i++) {
557 my ($text,$authorised_value) = split /\|/,$split[$i*2+1];
560 if ($authorised_value eq "date") {
563 elsif ($authorised_value) {
564 my $dbh=C4
::Context
->dbh;
565 my @authorised_values;
567 # builds list, depending on authorised value...
568 if ( $authorised_value eq "branches" ) {
569 my $branches = GetBranchesLoop
();
570 foreach my $thisbranch (@
$branches) {
571 push @authorised_values, $thisbranch->{value
};
572 $authorised_lib{$thisbranch->{value
}} = $thisbranch->{branchname
};
575 elsif ( $authorised_value eq "itemtypes" ) {
576 my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes ORDER BY description");
578 while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
579 push @authorised_values, $itemtype;
580 $authorised_lib{$itemtype} = $description;
583 elsif ( $authorised_value eq "cn_source" ) {
584 my $class_sources = GetClassSources
();
585 my $default_source = C4
::Context
->preference("DefaultClassificationSource");
586 foreach my $class_source (sort keys %$class_sources) {
587 next unless $class_sources->{$class_source}->{'used'} or
588 ($class_source eq $default_source);
589 push @authorised_values, $class_source;
590 $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
593 elsif ( $authorised_value eq "categorycode" ) {
594 my $sth = $dbh->prepare("SELECT categorycode, description FROM categories ORDER BY description");
596 while ( my ( $categorycode, $description ) = $sth->fetchrow_array ) {
597 push @authorised_values, $categorycode;
598 $authorised_lib{$categorycode} = $description;
601 #---- "true" authorised value
604 my $authorised_values_sth = $dbh->prepare("SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib");
606 $authorised_values_sth->execute( $authorised_value);
608 while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
609 push @authorised_values, $value;
610 $authorised_lib{$value} = $lib;
611 # For item location, we show the code and the libelle
612 $authorised_lib{$value} = $lib;
617 $input =CGI
::scrolling_list
( # FIXME: factor out scrolling_list
618 -name
=> "sql_params",
619 -id
=> "sql_params_".$labelid,
620 -values => \
@authorised_values,
621 # -default => $value,
622 -labels
=> \
%authorised_lib,
631 push @tmpl_parameters, {'entry' => $text, 'input' => $input, 'labelid' => $labelid };
633 $template->param('sql' => $sql,
635 'sql_params' => \
@tmpl_parameters,
637 'reports' => $report_id,
640 # OK, we have parameters, or there are none, we run the report
641 # if there were parameters, replace before running
642 # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill
643 my @split = split /<<|>>/,$sql;
645 for(my $i=0;$i<$#split/2;$i++) {
646 my $quoted = C4
::Context
->dbh->quote($sql_params[$i]);
647 # if there are special regexp chars, we must \ them
648 $split[$i*2+1] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g;
649 $sql =~ s/<<$split[$i*2+1]>>/$quoted/;
651 my ($sth, $errors) = execute_query
($sql, $offset, $limit);
652 my $total = nb_rows
($sql) || 0;
654 die "execute_query failed to return sth for report $report_id: $sql";
656 my $headref = $sth->{NAME
} || [];
657 my @headers = map { +{ cell
=> $_ } } @
$headref;
658 $template->param(header_row
=> \
@headers);
659 while (my $row = $sth->fetchrow_arrayref()) {
660 my @cells = map { +{ cell
=> $_ } } @
$row;
661 push @rows, { cells
=> \
@cells };
665 my $totpages = int($total/$limit) + (($total % $limit) > 0 ?
1 : 0);
666 my $url = "/cgi-bin/koha/reports/guided_reports.pl?reports=$report_id&phase=Run%20this%20report&limit=$limit";
668 $url = join('&sql_params=', $url, map { URI
::Escape
::uri_escape
($_) } @sql_params);
678 'pagination_bar' => pagination_bar
($url, $totpages, $input->param('page')),
679 'unlimited_total' => $total,
684 push @errors, { no_sql_for_id
=> $report_id };
688 elsif ($phase eq 'Export'){
689 binmode STDOUT
, ':encoding(UTF-8)';
691 # export results to tab separated text or CSV
692 my $sql = $input->param('sql'); # FIXME: use sql from saved report ID#, not new user-supplied SQL!
693 my $format = $input->param('format');
694 my ($sth, $q_errors) = execute_query
($sql);
695 unless ($q_errors and @
$q_errors) {
696 print $input->header( -type
=> 'application/octet-stream',
697 -attachment
=>"reportresults.$format"
699 if ($format eq 'tab') {
700 print join("\t", header_cell_values
($sth)), "\n";
701 while (my $row = $sth->fetchrow_arrayref()) {
702 print join("\t", @
$row), "\n";
705 my $csv = Text
::CSV
->new({binary
=> 1});
706 $csv or die "Text::CSV->new({binary => 1}) FAILED: " . Text
::CSV
->error_diag();
707 if ($csv->combine(header_cell_values
($sth))) {
708 print $csv->string(), "\n";
710 push @
$q_errors, { combine
=> 'HEADER ROW: ' . $csv->error_diag() } ;
712 while (my $row = $sth->fetchrow_arrayref()) {
713 if ($csv->combine(@
$row)) {
714 print $csv->string(), "\n";
716 push @
$q_errors, { combine
=> $csv->error_diag() } ;
720 foreach my $err (@
$q_errors, @errors) {
721 print "# ERROR: " . (map {$_ . ": " . $err->{$_}} keys %$err) . "\n";
722 } # here we print all the non-fatal errors at the end. Not super smooth, but better than nothing.
728 'name' => 'Error exporting report!',
730 'errors' => $q_errors,
734 elsif ( $phase eq 'Create report from SQL' ) {
736 my ($group, $subgroup);
737 # allow the user to paste in sql
738 if ( $input->param('sql') ) {
739 $group = $input->param('report_group');
740 $subgroup = $input->param('report_subgroup');
742 'sql' => $input->param('sql') // '',
743 'reportname' => $input->param('reportname') // '',
744 'notes' => $input->param('notes') // '',
749 'groups_with_subgroups' => groups_with_subgroups
($group, $subgroup),
751 'cache_expiry' => 300,
752 'usecache' => $usecache,
756 elsif ($phase eq 'Create Compound Report'){
757 $template->param( 'savedreports' => get_saved_reports
(),
762 elsif ($phase eq 'Save Compound'){
763 my $master = $input->param('master');
764 my $subreport = $input->param('subreport');
765 my ($mastertables,$subtables) = create_compound
($master,$subreport);
766 $template->param( 'save_compound' => 1,
767 master
=>$mastertables,
772 # pass $sth, get back an array of names for the column headers
773 sub header_cell_values
{
774 my $sth = shift or return ();
775 return @
{$sth->{NAME
}};
778 # pass $sth, get back a TMPL_LOOP-able set of names for the column headers
779 sub header_cell_loop
{
780 my @headers = map { +{ cell
=> $_ } } header_cell_values
(shift);
785 $template->{VARS
}->{'build' . $_} and $template->{VARS
}->{'buildx' . $_} and last;
787 $template->param( 'referer' => $input->referer(),
790 output_html_with_http_headers
$input, $cookie, $template->output;
792 sub groups_with_subgroups
{
793 my ($group, $subgroup) = @_;
795 my $groups_with_subgroups = get_report_groups
();
797 my @sorted_keys = sort {
798 $groups_with_subgroups->{$a}->{name
} cmp $groups_with_subgroups->{$b}->{name
}
799 } keys %$groups_with_subgroups;
800 foreach my $g_id (@sorted_keys) {
801 my $v = $groups_with_subgroups->{$g_id};
803 if (my $sg = $v->{subgroups
}) {
804 foreach my $sg_id (sort { $sg->{$a} cmp $sg->{$b} } keys %$sg) {
807 name
=> $sg->{$sg_id},
808 selected
=> ($group && $g_id eq $group && $subgroup && $sg_id eq $subgroup ),
815 selected
=> ($group && $g_id eq $group),
816 subgroups
=> \
@subgroups,
822 sub create_non_existing_group_and_subgroup
{
823 my ($input, $group, $subgroup) = @_;
825 if (defined $group and $group ne '') {
826 my $report_groups = C4
::Reports
::Guided
::get_report_groups
;
827 if (not exists $report_groups->{$group}) {
828 my $groupdesc = $input->param('groupdesc') // $group;
829 C4
::Koha
::AddAuthorisedValue
('REPORT_GROUP', $group, $groupdesc);
831 if (defined $subgroup and $subgroup ne '') {
832 if (not exists $report_groups->{$group}->{subgroups
}->{$subgroup}) {
833 my $subgroupdesc = $input->param('subgroupdesc') // $subgroup;
834 C4
::Koha
::AddAuthorisedValue
('REPORT_SUBGROUP', $subgroup, $subgroupdesc, $group);