[Koha-cvs] koha/reports acquisitions_stats.pl

Mason James szrj1m at yahoo.com
Tue Jun 27 02:37:34 CEST 2006


CVSROOT:	/sources/koha
Module name:	koha
Changes by:	Mason James <sushi>	06/06/27 00:37:34

Modified files:
	reports        : acquisitions_stats.pl 

Log message:
	now allows reporting on accession date too, and small sql fix for mysql-5.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/reports/acquisitions_stats.pl?cvsroot=koha&r1=1.9&r2=1.10

Patches:
Index: acquisitions_stats.pl
===================================================================
RCS file: /sources/koha/koha/reports/acquisitions_stats.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -b -r1.9 -r1.10
--- acquisitions_stats.pl	6 Jan 2006 16:39:42 -0000	1.9
+++ acquisitions_stats.pl	27 Jun 2006 00:37:34 -0000	1.10
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-# $Id: acquisitions_stats.pl,v 1.9 2006/01/06 16:39:42 tipaul Exp $
+# $Id: acquisitions_stats.pl,v 1.10 2006/06/27 00:37:34 sushi Exp $
 
 # Copyright 2000-2002 Katipo Communications
 #
@@ -44,7 +44,7 @@
 =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");
@@ -57,168 +57,210 @@
 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,
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+    {
+        template_name   => $fullreportname,
                                 query => $input,
                                 type => "intranet",
                                 authnotrequired => 0,
-                                flagsrequired => {editcatalogue => 1},
+        flagsrequired   => { editcatalogue => 1 },
                                 debug => 1,
-                                });
-$template->param(do_it => $do_it);
+    }
+);
+$template->param( do_it => $do_it );
 if ($do_it) {
-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);
+    #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',
+            -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 itemtype,description FROM itemtypes ORDER BY description");
+    $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 $CGIItemTypes=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 bookfundid,bookfundname FROM aqbookfund ORDER BY bookfundname");
+    $req =
+      $dbh->prepare(
+"SELECT DISTINCTROW bookfundid,bookfundname FROM aqbookfund ORDER BY bookfundname"
+      );
         $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 $CGIBudget = 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 sort1 FROM aqorders WHERE sort1 IS NOT NULL ORDER BY sort1"
+      );
         $req->execute;
         undef @select;
-        push @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,
@@ -229,414 +271,461 @@
 }
 output_html_with_http_headers $input, $cookie, $template->output;
 
-
-
 sub calculate {
-        my ($line, $column, $podsp, $rodsp, $aodsp, $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<=8;$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} .="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);
+            $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 =~ /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];
                                               
-# 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;
-	my $lineorder;                               
-	if (($line =~/closedate/) and ($podsp == 1)) {
-		#Display by day
-		$linefield .="dayname($line)";  
-		$lineorder .="weekday($line)";  
-	} elsif (($line=~/closedate/) and ($podsp == 2)) {
-		#Display by Month
-		$linefield .="monthname($line)";  
-		$lineorder .="month($line)";  
-	} elsif (($line=~/closedate/) and ($podsp == 3)) {
-		#Display by Year
-		$linefield .="Year($line)";
-		$lineorder .=$linefield;  
-	} elsif (($line =~/received/) and ($rodsp == 1)) {
+    if ( ( $line =~ /closedate/ ) and ( $podsp == 1 ) ) {
+
 		#Display by day
-		$linefield .="dayname($line)";  
-		$lineorder .="weekday($line)";  
-	} elsif (($line=~/received/) and ($rodsp == 2)) {
+        $linefield .= "dayname($line)";
+    }
+    elsif ( ( $line =~ /closedate/ ) and ( $podsp == 2 ) ) {
+
 		#Display by Month
-		$linefield .="monthname($line)";  
-		$lineorder .="month($line)";  
-	} elsif (($line=~/received/) and ($rodsp == 3)) {
-		#Display by Year
-		$linefield .="Year($line)";
-		$lineorder .=$linefield;  
-	} else {
-		$linefield .= $line;
-		$lineorder .=$linefield;  
+        $linefield .= "monthname($line)";
 	}  
+    elsif ( ( $line =~ /closedate/ ) and ( $podsp == 3 ) ) {
 	
- 	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 ";
+        #Display by Year
+        $linefield .= "Year($line)";
 	
-	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]) {
-			$linefilter[0] =~ s/\*/%/g;
- 			$strsth .= " and $line LIKE ? " ;
- 		}
- 	}
-	$strsth .=" group by $linefield";
-	$strsth .=" order by $lineorder";
-	warn "rows: ". $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 {
-		$sth->execute;
 	}
+    elsif ( ( $line =~ /received/ ) and ( $rodsp == 1 ) ) {
 	
- 	while ( my ($celvalue) = $sth->fetchrow) {
- 		my %cell;
-		if ($celvalue) {
-			$cell{rowtitle} = $celvalue;
-#		} else {
-#			$cell{rowtitle} = "";
-		}
-		$cell{totalrow} = 0;
-		push @loopline, \%cell;
+        #Display by day
+        $linefield .= "dayname($line)";
  	}
+    elsif ( ( $line =~ /received/ ) and ( $rodsp == 2 ) ) {
 
-warn "line=$line, podsp=$podsp, rodsp=$rodsp, aodsp=$aodsp\n";
-
-# 1st, loop rows.
-        my $linefield;
-        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)";
+        $linefield .= "monthname($line)";
+    }
+    elsif ( ( $line =~ /received/ ) and ( $rodsp == 3 ) ) {
 
-        } elsif (($line =~/received/) and ($rodsp == 1)) {
-                #Display by day
-                $linefield .="dayname($line)";
-        } elsif (($line=~/received/) and ($rodsp == 2)) {
-                #Display by Month
-                $linefield .="monthname($line)";
-        } elsif (($line=~/received/) and ($rodsp == 3)) {
                 #Display by Year
-                $linefield .="Year($line)";
+        $linefield .= "Year($line)";
+
+    }
+    elsif ( ( $line =~ /acquired/ ) and ( $aodsp == 1 ) ) {
 
-        } elsif (($line =~/acquired/) and ($aodsp == 1)) {
                 #Display by day
-                $linefield .="dayname($line)";
-        } elsif (($line=~/acquired/) and ($aodsp == 2)) {
+        $linefield .= "dayname($line)";
+    }
+    elsif ( ( $line =~ /acquired/ ) and ( $aodsp == 2 ) ) {
+
                 #Display by Month
-                $linefield .="monthname($line)";
-        } elsif (($line=~/acquired/) and ($aodsp == 3)) {
-                #Display by Year
-                $linefield .="Year($line)";
+        $linefield .= "monthname($line)";
+    }
+    elsif ( ( $line =~ /acquired/ ) and ( $aodsp == 3 ) ) {
 
+        #Display by Year
+        $linefield .= "Year($line)";
 
-        } else {
+    }
+    else {
                 $linefield .= $line;
         }
 
         my $strsth;
-        $strsth .= "SELECT DISTINCTROW $linefield FROM aqorders, aqbasket,aqorderbreakdown
+    $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]) {
+    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] . "'" );
         }
-        $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]);
-        } else {
+    elsif ( $linefilter[0] ) {
+        $sth->execute( $linefilter[0] );
+    }
+    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;
         }
 
-warn "column=$column, podsp=$podsp, rodsp=$rodsp, aodsp=$aodsp\n";
-# 2nd, loop cols.
+    #warn "column=$column, podsp=$podsp, rodsp=$rodsp, aodsp=$aodsp\n";
+
+    # 2nd, loop cols.
 	my $colfield;
-	my $colorder;
-	if (($column =~/closedate/) and ($podsp == 1)) {
+    if ( ( $column =~ /closedate/ ) and ( $podsp == 1 ) ) {
+
+        #Display by day
+        $colfield .= "dayname($column)";
+    }
+    elsif ( ( $column =~ /closedate/ ) and ( $podsp == 2 ) ) {
+
+        #Display by Month
+        $colfield .= "monthname($column)";
+    }
+    elsif ( ( $column =~ /closedate/ ) and ( $podsp == 3 ) ) {
+
+        #Display by Year
+        $colfield .= "Year($column)";
+
+    }
+    elsif ( ( $column =~ /deliverydate/ ) and ( $rodsp == 1 ) ) {
+
 		#Display by day
-		$colfield .="dayname($column)";
-		$colorder .="weekday($column)";
-	} elsif (($column=~/closedate/) and ($podsp == 2)) {
+        $colfield .= "dayname($column)";
+    }
+    elsif ( ( $column =~ /deliverydate/ ) and ( $rodsp == 2 ) ) {
+
 		#Display by Month
-		$colfield .="monthname($column)";  
-		$colorder .="month($column)";
-	} elsif (($column=~/closedate/) and ($podsp == 3)) {
+        $colfield .= "monthname($column)";
+    }
+    elsif ( ( $column =~ /deliverydate/ ) and ( $rodsp == 3 ) ) {
+
 		#Display by Year
-		$colfield .="Year($column)";
-		$colorder .= $colfield;
-	} elsif (($column =~/received/) and ($rodsp == 1)) {
+        $colfield .= "Year($column)";
+
+    }
+    elsif ( ( $column =~ /dateaccessioned/ ) and ( $aodsp == 1 ) ) {
+
 		#Display by day
-		$colfield .="dayname($column)";  
-		$colorder .="weekday($column)";
-	} elsif (($column=~/received/) and ($rodsp == 2)) {
+        $colfield .= "dayname($column)";
+    }
+    elsif ( ( $column =~ /dateaccessioned/ ) and ( $aodsp == 2 ) ) {
+
 		#Display by Month
-		$colfield .="monthname($column)";  
-		$colorder .="month($column)";
-	} elsif (($column=~/received/) and ($rodsp == 3)) {
+        $colfield .= "monthname($column)";
+    }
+    elsif ( ( $column =~ /dateaccessioned/ ) and ( $aodsp == 3 ) ) {
+
 		#Display by Year
-		$colfield .="Year($column)";
-		$colorder .= $colfield;
-	} else {
+        $colfield .= "Year($column)";
+
+    }
+    else {
 		$colfield .= $column;
-		$colorder .= $colfield;
 	}  
 	
  	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 $colorder";
- 	warn "columns : ". $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 aqorderbreakdown.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 $lineorder,$colorder";
-	warn "". $strcalc;
+    $strcalc .= "COUNT( aqorders.ordernumber ) " 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 ) {
+
+        #              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;
+        $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 (@loopline) {
+    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->{'rowtitle'} eq "NULL")?"zzEMPTY":$row->{'rowtitle'}}->{($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->{'rowtitle'},
+        push @looprow,
+          {
+            'rowtitle' => ( $row eq "zzEMPTY" ) ? "NULL" : $row,
 						'loopcell' => \@loopcell,
-						'hilighted' => ($hilighted >0),
-						'totalrow' => $table{($row->{'rowtitle'} eq "NULL")?"zzEMPTY":$row->{'rowtitle'}}->{totalrow}
+            '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;
 }
 





More information about the Koha-cvs mailing list