[Koha-cvs] koha/reports acquisitions_stats.pl bor_issues_t...
paul poulain
paul at koha-fr.org
Fri Mar 9 16:13:36 CET 2007
CVSROOT: /sources/koha
Module name: koha
Changes by: paul poulain <tipaul> 07/03/09 15:13:36
Modified files:
reports : acquisitions_stats.pl bor_issues_top.pl
borrowers_out.pl borrowers_stats.pl
cat_issues_top.pl catalogue_out.pl
catalogue_stats.pl inventory.pl
issues_avg_stats.pl
issues_by_borrower_category.plugin
issues_stats.pl itemtypes.plugin manager.pl
reports-home.pl reservereport.pl stats.print.pl
stats.screen.pl
Log message:
rel_3_0 moved to HEAD
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/reports/acquisitions_stats.pl?cvsroot=koha&r1=1.12&r2=1.13
http://cvs.savannah.gnu.org/viewcvs/koha/reports/bor_issues_top.pl?cvsroot=koha&r1=1.9&r2=1.10
http://cvs.savannah.gnu.org/viewcvs/koha/reports/borrowers_out.pl?cvsroot=koha&r1=1.7&r2=1.8
http://cvs.savannah.gnu.org/viewcvs/koha/reports/borrowers_stats.pl?cvsroot=koha&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/koha/reports/cat_issues_top.pl?cvsroot=koha&r1=1.11&r2=1.12
http://cvs.savannah.gnu.org/viewcvs/koha/reports/catalogue_out.pl?cvsroot=koha&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/koha/reports/catalogue_stats.pl?cvsroot=koha&r1=1.18&r2=1.19
http://cvs.savannah.gnu.org/viewcvs/koha/reports/inventory.pl?cvsroot=koha&r1=1.3&r2=1.4
http://cvs.savannah.gnu.org/viewcvs/koha/reports/issues_avg_stats.pl?cvsroot=koha&r1=1.6&r2=1.7
http://cvs.savannah.gnu.org/viewcvs/koha/reports/issues_by_borrower_category.plugin?cvsroot=koha&r1=1.5&r2=1.6
http://cvs.savannah.gnu.org/viewcvs/koha/reports/issues_stats.pl?cvsroot=koha&r1=1.14&r2=1.15
http://cvs.savannah.gnu.org/viewcvs/koha/reports/itemtypes.plugin?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/reports/manager.pl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/reports/reports-home.pl?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/reports/reservereport.pl?cvsroot=koha&r1=1.10&r2=1.11
http://cvs.savannah.gnu.org/viewcvs/koha/reports/stats.print.pl?cvsroot=koha&r1=1.2&r2=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/reports/stats.screen.pl?cvsroot=koha&r1=1.2&r2=1.3
Patches:
Index: acquisitions_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/acquisitions_stats.pl,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -b -r1.12 -r1.13
--- acquisitions_stats.pl 11 Sep 2006 17:41:55 -0000 1.12
+++ acquisitions_stats.pl 9 Mar 2007 15:13:36 -0000 1.13
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: acquisitions_stats.pl,v 1.12 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: acquisitions_stats.pl,v 1.13 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -19,11 +19,14 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# test comment
+
use strict;
use C4::Auth;
use CGI;
use C4::Context;
-use C4::Search;
+
+use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2;
@@ -40,160 +43,226 @@
=cut
my $input = new CGI;
-my $do_it=$input->param('do_it');
+my $do_it = $input->param('do_it');
my $fullreportname = "reports/acquisitions_stats.tmpl";
my $line = $input->param("Line");
my $column = $input->param("Column");
my @filters = $input->param("Filter");
my $podsp = $input->param("PlacedOnDisplay");
my $rodsp = $input->param("ReceivedOnDisplay");
+my $aodsp = $input->param("AcquiredOnDisplay"); ##added by mason.
my $calc = $input->param("Cellvalue");
my $output = $input->param("output");
my $basename = $input->param("basename");
my $mime = $input->param("MIME");
my $del = $input->param("sep");
+
#warn "calcul : ".$calc;
my ($template, $borrowernumber, $cookie)
= get_template_and_user({template_name => $fullreportname,
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
-$template->param(do_it => $do_it);
+$template->param(do_it => $do_it,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
if ($do_it) {
- my $results = calculate($line, $column, $podsp, $rodsp, $calc, \@filters);
- if ($output eq "screen"){
- $template->param(mainloop => $results);
+
+ #warn
+"line=$line, col=$column, pod=$podsp, rod=$rodsp, aod=$aodsp, calc=$calc, filters=@filters\n";
+
+ my $results =
+ calculate( $line, $column, $podsp, $rodsp, $aodsp, $calc, \@filters );
+ if ( $output eq "screen" ) {
+ $template->param( mainloop => $results );
output_html_with_http_headers $input, $cookie, $template->output;
exit(1);
- } else {
- print $input->header(-type => 'application/vnd.sun.xml.calc',
- -attachment=>"$basename.csv",
- -name=>"$basename.csv" );
+ }
+ else {
+ print $input->header(
+ -type => 'application/vnd.sun.xml.calc',
+ -encoding => 'utf-8',
+ -attachment => "$basename.csv",
+ -name => "$basename.csv"
+ );
my $cols = @$results[0]->{loopcol};
my $lines = @$results[0]->{looprow};
my $sep;
- $sep =C4::Context->preference("delimiter");
- print @$results[0]->{line} ."/". @$results[0]->{column} .$sep;
- foreach my $col ( @$cols ) {
- print $col->{coltitle}.$sep;
+ $sep = C4::Context->preference("delimiter");
+ print @$results[0]->{line} . "/" . @$results[0]->{column} . $sep;
+ foreach my $col (@$cols) {
+ print $col->{coltitle} . $sep;
}
print "Total\n";
- foreach my $line ( @$lines ) {
+ foreach my $line (@$lines) {
my $x = $line->{loopcell};
- print $line->{rowtitle}.$sep;
+ print $line->{rowtitle} . $sep;
foreach my $cell (@$x) {
- print $cell->{value}.$sep;
+ print $cell->{value} . $sep;
}
print $line->{totalrow};
print "\n";
}
print "TOTAL";
$cols = @$results[0]->{loopfooter};
- foreach my $col ( @$cols ) {
- print $sep.$col->{totalcol};
+ foreach my $col (@$cols) {
+ print $sep. $col->{totalcol};
}
- print $sep.@$results[0]->{total};
+ print $sep. @$results[0]->{total};
exit(1);
}
-} else {
+}
+else {
my $dbh = C4::Context->dbh;
my @values;
my %labels;
my %select;
my $req;
- $req = $dbh->prepare("select distinctrow id,name from aqbooksellers order by name");
+ $req =
+ $dbh->prepare(
+ "SELECT distinctrow id,name FROM aqbooksellers ORDER BY name");
$req->execute;
my @select;
- push @select,"";
-# $select{""}="";
- while (my ($value, $desc) =$req->fetchrow) {
+ push @select, "";
+
+ # $select{""}="";
+ while ( my ( $value, $desc ) = $req->fetchrow ) {
push @select, $desc;
-# $select{$value}=$desc;
+
+ # $select{$value}=$desc;
}
- my $CGIBookSellers=CGI::scrolling_list( -name => 'Filter',
+ my $CGIBookSellers = CGI::scrolling_list(
+ -name => 'Filter',
-id => 'Filter',
-values => \@select,
-# -labels => \%select,
+
+ # -labels => \%select,
-size => 1,
- -multiple => 0 );
+ -multiple => 0
+ );
- $req = $dbh->prepare( "select distinctrow bookfundid,bookfundname from aqbookfund order by bookfundname");
+ $req =
+ $dbh->prepare(
+"SELECT DISTINCTROW itemtype,description FROM itemtypes ORDER BY description"
+ );
$req->execute;
undef @select;
undef %select;
- push @select,"";
- $select{""}="";
- while (my ($value,$desc) =$req->fetchrow) {
+ push @select, "";
+ $select{""} = "";
+ while ( my ( $value, $desc ) = $req->fetchrow ) {
push @select, $value;
- $select{$value}=$desc;
+ $select{$value} = $desc;
}
- my $CGIBudget=CGI::scrolling_list( -name => 'Filter',
+ my $CGIItemTypes = CGI::scrolling_list(
+ -name => 'Filter',
-id => 'Filter',
-values => \@select,
-labels => \%select,
-size => 1,
- -multiple => 0 );
+ -multiple => 0
+ );
- $req = $dbh->prepare("select distinctrow sort1 from aqorders where sort1 is not null order by sort1");
+ $req =
+ $dbh->prepare(
+"SELECT DISTINCTROW bookfundid,bookfundname FROM aqbookfund ORDER BY bookfundname"
+ );
$req->execute;
undef @select;
- push @select,"";
+ undef %select;
+ push @select, "";
+ $select{""} = "";
+
+ while ( my ( $value, $desc ) = $req->fetchrow ) {
+ push @select, $value;
+ $select{$value} = $desc;
+ }
+ my $CGIBudget = CGI::scrolling_list(
+ -name => 'Filter',
+ -id => 'Filter',
+ -values => \@select,
+ -labels => \%select,
+ -size => 1,
+ -multiple => 0
+ );
+
+ $req =
+ $dbh->prepare(
+"SELECT DISTINCTROW sort1 FROM aqorders WHERE sort1 IS NOT NULL ORDER BY sort1"
+ );
+ $req->execute;
+ undef @select;
+ push @select, "";
my $hassort1;
- while (my ($value) =$req->fetchrow) {
- $hassort1 =1 if ($value);
+ while ( my ($value) = $req->fetchrow ) {
+ $hassort1 = 1 if ($value);
push @select, $value;
}
- my $CGISort1=CGI::scrolling_list( -name => 'Filter',
+ my $CGISort1 = CGI::scrolling_list(
+ -name => 'Filter',
-id => 'Filter',
-values => \@select,
-size => 1,
- -multiple => 0 );
+ -multiple => 0
+ );
- $req = $dbh->prepare("select distinctrow sort2 from aqorders where sort2 is not null order by sort2");
+ $req =
+ $dbh->prepare(
+"SELECT DISTINCTROW sort2 FROM aqorders WHERE sort2 IS NOT NULL ORDER BY sort2"
+ );
$req->execute;
undef @select;
- push @select,"";
+ push @select, "";
my $hassort2;
my $hglghtsort2;
- while (my ($value) =$req->fetchrow) {
- $hassort2 =1 if ($value);
- $hglghtsort2= !($hassort1);
+
+ while ( my ($value) = $req->fetchrow ) {
+ $hassort2 = 1 if ($value);
+ $hglghtsort2 = !($hassort1);
push @select, $value;
}
- my $CGISort2=CGI::scrolling_list( -name => 'Filter',
+ my $CGISort2 = CGI::scrolling_list(
+ -name => 'Filter',
-id => 'Filter',
-values => \@select,
-size => 1,
- -multiple => 0 );
+ -multiple => 0
+ );
my @mime = ( C4::Context->preference("MIME") );
- foreach my $mime (@mime){
-# warn "".$mime;
+ foreach my $mime (@mime) {
+
+ # warn "".$mime;
}
- my $CGIextChoice=CGI::scrolling_list(
+ my $CGIextChoice = CGI::scrolling_list(
-name => 'MIME',
-id => 'MIME',
-values => \@mime,
-size => 1,
- -multiple => 0 );
+ -multiple => 0
+ );
my @dels = ( C4::Context->preference("delimiter") );
- my $CGIsepChoice=CGI::scrolling_list(
+ my $CGIsepChoice = CGI::scrolling_list(
-name => 'sep',
-id => 'sep',
-values => \@dels,
-size => 1,
- -multiple => 0 );
+ -multiple => 0
+ );
$template->param(
CGIBookSeller => $CGIBookSellers,
+ CGIItemType => $CGIItemTypes,
CGIBudget => $CGIBudget,
- hassort1=> $hassort1,
- hassort2=> $hassort2,
+ hassort1 => $hassort1,
+ hassort2 => $hassort2,
HlghtSort2 => $hglghtsort2,
CGISort1 => $CGISort1,
CGISort2 => $CGISort2,
@@ -204,298 +273,463 @@
}
output_html_with_http_headers $input, $cookie, $template->output;
-
-
sub calculate {
- my ($line, $column, $podsp, $rodsp, ,$process, $filters) = @_;
+ my ( $line, $column, $podsp, $rodsp, $aodsp, $process, $filters ) = @_;
my @mainloop;
my @loopfooter;
my @loopcol;
my @loopline;
my @looprow;
my %globalline;
- my $grantotal =0;
-# extract parameters
+ my $grantotal = 0;
+
+ # extract parameters
my $dbh = C4::Context->dbh;
-# Filters
-# Checking filters
-#
+ # Filters
+ # Checking filters
+ #
my @loopfilter;
- for (my $i=0;$i<=7;$i++) {
+ for ( my $i = 0 ; $i <= 8 ; $i++ ) {
my %cell;
if ( @$filters[$i] ) {
- if ((($i==1) or ($i==3)) and (@$filters[$i-1])) {
- $cell{err} = 1 if (@$filters[$i]<@$filters[$i-1]) ;
+ if ( ( ( $i == 1 ) or ( $i == 3 ) ) and ( @$filters[ $i - 1 ] ) ) {
+ $cell{err} = 1 if ( @$filters[$i] < @$filters[ $i - 1 ] );
}
$cell{filter} .= @$filters[$i];
- $cell{crit} .="Placed On From" if ($i==0);
- $cell{crit} .="Placed On To" if ($i==1);
- $cell{crit} .="Received On From" if ($i==2);
- $cell{crit} .="Received On To" if ($i==3);
- $cell{crit} .="BookSeller" if ($i==4);
- $cell{crit} .="Budget" if ($i==5);
- $cell{crit} .="Sort1" if ($i==6);
- $cell{crit} .="Sort2" if ($i==7);
+ $cell{crit} .= "Placed On From" if ( $i == 0 );
+ $cell{crit} .= "Placed On To" if ( $i == 1 );
+ $cell{crit} .= "Received On From" if ( $i == 2 );
+ $cell{crit} .= "Received On To" if ( $i == 3 );
+
+ $cell{crit} .= "Acquired On From" if ( $i == 4 );
+ $cell{crit} .= "Acquired On To" if ( $i == 5 );
+
+ $cell{crit} .= "BookSeller" if ( $i == 6 );
+ $cell{crit} .= "Doc Type" if ( $i == 7 );
+ $cell{crit} .= "Budget" if ( $i == 8 );
+ $cell{crit} .= "Sort1" if ( $i == 9 );
+ $cell{crit} .= "Sort2" if ( $i == 10 );
push @loopfilter, \%cell;
}
}
my @linefilter;
-# warn "filtres ". at filters[0];
-# warn "filtres ". at filters[1];
-# warn "filtres ". at filters[2];
-# warn "filtres ". at filters[3];
-
- $linefilter[0] = @$filters[0] if ($line =~ /closedate/ ) ;
- $linefilter[1] = @$filters[1] if ($line =~ /closedate/ ) ;
- $linefilter[0] = @$filters[2] if ($line =~ /received/ ) ;
- $linefilter[1] = @$filters[3] if ($line =~ /received/ ) ;
- $linefilter[0] = @$filters[4] if ($line =~ /bookseller/ ) ;
- $linefilter[0] = @$filters[5] if ($line =~ /bookfund/ ) ;
- $linefilter[0] = @$filters[6] if ($line =~ /sort1/ ) ;
- $linefilter[0] = @$filters[7] if ($line =~ /sort2/ ) ;
-#warn "filtre lignes".$linefilter[0]." ".$linefilter[1];
-#
- my @colfilter ;
- $colfilter[0] = @$filters[0] if ($column =~ /closedate/ ) ;
- $colfilter[1] = @$filters[1] if ($column =~ /closedate/ ) ;
- $colfilter[0] = @$filters[2] if ($column =~ /received/ ) ;
- $colfilter[1] = @$filters[3] if ($column =~ /received/ ) ;
- $colfilter[0] = @$filters[4] if ($column =~ /bookseller/ );
- $colfilter[0] = @$filters[5] if ($column =~ /bookfund/ ) ;
- $colfilter[0] = @$filters[6] if ($column =~ /sort1/ ) ;
- $colfilter[0] = @$filters[7] if ($column =~ /sort2/ ) ;
-#warn "filtre col ".$colfilter[0]." ".$colfilter[1];
-# 1st, loop rows.
+ # warn "filtres ". at filters[0];
+ # warn "filtres ". at filters[1];
+ # warn "filtres ". at filters[2];
+ # warn "filtres ". at filters[3];
+
+ $linefilter[0] = @$filters[0] if ( $line =~ /closedate/ );
+ $linefilter[1] = @$filters[1] if ( $line =~ /closedate/ );
+ $linefilter[0] = @$filters[2] if ( $line =~ /received/ );
+ $linefilter[1] = @$filters[3] if ( $line =~ /received/ );
+
+ $linefilter[0] = @$filters[4] if ( $line =~ /acquired/ );
+ $linefilter[1] = @$filters[5] if ( $line =~ /acquired/ );
+
+ $linefilter[0] = @$filters[6] if ( $line =~ /bookseller/ );
+ $linefilter[0] = @$filters[7] if ( $line =~ /itemtype/ );
+ $linefilter[0] = @$filters[8] if ( $line =~ /bookfund/ );
+ $linefilter[0] = @$filters[9] if ( $line =~ /sort1/ );
+ $linefilter[0] = @$filters[10] if ( $line =~ /sort2/ );
+
+ #warn "filtre lignes".$linefilter[0]." ".$linefilter[1];
+ #
+ my @colfilter;
+ $colfilter[0] = @$filters[0] if ( $column =~ /closedate/ );
+ $colfilter[1] = @$filters[1] if ( $column =~ /closedate/ );
+ $colfilter[0] = @$filters[2] if ( $column =~ /received/ );
+ $colfilter[1] = @$filters[3] if ( $column =~ /received/ );
+
+ $colfilter[0] = @$filters[4] if ( $column =~ /acquired/ );
+ $colfilter[1] = @$filters[5] if ( $column =~ /acquired/ );
+
+ $colfilter[0] = @$filters[6] if ( $column =~ /bookseller/ );
+ $colfilter[0] = @$filters[7] if ( $column =~ /itemtype/ );
+ $colfilter[0] = @$filters[8] if ( $column =~ /bookfund/ );
+ $colfilter[0] = @$filters[9] if ( $column =~ /sort1/ );
+ $colfilter[0] = @$filters[10] if ( $column =~ /sort2/ );
+
+ #warn "filtre col ".$colfilter[0]." ".$colfilter[1];
+
+ #warn "line=$line, podsp=$podsp, rodsp=$rodsp, aodsp=$aodsp\n";
+
+ # 1st, loop rows.
my $linefield;
- if (($line =~/closedate/) and ($podsp == 1)) {
+ if ( ( $line =~ /closedate/ ) and ( $podsp == 1 ) ) {
+
+ #Display by day
+ $linefield .= "dayname($line)";
+ }
+ elsif ( ( $line =~ /closedate/ ) and ( $podsp == 2 ) ) {
+
+ #Display by Month
+ $linefield .= "monthname($line)";
+ }
+ elsif ( ( $line =~ /closedate/ ) and ( $podsp == 3 ) ) {
+
+ #Display by Year
+ $linefield .= "Year($line)";
+
+ }
+ elsif ( ( $line =~ /received/ ) and ( $rodsp == 1 ) ) {
+
#Display by day
- $linefield .="dayname($line)";
- } elsif (($line=~/closedate/) and ($podsp == 2)) {
+ $linefield .= "dayname($line)";
+ }
+ elsif ( ( $line =~ /received/ ) and ( $rodsp == 2 ) ) {
+
#Display by Month
- $linefield .="monthname($line)";
- } elsif (($line=~/closedate/) and ($podsp == 3)) {
+ $linefield .= "monthname($line)";
+ }
+ elsif ( ( $line =~ /received/ ) and ( $rodsp == 3 ) ) {
+
#Display by Year
- $linefield .="Year($line)";
- } elsif (($line =~/received/) and ($rodsp == 1)) {
+ $linefield .= "Year($line)";
+
+ }
+ elsif ( ( $line =~ /acquired/ ) and ( $aodsp == 1 ) ) {
+
#Display by day
- $linefield .="dayname($line)";
- } elsif (($line=~/received/) and ($rodsp == 2)) {
+ $linefield .= "dayname($line)";
+ }
+ elsif ( ( $line =~ /acquired/ ) and ( $aodsp == 2 ) ) {
+
#Display by Month
- $linefield .="monthname($line)";
- } elsif (($line=~/received/) and ($rodsp == 3)) {
+ $linefield .= "monthname($line)";
+ }
+ elsif ( ( $line =~ /acquired/ ) and ( $aodsp == 3 ) ) {
+
#Display by Year
- $linefield .="Year($line)";
- } else {
+ $linefield .= "Year($line)";
+
+ }
+ else {
$linefield .= $line;
}
my $strsth;
- $strsth .= "select distinctrow $linefield from aqorders, aqbasket,aqorderbreakdown left join aqorderdelivery on (aqorders.ordernumber =aqorderdelivery.ordernumber ) left join aqbooksellers on (aqbasket.booksellerid=aqbooksellers.id) where (aqorders.basketno=aqbasket.basketno) and (aqorderbreakdown.ordernumber=aqorders.ordernumber) and $line is not null ";
-
- if ( @linefilter ) {
- if ($linefilter[1]){
- if ($linefilter[0]){
- $strsth .= " and $line between ? and ? " ;
- } else {
- $strsth .= " and $line < ? " ;
- }
- } elsif (($linefilter[0]) and (($line=~/closedate/) or ($line=~/received/))){
- $strsth .= " and $line > ? " ;
- } elsif ($linefilter[0]) {
+ $strsth .=
+ "SELECT DISTINCTROW $linefield FROM (aqorders, aqbasket,aqorderbreakdown)
+ LEFT JOIN items ON (aqorders.biblioitemnumber= items.biblioitemnumber)
+ LEFT JOIN biblioitems ON (aqorders.biblioitemnumber= biblioitems.biblioitemnumber)
+ LEFT JOIN aqorderdelivery ON (aqorders.ordernumber =aqorderdelivery.ordernumber )
+ LEFT JOIN aqbooksellers ON (aqbasket.booksellerid=aqbooksellers.id) WHERE (aqorders.basketno=aqbasket.basketno)
+ AND (aqorderbreakdown.ordernumber=aqorders.ordernumber) AND $line IS NOT NULL ";
+
+ if (@linefilter) {
+ if ( $linefilter[1] ) {
+ if ( $linefilter[0] ) {
+ $strsth .= " AND $line BETWEEN ? AND ? ";
+ }
+ else {
+ $strsth .= " AND $line < ? ";
+ }
+ }
+ elsif (
+ ( $linefilter[0] )
+ and ( ( $line =~ /closedate/ )
+ or ( $line =~ /received/ )
+ or ( $line =~ /acquired/ ) )
+ )
+ {
+ $strsth .= " AND $line > ? ";
+ }
+ elsif ( $linefilter[0] ) {
$linefilter[0] =~ s/\*/%/g;
- $strsth .= " and $line LIKE ? " ;
+ $strsth .= " AND $line LIKE ? ";
+ }
+ }
+ $strsth .= " GROUP BY $linefield";
+ $strsth .= " ORDER BY $linefield";
+
+ #warn "377:strsth= $strsth";
+
+ my $sth = $dbh->prepare($strsth);
+ if ( (@linefilter) and ( $linefilter[1] ) ) {
+ $sth->execute( "'" . $linefilter[0] . "'", "'" . $linefilter[1] . "'" );
}
+ elsif ( $linefilter[0] ) {
+ $sth->execute( $linefilter[0] );
}
- $strsth .=" group by $linefield";
- $strsth .=" order by $linefield";
- warn "". $strsth;
-
- my $sth = $dbh->prepare( $strsth );
- if (( @linefilter ) and ($linefilter[1])){
- $sth->execute("'".$linefilter[0]."'","'".$linefilter[1]."'");
- } elsif ($linefilter[0]) {
- $sth->execute($linefilter[0]);
- } else {
+ else {
$sth->execute;
}
- while ( my ($celvalue) = $sth->fetchrow) {
+ while ( my ($celvalue) = $sth->fetchrow ) {
my %cell;
if ($celvalue) {
$cell{rowtitle} = $celvalue;
-# } else {
-# $cell{rowtitle} = "";
+
+ # } else {
+ # $cell{rowtitle} = "";
}
$cell{totalrow} = 0;
push @loopline, \%cell;
}
-# 2nd, loop cols.
+ #warn "column=$column, podsp=$podsp, rodsp=$rodsp, aodsp=$aodsp\n";
+
+ # 2nd, loop cols.
my $colfield;
- if (($column =~/closedate/) and ($podsp == 1)) {
+ if ( ( $column =~ /closedate/ ) and ( $podsp == 1 ) ) {
+
#Display by day
- $colfield .="dayname($column)";
- } elsif (($column=~/closedate/) and ($podsp == 2)) {
+ $colfield .= "dayname($column)";
+ }
+ elsif ( ( $column =~ /closedate/ ) and ( $podsp == 2 ) ) {
+
#Display by Month
- $colfield .="monthname($column)";
- } elsif (($column=~/closedate/) and ($podsp == 3)) {
+ $colfield .= "monthname($column)";
+ }
+ elsif ( ( $column =~ /closedate/ ) and ( $podsp == 3 ) ) {
+
#Display by Year
- $colfield .="Year($column)";
- } elsif (($column =~/received/) and ($rodsp == 1)) {
+ $colfield .= "Year($column)";
+
+ }
+ elsif ( ( $column =~ /deliverydate/ ) and ( $rodsp == 1 ) ) {
+
#Display by day
- $colfield .="dayname($column)";
- } elsif (($column=~/received/) and ($rodsp == 2)) {
+ $colfield .= "dayname($column)";
+ }
+ elsif ( ( $column =~ /deliverydate/ ) and ( $rodsp == 2 ) ) {
+
#Display by Month
- $colfield .="monthname($column)";
- } elsif (($column=~/received/) and ($rodsp == 3)) {
+ $colfield .= "monthname($column)";
+ }
+ elsif ( ( $column =~ /deliverydate/ ) and ( $rodsp == 3 ) ) {
+
#Display by Year
- $colfield .="Year($column)";
- } else {
+ $colfield .= "Year($column)";
+
+ }
+ elsif ( ( $column =~ /dateaccessioned/ ) and ( $aodsp == 1 ) ) {
+
+ #Display by day
+ $colfield .= "dayname($column)";
+ }
+ elsif ( ( $column =~ /dateaccessioned/ ) and ( $aodsp == 2 ) ) {
+
+ #Display by Month
+ $colfield .= "monthname($column)";
+ }
+ elsif ( ( $column =~ /dateaccessioned/ ) and ( $aodsp == 3 ) ) {
+
+ #Display by Year
+ $colfield .= "Year($column)";
+
+ }
+ else {
$colfield .= $column;
}
my $strsth2;
- $strsth2 .= "select distinctrow $colfield from aqorders, aqbasket,aqorderbreakdown left join aqorderdelivery on (aqorders.ordernumber =aqorderdelivery.ordernumber ) left join aqbooksellers on (aqbasket.booksellerid=aqbooksellers.id) where (aqorders.basketno=aqbasket.basketno) and (aqorderbreakdown.ordernumber=aqorders.ordernumber) and $column is not null ";
-
- if ( @colfilter ) {
- if ($colfilter[1]){
- if ($colfilter[0]){
- $strsth2 .= " and $column between ? and ? " ;
- } else {
- $strsth2 .= " and $column < ? " ;
- }
- } elsif (($colfilter[0]) and (($column=~/closedate/) or ($column=~/received/))){
- $strsth2 .= " and $column > ? " ;
- } elsif ($colfilter[0]) {
+ $strsth2 .=
+ "SELECT distinctrow $colfield FROM (aqorders, aqbasket,aqorderbreakdown)
+ LEFT JOIN items ON (aqorders.biblioitemnumber= items.biblioitemnumber)
+ LEFT JOIN biblioitems ON (aqorders.biblioitemnumber= biblioitems.biblioitemnumber)
+ LEFT JOIN aqorderdelivery ON (aqorders.ordernumber =aqorderdelivery.ordernumber )
+ LEFT JOIN aqbooksellers ON (aqbasket.booksellerid=aqbooksellers.id)
+ WHERE (aqorders.basketno=aqbasket.basketno) AND (aqorderbreakdown.ordernumber=aqorders.ordernumber)
+ AND $column IS NOT NULL";
+
+ if (@colfilter) {
+ if ( $colfilter[1] ) {
+ if ( $colfilter[0] ) {
+ $strsth2 .= " AND $column BETWEEN ? AND ? ";
+ }
+ else {
+ $strsth2 .= " AND $column < ? ";
+ }
+ }
+ elsif (
+ ( $colfilter[0] )
+ and ( ( $column =~ /closedate/ )
+ or ( $line =~ /received/ )
+ or ( $line =~ /acquired/ ) )
+ )
+ {
+ $strsth2 .= " AND $column > ? ";
+ }
+ elsif ( $colfilter[0] ) {
$colfilter[0] =~ s/\*/%/g;
- $strsth2 .= " and $column LIKE ? " ;
+ $strsth2 .= " AND $column LIKE ? ";
+ }
+ }
+ $strsth2 .= " GROUP BY $colfield";
+ $strsth2 .= " ORDER BY $colfield";
+
+ # warn "MASON:. $strsth2";
+
+ my $sth2 = $dbh->prepare($strsth2);
+ if ( (@colfilter) and ( $colfilter[1] ) ) {
+
+ # warn "from : ".$colfilter[0]." To :".$colfilter[1];
+ $sth2->execute( "'" . $colfilter[0] . "'", "'" . $colfilter[1] . "'" );
}
+ elsif ( $colfilter[0] ) {
+ $sth2->execute( $colfilter[0] );
}
- $strsth2 .=" group by $colfield";
- $strsth2 .=" order by $colfield";
- warn "". $strsth2;
-
- my $sth2 = $dbh->prepare( $strsth2 );
- if (( @colfilter ) and ($colfilter[1])){
- warn "from : ".$colfilter[0]." To :".$colfilter[1];
- $sth2->execute("'".$colfilter[0]."'","'".$colfilter[1]."'");
- } elsif ($colfilter[0]) {
- $sth2->execute($colfilter[0]);
- } else {
+ else {
$sth2->execute;
}
- while (my ($celvalue) = $sth2->fetchrow) {
+ while ( my ($celvalue) = $sth2->fetchrow ) {
my %cell;
- if ($celvalue){
-# warn "coltitle :".$celvalue;
+ if ($celvalue) {
+
+ # warn "coltitle :".$celvalue;
$cell{coltitle} = $celvalue;
}
push @loopcol, \%cell;
}
-# warn "fin des titres colonnes";
- my $i=0;
+ # warn "fin des titres colonnes";
+
+ my $i = 0;
my @totalcol;
- my $hilighted=-1;
+ my $hilighted = -1;
#Initialization of cell values.....
my %table;
-# warn "init table";
- foreach my $row ( @loopline ) {
- foreach my $col ( @loopcol ) {
+
+ # warn "init table";
+ foreach my $row (@loopline) {
+ foreach my $col (@loopcol) {
+
# warn " init table : $row->{rowtitle} / $col->{coltitle} ";
- $table{$row->{rowtitle}}->{$col->{coltitle}}=0;
+ $table{ $row->{rowtitle} }->{ $col->{coltitle} } = 0;
}
- $table{$row->{rowtitle}}->{totalrow}=0;
+ $table{ $row->{rowtitle} }->{totalrow} = 0;
}
-# preparing calculation
- my $strcalc ;
+ # preparing calculation
+ my $strcalc;
$strcalc .= "SELECT $linefield, $colfield, ";
- $strcalc .= "COUNT( aqorders.ordernumber ) " if ($process ==1);
- $strcalc .= "SUM( aqorders.quantity * aqorders.listprice ) " if ($process ==2);
- $strcalc .= "FROM aqorders, aqbasket,aqorderbreakdown left join aqorderdelivery on (aqorders.ordernumber =aqorderdelivery.ordernumber ) left join aqbooksellers on (aqbasket.booksellerid=aqbooksellers.id) where (aqorders.basketno=aqbasket.basketno) and (aqorderbreakdown.ordernumber=aqorders.ordernumber) ";
-
- @$filters[0]=~ s/\*/%/g if (@$filters[0]);
- $strcalc .= " AND aqbasket.closedate > '" . @$filters[0] ."'" if ( @$filters[0] );
- @$filters[1]=~ s/\*/%/g if (@$filters[1]);
- $strcalc .= " AND aqbasket.closedate < '" . @$filters[1] ."'" if ( @$filters[1] );
- @$filters[2]=~ s/\*/%/g if (@$filters[2]);
- $strcalc .= " AND aqorderdelivery.deliverydate > '" . @$filters[2] ."'" if ( @$filters[2] );
- @$filters[3]=~ s/\*/%/g if (@$filters[3]);
- $strcalc .= " AND aqorderdelivery.deliverydate < '" . @$filters[3] ."'" if ( @$filters[3] );
- @$filters[4]=~ s/\*/%/g if (@$filters[4]);
- $strcalc .= " AND aqbooksellers.name like '" . @$filters[4] ."'" if ( @$filters[4] );
- @$filters[5]=~ s/\*/%/g if (@$filters[5]);
- $strcalc .= " AND aqbookfund.bookfundid like '" . @$filters[5] ."'" if ( @$filters[5] );
- @$filters[6]=~ s/\*/%/g if (@$filters[6]);
- $strcalc .= " AND aqorders.sort1 like '" . @$filters[6] ."'" if ( @$filters[6] );
- @$filters[7]=~ s/\*/%/g if (@$filters[7]);
- $strcalc .= " AND aqorders.sort2 like '" . @$filters[7] ."'" if ( @$filters[7] );
- $strcalc .= " group by $linefield, $colfield order by $linefield,$colfield";
- warn "". $strcalc;
+ $strcalc .= "SUM( aqorders.quantity ) " if ( $process == 1 );
+ $strcalc .= "SUM( aqorders.quantity * aqorders.listprice ) "
+ if ( $process == 2 );
+ $strcalc .= "FROM (aqorders, aqbasket,aqorderbreakdown)
+ LEFT JOIN items ON (aqorders.biblioitemnumber= items.biblioitemnumber)
+ LEFT JOIN biblioitems ON (aqorders.biblioitemnumber= biblioitems.biblioitemnumber)
+ LEFT JOIN aqorderdelivery ON (aqorders.ordernumber =aqorderdelivery.ordernumber )
+ LEFT JOIN aqbooksellers ON (aqbasket.booksellerid=aqbooksellers.id) WHERE (aqorders.basketno=aqbasket.basketno)
+ AND (aqorderbreakdown.ordernumber=aqorders.ordernumber) ";
+
+ @$filters[0] =~ s/\*/%/g if ( @$filters[0] );
+ $strcalc .= " AND aqbasket.closedate > '" . @$filters[0] . "'"
+ if ( @$filters[0] );
+ @$filters[1] =~ s/\*/%/g if ( @$filters[1] );
+ $strcalc .= " AND aqbasket.closedate < '" . @$filters[1] . "'"
+ if ( @$filters[1] );
+ @$filters[2] =~ s/\*/%/g if ( @$filters[2] );
+ $strcalc .= " AND aqorderdelivery.deliverydate > '" . @$filters[2] . "'"
+ if ( @$filters[2] );
+ @$filters[3] =~ s/\*/%/g if ( @$filters[3] );
+ $strcalc .= " AND aqorderdelivery.deliverydate < '" . @$filters[3] . "'"
+ if ( @$filters[3] );
+ @$filters[4] =~ s/\*/%/g if ( @$filters[4] );
+ $strcalc .= " AND aqbasket.closedate > '" . @$filters[4] . "'"
+ if ( @$filters[4] );
+ @$filters[5] =~ s/\*/%/g if ( @$filters[5] );
+ $strcalc .= " AND aqbasket.closedate < '" . @$filters[5] . "'"
+ if ( @$filters[5] );
+ @$filters[6] =~ s/\*/%/g if ( @$filters[6] );
+ $strcalc .= " AND aqbooksellers.name LIKE '" . @$filters[6] . "'"
+ if ( @$filters[6] );
+ @$filters[7] =~ s/\*/%/g if ( @$filters[7] );
+ $strcalc .= " AND biblioitems.itemtype LIKE '" . @$filters[7] . "'"
+ if ( @$filters[7] );
+ @$filters[8] =~ s/\*/%/g if ( @$filters[8] );
+ $strcalc .= " AND aqbookfund.bookfundid LIKE '" . @$filters[8] . "'"
+ if ( @$filters[8] );
+ @$filters[9] =~ s/\*/%/g if ( @$filters[9] );
+ $strcalc .= " AND aqorders.sort1 LIKE '" . @$filters[9] . "'"
+ if ( @$filters[9] );
+ @$filters[10] =~ s/\*/%/g if ( @$filters[10] );
+ $strcalc .= " AND aqorders.sort2 LIKE '" . @$filters[10] . "'"
+ if ( @$filters[10] );
+ $strcalc .= " GROUP BY $linefield, $colfield ORDER BY $linefield,$colfield";
+
+ # warn "/n/n". $strcalc;
my $dbcalc = $dbh->prepare($strcalc);
$dbcalc->execute;
-# warn "filling table";
+ # warn "filling table";
my $emptycol;
- while (my ($row, $col, $value) = $dbcalc->fetchrow) {
-# warn "filling table $row / $col / $value ";
- $emptycol = 1 if ($col eq undef);
- $col = "zzEMPTY" if ($col eq undef);
- $row = "zzEMPTY" if ($row eq undef);
+ while ( my ( $row, $col, $value ) = $dbcalc->fetchrow ) {
- $table{$row}->{$col}+=$value;
- $table{$row}->{totalrow}+=$value;
+ # warn "filling table $row / $col / $value ";
+ $emptycol = 1 if ( $col eq undef );
+ $col = "zzEMPTY" if ( $col eq undef );
+ $row = "zzEMPTY" if ( $row eq undef );
+
+ $table{$row}->{$col} += $value;
+ $table{$row}->{totalrow} += $value;
$grantotal += $value;
}
- push @loopcol,{coltitle => "NULL"} if ($emptycol);
+ push @loopcol, { coltitle => "NULL" } if ($emptycol);
foreach my $row ( sort keys %table ) {
my @loopcell;
+
#@loopcol ensures the order for columns is common with column titles
# and the number matches the number of columns
- foreach my $col ( @loopcol ) {
- my $value =$table{$row}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}};
- push @loopcell, {value => $value } ;
+ foreach my $col (@loopcol) {
+ my $value = $table{$row}->{
+ ( $col->{coltitle} eq "NULL" )
+ ? "zzEMPTY"
+ : $col->{coltitle}
+ };
+ push @loopcell, { value => $value };
}
- push @looprow,{ 'rowtitle' => ($row eq "zzEMPTY")?"NULL":$row,
+ push @looprow,
+ {
+ 'rowtitle' => ( $row eq "zzEMPTY" ) ? "NULL" : $row,
'loopcell' => \@loopcell,
- 'hilighted' => ($hilighted >0),
+ 'hilighted' => ( $hilighted > 0 ),
'totalrow' => $table{$row}->{totalrow}
};
$hilighted = -$hilighted;
}
-# warn "footer processing";
- foreach my $col ( @loopcol ) {
- my $total=0;
- foreach my $row ( @looprow ) {
- $total += $table{($row->{rowtitle} eq "NULL")?"zzEMPTY":$row->{rowtitle}}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}};
+ # warn "footer processing";
+ foreach my $col (@loopcol) {
+ my $total = 0;
+ foreach my $row (@looprow) {
+ $total += $table{
+ ( $row->{rowtitle} eq "NULL" ) ? "zzEMPTY"
+ : $row->{rowtitle}
+ }->{
+ ( $col->{coltitle} eq "NULL" ) ? "zzEMPTY"
+ : $col->{coltitle}
+ };
+
# warn "value added ".$table{$row->{rowtitle}}->{$col->{coltitle}}. "for line ".$row->{rowtitle};
}
-# warn "summ for column ".$col->{coltitle}." = ".$total;
- push @loopfooter, {'totalcol' => $total};
- }
+ # warn "summ for column ".$col->{coltitle}." = ".$total;
+ push @loopfooter, { 'totalcol' => $total };
+ }
# the header of the table
- $globalline{loopfilter}=\@loopfilter;
+ # $globalline{loopfilter}=\@loopfilter;
# the core of the table
$globalline{looprow} = \@looprow;
$globalline{loopcol} = \@loopcol;
-# # the foot (totals by borrower type)
+
+ # # the foot (totals by borrower type)
$globalline{loopfooter} = \@loopfooter;
- $globalline{total}= $grantotal;
+ $globalline{total} = $grantotal;
$globalline{line} = $line;
$globalline{column} = $column;
- push @mainloop,\%globalline;
+ push @mainloop, \%globalline;
return \@mainloop;
}
1;
\ No newline at end of file
+
Index: bor_issues_top.pl
===================================================================
RCS file: /sources/koha/koha/reports/bor_issues_top.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -b -r1.9 -r1.10
--- bor_issues_top.pl 11 Sep 2006 17:41:55 -0000 1.9
+++ bor_issues_top.pl 9 Mar 2007 15:13:36 -0000 1.10
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: bor_issues_top.pl,v 1.9 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: bor_issues_top.pl,v 1.10 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,11 +23,13 @@
use C4::Auth;
use CGI;
use C4::Context;
-use C4::Search;
+use C4::Branch; # GetBranches
+use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2;
use Date::Manip;
+use C4::Members;
=head1 NAME
@@ -56,10 +58,14 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
-$template->param(do_it => $do_it);
+$template->param(do_it => $do_it,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
if ($do_it) {
# Displaying results
my $results = calculate($limit, $column, \@filters);
@@ -71,6 +77,7 @@
} else {
# Printing to a csv file
print $input->header(-type => 'application/vnd.sun.xml.calc',
+ -encoding => 'utf-8',
-attachment=>"$basename.csv",
-filename=>"$basename.csv" );
my $cols = @$results[0]->{loopcol};
@@ -130,10 +137,50 @@
-values => \@dels,
-size => 1,
-multiple => 0 );
+ #branch
+ my $branches = GetBranches;
+ my @branchloop;
+ foreach my $thisbranch (keys %$branches) {
+# my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisbranch,
+# selected => $selected,
+ branchname => $branches->{$thisbranch}->{'branchname'},
+ );
+ push @branchloop, \%row;
+ }
+
+ #doctype
+ my $itemtypes = GetItemTypes;
+ my @itemtypeloop;
+ foreach my $thisitemtype (keys %$itemtypes) {
+# my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisitemtype,
+# selected => $selected,
+ description => $itemtypes->{$thisitemtype}->{'description'},
+ );
+ push @itemtypeloop, \%row;
+ }
+
+ #borcat
+ my ($codes,$labels) = GetborCatFromCatType(undef,undef);
+ my @borcatloop;
+ foreach my $thisborcat (sort keys %$labels) {
+ # my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisborcat,
+ # selected => $selected,
+ description => $labels->{$thisborcat},
+ );
+ push @borcatloop, \%row;
+ }
+ #Day
+ #Month
$template->param(
CGIextChoice => $CGIextChoice,
- CGIsepChoice => $CGIsepChoice
+ CGIsepChoice => $CGIsepChoice,
+ branchloop =>\@branchloop,
+ itemtypeloop =>\@itemtypeloop,
+ borcatloop =>\@borcatloop,
);
output_html_with_http_headers $input, $cookie, $template->output;
}
@@ -241,7 +288,7 @@
while (my ($celvalue) = $sth2->fetchrow) {
my %cell;
- $cell{coltitle} = $celvalue;
+ $cell{'coltitle'} = ($celvalue?$celvalue:"NULL");
push @loopcol, \%cell;
}
# warn "fin des titres colonnes";
@@ -294,31 +341,29 @@
$strcalc .= " group by borrowers.borrowernumber";
$strcalc .= ", $colfield" if ($column);
- $strcalc .= " order by ";
- $strcalc .= "$colfield, " if ($colfield);
- $strcalc .= "RANK DESC ";
- my $max;
- if (@loopcol) {
- $max = $line*@loopcol;
- } else { $max=$line;}
- $strcalc .= " LIMIT 0,$max";
+ $strcalc .= " order by RANK DESC";
+ $strcalc .= ",$colfield " if ($colfield);
+# my $max;
+# if (@loopcol) {
+# $max = $line*@loopcol;
+# } else { $max=$line;}
+# $strcalc .= " LIMIT 0,$max";
warn "SQL :". $strcalc;
my $dbcalc = $dbh->prepare($strcalc);
$dbcalc->execute;
# warn "filling table";
my $previous_col;
- my $i=1;
+ my %indice;
while (my @data = $dbcalc->fetchrow) {
my ($row, $rank, $id, $col )=@data;
$col = "zzEMPTY" if ($col eq undef);
- $i=1 if (($previous_col) and not($col eq $previous_col));
- $table[$i]->{$col}->{'name'}=$row;
- $table[$i]->{$col}->{'count'}=$rank;
- $table[$i]->{$col}->{'link'}=$id;
- warn " ".$i." ".$col. " ".$row;
- $i++;
- $previous_col=$col;
+ $indice{$col}=1 if (not($indice{$col}));
+ $table[$indice{$col}]->{$col}->{'name'}=$row;
+ $table[$indice{$col}]->{$col}->{'count'}=$rank;
+ $table[$indice{$col}]->{$col}->{'link'}=$id;
+# warn " ".$i." ".$col. " ".$row;
+ $indice{$col}++;
}
push @loopcol,{coltitle => "Global"} if not($column);
@@ -326,7 +371,7 @@
for ($i=1; $i<=$line;$i++) {
my @loopcell;
warn " $i";
- #@loopcol ensures the order for columns is common with column titles
+ #@loborrowersopcol ensures the order for columns is common with column titles
# and the number matches the number of columns
my $colcount=0;
foreach my $col ( @loopcol ) {
Index: borrowers_out.pl
===================================================================
RCS file: /sources/koha/koha/reports/borrowers_out.pl,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- borrowers_out.pl 11 Sep 2006 17:41:55 -0000 1.7
+++ borrowers_out.pl 9 Mar 2007 15:13:36 -0000 1.8
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: borrowers_out.pl,v 1.7 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: borrowers_out.pl,v 1.8 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,11 +23,13 @@
use C4::Auth;
use CGI;
use C4::Context;
-use C4::Search;
+
+use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2;
use Date::Manip;
+use C4::Members;
=head1 NAME
@@ -56,10 +58,14 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
-$template->param(do_it => $do_it);
+$template->param(do_it => $do_it,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
if ($do_it) {
# Displaying results
my $results = calculate($limit, $column, \@filters);
@@ -71,6 +77,7 @@
} else {
# Printing to a csv file
print $input->header(-type => 'application/vnd.sun.xml.calc',
+ -encoding => 'utf-8',
-attachment=>"$basename.csv",
-filename=>"$basename.csv" );
my $cols = @$results[0]->{loopcol};
@@ -131,9 +138,22 @@
-size => 1,
-multiple => 0 );
+ my ($codes,$labels) = GetborCatFromCatType(undef,undef);
+ my @borcatloop;
+ foreach my $thisborcat (sort keys %$labels) {
+ # my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisborcat,
+ # selected => $selected,
+ description => $labels->{$thisborcat},
+ );
+ push @borcatloop, \%row;
+ }
+
+
$template->param(
CGIextChoice => $CGIextChoice,
- CGIsepChoice => $CGIsepChoice
+ CGIsepChoice => $CGIsepChoice,
+ borcatloop =>\@borcatloop,
);
output_html_with_http_headers $input, $cookie, $template->output;
}
@@ -157,7 +177,7 @@
# Checking filters
#
my @loopfilter;
- for (my $i=0;$i<=6;$i++) {
+ for (my $i=0;$i<=2;$i++) {
my %cell;
if ( @$filters[$i] ) {
if (($i==1) and (@$filters[$i-1])) {
@@ -165,6 +185,7 @@
}
$cell{filter} .= @$filters[$i];
$cell{crit} .="Bor Cat" if ($i==0);
+ $cell{crit} .="Without issues since" if ($i==1);
push @loopfilter, \%cell;
}
}
@@ -226,13 +247,31 @@
# preparing calculation
my $strcalc ;
-# Processing average loanperiods
+# Processing calculation
$strcalc .= "SELECT CONCAT( borrowers.surname , \"\\t\",borrowers.firstname, \"\\t\", borrowers.cardnumber)";
$strcalc .= " , $colfield " if ($colfield);
- $strcalc .= " FROM borrowers LEFT JOIN issues ON issues.borrowernumber=borrowers.borrowernumber WHERE issues.borrowernumber is null";
+ $strcalc .= " FROM borrowers ";
+ $strcalc .= "WHERE 1 ";
@$filters[0]=~ s/\*/%/g if (@$filters[0]);
$strcalc .= " AND borrowers.categorycode like '" . @$filters[0] ."'" if ( @$filters[0] );
-
+ if (@$filters[1]){
+ my $strqueryfilter="SELECT DISTINCT borrowernumber FROM issues where issues.timestamp> @$filters[1] ";
+ my $queryfilter = $dbh->prepare("SELECT DISTINCT borrowernumber FROM issues where issues.timestamp> @$filters[1] ");
+ $strcalc .= " AND borrowers.borrowernumber not in ($strqueryfilter)";
+
+# $queryfilter->execute(@$filters[1]);
+# while (my ($borrowernumber)=$queryfilter->fetchrow){
+# $strcalc .= " AND borrowers.borrowernumber <> $borrowernumber ";
+# }
+ } else {
+ my $strqueryfilter="SELECT DISTINCT borrowernumber FROM issues ";
+ my $queryfilter = $dbh->prepare("SELECT DISTINCT borrowernumber FROM issues ");
+ $queryfilter->execute;
+ $strcalc .= " AND borrowers.borrowernumber not in ($strqueryfilter)";
+# while (my ($borrowernumber)=$queryfilter->fetchrow){
+# $strcalc .= " AND borrowers.borrowernumber <> $borrowernumber ";
+# }
+ }
$strcalc .= " group by borrowers.borrowernumber";
$strcalc .= ", $colfield" if ($column);
$strcalc .= " order by $colfield " if ($colfield);
@@ -260,7 +299,7 @@
push @loopcol,{coltitle => "Global"} if not($column);
- my $max =(($line)?$line:@table);
+ my $max =(($line)?$line:@table -1);
for ($i=1; $i<=$max;$i++) {
my @loopcell;
#@loopcol ensures the order for columns is common with column titles
Index: borrowers_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/borrowers_stats.pl,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- borrowers_stats.pl 11 Sep 2006 17:41:55 -0000 1.11
+++ borrowers_stats.pl 9 Mar 2007 15:13:36 -0000 1.12
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: borrowers_stats.pl,v 1.11 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: borrowers_stats.pl,v 1.12 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,8 +23,10 @@
use C4::Auth;
use CGI;
use C4::Context;
-use C4::Search;
+use C4::Branch; # GetBranches
+use C4::Output;
use C4::Koha;
+use C4::Acquisition;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2;
@@ -57,7 +59,7 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports=> 1},
debug => 1,
});
$template->param(do_it => $do_it);
@@ -69,6 +71,7 @@
exit(1);
} else {
print $input->header(-type => 'application/vnd.sun.xml.calc',
+ -encoding => 'utf-8',
-name=>"$basename.csv",
-attachment=>"$basename.csv");
my $cols = @$results[0]->{loopcol};
@@ -119,6 +122,17 @@
-size => 1,
-multiple => 0 );
+my $branches = GetBranches;
+my @branchloop;
+foreach my $thisbranch (keys %$branches) {
+ # my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisbranch,
+# selected => $selected,
+ branchname => $branches->{$thisbranch}->{'branchname'},
+ );
+ push @branchloop, \%row;
+}
+
$req = $dbh->prepare( "select distinctrow sort1 from borrowers order by sort1");
$req->execute;
my @select_sort1;
@@ -172,13 +186,14 @@
-values => \@dels,
-size => 1,
-multiple => 0 );
- $template->param(CGICatCode => $CGICatCode,
+ $template->param(CGICatcode => $CGICatCode,
CGISort1 => $CGIsort1,
hassort1 => $hassort1,
CGISort2 => $CGIsort2,
hassort2 => $hassort2,
CGIextChoice => $CGIextChoice,
- CGIsepChoice => $CGIsepChoice
+ CGIsepChoice => $CGIsepChoice,
+ CGIBranch => @branchloop
);
}
@@ -207,14 +222,16 @@
$linefilter = @$filters[0] if ($line =~ /categorycode/ ) ;
$linefilter = @$filters[1] if ($line =~ /zipcode/ ) ;
- $linefilter = @$filters[2] if ($line =~ /sort1/ ) ;
- $linefilter = @$filters[3] if ($line =~ /sort2/ ) ;
+ $linefilter = @$filters[2] if ($line =~ /branccode/ ) ;
+ $linefilter = @$filters[3] if ($line =~ /sort1/ ) ;
+ $linefilter = @$filters[4] if ($line =~ /sort2/ ) ;
#
my $colfilter = "";
$colfilter = @$filters[0] if ($column =~ /categorycode/);
$colfilter = @$filters[1] if ($column =~ /zipcode/);
- $colfilter = @$filters[2] if ($column =~ /sort1/);
- $colfilter = @$filters[3] if ($column =~ /sort2/);
+ $colfilter = @$filters[2] if ($column =~ /branchcode/);
+ $colfilter = @$filters[3] if ($column =~ /sort1/);
+ $colfilter = @$filters[4] if ($column =~ /sort2/);
my @loopfilter;
for (my $i=0;$i<=3;$i++) {
@@ -223,8 +240,9 @@
$cell{filter} .= @$filters[$i];
$cell{crit} .="Cat Code " if ($i==0);
$cell{crit} .="Zip Code" if ($i==1);
- $cell{crit} .="Sort1" if ($i==2);
- $cell{crit} .="Sort2" if ($i==3);
+ $cell{crit} .="Branchcode" if ($i==2);
+ $cell{crit} .="Sort1" if ($i==3);
+ $cell{crit} .="Sort2" if ($i==4);
push @loopfilter, \%cell;
}
}
@@ -281,7 +299,7 @@
}
$strsth2 .= " and $status='1' " if ($status);
$strsth2 .= " order by $colfield";
- warn "". $strsth2;
+# warn "". $strsth2;
my $sth2 = $dbh->prepare( $strsth2 );
if ($colfilter) {
$sth2->execute($colfilter);
@@ -385,4 +403,3 @@
return \@mainloop;
}
-1;
\ No newline at end of file
Index: cat_issues_top.pl
===================================================================
RCS file: /sources/koha/koha/reports/cat_issues_top.pl,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -b -r1.11 -r1.12
--- cat_issues_top.pl 11 Sep 2006 17:41:55 -0000 1.11
+++ cat_issues_top.pl 9 Mar 2007 15:13:36 -0000 1.12
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: cat_issues_top.pl,v 1.11 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: cat_issues_top.pl,v 1.12 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,13 +23,13 @@
use C4::Auth;
use CGI;
use C4::Context;
-use HTML::Template;
-use C4::Search;
+use C4::Branch; # GetBranches
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2;
use Date::Manip;
+use C4::Members;
=head1 NAME
@@ -58,10 +58,14 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => { reports => 1},
debug => 1,
});
-$template->param(do_it => $do_it);
+$template->param(do_it => $do_it,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
if ($do_it) {
# Displaying results
my $results = calculate($limit, $column, \@filters);
@@ -74,6 +78,7 @@
} else {
# Printing to a csv file
print $input->header(-type => 'application/vnd.sun.xml.calc',
+ -encoding => 'utf-8',
-attachment=>"$basename.csv",
-filename=>"$basename.csv" );
my $cols = @$results[0]->{loopcol};
@@ -133,10 +138,50 @@
-values => \@dels,
-size => 1,
-multiple => 0 );
+ #branch
+ my $branches = GetBranches;
+ my @branchloop;
+ foreach my $thisbranch (keys %$branches) {
+# my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisbranch,
+# selected => $selected,
+ branchname => $branches->{$thisbranch}->{'branchname'},
+ );
+ push @branchloop, \%row;
+ }
+
+ #doctype
+ my $itemtypes = GetItemTypes;
+ my @itemtypeloop;
+ foreach my $thisitemtype (keys %$itemtypes) {
+# my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisitemtype,
+# selected => $selected,
+ description => $itemtypes->{$thisitemtype}->{'description'},
+ );
+ push @itemtypeloop, \%row;
+ }
+
+ #borcat
+ my ($codes,$labels) = GetborCatFromCatType(undef,undef);
+ my @borcatloop;
+ foreach my $thisborcat (sort keys %$labels) {
+ # my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisborcat,
+ # selected => $selected,
+ description => $labels->{$thisborcat},
+ );
+ push @borcatloop, \%row;
+ }
+ #Day
+ #Month
$template->param(
CGIextChoice => $CGIextChoice,
- CGIsepChoice => $CGIsepChoice
+ CGIsepChoice => $CGIsepChoice,
+ branchloop =>\@branchloop,
+ itemtypeloop =>\@itemtypeloop,
+ borcatloop =>\@borcatloop,
);
output_html_with_http_headers $input, $cookie, $template->output;
}
@@ -251,10 +296,7 @@
while (my ($celvalue) = $sth2->fetchrow) {
my %cell;
- # my %ft;
- # warn "coltitle :".$celvalue;
- $cell{coltitle} = $celvalue;
- # $ft{totalcol} = 0;
+ $cell{coltitle} = ($celvalue?$celvalue:"NULL");
push @loopcol, \%cell;
}
# warn "fin des titres colonnes";
@@ -307,31 +349,29 @@
$strcalc .= " group by biblio.biblionumber";
$strcalc .= ", $colfield" if ($column);
- $strcalc .= " order by ";
- $strcalc .= "$colfield, " if ($colfield);
- $strcalc .= "RANK DESC ";
- my $max;
- if (@loopcol) {
- $max = $line*@loopcol;
- } else { $max=$line;}
- $strcalc .= " LIMIT 0,$max";
+ $strcalc .= " order by RANK DESC";
+ $strcalc .= ", $colfield " if ($colfield);
+# my $max;
+# if (@loopcol) {
+# $max = $line*@loopcol;
+# } else { $max=$line;}
+# $strcalc .= " LIMIT 0,$max";
warn "SQL :". $strcalc;
my $dbcalc = $dbh->prepare($strcalc);
$dbcalc->execute;
# warn "filling table";
my $previous_col;
- my $i=1;
+ my %indice;
while (my @data = $dbcalc->fetchrow) {
my ($row, $rank, $id, $col )=@data;
$col = "zzEMPTY" if ($col eq undef);
- $i=1 if (($previous_col) and not($col eq $previous_col));
- $table[$i]->{$col}->{'name'}=$row;
- $table[$i]->{$col}->{'count'}=$rank;
- $table[$i]->{$col}->{'link'}=$id;
+ $indice{$col}=1 if (not($indice{$col}));
+ $table[$indice{$col}]->{$col}->{'name'}=$row;
+ $table[$indice{$col}]->{$col}->{'count'}=$rank;
+ $table[$indice{$col}]->{$col}->{'link'}=$id;
# warn " ".$i." ".$col. " ".$row;
- $i++;
- $previous_col=$col;
+ $indice{$col}++;
}
push @loopcol,{coltitle => "Global"} if not($column);
Index: catalogue_out.pl
===================================================================
RCS file: /sources/koha/koha/reports/catalogue_out.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- catalogue_out.pl 11 Sep 2006 17:41:55 -0000 1.6
+++ catalogue_out.pl 9 Mar 2007 15:13:36 -0000 1.7
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: catalogue_out.pl,v 1.6 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: catalogue_out.pl,v 1.7 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,8 +23,7 @@
use C4::Auth;
use CGI;
use C4::Context;
-use HTML::Template;
-use C4::Search;
+use C4::Branch; # GetBranches
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
@@ -58,10 +57,14 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
-$template->param(do_it => $do_it);
+$template->param(do_it => $do_it,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
if ($do_it) {
# Displaying results
my $results = calculate($limit, $column, \@filters);
@@ -73,6 +76,7 @@
} else {
# Printing to a csv file
print $input->header(-type => 'application/vnd.sun.xml.calc',
+ -encoding => 'utf-8',
-attachment=>"$basename.csv",
-filename=>"$basename.csv" );
my $cols = @$results[0]->{loopcol};
@@ -132,10 +136,35 @@
-values => \@dels,
-size => 1,
-multiple => 0 );
+ #doctype
+ my $itemtypes = GetItemTypes;
+ my @itemtypeloop;
+ foreach my $thisitemtype (keys %$itemtypes) {
+# my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisitemtype,
+# selected => $selected,
+ description => $itemtypes->{$thisitemtype}->{'description'},
+ );
+ push @itemtypeloop, \%row;
+ }
+
+ #branch
+ my $branches = GetBranches;
+ my @branchloop;
+ foreach my $thisbranch (keys %$branches) {
+# my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisbranch,
+# selected => $selected,
+ branchname => $branches->{$thisbranch}->{'branchname'},
+ );
+ push @branchloop, \%row;
+ }
$template->param(
CGIextChoice => $CGIextChoice,
- CGIsepChoice => $CGIsepChoice
+ CGIsepChoice => $CGIsepChoice,
+ itemtypeloop =>\@itemtypeloop,
+ branchloop =>\@branchloop,
);
output_html_with_http_headers $input, $cookie, $template->output;
}
@@ -231,9 +260,9 @@
my $strcalc ;
# Processing average loanperiods
- $strcalc .= "SELECT CONCAT( items.itemnumber, \" \",biblioitems.biblioitemnumber)";
+ $strcalc .= "SELECT items.barcode, biblio.title, biblio.biblionumber, biblio.author";
$strcalc .= " , $colfield " if ($colfield);
- $strcalc .= " FROM (items LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber) LEFT JOIN issues ON issues.itemnumber=items.itemnumber WHERE issues.itemnumber is null";
+ $strcalc .= " FROM (items LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber LEFT JOIN biblio ON biblio.biblionumber=items.biblionumber) LEFT JOIN issues ON issues.itemnumber=items.itemnumber WHERE issues.itemnumber is null";
# @$filters[0]=~ s/\*/%/g if (@$filters[0]);
# $strcalc .= " AND issues.timestamp <= '" . @$filters[0] ."'" if ( @$filters[0] );
# @$filters[1]=~ s/\*/%/g if (@$filters[1]);
@@ -263,10 +292,13 @@
my $previous_col;
my $i=1;
while (my @data = $dbcalc->fetchrow) {
- my ($row, $col )=@data;
+ my ($barcode,$title,$bibnum,$author, $col )=@data;
$col = "zzEMPTY" if ($col eq undef);
$i=1 if (($previous_col) and not($col eq $previous_col));
- $table[$i]->{$col}=$row;
+ $table[$i]->{$col}->{'barcode'}=$barcode;
+ $table[$i]->{$col}->{'title'}=$title;
+ $table[$i]->{$col}->{'bibnum'}=$bibnum;
+ $table[$i]->{$col}->{'author'}=$author;
# warn " ".$i." ".$col. " ".$row;
$i++;
$previous_col=$col;
@@ -281,13 +313,19 @@
# and the number matches the number of columns
my $colcount=0;
foreach my $col ( @loopcol ) {
- my $value;
+ my ($barcode, $author, $title, $bibnum);
if (@loopcol){
- $value =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}};
+ $barcode =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'barcode'};
+ $title =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'title'};
+ $author =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'author'};
+ $bibnum =$table[$i]->{(($col->{coltitle} eq "NULL") or ($col->{coltitle} eq "Global"))?"zzEMPTY":$col->{coltitle}}->{'bibnum'};
} else {
- $value =$table[$i]->{"zzEMPTY"};
+ $barcode =$table[$i]->{"zzEMPTY"}->{'barcode'};
+ $title =$table[$i]->{"zzEMPTY"}->{'title'};
+ $author =$table[$i]->{"zzEMPTY"}->{'author'};
+ $bibnum =$table[$i]->{"zzEMPTY"}->{'bibnum'};
}
- push @loopcell, {value => $value} ;
+ push @loopcell, {author=> $author, title=>$title,bibnum=>$bibnum,barcode=>$barcode} ;
}
push @looprow,{ 'rowtitle' => $i ,
'loopcell' => \@loopcell,
Index: catalogue_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/catalogue_stats.pl,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -b -r1.18 -r1.19
--- catalogue_stats.pl 11 Sep 2006 17:41:55 -0000 1.18
+++ catalogue_stats.pl 9 Mar 2007 15:13:36 -0000 1.19
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-## Will not work. Requires a complete re-write for ZEBRA
-# $Id: catalogue_stats.pl,v 1.18 2006/09/11 17:41:55 tgarip1957 Exp $
+
+# $Id: catalogue_stats.pl,v 1.19 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,7 +23,7 @@
use C4::Auth;
use CGI;
use C4::Context;
-use C4::Search;
+use C4::Branch; # GetBranches
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
@@ -31,7 +31,7 @@
=head1 NAME
-plugin that shows a stats on catalogue
+plugin that shows a stats on borrowers
=head1 DESCRIPTION
@@ -59,7 +59,7 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
$template->param(do_it => $do_it);
@@ -71,6 +71,7 @@
exit(1);
} else {
print $input->header(-type => 'application/vnd.sun.xml.calc',
+ -encoding => 'utf-8',
-attachment=>"$basename.csv",
-name=>"$basename.csv" );
my $cols = @$results[0]->{loopcol};
@@ -105,66 +106,99 @@
my %labels;
my $count=0;
my $req;
-###Use mfield of koha_attr instead of dewey
-my $sth = $dbh->prepare("select authorised_value from authorised_values where category='mfield' order by lib");
- $sth->execute;
- my @authorised_values;
- #push @authorised_values,"";
- while ((my $category) = $sth->fetchrow_array) {
- push @authorised_values, $category;
- }
-my $hasdewey;
- my $CGIdewey=CGI::scrolling_list( -name => 'Filter',
- -id => 'Filter',
- -values => \@authorised_values,
- -size => 1,
- -multiple => 0 );
-
-
- my $haslccn=1;
- my $hlghtlccn=1;
+ $req = $dbh->prepare("select count(dewey) from biblioitems ");
+ $req->execute;
+ my $hasdewey;
my @select;
- for my $value ("A".."Z") {
- push @select, $value;
- }
- my $CGIlccn=CGI::scrolling_list( -name => 'Filter',
- -id => 'Filter',
- -values => \@select,
- -size => 1,
- -multiple => 0 );
+# push @select,"";
+ while (my ($value) =$req->fetchrow) {
+ $hasdewey =1 if (($value>2) and (! $hasdewey));
+ $count++ if (($value>2) and (! $hasdewey));
+# push @select, $value;
+ }
+# my $CGIdewey=CGI::scrolling_list( -name => 'Filter',
+# -id => 'Filter',
+# -values => \@select,
+# -size => 1,
+# -multiple => 0 );
+ $req = $dbh->prepare( "select count(lccn) from biblioitems ");
+ $req->execute;
+# undef @select;
+# push @select,"";
+ my $haslccn;
+ my $hlghtlccn;
+ while (my ($value) =$req->fetchrow) {
+ $hlghtlccn = !($hasdewey);
+ $haslccn =1 if (($value>2) and (! $haslccn));
+ $count++ if (($value) and (! $haslccn));
+# push @select, $value;
+ }
+# my $CGIlccn=CGI::scrolling_list( -name => 'Filter',
+# -id => 'Filter',
+# -values => \@select,
+# -size => 1,
+# -multiple => 0 );
+
+ $req = $dbh->prepare("select count(itemcallnumber) from items");
+ $req->execute;
+# undef @select;
+# push @select,"";
my $hascote;
my $hlghtcote;
+ while (my ($value) =$req->fetchrow) {
+ $hascote =1 if (($value>2) and (! $hascote));
+ $count++ if (($value) and (! $hascote));
+ $hlghtcote = (($hasdewey) and ($haslccn)) or (!($hasdewey) and !($haslccn));
+# push @select, $value;
+ }
+# my $CGIcote=CGI::scrolling_list( -name => 'Filter',
+# -id => 'Filter',
+# -values => \@select,
+# -size => 1,
+# -multiple => 0 );
$count++;
my $hglghtDT =$count % 2;
+# warn "highlightDT ".$hglghtDT;
$count++;
my $hglghtPub =$count % 2;
+# warn "highlightPub ".$hglghtPub;
$count++;
my $hglghtPY =$count % 2;
+# warn "highlightPY ".$hglghtPY;
$count++;
my $hglghtHB =$count % 2;
+# warn "highlightHB ".$hglghtHB;
$count++;
my $hglghtLOC =$count % 2;
- my $hglghtSTACK =$count % 2;
+# warn "highlightLOC ".$hglghtLOC;
- my $itemtypes = GetItemTypes;
+
+ $req = $dbh->prepare("select distinctrow itemtype from biblioitems order by itemtype");
+ $req->execute;
undef @select;
push @select,"";
- my %select_item;
- $select_item{""} = "";
-foreach my $thisitemtype (sort keys %$itemtypes) {
- push @select,$thisitemtype;
- $select_item{$thisitemtype}=$itemtypes->{$thisitemtype}->{'description'};
-
-}
-
+ while (my ($value) =$req->fetchrow) {
+ push @select, $value;
+ }
my $CGIitemtype=CGI::scrolling_list( -name => 'Filter',
-id => 'itemtype',
-values => \@select,
- -labels=>\%select_item,
-size => 1,
-multiple => 0 );
+# $req = $dbh->prepare("select distinctrow left(publishercode,75) from biblioitems order by publishercode");
+# $req->execute;
+# undef @select;
+# push @select,"";
+# while (my ($value) =$req->fetchrow) {
+# push @select, $value;
+# }
+# my $CGIpublisher=CGI::scrolling_list( -name => 'Filter',
+# -id => 'Filter',
+# -values => \@select,
+# -size => 1,
+# -multiple => 0 );
undef @select;
push @select,"";
@@ -182,27 +216,13 @@
-size => 1,
-multiple => 0 );
- my $CGIholdingbranch=CGI::scrolling_list( -name => 'Filter',
- -id => 'holdingbranch',
- -values => \@select,
- -labels => \%select_branches,
- -size => 1,
- -multiple => 0 );
- $req = $dbh->prepare("select authorised_value,lib from authorised_values where category='sections'");
+ $req = $dbh->prepare("select distinctrow holdingbranch from items order by holdingbranch");
$req->execute;
undef @select;
push @select,"";
- my %desc;
- $desc{""}="";
- while (my ($value,$desc) =$req->fetchrow) {
- push @select, $value;
- $desc{$value}=$desc;
- }
-
- my $CGISTACK=CGI::scrolling_list( -name => 'Filter',
- -id => 'shelf',
+ my $CGIlocation=CGI::scrolling_list( -name => 'Filter',
+ -id => 'holdingbranch',
-values => \@select,
- -labels =>\%desc,
-size => 1,
-multiple => 0 );
@@ -227,12 +247,12 @@
-multiple => 0 );
$template->param(hasdewey=>$hasdewey,
- CGIFromDeweyClass => $CGIdewey,
- CGIToDeweyClass => $CGIdewey,
+# CGIFromDeweyClass => $CGIdewey,
+# CGIToDeweyClass => $CGIdewey,
haslccn=> $haslccn,
hlghtlccn => $hlghtlccn,
- CGIFromLoCClass => $CGIlccn,
- CGIToLoCClass => $CGIlccn,
+# CGIFromLoCClass => $CGIlccn,
+# CGIToLoCClass => $CGIlccn,
hascote=> $hascote,
hlghtcote => $hlghtcote,
hglghtDT => $hglghtDT,
@@ -240,11 +260,14 @@
hglghtPY => $hglghtPY,
hglghtHB => $hglghtHB,
hglghtLOC => $hglghtLOC,
- hglghtSTACK => $hglghtSTACK,
+# CGIFromCoteClass => $CGIcote,
+# CGIToCoteClass => $CGIcote,
CGIItemType => $CGIitemtype,
+# CGIFromPublicationYear => $CGIpublicationyear,
+# CGIToPublicationYear => $CGIpublicationyear,
+# CGIPublisher => $CGIpublisher,
CGIBranch => $CGIbranch,
- CGILocation => $CGIbranch,
- CGISTACK => $CGISTACK,
+ CGILocation => $CGIlocation,
CGIextChoice => $CGIextChoice,
CGIsepChoice => $CGIsepChoice
);
@@ -279,17 +302,16 @@
$cell{filter} .= @$filters[$i];
$cell{crit} .="Dewey Classification From" if ($i==0);
$cell{crit} .="Dewey Classification To" if ($i==1);
- $cell{crit} .="Classification From" if ($i==2);
- $cell{crit} .="Classification To" if ($i==3);
- $cell{crit} .="Call Number From" if ($i==4);
- $cell{crit} .="Call Number To" if ($i==5);
+ $cell{crit} .="Lccn Classification From" if ($i==2);
+ $cell{crit} .="Lccn Classification To" if ($i==3);
+ $cell{crit} .="Cote Classification From" if ($i==4);
+ $cell{crit} .="Cote Classification To" if ($i==5);
$cell{crit} .="Document type" if ($i==6);
$cell{crit} .="Publisher" if ($i==7);
$cell{crit} .="Publication year From" if ($i==8);
$cell{crit} .="Publication year To" if ($i==9);
$cell{crit} .="Branch :" if ($i==10);
$cell{crit} .="Location:" if ($i==11);
- $cell{crit} .="Shelving:" if ($i==12);
push @loopfilter, \%cell;
}
}
@@ -302,47 +324,46 @@
$linefilter[0] = @$filters[0] if ($line =~ /dewey/ ) ;
$linefilter[1] = @$filters[1] if ($line =~ /dewey/ ) ;
- $linefilter[0] = @$filters[2] if ($line =~ /classification/ ) ;
- $linefilter[1] = @$filters[3] if ($line =~ /classification/ ) ;
- $linefilter[0] = @$filters[4] if ($line =~ /itemcallnumber/ ) ;
- $linefilter[1] = @$filters[5] if ($line =~ /itemcallnumber/ ) ;
+ $linefilter[0] = @$filters[2] if ($line =~ /lccn/ ) ;
+ $linefilter[1] = @$filters[3] if ($line =~ /lccn/ ) ;
+ $linefilter[0] = @$filters[4] if ($line =~ /items.itemcallnumber/ ) ;
+ $linefilter[1] = @$filters[5] if ($line =~ /items.itemcallnumber/ ) ;
$linefilter[0] = @$filters[6] if ($line =~ /itemtype/ ) ;
$linefilter[0] = @$filters[7] if ($line =~ /publishercode/ ) ;
$linefilter[0] = @$filters[8] if ($line =~ /publicationyear/ ) ;
$linefilter[1] = @$filters[9] if ($line =~ /publicationyear/ ) ;
- $linefilter[0] = @$filters[10] if ($line =~ /homebranch/ ) ;
- $linefilter[0] = @$filters[11] if ($line =~ /holdingbranch/ ) ;
- $linefilter[0] = @$filters[12] if ($line =~ /shelf/ ) ;
+ @linefilter[0] = @$filters[10] if ($line =~ /items.homebranch/ ) ;
+ @linefilter[0] = @$filters[11] if ($line =~ /items.holdingbranch/ ) ;
#
my @colfilter ;
$colfilter[0] = @$filters[0] if ($column =~ /dewey/ ) ;
$colfilter[1] = @$filters[1] if ($column =~ /dewey/ ) ;
- $colfilter[0] = @$filters[2] if ($column =~ /classification/ ) ;
- $colfilter[1] = @$filters[3] if ($column =~ /classification/ ) ;
+ $colfilter[0] = @$filters[2] if ($column =~ /lccn/ ) ;
+ $colfilter[1] = @$filters[3] if ($column =~ /lccn/ ) ;
$colfilter[0] = @$filters[4] if ($column =~ /itemcallnumber/ ) ;
$colfilter[1] = @$filters[5] if ($column =~ /itemcallnumber/ ) ;
$colfilter[0] = @$filters[6] if ($column =~ /itemtype/ ) ;
$colfilter[0] = @$filters[7] if ($column =~ /publishercode/ ) ;
$colfilter[0] = @$filters[8] if ($column =~ /publicationyear/ ) ;
$colfilter[1] = @$filters[9] if ($column =~ /publicationyear/ ) ;
- $colfilter[0] = @$filters[10] if ($column =~ /homebranch/ ) ;
- $colfilter[0] = @$filters[11] if ($column =~ /holdingbranch/ ) ;
- $colfilter[0] = @$filters[12] if ($column =~ /shelf/ ) ;
+ @colfilter[0] = @$filters[10] if ($column =~ /items.homebranch/ ) ;
+ @colfilter[0] = @$filters[11] if ($column =~ /items.holdingbranch/ ) ;
+
# 1st, loop rows.
my $linefield;
if (($line =~/dewey/) and ($deweydigits)) {
$linefield .="left($line,$deweydigits)";
- } elsif (($line=~/classification/) and ($lccndigits)) {
+ } elsif (($line=~/lccn/) and ($lccndigits)) {
$linefield .="left($line,$lccndigits)";
- } elsif (($line=~/itemcallnumber/) and ($cotedigits)) {
+ } elsif (($line=~/items.itemcallnumber/) and ($cotedigits)) {
$linefield .="left($line,$cotedigits)";
}else {
$linefield .= $line;
}
-warn $linefield,$colfilter[0],$linefilter[0],$line;
+
my $strsth;
- $strsth .= "select distinctrow $linefield from biblio left join items on (items.biblionumber = biblio.biblionumber) where $line is not null ";
+ $strsth .= "select distinctrow $linefield from biblioitems left join items on (items.biblioitemnumber = biblioitems.biblioitemnumber) where $line is not null ";
if ( @linefilter ) {
if ($linefilter[1]){
$strsth .= " and $line >= ? " ;
@@ -378,7 +399,7 @@
my $colfield;
if (($column =~/dewey/) and ($deweydigits)) {
$colfield .="left($column,$deweydigits)";
- }elsif (($column=~/classification/) and ($lccndigits)) {
+ }elsif (($column=~/lccn/) and ($lccndigits)) {
$colfield .="left($column,$lccndigits)";
}elsif (($column=~/itemcallnumber/) and ($cotedigits)) {
$colfield .="left($column,$cotedigits)";
@@ -387,7 +408,7 @@
}
my $strsth2;
- $strsth2 .= "select distinctrow $colfield from biblio left join items on (items.biblionumber = biblio.biblionumber) where $column is not null ";
+ $strsth2 .= "select distinctrow $colfield from biblioitems left join items on (items.biblioitemnumber = biblioitems.biblioitemnumber) where $column is not null ";
if (( @colfilter ) and ($colfilter[1])) {
$strsth2 .= " and $column> ? and $column< ?";
}elsif ($colfilter[0]){
@@ -431,83 +452,45 @@
}
$table{$row->{rowtitle}}->{totalrow}=0;
}
-my @kohafield;
-my @values;
-my @and_or;
-my @relations;
-# preparing calculation in zebra
+
+# preparing calculation
my $strcalc .= "SELECT $linefield, $colfield, count( * ) FROM biblioitems LEFT JOIN items ON (items.biblioitemnumber = biblioitems.biblioitemnumber) WHERE 1";
if (@$filters[0]){
@$filters[0]=~ s/\*/%/g;
$strcalc .= " AND dewey >" . @$filters[0] ."";
- push @and_or, "\@and";
- push @relations "\@attr 2=5";
- push @kohafield, "dewey";
- push @values, @$filters[0] ;
-
}
if (@$filters[1]){
@$filters[1]=~ s/\*/%/g ;
$strcalc .= " AND dewey <" . @$filters[1] ."";
- push @and_or, "\@and";
- push @relations "\@attr 2=1";
- push @kohafield, "dewey";
- push @values, @$filters[1] ;
-
}
if (@$filters[2]){
@$filters[2]=~ s/\*/%/g ;
- $strcalc .= " AND classification >=" .$dbh->quote(@$filters[2]) ."" ;
- push @and_or, "\@and";
- push @relations "\@attr 2=4";
- push @kohafield, "classification";
- push @values, @$filters[2];
-
+ $strcalc .= " AND lccn >" . @$filters[2] ."" ;
}
if (@$filters[3]){
@$filters[3]=~ s/\*/%/g;
- $strcalc .= " AND classification <=" . $dbh->quote(@$filters[3]) ."" ;
- push @and_or, "\@and";
- push @relations "\@attr 2=2";
- push @kohafield, "classification";
- push @values, @$filters[3] ;
+ $strcalc .= " AND lccn <" . @$filters[3] ."" ;
}
if (@$filters[4]){
@$filters[4]=~ s/\*/%/g ;
$strcalc .= " AND items.itemcallnumber >=" . $dbh->quote(@$filters[4]) ."" ;
- push @and_or, "\@and";
- push @relations "\@attr 2=4";
- push @kohafield, "itemcallnumber";
- push @values, @$filters[4] ;
}
if (@$filters[5]){
@$filters[5]=~ s/\*/%/g;
$strcalc .= " AND items.itemcallnumber <=" . $dbh->quote(@$filters[5]) ."" ;
- push @and_or, "\@and";
- push @relations "\@attr 2=2";
- push @kohafield, "itemcallnumber";
- push @values, @$filters[5] ;
}
if (@$filters[6]){
@$filters[6]=~ s/\*/%/g;
$strcalc .= " AND biblioitems.itemtype like '" . @$filters[6] ."'";
- push @and_or, "\@and";
- push @relations "\@attr 2=3";
- push @kohafield, "itemtype";
- push @values, @$filters[6] ;
}
if (@$filters[7]){
@$filters[7]=~ s/\*/%/g;
@$filters[7].="%" unless @$filters[7]=~/%/;
$strcalc .= " AND biblioitems.publishercode like \"" . @$filters[7] ."\"";
- push @and_or, "\@and";
- push @relations "\@attr 2=3";
- push @kohafield, "publishercode";
- push @values, @$filters[7];
}
if (@$filters[8]){
@$filters[8]=~ s/\*/%/g;
@@ -525,14 +508,11 @@
@$filters[11]=~ s/\*/%/g;
$strcalc .= " AND items.holdingbranch like '" . @$filters[11] ."'" if ( @$filters[11] );
}
- if (@$filters[12]){
- @$filters[12]=~ s/\*/%/g;
- $strcalc .= " AND items.stack like '" . @$filters[12] ."'" if ( @$filters[12] );
- }
+
$strcalc .= " group by $linefield, $colfield order by $linefield,$colfield";
warn "". $strcalc;
my $dbcalc = $dbh->prepare($strcalc);
-# $dbcalc->execute;
+ $dbcalc->execute;
# warn "filling table";
my $emptycol;
@@ -547,6 +527,11 @@
$grantotal += $value;
}
+# my %cell = {rowtitle => 'zzROWEMPTY'};
+# push @loopline,\%cell;
+# undef %cell;
+# my %cell;
+# %cell = {coltitle => "zzEMPTY"};
push @loopcol,{coltitle => "NULL"} if ($emptycol);
foreach my $row ( sort keys %table ) {
Index: inventory.pl
===================================================================
RCS file: /sources/koha/koha/reports/inventory.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -b -r1.3 -r1.4
--- inventory.pl 11 Sep 2006 17:41:55 -0000 1.3
+++ inventory.pl 9 Mar 2007 15:13:36 -0000 1.4
@@ -24,7 +24,8 @@
use C4::Output;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2;
-use C4::Biblio;
+use C4::Date;
+
# Fixed variables
my $linecolor1='#ffffcc';
@@ -38,60 +39,90 @@
# Main loop....
my $input = new CGI;
my $minlocation=$input->param('minlocation');
-#my $maxlocation=$input->param('maxlocation');
-#$maxlocation=$minlocation.'Z' unless $maxlocation;
+my $maxlocation=$input->param('maxlocation');
+$maxlocation=$minlocation.'Z' unless $maxlocation;
my $datelastseen = $input->param('datelastseen');
my $offset = $input->param('offset');
my $markseen = $input->param('markseen');
$offset=0 unless $offset;
my $pagesize = $input->param('pagesize');
$pagesize=20 unless $pagesize;
+my $uploadbarcodes = $input->param('uploadbarcodes');
+# warn "uploadbarcodes : ".$uploadbarcodes;
my ($template, $borrowernumber, $cookie)
= get_template_and_user({template_name => "reports/inventory.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
$template->param(minlocation => $minlocation,
-
+ maxlocation => $maxlocation,
offset => $offset,
pagesize => $pagesize,
datelastseen => $datelastseen,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
);
-if ($markseen) {
+if ($uploadbarcodes && length($uploadbarcodes)>0){
+ my $dbh=C4::Context->dbh;
+ my $date=format_date($input->param('setdate'));
+ $date = format_date("today") unless $date;
+# warn "$date";
+ my $strsth="update items set (datelastseen = $date) where items.barcode =?";
+ my $qupdate = $dbh->prepare($strsth);
+ my $strsth="select * from issues, items where items.itemnumber=issues.itemnumber and items.barcode =? and issues.returndate is null";
+ my $qonloan = $dbh->prepare($strsth);
+ my $strsth="select * from items where items.barcode =? and issues.wthdrawn=1";
+ my $qwthdrawn = $dbh->prepare($strsth);
+ my @errorloop;
+ my $count=0;
+ while (my $barcode=<$uploadbarcodes>){
+ chomp $barcode;
+# warn "$barcode";
+ if ($qwthdrawn->execute($barcode) &&$qwthdrawn->rows){
+ push @errorloop, {'barcode'=>$barcode,'ERR_WTHDRAWN'=>1};
+ }else{
+ $qupdate->execute($barcode);
+ $count += $qupdate->rows;
+# warn "$count";
+ if ($count){
+ $qonloan->execute($barcode);
+ if ($qonloan->rows){
+ my $data = $qonloan->fetchrow_hashref;
+ my ($doreturn, $messages, $iteminformation, $borrower) =returnbook($barcode, $data->{homebranch});
+ if ($doreturn){push @errorloop, {'barcode'=>$barcode,'ERR_ONLOAN_RET'=>1}}
+ else {push @errorloop, {'barcode'=>$barcode,'ERR_ONLOAN_NOT_RET'=>1}}
+ }
+ } else {
+ push @errorloop, {'barcode'=>$barcode,'ERR_BARCODE'=>1};
+ }
+ }
+ }
+ $qupdate->finish;
+ $qonloan->finish;
+ $qwthdrawn->finish;
+ $template->param(date=>$date,Number=>$count);
+# $template->param(errorfile=>$errorfile) if ($errorfile);
+ $template->param(errorloop=>\@errorloop) if (@errorloop);
+}else{
+ if ($markseen) {
foreach my $field ($input->param) {
if ($field =~ /SEEN-(.*)/) {
&itemseen($1);
- &returnbook($1,"MAIN");
}
}
-}
-if ($minlocation) {
- my @results = listitemsforinventory($minlocation,$datelastseen,$offset,$pagesize);
-## @results is now a hash of kohaxml
-## convert to normal koha hash for the templates
-my @res;
-my $i=0;
-foreach my $xml(@results) {
-
- my @kohafields; ## just parse the fields required
- push @kohafields,"title","author","biblionumber","itemnumber","barcode","itemcallnumber";
- my $dbh=C4::Context->dbh;
- my ($biblio, at itemrecords) = XMLmarc2koha($dbh,$xml,"", at kohafields);
- foreach my $data(@itemrecords){
- $data->{title}=$biblio->{title};
- $data->{author}=$biblio->{author};
- push @res,$data;
-
}
-}
- $template->param(loop =>\@res,
+ if ($minlocation) {
+ my $res = C4::Circulation::Circ2::listitemsforinventory($minlocation,$maxlocation,$datelastseen,$offset,$pagesize);
+ $template->param(loop =>$res,
nextoffset => ($offset+$pagesize),
prevoffset => ($offset?$offset-$pagesize:0),
);
+ }
}
output_html_with_http_headers $input, $cookie, $template->output;
Index: issues_avg_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/issues_avg_stats.pl,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -b -r1.6 -r1.7
--- issues_avg_stats.pl 11 Sep 2006 17:41:55 -0000 1.6
+++ issues_avg_stats.pl 9 Mar 2007 15:13:36 -0000 1.7
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: issues_avg_stats.pl,v 1.6 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: issues_avg_stats.pl,v 1.7 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,13 +23,12 @@
use C4::Auth;
use CGI;
use C4::Context;
-use HTML::Template;
-use C4::Search;
+use C4::Branch; # GetBranches
use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2;
-use Date::Manip;
+use Date::Calc qw(Delta_Days);
=head1 NAME
@@ -61,10 +60,14 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
-$template->param(do_it => $do_it);
+$template->param(do_it => $do_it,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
if ($do_it) {
# Displaying results
my $results = calculate($line, $column, $rodsp, $podsp, $calc, \@filters);
@@ -76,6 +79,7 @@
} else {
# Printing to a csv file
print $input->header(-type => 'application/vnd.sun.xml.calc',
+ -encoding => 'utf-8',
-attachment=>"$basename.csv",
-filename=>"$basename.csv" );
my $cols = @$results[0]->{loopcol};
@@ -157,7 +161,7 @@
$hassort1 =1 if ($value);
push @select, $value;
}
- my $branches=getbranches();
+ my $branches=GetBranches();
my @select_branch;
my %select_branches;
push @select_branch,"";
@@ -337,7 +341,7 @@
$linefield .="Year($line)";
$lineorder .= $line;
} elsif (($line=~/timestamp/) or ($line=~/returndate/)){
- $linefield .= "date_format('$line',\"%Y-%m-%d\")";
+ $linefield .= "date_format(\'$line\',\"%Y-%m-%d\")";
$lineorder .= $line;
} else {
$linefield .= $line;
@@ -351,9 +355,9 @@
if ($linefilter[1] and ($linefilter[0])){
$strsth .= " and $line between '$linefilter[0]' and '$linefilter[1]' " ;
} elsif ($linefilter[1]) {
- $strsth .= " and $line < '$linefilter[1]' " ;
+ $strsth .= " and $line < \'$linefilter[1]\' " ;
} elsif ($linefilter[0]) {
- $strsth .= " and $line > '$linefilter[0]' " ;
+ $strsth .= " and $line > \'$linefilter[0]\' " ;
}
if ($linefilter[2]){
$strsth .= " and dayname($line) = '$linefilter[2]' " ;
@@ -475,7 +479,7 @@
# Processing average loanperiods
$strcalc .= "SELECT $linefield, $colfield, ";
- $strcalc .= " DATE_SUB(date_due, INTERVAL CAST(issuingrules.issuelength AS SIGNED INTEGER) * (CAST(issues.renewals AS SIGNED INTEGER)+1) DAY) AS issuedate, returndate, COUNT(*), date_due, issues.renewals, issuelength FROM `issues`,borrowers,biblioitems LEFT JOIN items ON (biblioitems.biblioitemnumber=items.biblioitemnumber) LEFT JOIN issuingrules ON (issuingrules.branchcode=issues.branchcode AND issuingrules.itemtype=biblioitems.itemtype AND issuingrules.categorycode=borrowers.categorycode) WHERE issues.itemnumber=items.itemnumber AND issues.borrowernumber=borrowers.borrowernumber and returndate is not null";
+ $strcalc .= " issuedate, returndate, COUNT(*), date_due, issues.renewals, issuelength FROM `issues`,borrowers,biblioitems LEFT JOIN items ON (biblioitems.biblioitemnumber=items.biblioitemnumber) LEFT JOIN issuingrules ON (issuingrules.branchcode=issues.branchcode AND issuingrules.itemtype=biblioitems.itemtype AND issuingrules.categorycode=borrowers.categorycode) WHERE issues.itemnumber=items.itemnumber AND issues.borrowernumber=borrowers.borrowernumber and returndate is not null";
@$filters[0]=~ s/\*/%/g if (@$filters[0]);
$strcalc .= " AND issues.timestamp > '" . @$filters[0] ."'" if ( @$filters[0] );
@@ -521,10 +525,10 @@
$col = "zzEMPTY" if ($col eq undef);
$row = "zzEMPTY" if ($row eq undef);
# warn "506 row :".$row." column :".$col;
- my @result =split /:/,DateCalc($returndate,$issuedate) ;
+ my $result =Delta_Days(split(/-/,$issuedate),split (/-/,$returndate)) ;
# DateCalc returns => 0:0:WK:DD:HH:MM:SS the weeks, days, hours, minutes,
# and seconds between the two
- $loanlength = $result[2]*7+$result[3];
+ $loanlength = $result;
# warn "512 Same row and col DateCalc returns :$loanlength with return ". $returndate ."issue ". $issuedate ."weight : ". $weight;
# warn "513 row :".$row." column :".$col;
$table{$row}->{$col}+=$weight*$loanlength;
Index: issues_by_borrower_category.plugin
===================================================================
RCS file: /sources/koha/koha/reports/issues_by_borrower_category.plugin,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- issues_by_borrower_category.plugin 11 Sep 2006 17:41:55 -0000 1.5
+++ issues_by_borrower_category.plugin 9 Mar 2007 15:13:36 -0000 1.6
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: issues_by_borrower_category.plugin,v 1.5 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: issues_by_borrower_category.plugin,v 1.6 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,9 +23,11 @@
use C4::Auth;
use CGI;
use C4::Context;
+use HTML::Template;
use C4::Search;
use C4::Output;
use C4::Koha;
+use C4::Branch; # GetBranches
=head1 NAME
@@ -100,13 +102,13 @@
}
# now, parse each category. Before filling the result array, fill it with 0 to have every itemtype column.
my $strsth="SELECT itemtype, count( * )
- FROM issues, borrowers, biblio, items
+ FROM issues, borrowers, biblioitems, items
WHERE issues.borrowernumber = borrowers.borrowernumber
AND items.itemnumber = issues.itemnumber
- AND biblio.biblionumber = items.biblionumber
+ AND biblioitems.biblionumber = items.biblionumber
AND borrowers.categorycode = ?";
$strsth.= " AND borrowers.branchcode = ".$dbh->quote($branch) if ($branch);
- $strsth .= " GROUP BY biblio.itemtype";
+ $strsth .= " GROUP BY biblioitems.itemtype";
my $sth = $dbh->prepare($strsth);
my $sthcategories = $dbh->prepare("select categorycode,description from categories");
$sthcategories->execute;
Index: issues_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/issues_stats.pl,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -b -r1.14 -r1.15
--- issues_stats.pl 11 Sep 2006 17:41:55 -0000 1.14
+++ issues_stats.pl 9 Mar 2007 15:13:36 -0000 1.15
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: issues_stats.pl,v 1.14 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: issues_stats.pl,v 1.15 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,7 +23,8 @@
use C4::Auth;
use CGI;
use C4::Context;
-use C4::Search;
+use C4::Branch; # GetBranches
+use C4::Output;
use C4::Koha;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2;
@@ -40,8 +41,6 @@
=cut
-
-
my $input = new CGI;
my $do_it=$input->param('do_it');
my $fullreportname = "reports/issues_stats.tmpl";
@@ -63,10 +62,14 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
-$template->param(do_it => $do_it);
+$template->param(do_it => $do_it,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
if ($do_it) {
# Displaying results
my $results = calculate($line, $column, $podsp, $type, $daysel, $monthsel, $calc, \@filters);
@@ -78,6 +81,7 @@
} else {
# Printing to a csv file
print $input->header(-type => 'application/vnd.sun.xml.calc',
+ -encoding => 'utf-8',
-attachment=>"$basename.csv",
-filename=>"$basename.csv" );
my $cols = @$results[0]->{loopcol};
@@ -305,7 +309,7 @@
my $linefield;
if (($line =~/datetime/) and ($dsp == 1)) {
#Display by day
- $linefield .="concat(weekday($line),' ',dayname($line))";
+ $linefield .="dayname($line)";
} elsif (($line=~/datetime/) and ($dsp == 2)) {
#Display by Month
$linefield .="monthname($line)";
@@ -318,7 +322,9 @@
$linefield .= $line;
}
my $lineorder = $linefield;
- $lineorder = "weekday($line)" if $lineorder =~ "^dayname";
+ $lineorder = "weekday($line)" if $linefield =~ /dayname/;
+ $lineorder = "month($line)" if $linefield =~ "^month";
+ $lineorder = $linefield if (not ($linefield =~ "^month") and not($linefield =~ /dayname/));
my $strsth;
$strsth .= "select distinctrow $linefield from statistics, borrowers where (statistics.borrowernumber=borrowers.borrowernumber) and $line is not null ";
@@ -364,6 +370,7 @@
# 2nd, loop cols.
my $colfield;
+ my $colorder;
if (($column =~/datetime/) and ($dsp == 1)) {
#Display by day
$colfield .="dayname($column)";
@@ -378,6 +385,9 @@
} else {
$colfield .= $column;
}
+ $colorder = "weekday($line)" if $colfield =~ "^dayname";
+ $colorder = "month($line)" if $colfield =~ "^month";
+ $colorder = $colfield if (not ($colfield =~ "^month") and not($colfield =~ "^dayname"));
my $strsth2;
$strsth2 .= "select distinctrow $colfield from statistics, borrowers where (statistics.borrowernumber=borrowers.borrowernumber) and $column is not null ";
@@ -398,7 +408,7 @@
$strsth2 .= " and $column LIKE ? " ;
}
$strsth2 .=" group by $colfield";
- $strsth2 .=" order by $colfield";
+ $strsth2 .=" order by $colorder";
# warn "". $strsth2;
my $sth2 = $dbh->prepare( $strsth2 );
@@ -441,11 +451,17 @@
$strcalc .= "SELECT $linefield, $colfield, ";
$strcalc .= "COUNT( * ) " if ($process ==1);
+ if ($process ==2){
+ $strcalc .= "(COUNT(DISTINCT borrowers.borrowernumber))" ;
+ }
if ($process ==3){
+ $strcalc .= "(COUNT(DISTINCT issues.itemnumber))" ;
+ }
+ if ($process ==4){
my $rqbookcount = $dbh->prepare("SELECT count(*) FROM items");
$rqbookcount->execute;
my ($bookcount) = $rqbookcount->fetchrow;
- $strcalc .= "100*(COUNT(itemnumber))/ $bookcount " ;
+ $strcalc .= "100*(COUNT(DISTINCT issues.itemnumber))/ $bookcount " ;
}
$strcalc .= "FROM statistics,borrowers where (statistics.borrowernumber=borrowers.borrowernumber) ";
@@ -467,14 +483,14 @@
$strcalc .= " AND monthname(datetime) like '" . $monthsel ."'" if ( $monthsel );
$strcalc .= " AND statistics.type like '" . $type ."'" if ( $type );
- $strcalc .= " group by $linefield, $colfield order by $lineorder,$colfield";
+ $strcalc .= " group by $linefield, $colfield order by $lineorder,$colorder";
warn "". $strcalc;
my $dbcalc = $dbh->prepare($strcalc);
$dbcalc->execute;
# warn "filling table";
my $emptycol;
while (my ($row, $col, $value) = $dbcalc->fetchrow) {
-# warn "filling table $row / $col / $value ";
+ warn "filling table $row / $col / $value ";
$emptycol = 1 if ($col eq undef);
$col = "zzEMPTY" if ($col eq undef);
$row = "zzEMPTY" if ($row eq undef);
@@ -485,18 +501,18 @@
}
push @loopcol,{coltitle => "NULL"} if ($emptycol);
- foreach my $row ( sort keys %table ) {
+ foreach my $row (@loopline) {
my @loopcell;
#@loopcol ensures the order for columns is common with column titles
# and the number matches the number of columns
foreach my $col ( @loopcol ) {
- my $value =$table{$row}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}};
+ my $value =$table{($row->{rowtitle} eq "NULL")?"zzEMPTY":$row->{rowtitle}}->{($col->{coltitle} eq "NULL")?"zzEMPTY":$col->{coltitle}};
push @loopcell, {value => $value } ;
}
- push @looprow,{ 'rowtitle' => ($row eq "zzEMPTY")?"NULL":$row,
+ push @looprow,{ 'rowtitle' => ($row->{rowtitle} eq "NULL")?"zzEMPTY":$row->{rowtitle},
'loopcell' => \@loopcell,
'hilighted' => ($hilighted >0),
- 'totalrow' => $table{$row}->{totalrow}
+ 'totalrow' => $table{($row->{rowtitle} eq "NULL")?"zzEMPTY":$row->{rowtitle}}->{totalrow}
};
$hilighted = -$hilighted;
}
Index: itemtypes.plugin
===================================================================
RCS file: /sources/koha/koha/reports/itemtypes.plugin,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- itemtypes.plugin 11 Sep 2006 17:41:55 -0000 1.4
+++ itemtypes.plugin 9 Mar 2007 15:13:36 -0000 1.5
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-# $Id: itemtypes.plugin,v 1.4 2006/09/11 17:41:55 tgarip1957 Exp $
+# $Id: itemtypes.plugin,v 1.5 2007/03/09 15:13:36 tipaul Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -23,10 +23,11 @@
use C4::Auth;
use CGI;
use C4::Context;
+use HTML::Template;
use C4::Search;
use C4::Output;
use C4::Koha;
-
+use C4::Branch; # GetBranches
=head1
=cut
@@ -60,14 +61,15 @@
my $dbh = C4::Context->dbh;
my $sth;
if ($branch) {
- $sth = $dbh->prepare("select description, biblio.itemtype, count(*) as total from itemtypes, biblio, items
- where biblio.itemtype=itemtypes.itemtype
- and items.biblionumber=biblio.biblionumber
+ $sth = $dbh->prepare("select description, biblioitems.itemtype, count(*) as total from itemtypes, biblioitems, items
+ where biblioitems.itemtype=itemtypes.itemtype
+ and items.biblioitemnumber=biblioitems.biblioitemnumber
and items.holdingbranch=?
- group by biblio.itemtype");
+ group by biblioitems.itemtype");
$sth->execute($branch);
} else {
- $sth = $dbh->prepare("select description, biblio.itemtype, count(*) as total from itemtypes, biblio where biblio.itemtype=itemtypes.itemtype group by biblio.itemtype");
+ $sth = $dbh->prepare("select description, biblioitems.itemtype, count(*) as total from itemtypes, biblioitems,items where biblioitems.itemtype=itemtypes.itemtype
+ and biblioitems.biblioitemnumber = items.biblioitemnumber group by biblioitems.itemtype");
$sth->execute;
}
my ($description,$biblioitems,$total);
Index: manager.pl
===================================================================
RCS file: /sources/koha/koha/reports/manager.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- manager.pl 11 Sep 2006 17:41:55 -0000 1.4
+++ manager.pl 9 Mar 2007 15:13:36 -0000 1.5
@@ -21,6 +21,7 @@
use CGI;
use C4::Auth;
use C4::Context;
+use C4::Output;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2;
@@ -35,11 +36,15 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {editcatalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
$template->param(do_it => $do_it,
- report_name => $report_name);
+ report_name => $report_name,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
my $cgidir = C4::Context->config('intranetdir')."/cgi-bin/reports/";
unless (opendir(DIR, "$cgidir")) {
$cgidir = C4::Context->intranetdir."/reports/";
Index: reports-home.pl
===================================================================
RCS file: /sources/koha/koha/reports/reports-home.pl,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- reports-home.pl 11 Sep 2006 17:41:55 -0000 1.4
+++ reports-home.pl 9 Mar 2007 15:13:36 -0000 1.5
@@ -1,12 +1,28 @@
#!/usr/bin/perl
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# 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
+#
+
use strict;
use CGI;
use C4::Auth;
use C4::Output;
use C4::Interface::CGI::Output;
use C4::Context;
-use HTML::Template;
+
my $query = new CGI;
my ($template, $loggedinuser, $cookie)
@@ -14,7 +30,11 @@
query => $query,
type => "intranet",
authnotrequired => 0,
- flagsrequired => {catalogue => 1},
+ flagsrequired => {reports => 1},
debug => 1,
});
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
output_html_with_http_headers $query, $cookie, $template->output;
Index: reservereport.pl
===================================================================
RCS file: /sources/koha/koha/reports/reservereport.pl,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- reservereport.pl 11 Sep 2006 17:41:55 -0000 1.10
+++ reservereport.pl 9 Mar 2007 15:13:36 -0000 1.11
@@ -20,16 +20,30 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# script now takes a branchcode arg
+# eg: http://koha.rangitikei.katipo.co.nz/cgi-bin/koha/reports/reservereport.pl?branch=BL
+
use strict;
use C4::Stats;
use C4::Date;
use CGI;
use C4::Output;
+use C4::Branch; # GetBranches
use C4::Auth;
use C4::Interface::CGI::Output;
+use C4::Koha;
+
my $input = new CGI;
my $time = $input->param('time');
+my $branch = $input->param('branch');
+my $sort = $input->param('sort');
+
+if (!$branch) {
+ $branch = "ALL";
+}
+
+my $branches=GetBranches();
my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
{
@@ -37,12 +51,26 @@
query => $input,
type => "intranet",
authnotrequired => 0,
- flagsrequired => { editcatalogue => 1 },
+ flagsrequired => { reports => 1 },
debug => 1,
}
);
-my ( $count, $data ) = unfilledreserves();
+# building up branches dropdown box
+
+my %branchall;
+my $branchcount=0;
+my @branchloop;
+
+foreach my $br (keys %$branches) {
+ $branchcount++;
+ my %branch1;
+ $branch1{name}=$branches->{$br}->{'branchname'};
+ $branch1{value}=$br;
+ push(@branchloop,\%branch1);
+ }
+
+my ( $count, $data ) = unfilledreserves($branch);
my @dataloop;
my $toggle;
@@ -52,21 +80,71 @@
$line{'borrowernumber'} = $data->[$i]->{'borrowernumber'};
$line{'surname'} = $data->[$i]->{'surname'};
$line{'firstname'} = $data->[$i]->{'firstname'};
+ $line{'sortdate'} = $data->[$i]->{'reservedate'};
$line{'reservedate'} = format_date($data->[$i]->{'reservedate'});
$line{'biblionumber'} = $data->[$i]->{'biblionumber'};
$line{'title'} = $data->[$i]->{'title'};
$line{'classification'} = $data->[$i]->{'classification'};
$line{'dewey'} = $data->[$i]->{'dewey'};
$line{'status'} = $data->[$i]->{'found'};
+ $line{'branchcode'} = $data->[$i]->{'branchcode'};
$line{'toggle'} = $toggle;
+ if ( $line{'status'} ne 'W' ) {
+
+ # its not waiting, we need to find if its on issue, or on the shelf
+ # FIXME still need to shift the text to the template so its translateable
+ if ( $data->[$i]) {
+ # find if its on issue
+ my @items = &GetItemsInfo($line{'biblionumber'}, 'intra' );
+ my $onissue = 0;
+ foreach my $item (@items) {
+ if ( $item->{'datedue'} eq 'Reserved' ) {
+ $onissue = 0;
+ if ($item->{'branchname'} eq ''){
+ $line{'status'}='In Transit';
+ }
+ else {
+ $line{'status'} = "On shelf at $item->{'branchname'}";
+ }
+
+ }
+ else {
+ $onissue = 1;
+ }
+ }
+ if ($onissue) {
+ $line{'status'} = 'On Issue';
+ }
+ }
+ else {
+ $line{'status'}="Waiting for pickup";
+
+ }
+ }
push( @dataloop, \%line );
}
+if ($sort eq 'name'){
+ @dataloop = sort {$a->{'surname'} cmp $b->{'surname'}} @dataloop;
+}
+elsif ($sort eq 'date'){
+ @dataloop = sort {$a->{'sortdate'} cmp $b->{'sortdate'}} @dataloop;
+}
+elsif ($sort eq 'title'){
+ @dataloop = sort {$a->{'title'} cmp $b->{'title'}} @dataloop;
+}
+else {
+ @dataloop = sort {$a->{'status'} cmp $b->{'status'}} @dataloop;
+}
+
$template->param(
count => $count,
- dataloop => \@dataloop
+ dataloop => \@dataloop,
+ branchcode => $branch,
+ branchloop => \@branchloop
+
);
output_html_with_http_headers $input, $cookie, $template->output;
Index: stats.print.pl
===================================================================
RCS file: /sources/koha/koha/reports/stats.print.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- stats.print.pl 11 Sep 2006 17:41:55 -0000 1.2
+++ stats.print.pl 9 Mar 2007 15:13:36 -0000 1.3
@@ -3,7 +3,7 @@
use strict;
use CGI;
use C4::Output;
-use HTML::Template;
+
use C4::Auth;
use C4::Interface::CGI::Output;
use C4::Context;
@@ -23,6 +23,7 @@
my $input=new CGI;
my $time=$input->param('time');
+my $time2=$input->param('time2');
my @loop1;
my @loop2;
@@ -56,6 +57,10 @@
$date2=ParseDate('tomorrow');
}
+if ($time2 ne ''){
+ $date=ParseDate($time);
+ $date2=ParseDate($time2);
+}
my $date=UnixDate($date,'%Y-%m-%d');
my $date2=UnixDate($date2,'%Y-%m-%d');
@@ -94,7 +99,8 @@
my $sec=substr($payments[$i]{'timestamp'},12,2);
my $time="$hour:$min:$sec";
my $time2="$payments[$i]{'date'}";
- my $branch=Getpaidbranch($time2,$payments[$i]{'borrowernumber'});
+# my $branch=Getpaidbranch($time2,$payments[$i]{'borrowernumber'});
+ my $branch=$payments[$i]{'branch'};
my @rows1 = ($branch, # lets build up a row
$payments[$i]->{'datetime'},
@@ -102,17 +108,19 @@
$payments[$i]->{'firstname'},
$charges[$i2]->{'description'},
$charges[$i2]->{'accounttype'},
- sprintf("%.2f", $charges[$i2]->{'amount'}), # rounding amounts to 2dp
+ # rounding amounts to 2dp and adding dollar sign to make excel read it as currency format
+ "\$".sprintf("%.2f", $charges[$i2]->{'amount'}),
$payments[$i]->{'type'},
- $payments[$i]->{'value'});
+ "\$".$payments[$i]->{'value'});
push (@loop1, \@rows1);
+ $totalpaid = $totalpaid + $payments[$i]->{'value'};
}
} else {
++$totalwritten;
}
+
$i++; #increment the while loop
- $totalpaid = $totalpaid + $payments[$i]->{'value'};
}
#get credits and append to the bottom of payments
@@ -129,11 +137,11 @@
$credits[$i]->{'firstname'},
$credits[$i]->{'description'},
$credits[$i]->{'accounttype'},
- $credits[$i]->{'amount'});
+ "\$".$credits[$i]->{'amount'});
push (@loop2, \@rows2);
- $i++;
$totalcredits = $totalcredits + $credits[$i]->{'amount'};
+ $i++;
}
#takes off first char minus sign "-100.00"
@@ -141,9 +149,9 @@
print $input->header(
-type => 'application/vnd.ms-excel',
- -attachment => "moo.csv",
+ -attachment => "stats.csv",
);
-print "Branch, Datetime, Surame, Firstnames, Description, Type, Invoice amount, Payment type, Payment Amount\n";
+print "Branch, Datetime, Surname, Firstnames, Description, Type, Invoice amount, Payment type, Payment Amount\n";
for my $row ( @loop1 ) {
@@ -167,3 +175,4 @@
print ",,Total Amount Paid, $totalpaid\n";
print ",,Total Number Written, $totalwritten\n";
print ",,Total Amount Credits, $totalcredits\n";
+
Index: stats.screen.pl
===================================================================
RCS file: /sources/koha/koha/reports/stats.screen.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- stats.screen.pl 11 Sep 2006 17:41:55 -0000 1.2
+++ stats.screen.pl 9 Mar 2007 15:13:36 -0000 1.3
@@ -1,142 +1,230 @@
#!/usr/bin/perl
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# 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
+
use strict;
use CGI;
use C4::Output;
-use HTML::Template;
use C4::Auth;
use C4::Interface::CGI::Output;
use C4::Context;
use Date::Manip;
-use C4::Date;
use C4::Stats;
+
&Date_Init("DateFormat=non-US"); # set non-USA date, eg:19/08/2005
-my $input=new CGI;
-my $time=$input->param('time');
-my $date=$input->param('from');
-my $date2=$input->param('to');
-my ($template, $loggedinuser, $cookie)
- = get_template_and_user({template_name => "reports/stats.screen.tmpl",
+my $input = new CGI;
+my $time = $input->param('time');
+my $time2 = $input->param('time2');
+
+if ( $input->param('submit') eq "To Excel"
+ || $input->param('submit_x') eq "To Excel" )
+{
+ print $input->redirect(
+ "/cgi-bin/koha/stats.print.pl?time=$time&time2=$time2");
+}
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "stats_screen.tmpl",
query => $input,
type => "intranet",
- authnotrequired => 0,
- flagsrequired => {borrowers => 1},
+ authnotrequired => 1,
+ flagsrequired => { reports => 1 },
debug => 1,
- });
+ }
+);
+
+my $date;
+my $date2;
+if ( $time eq 'yesterday' ) {
+ $date = ParseDate('yesterday');
+ $date2 = ParseDate('today');
+}
+if ( $time eq 'today' ) {
+ $date = ParseDate('today');
+ $date2 = ParseDate('tomorrow');
+}
+if ( $time eq 'daybefore' ) {
+ $date = ParseDate('2 days ago');
+ $date2 = ParseDate('yesterday');
+}
+if ( $time eq 'month' ) {
+ $date = ParseDate('1 month ago');
+ $date2 = ParseDate('today');
+
+}
+if ( $time =~ /\// ) {
+ $date = ParseDate($time);
+ $date2 = ParseDateDelta('+ 1 day');
+ $date2 = DateCalc( $date, $date2 );
+}
+
+# if time is blank
+if ( $time eq '' ) {
+ $date = ParseDate('today');
+ $date2 = ParseDate('tomorrow');
+}
+
+# if script is called with a start and finsh date range...
+if ( $time ne '' && $time2 ne '' ) {
+ $date = ParseDate($time);
+ $date2 = ParseDate($time2);
+}
+my $date = UnixDate( $date, '%Y-%m-%d' );
+my $date2 = UnixDate( $date2, '%Y-%m-%d' );
-#get a list of every payment
-my @payments=TotalPaid($date,$date2);
+# warn "MASON: TIME: $time, $time2";
+# warn "MASON: DATE: $date, $date2";
-my $count=@payments;
-# warn "number of payments=$count\n";
+# get a list of every payment
+my @payments = TotalPaid( $date, $date2, 0 );
-my $i=0;
-my $totalcharges=0;
-my $totalcredits=0;
-my $totalpaid=0;
-my $totalwritten=0;
-my $totalwrittenamount=0;
-my $totalinvoicesamount=0;
-my $totalinvoices=0;
+my $count = @payments;
+
+# print "MASON: number of payments=$count\n";
+
+my $i = 0;
+my $totalcharges = 0;
+my $totalcredits = 0;
+my $totalpaid = 0;
+my $totalwritten = 0;
my @loop1;
my @loop2;
-my @loop3;
# lets get a a list of all individual item charges paid for by that payment
-while ($i<$count ){
+while ( $i < $count ) {
my $count;
my @charges;
- if ($payments[$i]->{'accounttype'} ne 'W'){ # lets ignore writeoff payments!.
- @charges=getcharges($payments[$i]{'borrowernumber'}, $payments[$i]{'offset'}, $payments[$i]{'accountno'});
+ if ( $payments[$i]{'type'} ne 'writeoff' ) {
+
+ @charges = getcharges(
+ $payments[$i]{'borrowernumber'},
+ $payments[$i]{'timestamp'},
+ $payments[$i]{'proccode'}
+ );
$totalcharges++;
- $count=@charges;
+ $count = @charges;
# getting each of the charges and putting them into a array to be printed out
#this loops per charge per person
- for (my $i2=0;$i2<$count;$i2++){
+ for ( my $i2 = 0 ; $i2 < $count ; $i2++ ) {
+ my $hour = substr( $payments[$i]{'timestamp'}, 8, 2 );
+ my $min = substr( $payments[$i]{'timestamp'}, 10, 2 );
+ my $sec = substr( $payments[$i]{'timestamp'}, 12, 2 );
+ my $time = "$hour:$min:$sec";
+ my $time2 = "$payments[$i]{'date'}";
- my $time2="$payments[$i]{'date'}";
# my $branch=Getpaidbranch($time2,$payments[$i]{'borrowernumber'});
+ my $branch = $payments[$i]{'branch'};
- # lets build up a row
- my %rows1 = ( datetime => $payments[$i]->{'timestamp'},
+# if ($payments[$i]{'borrowernumber'} == 18265){
+# warn "$payments[$i]{'branch'} $branch $payments[$i]{'borrowernumber'}";#
+# }
+# lets build up a row
+ my %rows1 = (
+ branch => $branch,
+ datetime => $payments[$i]->{'datetime'},
surname => $payments[$i]->{'surname'},
firstname => $payments[$i]->{'firstname'},
- description => $payments[$i]->{'description'},
+ description => $charges[$i2]->{'description'},
accounttype => $charges[$i2]->{'accounttype'},
- amount => sprintf("%.2f", $charges[$i2]->{'amount'}), # rounding amounts to 2dp
- type => $payments[$i]->{'accounttype'},
- value => sprintf("%.2f", $payments[$i]->{'amount'}*(-1))); # rounding amounts to 2dp
+ amount => sprintf( "%.2f", $charges[$i2]->{'amount'} )
+ , # rounding amounts to 2dp
+ type => $payments[$i]->{'type'},
+ value => sprintf( "%.2f", $payments[$i]->{'value'} )
+ ); # rounding amounts to 2dp
- push (@loop1, \%rows1);
- $totalpaid = sprintf("%.2f",$totalpaid + $payments[$i]->{'amount'}*(-1));
+ push( @loop1, \%rows1 );
+ $totalpaid = $totalpaid + $payments[$i]->{'value'};
}
- } else {
-$totalwrittenamount= sprintf("%.2f",$totalwrittenamount + $payments[$i]->{'amount'}*(-1));
+ }
+ else {
++$totalwritten;
}
-
$i++; #increment the while loop
}
#get credits and append to the bottom of payments
-my @credits=getcredits($date,$date2);
+my @credits = getcredits( $date, $date2 );
-my $count=@credits;
-my $i=0;
+my $count = @credits;
+my $i = 0;
-while ($i<$count ){
+while ( $i < $count ) {
- my %rows2 = (creditdate => format_date($credits[$i]->{'date'}),
+ my %rows2 = (
+ creditbranch => $credits[$i]->{'branchcode'},
+ creditdate => $credits[$i]->{'date'},
creditsurname => $credits[$i]->{'surname'},
creditfirstname => $credits[$i]->{'firstname'},
creditdescription => $credits[$i]->{'description'},
creditaccounttype => $credits[$i]->{'accounttype'},
- creditamount => sprintf("%.2f",$credits[$i]->{'amount'}*(-1)));
+ creditamount => sprintf( "%.2f", $credits[$i]->{'amount'} )
+ );
- push (@loop2, \%rows2);
-
- $totalcredits =sprintf("%.2f", $totalcredits + $credits[$i]->{'amount'});
+ push( @loop2, \%rows2 );
+ $totalcredits = $totalcredits + $credits[$i]->{'amount'};
$i++; #increment the while loop
-
}
-
#takes off first char minus sign "-100.00"
-$totalcredits = substr($totalcredits, 1);
+$totalcredits = substr( $totalcredits, 1 );
-my @invoices=getinvoices($date,$date2);
-my $count=@invoices;
-my $i=0;
-
-while ($i<$count ){
-
- my %rows3 = (invoicesdate => format_date($invoices[$i]->{'date'}),
- invoicessurname => $invoices[$i]->{'surname'},
- invoicesfirstname => $invoices[$i]->{'firstname'},
- invoicesdescription => $invoices[$i]->{'description'},
- invoicesaccounttype => $invoices[$i]->{'accounttype'},
- invoicesamount => sprintf("%.2f",$invoices[$i]->{'amount'}),
- invoicesamountremaining=>sprintf("%.2f",$invoices[$i]->{'amountoutstanding'}));
- push (@loop3, \%rows3);
- $totalinvoicesamount =sprintf("%.2f", $totalinvoicesamount + $invoices[$i]->{'amountoutstanding'});
- $totalinvoices =sprintf("%.2f", $totalinvoices + $invoices[$i]->{'amount'});
- $i++; #increment the while loop
+my $totalrefunds = 0;
+my @loop3;
+my @refunds = getrefunds( $date, $date2 );
+$count = @refunds;
+$i = 0;
+
+while ( $i < $count ) {
+
+ my %rows2 = (
+ refundbranch => $refunds[$i]->{'branchcode'},
+ refunddate => $refunds[$i]->{'date'},
+ refundsurname => $refunds[$i]->{'surname'},
+ refundfirstname => $refunds[$i]->{'firstname'},
+ refunddescription => $refunds[$i]->{'description'},
+ refundaccounttype => $refunds[$i]->{'accounttype'},
+ refundamount => sprintf( "%.2f", $refunds[$i]->{'amount'} )
+ );
+ push( @loop3, \%rows2 );
+ $totalrefunds = $totalrefunds + $refunds[$i]->{'amount'};
+ $i++; #increment the while loop
}
-$template->param( loop1 => \@loop1,
+
+my $totalcash = $totalpaid - $totalrefunds;
+
+$template->param(
+ date => $time,
+ date2 => $time2,
+ loop1 => \@loop1,
loop2 => \@loop2,
loop3 => \@loop3,
totalpaid => $totalpaid,
totalcredits => $totalcredits,
- totalcreditsamount => sprintf("%.2f",$totalcredits-$totalwrittenamount),
- totalwrittenamount => $totalwrittenamount,
- totalwritten => $totalwritten ,
- totalinvoices=>$totalinvoices, totalinvoicesamount=>$totalinvoicesamount );
+ totalwritten => $totalwritten,
+ totalrefund => $totalrefunds,
+ totalcash => $totalcash
+);
output_html_with_http_headers $input, $cookie, $template->output;
+
More information about the Koha-cvs
mailing list