Bug 5385: POD Cleanups (part 1)
[koha_gimpoz] / C4 / Reports / Guided.pm
index 669b3eb..22ee977 100644 (file)
@@ -13,17 +13,18 @@ package C4::Reports::Guided;
 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA  02111-1307 USA
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 use strict;
-# use warnings;  # FIXME: this module needs a lot of repair to run clean under warnings
+#use warnings; FIXME - Bug 2505 this module needs a lot of repair to run clean under warnings
 use CGI;
 use Carp;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
 use C4::Context;
+use C4::Dates qw/format_date/;
 use C4::Output;
 use C4::Dates;
 use XML::Simple;
@@ -39,10 +40,10 @@ BEGIN {
        @ISA = qw(Exporter);
        @EXPORT = qw(
                get_report_types get_report_areas get_columns build_query get_criteria
-               save_report get_saved_reports execute_query get_saved_report create_compound run_compound
+           save_report get_saved_reports execute_query get_saved_report create_compound run_compound
                get_column_type get_distinct_values save_dictionary get_from_dictionary
                delete_definition delete_report format_results get_sql
-        select_2_select_count_value
+        select_2_select_count_value update_sql
        );
 }
 
@@ -73,18 +74,29 @@ $keys{'5'} = ['borrowers.borrowernumber=accountlines.borrowernumber'];
 # have to do someting here to know if its dropdown, free text, date etc
 
 our %criteria;
+# reports on circulation
 $criteria{'1'} = [
     'statistics.type',   'borrowers.categorycode',
     'statistics.branch',
     'biblioitems.publicationyear|date',
     'items.dateaccessioned|date'
 ];
+# reports on catalogue
 $criteria{'2'} =
-  [ 'items.holdingbranch', 'items.homebranch' ,'items.itemlost', 'items.location', 'items.ccode'];
-$criteria{'3'} = ['borrowers.branchcode'];
+  [ 'items.itemnumber|textrange',   'items.biblionumber|textrange',   'items.barcode|textrange', 
+    'biblio.frameworkcode',         'items.holdingbranch',            'items.homebranch', 
+  'biblio.datecreated|daterange',   'biblio.timestamp|daterange',     'items.onloan|daterange', 
+  'items.ccode',                    'items.itemcallnumber|textrange', 'items.itype', 
+  'items.itemlost',                 'items.location' ];
+# reports on borrowers
+$criteria{'3'} = ['borrowers.branchcode', 'borrowers.categorycode'];
+# reports on acquisition
 $criteria{'4'} = ['aqorders.datereceived|date'];
-$criteria{'5'} = ['borrowers.branchcode'];
 
+# reports on accounting
+$criteria{'5'} = ['borrowers.branchcode', 'borrowers.categorycode'];
+
+# Adds itemtypes to criteria, according to the syspref
 if (C4::Context->preference('item-level_itypes')) {
     unshift @{ $criteria{'1'} }, 'items.itype';
     unshift @{ $criteria{'2'} }, 'items.itype';
@@ -94,7 +106,7 @@ if (C4::Context->preference('item-level_itypes')) {
 }
 
 =head1 NAME
-   
+
 C4::Reports::Guided - Module for generating guided reports 
 
 =head1 SYNOPSIS
@@ -103,6 +115,7 @@ C4::Reports::Guided - Module for generating guided reports
 
 =head1 DESCRIPTION
 
+=cut
 
 =head1 METHODS
 
@@ -242,7 +255,6 @@ sub _build_query {
     my $dbh           = C4::Context->dbh();
     my $joinedtables  = join( ',', @$tables );
     my $joinedcolumns = join( ',', @$columns );
-    my $joinedkeys    = join( ' AND ', @$keys );
     my $query =
       "SELECT $totals $joinedcolumns FROM $tables->[0] ";
        for (my $i=1;$i<@$tables;$i++){
@@ -299,61 +311,86 @@ sub get_criteria {
     my ($area,$cgi) = @_;
     my $dbh    = C4::Context->dbh();
     my $crit   = $criteria{$area};
-       my $column_defs = _get_column_defs($cgi);
+    my $column_defs = _get_column_defs($cgi);
     my @criteria_array;
     foreach my $localcrit (@$crit) {
         my ( $value, $type )   = split( /\|/, $localcrit );
         my ( $table, $column ) = split( /\./, $value );
-        if ( $type eq 'date' ) {
-                       my %temp;
-            $temp{'name'}   = $value;
-            $temp{'date'}   = 1;
-                       $temp{'description'} = $column_defs->{$value};
+        if ($type eq 'textrange') {
+            my %temp;
+            $temp{'name'}        = $value;
+            $temp{'from'}        = "from_" . $value;
+            $temp{'to'}          = "to_" . $value;
+            $temp{'textrange'}   = 1;
+            $temp{'description'} = $column_defs->{$value};
+            push @criteria_array, \%temp;
+        }
+        elsif ($type eq 'date') {
+            my %temp;
+            $temp{'name'}        = $value;
+            $temp{'date'}        = 1;
+            $temp{'description'} = $column_defs->{$value};
+            push @criteria_array, \%temp;
+        }
+        elsif ($type eq 'daterange') {
+            my %temp;
+            $temp{'name'}        = $value;
+            $temp{'from'}        = "from_" . $value;
+            $temp{'to'}          = "to_" . $value;
+            $temp{'daterange'}   = 1;
+            $temp{'description'} = $column_defs->{$value};
             push @criteria_array, \%temp;
         }
         else {
-
             my $query =
-              "SELECT distinct($column) as availablevalues FROM $table";
+            "SELECT distinct($column) as availablevalues FROM $table";
             my $sth = $dbh->prepare($query);
             $sth->execute();
             my @values;
+            # push the runtime choosing option
+            my $list;
+            $list='branches' if $column eq 'branchcode' or $column eq 'holdingbranch' or $column eq 'homebranch';
+            $list='categorycode' if $column eq 'categorycode';
+            $list='itemtype' if $column eq 'itype';
+            $list='ccode' if $column eq 'ccode';
+            # TODO : improve to let the librarian choose the description at runtime
+            push @values, { availablevalues => "<<$column".($list?"|$list":'').">>" };
             while ( my $row = $sth->fetchrow_hashref() ) {
                 push @values, $row;
-                ### $row;
+                if ($row->{'availablevalues'} eq '') { $row->{'default'} = 1 };
             }
             $sth->finish();
+
             my %temp;
-            $temp{'name'}   = $value;
-                       $temp{'description'} = $column_defs->{$value};
-            $temp{'values'} = \@values;
+            $temp{'name'}        = $value;
+            $temp{'description'} = $column_defs->{$value};
+            $temp{'values'}      = \@values;
+
             push @criteria_array, \%temp;
         }
+
     }
     return ( \@criteria_array );
 }
 
 =item execute_query
 
-=over
+  ($results, $total, $error) = execute_query($sql, $offset, $limit)
 
-($results, $total, $error) = execute_query($sql, $offset, $limit)
 
-=back
+When passed C<$sql>, this function returns an array ref containing a result set
+suitably formatted for display in html or for output as a flat file when passed in
+C<$format> and C<$id>. It also returns the C<$total> records available for the
+supplied query. If passed any query other than a SELECT, or if there is a db error,
+C<$errors> an array ref is returned containing the error after this manner:
 
-    When passed C<$sql>, this function returns an array ref containing a result set
-    suitably formatted for display in html or for output as a flat file when passed in
-    C<$format> and C<$id>. It also returns the C<$total> records available for the
-    supplied query. If passed any query other than a SELECT, or if there is a db error,
-    C<$errors> an array ref is returned containing the error after this manner:
+C<$error->{'sqlerr'}> contains the offending SQL keyword.
+C<$error->{'queryerr'}> contains the native db engine error returned for the query.
 
-    C<$error->{'sqlerr'}> contains the offending SQL keyword.
-    C<$error->{'queryerr'}> contains the native db engine error returned for the query.
-    
-    Valid values for C<$format> are 'text,' 'tab,' 'csv,' or 'url. C<$sql>, C<$type>,
-    C<$offset>, and C<$limit> are required parameters. If a valid C<$format> is passed
-    in, C<$offset> and C<$limit> are ignored for obvious reasons. A LIMIT specified by
-    the user in a user-supplied SQL query WILL apply in any case.
+Valid values for C<$format> are 'text,' 'tab,' 'csv,' or 'url. C<$sql>, C<$type>,
+C<$offset>, and C<$limit> are required parameters. If a valid C<$format> is passed
+in, C<$offset> and C<$limit> are ignored for obvious reasons. A LIMIT specified by
+the user in a user-supplied SQL query WILL apply in any case.
 
 =cut
 
@@ -381,8 +418,8 @@ sub select_2_select_count ($) {
 sub strip_limit ($) {
     my $sql = shift or return;
     ($sql =~ /\bLIMIT\b/i) or return ($sql, 0, undef);
-    $sql =~ s/\bLIMIT\b\s*\d+(\,\s*\d+)?\s*/ /ig;
-    return ($sql, (defined $1 ? $1 : 0), $2);   # offset can default to 0, LIMIT cannot!
+    $sql =~ s/\bLIMIT\b\s*(\d+)(\s*\,\s*(\d+))?\s*/ /ig;
+    return ($sql, (defined $2 ? $1 : 0), (defined $3 ? $3 : $1));   # offset can default to 0, LIMIT cannot!
 }
 
 sub execute_query ($;$$$) {
@@ -411,13 +448,12 @@ sub execute_query ($;$$$) {
         $useroffset,
         (defined($userlimit ) ? $userlimit  : 'UNDEF');
     $offset += $useroffset;
-    my $total;
     if (defined($userlimit)) {
         if ($offset + $limit > $userlimit ) {
             $limit = $userlimit - $offset;
+        } elsif ( ! $offset && $limit < $userlimit ) {
+            $limit = $userlimit;
         }
-        $total = $userlimit if $userlimit < $total;     # we will never exceed a user defined LIMIT and...
-        $userlimit = $total if $userlimit > $total;     # we will never exceed the total number of records available to satisfy the query
     }
     $sql .= " LIMIT ?, ?";
 
@@ -437,13 +473,26 @@ Given some sql and a name this will saved it so that it can resued
 =cut
 
 sub save_report {
-    my ( $sql, $name, $type, $notes ) = @_;
+    my ( $borrowernumber, $sql, $name, $type, $notes ) = @_;
     my $dbh = C4::Context->dbh();
     $sql =~ s/(\s*\;\s*)$//; # removes trailing whitespace and /;/
     my $query =
 "INSERT INTO saved_sql (borrowernumber,date_created,last_modified,savedsql,report_name,type,notes)  VALUES (?,now(),now(),?,?,?,?)";
     my $sth = $dbh->prepare($query);
-    $sth->execute( 0, $sql, $name, $type, $notes );
+    $sth->execute( $borrowernumber, $sql, $name, $type, $notes );
+}
+
+sub update_sql {
+    my $id = shift || croak "No Id given";
+    my $sql = shift;
+    my $reportname = shift;
+    my $notes = shift;
+    my $dbh = C4::Context->dbh();
+    $sql =~ s/(\s*\;\s*)$//; # removes trailing whitespace and /;/
+    my $query = "UPDATE saved_sql SET savedsql = ?, last_modified = now(), report_name = ?, notes = ? WHERE id = ? ";
+    my $sth = $dbh->prepare($query);
+    $sth->execute( $sql, $reportname, $notes, $id );
+    $sth->finish();
 }
 
 sub store_results {
@@ -504,7 +553,16 @@ sub get_saved_reports {
     ORDER by date_created";
     my $sth   = $dbh->prepare($query);
     $sth->execute();
-    return $sth->fetchall_arrayref({});
+    
+    my $result = $sth->fetchall_arrayref({});
+    foreach (@$result){
+        $_->{date_created} = format_date($_->{date_created}); 
+        
+        my $member = C4::Members::GetMember(borrowernumber=>$_->{borrowernumber});
+        $_->{borrowerfirstname} = $member->{firstname};
+        $_->{borrowersurname}   = $member->{surname};
+    }
+    return $result;
 }
 
 sub get_saved_report {