# 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;
@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 update_sql
# 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';
}
=head1 NAME
-
+
C4::Reports::Guided - Module for generating guided reports
=head1 SYNOPSIS
=head1 DESCRIPTION
+=cut
=head1 METHODS
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++){
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
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 ($;$$$) {
$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 ?, ?";
=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() WHERE id = ? ";
+ my $query = "UPDATE saved_sql SET savedsql = ?, last_modified = now(), report_name = ?, notes = ? WHERE id = ? ";
my $sth = $dbh->prepare($query);
- $sth->execute( $sql, $id );
+ $sth->execute( $sql, $reportname, $notes, $id );
$sth->finish();
}
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 {