help.pl - bugfix module usage (HTML::Template::Pro)
[koha.git] / C4 / Reports.pm
1 package C4::Reports;
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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA  02111-1307 USA
19
20 use strict;
21 use CGI;
22
23 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
24 use C4::Context;
25 use C4::Output;
26 use XML::Simple;
27 use XML::Dumper;
28 # use Smart::Comments;
29 # use Data::Dumper;
30
31 BEGIN {
32         # set the version for version checking
33         $VERSION = 0.12;
34         require Exporter;
35         @ISA = qw(Exporter);
36         @EXPORT = qw(
37                 get_report_types get_report_areas get_columns build_query get_criteria
38                 save_report get_saved_reports execute_query get_saved_report create_compound run_compound
39                 get_column_type get_distinct_values save_dictionary get_from_dictionary
40                 delete_definition delete_report format_results get_sql
41         );
42 }
43
44 our %table_areas;
45 $table_areas{'1'} =
46   [ 'borrowers', 'statistics','items', 'biblioitems' ];    # circulation
47 $table_areas{'2'} = [ 'items', 'biblioitems', 'biblio' ];   # catalogue
48 $table_areas{'3'} = [ 'borrowers' ];        # patrons
49 $table_areas{'4'} = ['aqorders', 'biblio', 'items'];        # acquisitions
50 $table_areas{'5'} = [ 'borrowers', 'accountlines' ];        # accounts
51 our %keys;
52 $keys{'1'} = [
53     'statistics.borrowernumber=borrowers.borrowernumber',
54     'items.itemnumber = statistics.itemnumber',
55     'biblioitems.biblioitemnumber = items.biblioitemnumber'
56 ];
57 $keys{'2'} = [
58     'items.biblioitemnumber=biblioitems.biblioitemnumber',
59     'biblioitems.biblionumber=biblio.biblionumber'
60 ];
61 $keys{'3'} = [ ];
62 $keys{'4'} = [
63         'aqorders.biblionumber=biblio.biblionumber',
64         'biblio.biblionumber=items.biblionumber'
65 ];
66 $keys{'5'} = ['borrowers.borrowernumber=accountlines.borrowernumber'];
67
68 # have to do someting here to know if its dropdown, free text, date etc
69
70 our %criteria;
71 $criteria{'1'} = [
72     'statistics.type',   'borrowers.categorycode',
73     'statistics.branch', 'biblioitems.itemtype',
74     'biblioitems.publicationyear|date',
75     'items.dateaccessioned|date'
76 ];
77 $criteria{'2'} =
78   [ 'biblioitems.itemtype', 'items.holdingbranch', 'items.homebranch' ,'items.itemlost'];
79 $criteria{'3'} = ['borrowers.branchcode'];
80 $criteria{'4'} = ['aqorders.datereceived|date'];
81 $criteria{'5'} = ['borrowers.branchcode'];
82
83 our %columns;
84 my $columns_def_file = "columns.def";
85 my $htdocs = C4::Context->config('intrahtdocs');                       
86 my $section='intranet';
87 my $cgi = new CGI;
88 my ($theme, $lang) = themelanguage($htdocs, $columns_def_file, $section,$cgi);
89
90 my $full_path_to_columns_def_file="$htdocs/$theme/$lang/$columns_def_file";    
91 open (COLUMNS,$full_path_to_columns_def_file);
92 while (my $input = <COLUMNS>){
93         my @row =split(/\t/,$input);
94         $columns{$row[0]}=$row[1];
95 }
96
97 close COLUMNS;
98
99 =head1 NAME
100    
101 C4::Reports - Module for generating reports 
102
103 =head1 SYNOPSIS
104
105   use C4::Reports;
106
107 =head1 DESCRIPTION
108
109
110 =head1 METHODS
111
112 =over 2
113
114 =cut
115
116 =item get_report_types()
117
118 This will return a list of all the available report types
119
120 =cut
121
122 sub get_report_types {
123     my $dbh = C4::Context->dbh();
124
125     # FIXME these should be in the database perhaps
126     my @reports = ( 'Tabular', 'Summary', 'Matrix' );
127     my @reports2;
128     for ( my $i = 0 ; $i < 3 ; $i++ ) {
129         my %hashrep;
130         $hashrep{id}   = $i + 1;
131         $hashrep{name} = $reports[$i];
132         push @reports2, \%hashrep;
133     }
134     return ( \@reports2 );
135
136 }
137
138 =item get_report_areas()
139
140 This will return a list of all the available report areas
141
142 =cut
143
144 sub get_report_areas {
145     my $dbh = C4::Context->dbh();
146
147     # FIXME these should be in the database
148     my @reports = ( 'Circulation', 'Catalog', 'Patrons', 'Acquisitions', 'Accounts');
149     my @reports2;
150     for ( my $i = 0 ; $i < 5 ; $i++ ) {
151         my %hashrep;
152         $hashrep{id}   = $i + 1;
153         $hashrep{name} = $reports[$i];
154         push @reports2, \%hashrep;
155     }
156     return ( \@reports2 );
157
158 }
159
160 =item get_all_tables()
161
162 This will return a list of all tables in the database 
163
164 =cut
165
166 sub get_all_tables {
167     my $dbh   = C4::Context->dbh();
168     my $query = "SHOW TABLES";
169     my $sth   = $dbh->prepare($query);
170     $sth->execute();
171     my @tables;
172     while ( my $data = $sth->fetchrow_arrayref() ) {
173         push @tables, $data->[0];
174     }
175     $sth->finish();
176     return ( \@tables );
177
178 }
179
180 =item get_columns($area)
181
182 This will return a list of all columns for a report area
183
184 =cut
185
186 sub get_columns {
187
188     # this calls the internal fucntion _get_columns
189     my ($area) = @_;
190     my $tables = $table_areas{$area};
191     my @allcolumns;
192     foreach my $table (@$tables) {
193         my @columns = _get_columns($table);
194         push @allcolumns, @columns;
195     }
196     return ( \@allcolumns );
197 }
198
199 sub _get_columns {
200     my ($tablename) = @_;
201     my $dbh         = C4::Context->dbh();
202     my $sth         = $dbh->prepare("show columns from $tablename");
203     $sth->execute();
204     my @columns;
205         my %tablehash;
206         $tablehash{'table'}=$tablename;
207         push @columns, \%tablehash;
208     while ( my $data = $sth->fetchrow_arrayref() ) {
209         my %temphash;
210         $temphash{'name'}        = "$tablename.$data->[0]";
211         $temphash{'description'} = $columns{"$tablename.$data->[0]"};
212         push @columns, \%temphash;
213     }
214     $sth->finish();
215     return (@columns);
216 }
217
218 =item build_query($columns,$criteria,$orderby,$area)
219
220 This will build the sql needed to return the results asked for, 
221 $columns is expected to be of the format tablename.columnname.
222 This is what get_columns returns.
223
224 =cut
225
226 sub build_query {
227     my ( $columns, $criteria, $orderby, $area, $totals, $definition ) = @_;
228 ### $orderby
229     my $keys   = $keys{$area};
230     my $tables = $table_areas{$area};
231
232     my $sql =
233       _build_query( $tables, $columns, $criteria, $keys, $orderby, $totals, $definition );
234     return ($sql);
235 }
236
237 sub _build_query {
238     my ( $tables, $columns, $criteria, $keys, $orderby, $totals, $definition) = @_;
239 ### $orderby
240     # $keys is an array of joining constraints
241     my $dbh           = C4::Context->dbh();
242     my $joinedtables  = join( ',', @$tables );
243     my $joinedcolumns = join( ',', @$columns );
244     my $joinedkeys    = join( ' AND ', @$keys );
245     my $query =
246       "SELECT $totals $joinedcolumns FROM $tables->[0] ";
247         for (my $i=1;$i<@$tables;$i++){
248                 $query .= "LEFT JOIN $tables->[$i] on ($keys->[$i-1]) ";
249         }
250
251     if ($criteria) {
252                 $criteria =~ s/AND/WHERE/;
253         $query .= " $criteria";
254     }
255         if ($definition){
256                 my @definitions = split(',',$definition);
257                 my $deftext;
258                 foreach my $def (@definitions){
259                         my $defin=get_from_dictionary('',$def);
260                         $deftext .=" ".$defin->[0]->{'saved_sql'};
261                 }
262                 if ($query =~ /WHERE/i){
263                         $query .= $deftext;
264                 }
265                 else {
266                         $deftext  =~ s/AND/WHERE/;
267                         $query .= $deftext;                     
268                 }
269         }
270     if ($totals) {
271         my $groupby;
272         my @totcolumns = split( ',', $totals );
273         foreach my $total (@totcolumns) {
274             if ( $total =~ /\((.*)\)/ ) {
275                 if ( $groupby eq '' ) {
276                     $groupby = " GROUP BY $1";
277                 }
278                 else {
279                     $groupby .= ",$1";
280                 }
281             }
282         }
283         $query .= $groupby;
284     }
285     if ($orderby) {
286         $query .= $orderby;
287     }
288     return ($query);
289 }
290
291 =item get_criteria($area);
292
293 Returns an arraref to hashrefs suitable for using in a tmpl_loop. With the criteria and available values.
294
295 =cut
296
297 sub get_criteria {
298     my ($area) = @_;
299     my $dbh    = C4::Context->dbh();
300     my $crit   = $criteria{$area};
301     my @criteria_array;
302     foreach my $localcrit (@$crit) {
303         my ( $value, $type )   = split( /\|/, $localcrit );
304         my ( $table, $column ) = split( /\./, $value );
305         if ( $type eq 'date' ) {
306                         my %temp;
307             $temp{'name'}   = $value;
308             $temp{'date'}   = 1;
309                         $temp{'description'} = $columns{$value};
310             push @criteria_array, \%temp;
311         }
312         else {
313
314             my $query =
315               "SELECT distinct($column) as availablevalues FROM $table";
316             my $sth = $dbh->prepare($query);
317             $sth->execute();
318             my @values;
319             while ( my $row = $sth->fetchrow_hashref() ) {
320                 push @values, $row;
321                 ### $row;
322             }
323             $sth->finish();
324             my %temp;
325             $temp{'name'}   = $value;
326                         $temp{'description'} = $columns{$value};
327             $temp{'values'} = \@values;
328             push @criteria_array, \%temp;
329         }
330     }
331     return ( \@criteria_array );
332 }
333
334 sub execute_query {
335     my ( $sql, $type, $format, $id ) = @_;
336     my $dbh = C4::Context->dbh();
337
338     # take this line out when in production
339         if ($format eq 'url'){
340                 }
341         else {
342                 $sql .= " LIMIT 10";
343         }
344     my $sth = $dbh->prepare($sql);
345     $sth->execute();
346         my $colnames=$sth->{'NAME'};
347         my @results;
348         my $row;
349         my %temphash;
350         $row = join ('</th><th>',@$colnames);
351         $row = "<tr><th>$row</th></tr>";
352         $temphash{'row'} = $row;
353         push @results, \%temphash;
354     my $string;
355         my @xmlarray;
356     while ( my @data = $sth->fetchrow_array() ) {
357
358             # tabular
359             my %temphash;
360             my $row = join( '</td><td>', @data );
361             $row = "<tr><td>$row</td></tr>";
362             $temphash{'row'} = $row;
363             if ( $format eq 'text' ) {
364                 $string .= "\n" . $row;
365             }
366                         if ($format eq 'tab' ){
367                                 $row = join("\t",@data);
368                                 $string .="\n" . $row;
369                         }
370                         if ($format eq 'csv' ){
371                                 $row = join(",",@data);
372                                 $string .="\n" . $row;
373                         }
374                 if ($format eq 'url'){
375                         my $temphash;
376                         @$temphash{@$colnames}=@data;
377                         push @xmlarray,$temphash;
378                 }
379             push @results, \%temphash;
380 #        }
381     }
382     $sth->finish();
383     if ( $format eq 'text' || $format eq 'tab' || $format eq 'csv' ) {
384         return $string;
385     }
386         elsif ($format eq 'url') {
387                 my $url = "/cgi-bin/koha/reports/guided_reports.pl?phase=retrieve%20results&id=$id";
388                 my $dump = new XML::Dumper;
389                 my $xml = $dump->pl2xml( \@xmlarray );
390                 store_results($id,$xml);
391                 return $url;
392         }
393     else {
394         return ( \@results );
395     }
396 }
397
398 =item save_report($sql,$name,$type,$notes)
399
400 Given some sql and a name this will saved it so that it can resued
401
402 =cut
403
404 sub save_report {
405     my ( $sql, $name, $type, $notes ) = @_;
406     my $dbh = C4::Context->dbh();
407     my $query =
408 "INSERT INTO saved_sql (borrowernumber,date_created,last_modified,savedsql,report_name,type,notes)  VALUES (?,now(),now(),?,?,?,?)";
409     my $sth = $dbh->prepare($query);
410     $sth->execute( 0, $sql, $name, $type, $notes );
411     $sth->finish();
412
413 }
414
415 sub store_results {
416         my ($id,$xml)=@_;
417         my $dbh = C4::Context->dbh();
418         my $query = "SELECT * FROM saved_reports WHERE report_id=?";
419         my $sth = $dbh->prepare($query);
420         $sth->execute($id);
421         if (my $data=$sth->fetchrow_hashref()){
422                 my $query2 = "UPDATE saved_reports SET report=?,date_run=now() WHERE report_id=?";
423                 my $sth2 = $dbh->prepare($query2);
424             $sth2->execute($xml,$id);
425                 $sth2->finish();
426         }
427         else {
428                 my $query2 = "INSERT INTO saved_reports (report_id,report,date_run) VALUES (?,?,now())";
429                 my $sth2 = $dbh->prepare($query2);
430                 $sth2->execute($id,$xml);
431                 $sth2->finish();
432         }
433         $sth->finish();
434 }
435
436 sub format_results {
437         my ($id) = @_;
438         my $dbh = C4::Context->dbh();
439         my $query = "SELECT * FROM saved_reports WHERE report_id = ?";
440         my $sth = $dbh->prepare($query);
441         $sth->execute($id);
442         my $data = $sth->fetchrow_hashref();
443         my $dump = new XML::Dumper;
444         my $perl = $dump->xml2pl( $data->{'report'} );
445         foreach my $row (@$perl) {
446                 my $htmlrow="<tr>";
447                 foreach my $key (keys %$row){
448                         $htmlrow .= "<td>$row->{$key}</td>";
449                 }
450                 $htmlrow .= "</tr>";
451                 $row->{'row'} = $htmlrow;
452         }
453         $sth->finish;
454         $query = "SELECT * FROM saved_sql WHERE id = ?";
455         $sth = $dbh->prepare($query);
456         $sth->execute($id);
457         $data = $sth->fetchrow_hashref();
458     $sth->finish();
459         return ($perl,$data->{'report_name'},$data->{'notes'}); 
460 }       
461
462 sub delete_report {
463         my ( $id ) = @_;
464         my $dbh = C4::Context->dbh();
465         my $query = "DELETE FROM saved_sql WHERE id = ?";
466         my $sth = $dbh->prepare($query);
467         $sth->execute($id);
468         $sth->finish();
469 }       
470
471 sub get_saved_reports {
472     my $dbh   = C4::Context->dbh();
473     my $query = "SELECT *,saved_sql.id AS id FROM saved_sql 
474     LEFT JOIN saved_reports ON saved_reports.report_id = saved_sql.id
475     ORDER by date_created";
476     my $sth   = $dbh->prepare($query);
477     $sth->execute();
478     my @reports;
479     while ( my $data = $sth->fetchrow_hashref() ) {
480         push @reports, $data;
481     }
482     $sth->finish();
483     return ( \@reports );
484 }
485
486 sub get_saved_report {
487     my ($id)  = @_;
488     my $dbh   = C4::Context->dbh();
489     my $query = " SELECT * FROM saved_sql WHERE id = ?";
490     my $sth   = $dbh->prepare($query);
491     $sth->execute($id);
492     my $data = $sth->fetchrow_hashref();
493     $sth->finish();
494     return ( $data->{'savedsql'}, $data->{'type'}, $data->{'report_name'}, $data->{'notes'} );
495 }
496
497 =item create_compound($masterID,$subreportID)
498
499 This will take 2 reports and create a compound report using both of them
500
501 =cut
502
503 sub create_compound {
504         my ($masterID,$subreportID) = @_;
505         my $dbh = C4::Context->dbh();
506         # get the reports
507         my ($mastersql,$mastertype) = get_saved_report($masterID);
508         my ($subsql,$subtype) = get_saved_report($subreportID);
509         
510         # now we have to do some checking to see how these two will fit together
511         # or if they will
512         my ($mastertables,$subtables);
513         if ($mastersql =~ / from (.*) where /i){ 
514                 $mastertables = $1;
515         }
516         if ($subsql =~ / from (.*) where /i){
517                 $subtables = $1;
518         }
519         return ($mastertables,$subtables);
520 }
521
522 =item get_column_type($column)
523
524 This takes a column name of the format table.column and will return what type it is
525 (free text, set values, date)
526
527 =cut
528
529 sub get_column_type {
530         my ($tablecolumn) = @_;
531         my ($table,$column) = split(/\./,$tablecolumn);
532         my $dbh = C4::Context->dbh();
533         my $catalog;
534         my $schema;
535
536         # mysql doesnt support a column selection, set column to %
537         my $tempcolumn='%';
538         my $sth = $dbh->column_info( $catalog, $schema, $table, $tempcolumn ) || die $dbh->errstr;
539         while (my $info = $sth->fetchrow_hashref()){
540                 if ($info->{'COLUMN_NAME'} eq $column){
541                         #column we want
542                         if ($info->{'TYPE_NAME'} eq 'CHAR' || $info->{'TYPE_NAME'} eq 'VARCHAR'){
543                                 $info->{'TYPE_NAME'} = 'distinct';
544                         }
545                         return $info->{'TYPE_NAME'};            
546                 }
547         }
548         $sth->finish();
549 }
550
551 =item get_distinct_values($column)
552
553 Given a column name, return an arrary ref of hashrefs suitable for use as a tmpl_loop 
554 with the distinct values of the column
555
556 =cut
557
558 sub get_distinct_values {
559         my ($tablecolumn) = @_;
560         my ($table,$column) = split(/\./,$tablecolumn);
561         my $dbh = C4::Context->dbh();
562         my $query =
563           "SELECT distinct($column) as availablevalues FROM $table";
564         my $sth = $dbh->prepare($query);
565         $sth->execute();
566         my @values;
567         while ( my $row = $sth->fetchrow_hashref() ) {
568                 push @values, $row;
569         }
570         $sth->finish();
571         return \@values;
572 }       
573
574 sub save_dictionary {
575         my ($name,$description,$sql,$area) = @_;
576         my $dbh = C4::Context->dbh();
577         my $query = "INSERT INTO reports_dictionary (name,description,saved_sql,area,date_created,date_modified)
578   VALUES (?,?,?,?,now(),now())";
579     my $sth = $dbh->prepare($query);
580     $sth->execute($name,$description,$sql,$area) || return 0;
581     $sth->finish();
582     return 1;
583 }
584
585 sub get_from_dictionary {
586         my ($area,$id) = @_;
587         my $dbh = C4::Context->dbh();
588         my $query = "SELECT * FROM reports_dictionary";
589         if ($area){
590                 $query.= " WHERE area = ?";
591         }
592         elsif ($id){
593                 $query.= " WHERE id = ?"
594         }
595         my $sth = $dbh->prepare($query);
596         if ($id){
597                 $sth->execute($id);
598         }
599         elsif ($area) {
600                 $sth->execute($area);
601         }
602         else {
603                 $sth->execute();
604         }
605         my @loop;
606         while (my $data = $sth->fetchrow_hashref()){
607                 push @loop,$data;
608                 
609                 }
610         $sth->finish();
611         return (\@loop);
612 }
613
614 sub delete_definition {
615         my ($id) = @_;
616         my $dbh = C4::Context->dbh();
617         my $query = "DELETE FROM reports_dictionary WHERE id = ?";
618         my $sth = $dbh->prepare($query);
619         $sth->execute($id);
620         $sth->finish();
621 }
622
623 sub get_sql {
624         my ($id) = @_;
625         my $dbh = C4::Context->dbh();
626         my $query = "SELECT * FROM saved_sql WHERE id = ?";
627         my $sth = $dbh->prepare($query);
628         $sth->execute($id);
629         my $data=$sth->fetchrow_hashref();
630         $sth->finish(); 
631         return $data->{'savedsql'};
632 }
633
634 1;
635 __END__
636
637 =head1 AUTHOR
638
639 Chris Cormack <crc@liblime.com>
640
641 =cut