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