@ -24,11 +24,9 @@ use CGI;
use C4::Auth ;
use C4::Context ;
use C4::Debug ;
use C4::Branch ; # GetBranches
use C4::Branch ; # GetBranchesLoop
use C4::Output ;
use C4::Koha ; # GetItemTypes
use C4::Reports ; # GetDelimiterChoices
use C4::Circulation ;
# use Date::Manip; # TODO: add not borrowed since date X criteria
use Data::Dumper ;
@ -40,139 +38,105 @@ Report that shows unborrowed items.
my $ input = new CGI ;
my $ do_it = $ input - > param ( 'do_it' ) ;
my $ limit = $ input - > param ( "Limit" ) ;
my $ limit = $ input - > param ( "Limit" ) || 10 ;
my $ column = $ input - > param ( "Criteria" ) ;
my @ filters = $ input - > param ( "Filter" ) ;
my $ output = $ input - > param ( "output" ) ;
my $ basename = $ input - > param ( "basename" ) || 'catalogue_out' ;
my ( $ template , $ borrowernumber , $ cookie ) = get_template_and_user ( {
my ( $ template , $ borrowernumber , $ cookie ) = get_template_and_user (
{
template_name = > "reports/catalogue_out.tmpl" ,
query = > $ input ,
type = > "intranet" ,
authnotrequired = > 0 ,
flagsrequired = > { reports = > '*' } ,
flagsrequired = > { reports = > 'execute_reports' } ,
debug = > 1 ,
} ) ;
our $ sep = $ input - > param ( "sep" ) ;
$ sep = "\t" if ( ( ! defined $ sep ) or $ sep eq 'tabulation' ) ;
}
) ;
$ template - > param ( do_it = > $ do_it ) ;
$ template - > param ( do_it = > $ do_it ) ;
if ( $ do_it ) {
my $ results = calculate ( $ limit , $ column , \ @ filters ) ;
if ( $ output eq "screen" ) {
# Printing results to screen
$ template - > param ( mainloop = > $ results ) ;
my $ results = calculate ( $ limit , $ column , \ @ filters ) ;
$ template - > param ( mainloop = > $ results ) ;
output_html_with_http_headers $ input , $ cookie , $ template - > output ;
} else {
# Printing to a csv file FIXME: This is broken rather badly, if it ever worked at all here.
print $ input - > header (
- type = > 'application/vnd.sun.xml.calc' ,
- encoding = > 'utf-8' ,
- attachment = > "$basename.csv" ,
- filename = > "$basename.csv" ) ;
my $ cols = @$ results [ 0 ] - > { loopcol } ;
my $ lines = @$ results [ 0 ] - > { looprow } ;
# header
print "num /" . @$ results [ 0 ] - > { column } . $ sep ;
# Other header
foreach my $ col ( @$ cols ) {
print $ col - > { coltitle } . $ sep ;
}
print "Total\n" ;
# Table
foreach my $ line ( @$ lines ) {
my $ x = $ line - > { loopcell } ; # FIXME: No Such thing.
print $ line - > { rowtitle } . $ sep ;
foreach my $ cell ( @$ x ) {
print $ cell - > { value } . $ sep ;
}
print $ line - > { totalrow } , "\n" ;
}
# footer
print "TOTAL" ;
foreach my $ col ( @$ cols ) {
print $ sep . $ col - > { totalcol } ;
}
print $ sep . @$ results [ 0 ] - > { total } ;
}
exit ; # in either case, exit after do_it
}
# Displaying choices (i.e., not do_it)
my @ values ;
my % select ;
my @ mime = ( map { + { type = > $ _ } } ( split /[;:]/ , 'CSV' ) ) ; # FIXME translation
my $ itemtypes = GetItemTypes ;
my $ itemtypes = GetItemTypes ( ) ;
my @ itemtypeloop ;
foreach ( sort { $ itemtypes - > { $ a } - > { description } cmp $ itemtypes - > { $ b } - > { description } } keys %$ itemtypes ) {
push @ itemtypeloop , {
foreach (
sort { $ itemtypes - > { $ a } - > { 'description' } cmp $ itemtypes - > { $ b } - > { 'description' } }
keys %$ itemtypes
)
{
push @ itemtypeloop ,
{
value = > $ _ ,
description = > $ itemtypes - > { $ _ } - > { 'description' } ,
} ;
}
$ template - > param (
CGIextChoice = > \ @ mime ,
CGIsepChoice = > GetDelimiterChoices ,
itemtypeloop = > \ @ itemtypeloop ,
branchloop = > GetBranchesLoop ( $ input - > param ( "branch" ) || C4::Context - > userenv - > { branch } ) ,
branchloop = > GetBranchesLoop ( ) ,
) ;
output_html_with_http_headers $ input , $ cookie , $ template - > output ;
sub calculate {
my ( $ limit , $ column , $ filters ) = @ _ ;
my ( $ limit , $ column , $ filters ) = @ _ ;
my @ loopline ;
my @ looprow ;
my % globalline ;
my % columns = ( ) ;
my $ dbh = C4::Context - > dbh ;
# Filters
# Checking filters
#
# Filters
# Checking filters
#
my @ loopfilter ;
for ( my $ i = 0 ; $ i <= 6 ; $ i + + ) {
for ( my $ i = 0 ; $ i <= 6 ; $ i + + ) {
if ( @$ filters [ $ i ] ) {
my % cell = ( filter = > @$ filters [ $ i ] ) ;
if ( ( $ i == 1 ) and ( @$ filters [ $ i - 1 ] ) ) {
$ cell { err } = 1 if ( @$ filters [ $ i ] < @$ filters [ $ i - 1 ] ) ;
my % cell = ( filter = > @$ filters [ $ i ] ) ;
if ( ( $ i == 1 ) and ( @$ filters [ $ i - 1 ] ) ) {
$ cell { err } = 1 if ( @$ filters [ $ i ] < @$ filters [ $ i - 1 ] ) ;
}
$ cell { crit } = "Branch" if ( $ i == 0 ) ;
$ cell { crit } = "Doc Type" if ( $ i == 1 ) ;
$ cell { crit } = "Branch" if ( $ i == 0 ) ;
$ cell { crit } = "Doc Type" if ( $ i == 1 ) ;
push @ loopfilter , \ % cell ;
}
}
push @ loopfilter , { crit = > 'limit' , filter = > $ limit } if ( $ limit ) ;
if ( $ column ) {
push @ loopfilter , { crit = > 'by' , filter = > $ column } ;
my $ tablename = ( $ column =~ /branchcode/ ) ? 'branches' : 'items' ;
$ column = ( $ column =~ /branchcode/ or $ column =~ /itype/ ) ? "$tablename.$column" : $ column ;
my $ strsth2 = ( $ tablename eq 'branches' ) ?
"SELECT $column as coltitle, count(items.itemnumber) AS coltitle_count FROM $tablename LEFT JOIN items ON items.homebranch=$column " :
"SELECT $column as coltitle, count(*) AS coltitle_count FROM $tablename " ;
if ( $ tablename eq 'branches' ) {
push @ loopfilter , { crit = > 'limit' , filter = > $ limit } if ( $ limit ) ;
if ( $ column ) {
push @ loopfilter , { crit = > 'by' , filter = > $ column } ;
my $ tablename = ( $ column =~ /branchcode/ ) ? 'branches' : 'items' ;
$ column =
( $ column =~ /branchcode/ or $ column =~ /itype/ )
? "$tablename.$column"
: $ column ;
my $ strsth2 =
( $ tablename eq 'branches' )
? "SELECT $column as coltitle, count(items.itemnumber) AS coltitle_count FROM $tablename LEFT JOIN items ON items.homebranch=$column "
: "SELECT $column as coltitle, count(*) AS coltitle_count FROM $tablename " ;
if ( $ tablename eq 'branches' ) {
my $ f = @$ filters [ 0 ] ;
$ f =~ s/\*/%/g ;
$ strsth2 . = " AND $column LIKE '$f' " ;
$ strsth2 . = " AND $column LIKE '$f' " ;
}
$ strsth2 . = " GROUP BY $column ORDER BY $column " ; # needed for count
push @ loopfilter , { crit = > 'SQL' , sql = > 1 , filter = > $ strsth2 } ;
$ debug and warn "catalogue_out SQL: " . $ strsth2 ;
$ strsth2 . = " GROUP BY $column ORDER BY $column " ; # needed for count
push @ loopfilter , { crit = > 'SQL' , sql = > 1 , filter = > $ strsth2 } ;
$ debug and warn "catalogue_out SQL: " . $ strsth2 ;
my $ sth2 = $ dbh - > prepare ( $ strsth2 ) ;
$ sth2 - > execute ;
while ( my ( $ celvalue , $ count ) = $ sth2 - > fetchrow ) {
while ( my ( $ celvalue , $ count ) = $ sth2 - > fetchrow ) {
( $ celvalue ) or $ celvalue = 'UNKNOWN' ;
$ columns { $ celvalue } = $ count ;
}
}
my % tables = ( map { $ _ = > [] } keys % columns ) ;
my % tables = ( map { $ _ = > [] } keys % columns ) ;
# preparing calculation
# preparing calculation
my @ exe_args = ( ) ;
my $ query = "
SELECT items . barcode as barcode ,
@ -190,53 +154,60 @@ sub calculate {
WHERE issues . itemnumber IS NULL
AND old_issues . itemnumber IS NULL
" ;
if ( $ filters - > [ 0 ] ) {
$ filters - > [ 0 ] =~ s/\*/%/g ;
if ( $ filters - > [ 0 ] ) {
$ filters - > [ 0 ] =~ s/\*/%/g ;
push @ exe_args , $ filters - > [ 0 ] ;
$ query . = " AND items.homebranch LIKE ?" ;
}
if ( $ filters - > [ 1 ] ) {
$ filters - > [ 1 ] =~ s/\*/%/g ;
if ( $ filters - > [ 1 ] ) {
$ filters - > [ 1 ] =~ s/\*/%/g ;
push @ exe_args , $ filters - > [ 1 ] ;
$ query . = " AND items.itype LIKE ?" ;
}
if ( $ column ) {
$ query . = " AND $column = ? GROUP BY items.itemnumber, $column " ; # placeholder handled below
} else {
$ query . = " AND $column = ? GROUP BY items.itemnumber, $column " ;
# placeholder handled below
}
else {
$ query . = " GROUP BY items.itemnumber " ;
}
$ query . = " ORDER BY items.itemcallnumber DESC, barcode" ;
$ query . = " LIMIT 0,$limit" if ( $ limit ) ;
$ debug and warn "SQL : $query" ;
# warn "SQL : $query";
push @ loopfilter , { crit = > 'SQL' , sql = > 1 , filter = > $ query } ;
push @ loopfilter , { crit = > 'SQL' , sql = > 1 , filter = > $ query } ;
my $ dbcalc = $ dbh - > prepare ( $ query ) ;
if ( $ column ) {
foreach ( sort keys % columns ) {
my ( @ more_exe_args ) = @ exe_args ; # execute(@exe_args,$_) would fail when the array is empty.
push @ more_exe_args , $ _ ; # but @more_exe_args will work
$ dbcalc - > execute ( @ more_exe_args ) or die "Query execute(@more_exe_args) failed: $query" ;
while ( my $ data = $ dbcalc - > fetchrow_hashref ) {
foreach ( sort keys % columns ) {
# execute(@exe_args,$_) would fail when the array is empty
# but @more_exe_args will work
my ( @ more_exe_args ) = @ exe_args ;
push @ more_exe_args , $ _ ;
$ dbcalc - > execute ( @ more_exe_args )
or die "Query execute(@more_exe_args) failed: $query" ;
while ( my $ data = $ dbcalc - > fetchrow_hashref ) {
my $ col = $ data - > { col } || 'NULL' ;
$ tables { $ col } or $ tables { $ col } = [] ;
push @ { $ tables { $ col } } , $ data ;
push @ { $ tables { $ col } } , $ data ;
}
}
}
} else {
( scalar @ exe_args ) ? $ dbcalc - > execute ( @ exe_args ) : $ dbcalc - > execute ;
while ( my $ data = $ dbcalc - > fetchrow_hashref ) {
else {
( scalar @ exe_args ) ? $ dbcalc - > execute ( @ exe_args ) : $ dbcalc - > execute ;
while ( my $ data = $ dbcalc - > fetchrow_hashref ) {
my $ col = $ data - > { col } || 'NULL' ;
$ tables { $ col } or $ tables { $ col } = [] ;
push @ { $ tables { $ col } } , $ data ;
push @ { $ tables { $ col } } , $ data ;
}
}
foreach my $ tablename ( sort keys % tables ) {
foreach my $ tablename ( sort keys % tables ) {
my ( @ temptable ) ;
my $ i = 0 ;
foreach my $ cell ( @ { $ tables { $ tablename } } ) {
if ( 0 == $ i + + and $ debug ) {
my $ i = 0 ;
foreach my $ cell ( @ { $ tables { $ tablename } } ) {
if ( 0 == $ i + + and $ debug ) {
my $ dump = Dumper ( $ cell ) ;
$ dump =~ s/\n/ /gs ;
$ dump =~ s/\s+/ /gs ;
@ -248,21 +219,22 @@ sub calculate {
my $ allitems = $ columns { $ tablename } ;
$ globalline { total_looptable_count } += $ count ;
$ globalline { total_coltitle_count } += $ allitems ;
push @ { $ globalline { looptables } } , {
push @ { $ globalline { looptables } } ,
{
looprow = > \ @ temptable ,
coltitle = > $ tablename ,
coltitle_count = > $ allitems ,
looptable_count = > $ count ,
looptable_first = > ( $ count ) ? $ temptable [ 0 ] - > { itemcallnumber } : '' ,
looptable_first = > ( $ count ) ? $ temptable [ 0 ] - > { itemcallnumber } : '' ,
looptable_last = > ( $ count ) ? $ temptable [ - 1 ] - > { itemcallnumber } : '' ,
} ;
}
# the header of the table
$ globalline { loopfilter } = \ @ loopfilter ;
$ globalline { loopfilter } = \ @ loopfilter ;
$ globalline { limit } = $ limit ;
$ globalline { column } = $ column ;
return [ ( \ % globalline ) ] ; # reference to array of reference to hash
return [ ( \ % globalline ) ] ; # reference to array of reference to hash
}
1 ;
Fridolyn SOMERS
11 years ago
Galen Charlton