|
Lines 17-24
package C4::Reports::Guided;
Link Here
|
| 17 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
17 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
| 18 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
18 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
| 19 |
|
19 |
|
| 20 |
use strict; |
20 |
use Modern::Perl; |
| 21 |
#use warnings; FIXME - Bug 2505 this module needs a lot of repair to run clean under warnings |
|
|
| 22 |
use CGI; |
21 |
use CGI; |
| 23 |
use Carp; |
22 |
use Carp; |
| 24 |
|
23 |
|
|
Lines 54-59
$table_areas{'2'} = [ 'items', 'biblioitems', 'biblio' ]; # catalogue
Link Here
|
| 54 |
$table_areas{'3'} = [ 'borrowers' ]; # patrons |
53 |
$table_areas{'3'} = [ 'borrowers' ]; # patrons |
| 55 |
$table_areas{'4'} = ['aqorders', 'biblio', 'items']; # acquisitions |
54 |
$table_areas{'4'} = ['aqorders', 'biblio', 'items']; # acquisitions |
| 56 |
$table_areas{'5'} = [ 'borrowers', 'accountlines' ]; # accounts |
55 |
$table_areas{'5'} = [ 'borrowers', 'accountlines' ]; # accounts |
|
|
56 |
$table_areas{'6'} = [ 'biblio', 'biblioitems', 'serial', 'serialitems', 'subscription', 'subscriptionhistory', 'subscriptionroutinglists', 'aqbooksellers' ]; # serial |
| 57 |
|
| 57 |
our %keys; |
58 |
our %keys; |
| 58 |
$keys{'1'} = [ |
59 |
$keys{'1'} = [ |
| 59 |
'statistics.borrowernumber=borrowers.borrowernumber', |
60 |
'statistics.borrowernumber=borrowers.borrowernumber', |
|
Lines 70-75
$keys{'4'} = [
Link Here
|
| 70 |
'biblio.biblionumber=items.biblionumber' |
71 |
'biblio.biblionumber=items.biblionumber' |
| 71 |
]; |
72 |
]; |
| 72 |
$keys{'5'} = ['borrowers.borrowernumber=accountlines.borrowernumber']; |
73 |
$keys{'5'} = ['borrowers.borrowernumber=accountlines.borrowernumber']; |
|
|
74 |
$keys{'6'} = [ 'biblio.biblionumber=biblioitems.biblionumber', 'biblioitems.biblionumber=serial.biblionumber', 'serial.serialid=serialitems.serialid', 'serial.subscriptionid=subscription.subscriptionid', 'serial.subscriptionid=subscriptionhistory.subscriptionid', 'serial.subscriptionid=subscriptionroutinglists.subscriptionid', 'subscription.aqbooksellerid=aqbooksellers.id']; |
| 73 |
|
75 |
|
| 74 |
# have to do someting here to know if its dropdown, free text, date etc |
76 |
# have to do someting here to know if its dropdown, free text, date etc |
| 75 |
|
77 |
|
|
Lines 96-101
$criteria{'4'} = ['aqorders.datereceived|date'];
Link Here
|
| 96 |
# reports on accounting |
98 |
# reports on accounting |
| 97 |
$criteria{'5'} = ['borrowers.branchcode', 'borrowers.categorycode']; |
99 |
$criteria{'5'} = ['borrowers.branchcode', 'borrowers.categorycode']; |
| 98 |
|
100 |
|
|
|
101 |
# reports on serial |
| 102 |
$criteria{'6'} = ['subscription.startdate|date', 'subscription.enddate|date', 'subscription.periodicity', 'subscription.callnumber', 'subscription.location', 'subscription.branchcode']; |
| 103 |
|
| 99 |
# Adds itemtypes to criteria, according to the syspref |
104 |
# Adds itemtypes to criteria, according to the syspref |
| 100 |
if (C4::Context->preference('item-level_itypes')) { |
105 |
if (C4::Context->preference('item-level_itypes')) { |
| 101 |
unshift @{ $criteria{'1'} }, 'items.itype'; |
106 |
unshift @{ $criteria{'1'} }, 'items.itype'; |
|
Lines 155-163
sub get_report_areas {
Link Here
|
| 155 |
my $dbh = C4::Context->dbh(); |
160 |
my $dbh = C4::Context->dbh(); |
| 156 |
|
161 |
|
| 157 |
# FIXME these should be in the database |
162 |
# FIXME these should be in the database |
| 158 |
my @reports = ( 'Circulation', 'Catalog', 'Patrons', 'Acquisitions', 'Accounts'); |
163 |
my @reports = ( 'Circulation', 'Catalog', 'Patrons', 'Acquisitions', 'Accounts', 'Serials' ); |
| 159 |
my @reports2; |
164 |
my @reports2; |
| 160 |
for ( my $i = 0 ; $i < 5 ; $i++ ) { |
165 |
for my $i ( 0 .. $#reports ) { |
| 161 |
my %hashrep; |
166 |
my %hashrep; |
| 162 |
$hashrep{id} = $i + 1; |
167 |
$hashrep{id} = $i + 1; |
| 163 |
$hashrep{name} = $reports[$i]; |
168 |
$hashrep{name} = $reports[$i]; |
|
Lines 316-374
sub get_criteria {
Link Here
|
| 316 |
foreach my $localcrit (@$crit) { |
321 |
foreach my $localcrit (@$crit) { |
| 317 |
my ( $value, $type ) = split( /\|/, $localcrit ); |
322 |
my ( $value, $type ) = split( /\|/, $localcrit ); |
| 318 |
my ( $table, $column ) = split( /\./, $value ); |
323 |
my ( $table, $column ) = split( /\./, $value ); |
| 319 |
if ($type eq 'textrange') { |
324 |
given ( $type ) { |
| 320 |
my %temp; |
325 |
when ( 'textrange' ) { |
| 321 |
$temp{'name'} = $value; |
326 |
my %temp; |
| 322 |
$temp{'from'} = "from_" . $value; |
327 |
$temp{'name'} = $value; |
| 323 |
$temp{'to'} = "to_" . $value; |
328 |
$temp{'from'} = "from_" . $value; |
| 324 |
$temp{'textrange'} = 1; |
329 |
$temp{'to'} = "to_" . $value; |
| 325 |
$temp{'description'} = $column_defs->{$value}; |
330 |
$temp{'textrange'} = 1; |
| 326 |
push @criteria_array, \%temp; |
331 |
$temp{'description'} = $column_defs->{$value}; |
| 327 |
} |
332 |
push @criteria_array, \%temp; |
| 328 |
elsif ($type eq 'date') { |
333 |
} |
| 329 |
my %temp; |
334 |
when ( 'date' ) { |
| 330 |
$temp{'name'} = $value; |
335 |
my %temp; |
| 331 |
$temp{'date'} = 1; |
336 |
$temp{'name'} = $value; |
| 332 |
$temp{'description'} = $column_defs->{$value}; |
337 |
$temp{'date'} = 1; |
| 333 |
push @criteria_array, \%temp; |
338 |
$temp{'description'} = $column_defs->{$value}; |
| 334 |
} |
339 |
push @criteria_array, \%temp; |
| 335 |
elsif ($type eq 'daterange') { |
|
|
| 336 |
my %temp; |
| 337 |
$temp{'name'} = $value; |
| 338 |
$temp{'from'} = "from_" . $value; |
| 339 |
$temp{'to'} = "to_" . $value; |
| 340 |
$temp{'daterange'} = 1; |
| 341 |
$temp{'description'} = $column_defs->{$value}; |
| 342 |
push @criteria_array, \%temp; |
| 343 |
} |
| 344 |
else { |
| 345 |
my $query = |
| 346 |
"SELECT distinct($column) as availablevalues FROM $table"; |
| 347 |
my $sth = $dbh->prepare($query); |
| 348 |
$sth->execute(); |
| 349 |
my @values; |
| 350 |
# push the runtime choosing option |
| 351 |
my $list; |
| 352 |
$list='branches' if $column eq 'branchcode' or $column eq 'holdingbranch' or $column eq 'homebranch'; |
| 353 |
$list='categorycode' if $column eq 'categorycode'; |
| 354 |
$list='itemtype' if $column eq 'itype'; |
| 355 |
$list='ccode' if $column eq 'ccode'; |
| 356 |
# TODO : improve to let the librarian choose the description at runtime |
| 357 |
push @values, { availablevalues => "<<$column".($list?"|$list":'').">>" }; |
| 358 |
while ( my $row = $sth->fetchrow_hashref() ) { |
| 359 |
push @values, $row; |
| 360 |
if ($row->{'availablevalues'} eq '') { $row->{'default'} = 1 }; |
| 361 |
} |
340 |
} |
| 362 |
$sth->finish(); |
341 |
when ( 'daterange' ) { |
|
|
342 |
my %temp; |
| 343 |
$temp{'name'} = $value; |
| 344 |
$temp{'from'} = "from_" . $value; |
| 345 |
$temp{'to'} = "to_" . $value; |
| 346 |
$temp{'daterange'} = 1; |
| 347 |
$temp{'description'} = $column_defs->{$value}; |
| 348 |
push @criteria_array, \%temp; |
| 349 |
} |
| 350 |
default { |
| 351 |
my $query = |
| 352 |
"SELECT distinct($column) as availablevalues FROM $table"; |
| 353 |
my $sth = $dbh->prepare($query); |
| 354 |
$sth->execute(); |
| 355 |
my @values; |
| 356 |
# push the runtime choosing option |
| 357 |
my $list; |
| 358 |
$list='branches' if $column eq 'branchcode' or $column eq 'holdingbranch' or $column eq 'homebranch'; |
| 359 |
$list='categorycode' if $column eq 'categorycode'; |
| 360 |
$list='itemtype' if $column eq 'itype'; |
| 361 |
$list='ccode' if $column eq 'ccode'; |
| 362 |
# TODO : improve to let the librarian choose the description at runtime |
| 363 |
push @values, { |
| 364 |
availablevalues => "<<$column" . ( $list ? "|$list" : '' ) . ">>", |
| 365 |
display_value => "<<$column" . ( $list ? "|$list" : '' ) . ">>", |
| 366 |
}; |
| 367 |
while ( my $row = $sth->fetchrow_hashref() ) { |
| 368 |
if ($row->{'availablevalues'} eq '') { $row->{'default'} = 1 }; |
| 369 |
else { $row->{display_value} = _get_display_value( $row->{'availablevalues'}, $column ); } |
| 370 |
push @values, $row; |
| 371 |
} |
| 372 |
$sth->finish(); |
| 363 |
|
373 |
|
| 364 |
my %temp; |
374 |
my %temp; |
| 365 |
$temp{'name'} = $value; |
375 |
$temp{'name'} = $value; |
| 366 |
$temp{'description'} = $column_defs->{$value}; |
376 |
$temp{'description'} = $column_defs->{$value}; |
| 367 |
$temp{'values'} = \@values; |
377 |
$temp{'values'} = \@values; |
| 368 |
|
378 |
|
| 369 |
push @criteria_array, \%temp; |
379 |
push @criteria_array, \%temp; |
|
|
380 |
} |
| 370 |
} |
381 |
} |
| 371 |
|
|
|
| 372 |
} |
382 |
} |
| 373 |
return ( \@criteria_array ); |
383 |
return ( \@criteria_array ); |
| 374 |
} |
384 |
} |
|
Lines 736-742
sub get_from_dictionary {
Link Here
|
| 736 |
$sth->execute(); |
746 |
$sth->execute(); |
| 737 |
} |
747 |
} |
| 738 |
my @loop; |
748 |
my @loop; |
| 739 |
my @reports = ( 'Circulation', 'Catalog', 'Patrons', 'Acquisitions', 'Accounts'); |
749 |
my @reports = ( 'Circulation', 'Catalog', 'Patrons', 'Acquisitions', 'Accounts', 'Serial' ); |
| 740 |
while (my $data = $sth->fetchrow_hashref()){ |
750 |
while (my $data = $sth->fetchrow_hashref()){ |
| 741 |
$data->{'areaname'}=$reports[$data->{'area'}-1]; |
751 |
$data->{'areaname'}=$reports[$data->{'area'}-1]; |
| 742 |
push @loop,$data; |
752 |
push @loop,$data; |
|
Lines 782-787
sub _get_column_defs {
Link Here
|
| 782 |
close COLUMNS; |
792 |
close COLUMNS; |
| 783 |
return \%columns; |
793 |
return \%columns; |
| 784 |
} |
794 |
} |
|
|
795 |
|
| 796 |
sub _get_display_value { |
| 797 |
my ( $original_value, $column ) = @_; |
| 798 |
given ( $column ) { |
| 799 |
when ("periodicity") { |
| 800 |
my $dbh = C4::Context->dbh(); |
| 801 |
my $query = "SELECT description FROM subscription_frequencies WHERE id = ?"; |
| 802 |
my $sth = $dbh->prepare($query); |
| 803 |
$sth->execute($original_value); |
| 804 |
return $sth->fetchrow; |
| 805 |
} |
| 806 |
} |
| 807 |
return $original_value; |
| 808 |
} |
| 809 |
|
| 785 |
1; |
810 |
1; |
| 786 |
__END__ |
811 |
__END__ |
| 787 |
|
812 |
|