[Koha-cvs] koha/C4 Koha.pm Members.pm Output.pm Print.pm R... [rel_3_0]
Antoine Farnault
antoine at koha-fr.org
Mon Nov 20 11:26:10 CET 2006
CVSROOT: /sources/koha
Module name: koha
Branch: rel_3_0
Changes by: Antoine Farnault <toins> 06/11/20 10:26:10
Modified files:
C4 : Koha.pm Members.pm Output.pm Print.pm
Reserves2.pm
Log message:
* removing compilation warn.
* re-indent with perltidy.
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Koha.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.40.2.21&r2=1.40.2.22
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Members.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.32.2.18&r2=1.32.2.19
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Output.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.56.2.2&r2=1.56.2.3
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Print.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.17&r2=1.17.8.1
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Reserves2.pm?cvsroot=koha&only_with_tag=rel_3_0&r1=1.46.2.6&r2=1.46.2.7
Patches:
Index: Koha.pm
===================================================================
RCS file: /sources/koha/koha/C4/Koha.pm,v
retrieving revision 1.40.2.21
retrieving revision 1.40.2.22
diff -u -b -r1.40.2.21 -r1.40.2.22
--- Koha.pm 14 Nov 2006 15:01:08 -0000 1.40.2.21
+++ Koha.pm 20 Nov 2006 10:26:10 -0000 1.40.2.22
@@ -17,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Koha.pm,v 1.40.2.21 2006/11/14 15:01:08 toins Exp $
+# $Id: Koha.pm,v 1.40.2.22 2006/11/20 10:26:10 toins Exp $
use strict;
require Exporter;
@@ -25,7 +25,7 @@
use C4::Output;
use vars qw($VERSION @ISA @EXPORT);
-$VERSION = do { my @v = '$Revision: 1.40.2.21 $' =~ /\d+/g; shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
+$VERSION = do { my @v = '$Revision: 1.40.2.22 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -96,38 +96,16 @@
=cut
sub slashifyDate {
+
# accepts a date of the form xx-xx-xx[xx] and returns it in the
# form xx/xx/xx[xx]
- my @dateOut = split('-', shift);
- return("$dateOut[2]/$dateOut[1]/$dateOut[0]")
-}
-
-=head2 fixEthnicity
-
- $ethn_name = &fixEthnicity($ethn_code);
-
-Takes an ethnicity code (e.g., "european" or "pi") and returns the
-corresponding descriptive name from the C<ethnicity> table in the
-Koha database ("European" or "Pacific Islander").
-
-=cut
-
-#'
-
-sub fixEthnicity($) {
-
- my $ethnicity = shift;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select name from ethnicity where code = ?");
- $sth->execute($ethnicity);
- my $data=$sth->fetchrow_hashref;
- $sth->finish;
- return $data->{'name'};
+ my @dateOut = split( '-', shift );
+ return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
}
# FIXME.. this should be moved to a MARC-specific module
sub subfield_is_koha_internal_p ($) {
- my($subfield) = @_;
+ my ($subfield) = @_;
# We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
# But real MARC subfields are always single-character
@@ -167,18 +145,21 @@
=cut
-
sub GetBranches {
-# returns a reference to a hash of references to ALL branches...
+
+ # returns a reference to a hash of references to ALL branches...
my %branches;
my $dbh = C4::Context->dbh;
my $sth;
$sth = $dbh->prepare("Select * from branches order by branchname");
$sth->execute;
- while (my $branch=$sth->fetchrow_hashref) {
- my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
- $nsth->execute($branch->{'branchcode'});
- while (my ($cat) = $nsth->fetchrow_array) {
+ while ( my $branch = $sth->fetchrow_hashref ) {
+ my $nsth =
+ $dbh->prepare(
+ "select categorycode from branchrelations where branchcode = ?");
+ $nsth->execute( $branch->{'branchcode'} );
+ while ( my ($cat) = $nsth->fetchrow_array ) {
+
# FIXME - This seems wrong. It ought to be
# $branch->{categorycodes}{$cat} = 1;
# otherwise, there's a namespace collision if there's a
@@ -190,20 +171,20 @@
# that aren't fields in the "branches" table.
$branch->{$cat} = 1;
}
- $branches{$branch->{'branchcode'}}=$branch;
+ $branches{ $branch->{'branchcode'} } = $branch;
}
- return (\%branches);
+ return ( \%branches );
}
sub getbranchname {
- my ($branchcode)=@_;
+ my ($branchcode) = @_;
my $dbh = C4::Context->dbh;
my $sth;
$sth = $dbh->prepare("Select branchname from branches where branchcode=?");
$sth->execute($branchcode);
my $branchname = $sth->fetchrow_array;
$sth->finish;
- return($branchname);
+ return ($branchname);
}
=head2 GetItemTypes
@@ -245,19 +226,20 @@
=cut
sub GetItemTypes {
-# returns a reference to a hash of references to branches...
+
+ # returns a reference to a hash of references to branches...
my %itemtypes;
my $dbh = C4::Context->dbh;
my $query = qq|
SELECT *
FROM itemtypes
|;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $itemtypes{$IT->{'itemtype'}}=$IT;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $itemtypes{ $IT->{'itemtype'} } = $IT;
}
- return (\%itemtypes);
+ return ( \%itemtypes );
}
sub get_itemtypeinfos_of {
@@ -268,10 +250,10 @@
description,
notforloan
FROM itemtypes
- WHERE itemtype IN ('.join(',', map({"'".$_."'"} @itemtypes)).')
+ WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
';
- return get_infos_of($query, 'itemtype');
+ return get_infos_of( $query, 'itemtype' );
}
# this is temporary until we separate collection codes and item types
@@ -279,17 +261,20 @@
my $count = 0;
my @results;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT * FROM authorised_values ORDER BY authorised_value");
+ my $sth =
+ $dbh->prepare(
+ "SELECT * FROM authorised_values ORDER BY authorised_value");
$sth->execute;
- while (my $data=$sth->fetchrow_hashref) {
- if ($data->{category} eq "CCODE") {
+ while ( my $data = $sth->fetchrow_hashref ) {
+ if ( $data->{category} eq "CCODE" ) {
$count++;
$results[$count] = $data;
+
#warn "data: $data";
}
}
$sth->finish;
- return ($count, at results);
+ return ( $count, @results );
}
=head2
@@ -303,20 +288,23 @@
my $count = 0;
my @results;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT * FROM authorised_values ORDER BY authorised_value");
+ my $sth =
+ $dbh->prepare(
+ "SELECT * FROM authorised_values ORDER BY authorised_value");
$sth->execute;
- while (my $data=$sth->fetchrow_hashref) {
- if ($data->{category} eq "ITEMLOST") {
+ while ( my $data = $sth->fetchrow_hashref ) {
+ if ( $data->{category} eq "ITEMLOST" ) {
$count++;
- if ($itemlost eq $data->{'authorised_value'} ){
+ if ( $itemlost eq $data->{'authorised_value'} ) {
$data->{'selected'} = 1;
}
$results[$count] = $data;
+
#warn "data: $data";
}
}
$sth->finish;
- return ($count, at results);
+ return ( $count, @results );
}
=head2 GetAuthItembinding
@@ -325,30 +313,30 @@
=cut
-
sub GetAuthItembinding {
my $itembinding = shift;
my $count = 0;
my @results;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT * FROM authorised_values ORDER BY authorised_value");
+ my $sth =
+ $dbh->prepare(
+ "SELECT * FROM authorised_values ORDER BY authorised_value");
$sth->execute;
- while (my $data=$sth->fetchrow_hashref) {
- if ($data->{category} eq "BINDING") {
+ while ( my $data = $sth->fetchrow_hashref ) {
+ if ( $data->{category} eq "BINDING" ) {
$count++;
- if ($itembinding eq $data->{'authorised_value'} ){
+ if ( $itembinding eq $data->{'authorised_value'} ) {
$data->{'selected'} = 1;
}
$results[$count] = $data;
+
#warn "data: $data";
}
}
$sth->finish;
- return ($count, at results);
+ return ( $count, @results );
}
-
-
=head2 getauthtypes
$authtypes = &getauthtypes();
@@ -387,25 +375,27 @@
=cut
sub getauthtypes {
-# returns a reference to a hash of references to authtypes...
+
+ # returns a reference to a hash of references to authtypes...
my %authtypes;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
+ my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
$sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $authtypes{$IT->{'authtypecode'}}=$IT;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $authtypes{ $IT->{'authtypecode'} } = $IT;
}
- return (\%authtypes);
+ return ( \%authtypes );
}
sub getauthtype {
my ($authtypecode) = @_;
-# returns a reference to a hash of references to authtypes...
+
+ # returns a reference to a hash of references to authtypes...
my %authtypes;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
+ my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
$sth->execute($authtypecode);
- my $res=$sth->fetchrow_hashref;
+ my $res = $sth->fetchrow_hashref;
return $res;
}
@@ -448,16 +438,18 @@
=cut
sub getframeworks {
-# returns a reference to a hash of references to branches...
+
+ # returns a reference to a hash of references to branches...
my %itemtypes;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from biblio_framework");
+ my $sth = $dbh->prepare("select * from biblio_framework");
$sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $itemtypes{$IT->{'frameworkcode'}}=$IT;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $itemtypes{ $IT->{'frameworkcode'} } = $IT;
}
- return (\%itemtypes);
+ return ( \%itemtypes );
}
+
=head2 getframeworkinfo
$frameworkinfo = &getframeworkinfo($frameworkcode);
@@ -469,13 +461,13 @@
sub getframeworkinfo {
my ($frameworkcode) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from biblio_framework where frameworkcode=?");
+ my $sth =
+ $dbh->prepare("select * from biblio_framework where frameworkcode=?");
$sth->execute($frameworkcode);
my $res = $sth->fetchrow_hashref;
return $res;
}
-
=head2 getitemtypeinfo
$itemtype = &getitemtype($itemtype);
@@ -487,11 +479,11 @@
sub getitemtypeinfo {
my ($itemtype) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
+ my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
$sth->execute($itemtype);
my $res = $sth->fetchrow_hashref;
- $res->{imageurl} = getitemtypeimagesrcfromurl($res->{imageurl});
+ $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
return $res;
}
@@ -499,30 +491,23 @@
sub getitemtypeimagesrcfromurl {
my ($imageurl) = @_;
- if (defined $imageurl and $imageurl !~ m/^http/) {
- $imageurl =
- getitemtypeimagesrc()
- .'/'.$imageurl
- ;
+ if ( defined $imageurl and $imageurl !~ m/^http/ ) {
+ $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
}
return $imageurl;
}
sub getitemtypeimagedir {
- return
- C4::Context->opachtdocs
- .'/'.C4::Context->preference('template')
- .'/itemtypeimg'
- ;
+ return C4::Context->opachtdocs . '/'
+ . C4::Context->preference('template')
+ . '/itemtypeimg';
}
sub getitemtypeimagesrc {
- return
- '/opac-tmpl'
- .'/'.C4::Context->preference('template')
- .'/itemtypeimg'
- ;
+ return '/opac-tmpl' . '/'
+ . C4::Context->preference('template')
+ . '/itemtypeimg';
}
=head2 getprinters
@@ -544,19 +529,19 @@
my ($env) = @_;
my %printers;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from printers");
+ my $sth = $dbh->prepare("select * from printers");
$sth->execute;
- while (my $printer=$sth->fetchrow_hashref) {
- $printers{$printer->{'printqueue'}}=$printer;
+ while ( my $printer = $sth->fetchrow_hashref ) {
+ $printers{ $printer->{'printqueue'} } = $printer;
}
- return (\%printers);
+ return ( \%printers );
}
sub getbranch ($$) {
- my($query, $branches) = @_; # get branch for this query from branches
+ my ( $query, $branches ) = @_; # get branch for this query from branches
my $branch = $query->param('branch');
- ($branch) || ($branch = $query->cookie('branch'));
- ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
+ ($branch) || ( $branch = $query->cookie('branch') );
+ ( $branches->{$branch} ) || ( $branch = ( keys %$branches )[0] );
return $branch;
}
@@ -569,8 +554,7 @@
=cut
-sub getbranchdetail
-{
+sub getbranchdetail {
my ($branchcode) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
@@ -580,12 +564,11 @@
return $branchname;
}
-
sub getprinter ($$) {
- my($query, $printers) = @_; # get printer for this query from printers
+ my ( $query, $printers ) = @_; # get printer for this query from printers
my $printer = $query->param('printer');
- ($printer) || ($printer = $query->cookie('printer')) || ($printer='');
- ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
+ ($printer) || ( $printer = $query->cookie('printer') ) || ( $printer = '' );
+ ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
return $printer;
}
@@ -599,113 +582,117 @@
=cut
sub GetLanguages {
- my $type=shift;
- my $theme=shift;
+ my $type = shift;
+ my $theme = shift;
my $htdocs;
my @languages;
- if ($type eq 'opac') {
- $htdocs=C4::Context->config('opachtdocs');
- if ($theme and -d "$htdocs/$theme") {
+ if ( $type eq 'opac' ) {
+ $htdocs = C4::Context->config('opachtdocs');
+ if ( $theme and -d "$htdocs/$theme" ) {
opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
+ foreach my $language ( readdir D ) {
+ next if $language =~ /^\./;
next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
+ next if $language =~ /png$/;
+ next if $language =~ /css$/;
+ next if $language =~ /CVS$/;
+ next if $language =~ /itemtypeimg$/;
+ next if $language =~ /\.txt$/i; #Don't read the readme.txt !
next if $language eq 'images';
push @languages, $language;
}
return sort @languages;
- } else {
+ }
+ else {
my $lang;
- foreach my $theme (getallthemes('opac')) {
+ foreach my $theme ( getallthemes('opac') ) {
opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
+ foreach my $language ( readdir D ) {
+ next if $language =~ /^\./;
next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
+ next if $language =~ /png$/;
+ next if $language =~ /css$/;
+ next if $language =~ /CVS$/;
+ next if $language =~ /itemtypeimg$/;
+ next if $language =~ /\.txt$/i; #Don't read the readme.txt !
next if $language eq 'images';
- $lang->{$language}=1;
+ $lang->{$language} = 1;
}
}
- @languages=keys %$lang;
+ @languages = keys %$lang;
return sort @languages;
}
- } elsif ($type eq 'intranet') {
- $htdocs=C4::Context->config('intrahtdocs');
- if ($theme and -d "$htdocs/$theme") {
+ }
+ elsif ( $type eq 'intranet' ) {
+ $htdocs = C4::Context->config('intrahtdocs');
+ if ( $theme and -d "$htdocs/$theme" ) {
opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
+ foreach my $language ( readdir D ) {
+ next if $language =~ /^\./;
next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
+ next if $language =~ /png$/;
+ next if $language =~ /css$/;
+ next if $language =~ /CVS$/;
+ next if $language =~ /itemtypeimg$/;
+ next if $language =~ /\.txt$/i; #Don't read the readme.txt !
next if $language eq 'images';
push @languages, $language;
}
return sort @languages;
- } else {
+ }
+ else {
my $lang;
- foreach my $theme (getallthemes('opac')) {
+ foreach my $theme ( getallthemes('opac') ) {
opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
+ foreach my $language ( readdir D ) {
+ next if $language =~ /^\./;
next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
+ next if $language =~ /png$/;
+ next if $language =~ /css$/;
+ next if $language =~ /CVS$/;
+ next if $language =~ /itemtypeimg$/;
+ next if $language =~ /\.txt$/i; #Don't read the readme.txt !
next if $language eq 'images';
- $lang->{$language}=1;
+ $lang->{$language} = 1;
}
}
- @languages=keys %$lang;
+ @languages = keys %$lang;
return sort @languages;
}
- } else {
+ }
+ else {
my $lang;
- my $htdocs=C4::Context->config('intrahtdocs');
- foreach my $theme (getallthemes('intranet')) {
+ my $htdocs = C4::Context->config('intrahtdocs');
+ foreach my $theme ( getallthemes('intranet') ) {
opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
+ foreach my $language ( readdir D ) {
+ next if $language =~ /^\./;
next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
+ next if $language =~ /png$/;
+ next if $language =~ /css$/;
+ next if $language =~ /CVS$/;
+ next if $language =~ /itemtypeimg$/;
+ next if $language =~ /\.txt$/i; #Don't read the readme.txt !
next if $language eq 'images';
- $lang->{$language}=1;
+ $lang->{$language} = 1;
}
}
- $htdocs=C4::Context->config('opachtdocs');
- foreach my $theme (getallthemes('opac')) {
+ $htdocs = C4::Context->config('opachtdocs');
+ foreach my $theme ( getallthemes('opac') ) {
opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
+ foreach my $language ( readdir D ) {
+ next if $language =~ /^\./;
next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- next if $language=~ /\.txt$/i; #Don't read the readme.txt !
+ next if $language =~ /png$/;
+ next if $language =~ /css$/;
+ next if $language =~ /CVS$/;
+ next if $language =~ /itemtypeimg$/;
+ next if $language =~ /\.txt$/i; #Don't read the readme.txt !
next if $language eq 'images';
- $lang->{$language}=1;
+ $lang->{$language} = 1;
}
}
- @languages=keys %$lang;
+ @languages = keys %$lang;
return sort @languages;
}
}
@@ -718,9 +705,9 @@
=cut
sub getnbpages {
- my ($nb_items, $nb_items_per_page) = @_;
+ my ( $nb_items, $nb_items_per_page ) = @_;
- return int(($nb_items - 1) / $nb_items_per_page) + 1;
+ return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
}
=item getallthemes
@@ -733,16 +720,17 @@
=cut
sub getallthemes {
- my $type=shift;
+ my $type = shift;
my $htdocs;
my @themes;
- if ($type eq 'intranet') {
- $htdocs=C4::Context->config('intrahtdocs');
- } else {
- $htdocs=C4::Context->config('opachtdocs');
+ if ( $type eq 'intranet' ) {
+ $htdocs = C4::Context->config('intrahtdocs');
+ }
+ else {
+ $htdocs = C4::Context->config('opachtdocs');
}
opendir D, "$htdocs";
- my @dirlist=readdir D;
+ my @dirlist = readdir D;
foreach my $directory (@dirlist) {
-d "$htdocs/$directory/en" and push @themes, $directory;
}
@@ -751,11 +739,13 @@
sub getFacets {
my $facets;
- if (C4::Context->preference("marcflavour") eq "UNIMARC") {
- $facets = [ {
+ if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
+ $facets = [
+ {
link_value => 'su-to',
label_value => 'Topics',
- tags => ['600','601','602','603','604','605','606','610'],
+ tags =>
+ [ '600', '601', '602', '603', '604', '605', '606', '610' ],
subfield => 'a',
},
{
@@ -767,13 +757,13 @@
{
link_value => 'su-ut',
label_value => 'Titles',
- tags => ['500','501','502','503','504',],
+ tags => [ '500', '501', '502', '503', '504', ],
subfield => 'a',
},
{
link_value => 'au',
label_value => 'Authors',
- tags => ['700','701','702',],
+ tags => [ '700', '701', '702', ],
subfield => 'a',
},
{
@@ -785,18 +775,21 @@
{
link_value => 'branch',
label_value => 'Branches',
- tags => ['995',],
+ tags => [ '995', ],
subfield => 'b',
expanded => '1',
},
];
- } else {
- $facets = [ {
+ }
+ else {
+ $facets = [
+ {
link_value => 'su-to',
label_value => 'Topics',
tags => ['650'],
subfield => 'a',
},
+
# {
# link_value => 'su-na',
# label_value => 'People and Organizations',
@@ -818,19 +811,19 @@
{
link_value => 'au',
label_value => 'Authors',
- tags => ['100','110','700',],
+ tags => [ '100', '110', '700', ],
subfield => 'a',
},
{
link_value => 'se',
label_value => 'Series',
- tags => ['440','490',],
+ tags => [ '440', '490', ],
subfield => 'a',
},
{
link_value => 'branch',
label_value => 'Branches',
- tags => ['952',],
+ tags => [ '952', ],
subfield => 'b',
expanded => '1',
},
@@ -860,9 +853,10 @@
SELECT branchcode,
branchname
FROM branches
- WHERE branchcode IN ('.join(',', map({"'".$_."'"} @branchcodes)).')
+ WHERE branchcode IN ('
+ . join( ',', map( { "'" . $_ . "'" } @branchcodes ) ) . ')
';
- return get_infos_of($query, 'branchcode');
+ return get_infos_of( $query, 'branchcode' );
}
=head2 get_infos_of
@@ -889,7 +883,7 @@
=cut
sub get_infos_of {
- my ($query, $key_name, $value_name) = @_;
+ my ( $query, $key_name, $value_name ) = @_;
my $dbh = C4::Context->dbh;
@@ -897,8 +891,8 @@
$sth->execute();
my %infos_of;
- while (my $row = $sth->fetchrow_hashref) {
- if (defined $value_name) {
+ while ( my $row = $sth->fetchrow_hashref ) {
+ if ( defined $value_name ) {
$infos_of{ $row->{$key_name} } = $row->{$value_name};
}
else {
@@ -952,7 +946,7 @@
$sth = $dbh->prepare($query);
$sth->execute($statuscode);
my %notforloan_label_of;
- while (my $row = $sth->fetchrow_hashref) {
+ while ( my $row = $sth->fetchrow_hashref ) {
$notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
}
$sth->finish;
@@ -963,23 +957,44 @@
sub displaySortby {
my ($sort_by) = @_;
my $sort_by_loop = [
- {value =>"1=9523 >i", label => "Popularity (Most to Least)"},
- {value =>"1=9523 <i", label => "Popularity (Least to Most)"},
- {value =>"1=1003 <i", label => "Author (A-Z)"},
- {value =>"1=1003 >i", label => "Author (Z-A)"},
- {value =>"1=20 <i", label => "Call Number (Non-fiction 0-9 to Fiction A-Z)"},
- {value =>"1=20 >i", label => "Call Number (Fiction Z-A to Non-fiction 9-0)"},
- {value =>"1=31 >i", label => "Dates"},
- {value =>"1=31 >i", label => " Publication/Copyright Date: Newest to Oldest"},
- {value =>"1=31 <i", label => " Publication/Copyright Date: Oldest to Newest"},
- {value =>"1=32 >i", label => " Acquisition Date: Newest to Oldest"},
- {value =>"1=32 <i", label => " Acquisition Date: Oldest to Newest"},
- {value =>"1=36 <i", label => "Title (A-Z)"},
- {value =>"1=36 >i", label => "Title (Z-A)"},
+ { value => "1=9523 >i", label => "Popularity (Most to Least)" },
+ { value => "1=9523 <i", label => "Popularity (Least to Most)" },
+ { value => "1=1003 <i", label => "Author (A-Z)" },
+ { value => "1=1003 >i", label => "Author (Z-A)" },
+ {
+ value => "1=20 <i",
+ label => "Call Number (Non-fiction 0-9 to Fiction A-Z)"
+ },
+ {
+ value => "1=20 >i",
+ label => "Call Number (Fiction Z-A to Non-fiction 9-0)"
+ },
+ { value => "1=31 >i", label => "Dates" },
+ {
+ value => "1=31 >i",
+ label =>
+ " Publication/Copyright Date: Newest to Oldest"
+ },
+ {
+ value => "1=31 <i",
+ label =>
+ " Publication/Copyright Date: Oldest to Newest"
+ },
+ {
+ value => "1=32 >i",
+ label => " Acquisition Date: Newest to Oldest"
+ },
+ {
+ value => "1=32 <i",
+ label => " Acquisition Date: Oldest to Newest"
+ },
+ { value => "1=36 <i", label => "Title (A-Z)" },
+ { value => "1=36 >i", label => "Title (Z-A)" },
];
for my $hash (@$sort_by_loop) {
+
#warn "sort by: $sort_by ... hash:".$hash->{value};
- if ($hash->{value} eq $sort_by) {
+ if ( $hash->{value} eq $sort_by ) {
$hash->{selected} = "selected";
}
}
@@ -991,18 +1006,31 @@
my $indexes = [
{ value => '', label => 'Keyword' },
{ value => 'au', label => 'Author' },
- { value => 'au,phr', label => ' Author Phrase' },
+ {
+ value => 'au,phr',
+ label => ' Author Phrase'
+ },
{ value => 'cpn', label => ' Corporate Name' },
{ value => 'cfn', label => ' Conference Name' },
- { value => 'cpn,phr', label => ' Corporate Name Phrase' },
- { value => 'cfn,phr', label => ' Conference Name Phrase' },
+ {
+ value => 'cpn,phr',
+ label => ' Corporate Name Phrase'
+ },
+ {
+ value => 'cfn,phr',
+ label => ' Conference Name Phrase'
+ },
{ value => 'pn', label => ' Personal Name' },
- { value => 'pn,phr', label => ' Personal Name Phrase' },
+ {
+ value => 'pn,phr',
+ label => ' Personal Name Phrase'
+ },
{ value => 'ln', label => 'Language' },
-# { value => 'mt', label => 'Material Type' },
-# { value => 'mt,phr', label => 'Material Type Phrase' },
-# { value => 'mc', label => 'Musical Composition' },
-# { value => 'mc,phr', label => 'Musical Composition Phrase' },
+
+ # { value => 'mt', label => 'Material Type' },
+ # { value => 'mt,phr', label => 'Material Type Phrase' },
+ # { value => 'mc', label => 'Musical Composition' },
+ # { value => 'mc,phr', label => 'Musical Composition Phrase' },
{ value => 'nt', label => 'Notes/Comments' },
{ value => 'pb', label => 'Publisher' },
@@ -1012,7 +1040,11 @@
{ value => 'ns', label => ' ISSN' },
{ value => 'lcn', label => ' Call Number' },
{ value => 'su', label => 'Subject' },
- { value => 'su,phr', label => ' Subject Phrase' },
+ {
+ value => 'su,phr',
+ label => ' Subject Phrase'
+ },
+
# { value => 'de', label => ' Descriptor' },
# { value => 'ge', label => ' Genre/Form' },
# { value => 'gc', label => ' Geographic Coverage' },
@@ -1034,7 +1066,11 @@
{ # in MARC21, aud codes are stored in 008/22 (Target audience)
name => "limit",
inner_subtype_limits_loop => [
- { value => '', label => 'Any Audience', selected => "selected" },
+ {
+ value => '',
+ label => 'Any Audience',
+ selected => "selected"
+ },
{ value => 'aud:a', label => 'Easy', },
{ value => 'aud:c', label => 'Juvenile', },
{ value => 'aud:d', label => 'Young Adult', },
@@ -1064,7 +1100,10 @@
{ value => '', label => '-----------', },
{ value => 'l-format:sd', label => 'CD audio', },
{ value => 'l-format:ss', label => 'Cassette recording', },
- { value => 'l-format:vf', label => 'VHS tape / Videocassette', },
+ {
+ value => 'l-format:vf',
+ label => 'VHS tape / Videocassette',
+ },
{ value => 'l-format:vd', label => 'DVD video / Videodisc', },
{ value => 'l-format:co', label => 'CD Software', },
{ value => 'l-format:cr', label => 'Website', },
@@ -1079,16 +1118,16 @@
{ value => 'ctype:b', label => 'Bibliographies', },
{ value => 'ctype:c', label => 'Catalogs', },
{ value => 'ctype:d', label => 'Dictionaries', },
- { value => 'ctype:e', label => 'Encyclopedias ',},
+ { value => 'ctype:e', label => 'Encyclopedias ', },
{ value => 'ctype:f', label => 'Handbooks', },
- { value => 'ctype:g', label => 'Legal articles',},
+ { value => 'ctype:g', label => 'Legal articles', },
{ value => 'ctype:i', label => 'Indexes', },
{ value => 'ctype:j', label => 'Patent document', },
{ value => 'ctype:k', label => 'Discographies', },
{ value => 'ctype:l', label => 'Legislation', },
- { value => 'ctype:m', label => 'Theses',},
+ { value => 'ctype:m', label => 'Theses', },
{ value => 'ctype:n', label => 'Surveys', },
- { value => 'ctype:o', label => 'Reviews',},
+ { value => 'ctype:o', label => 'Reviews', },
{ value => 'ctype:p', label => 'Programmed texts', },
{ value => 'ctype:q', label => 'Filmographies', },
{ value => 'ctype:r', label => 'Directories', },
@@ -1105,140 +1144,343 @@
sub displayLanguagesLimit {
my $languages_loop = [
- {value => "", language_label => "No Limit", locale_label => "",selected => "selected",},
- {value => "ln:ara", language_label => "العربية", locale_label => "Arabic",,},
- {value => "ln:bul", language_label => "Български", locale_label => "Bulgarian",,},
- {value => "ln:chi", language_label => "中文", locale_label => "Chinese",,},
- {value => "ln:scr", language_label => "Hrvatski", locale_label => "Croatian",,},
- {value => "ln:cze", language_label => "čeština", locale_label => "Czech",,},
- {value => "ln:dan", language_label => "Dænsk", locale_label => "Danish",,},
- {value => "ln:dut", language_label => "nedərlɑns", locale_label => "Dutch",,},
- {value => "ln:eng", language_label => "English", locale_label => "",,},
- {value => "ln:fre", language_label => "Français", locale_label => "French",,},
- {value => "ln:ger", language_label => "Deutsch", locale_label => "German",,},
- {value => "ln:gre", language_label => "ελληνικά", locale_label => "Greek, Modern [1453- ]",,},
- {value => "ln:heb", language_label => "עברית", locale_label => "Hebrew",,},
- {value => "ln:hin", language_label => "हिन्दी", locale_label => "Hindi",,},
- {value => "ln:hun", language_label => "Magyar", locale_label => "Hungarian",,},
- {value => "ln:ind", language_label => "", locale_label => "Indonesian",,},
- {value => "ln:ita", language_label => "Italiano", locale_label => "Italian",,},
- {value => "ln:jpn", language_label => "日本語", locale_label => "Japanese",,},
- {value => "ln:kor", language_label => "한국어", locale_label => "Korean",,},
- {value => "ln:lat", language_label => "Latina", locale_label => "Latin",,},
- {value => "ln:nor", language_label => "Norsk", locale_label => "Norwegian",,},
- {value => "ln:per", language_label => "فارسى", locale_label => "Persian",,},
- {value => "ln:pol", language_label => "Polski", locale_label => "Polish",,},
- {value => "ln:por", language_label => "Português", locale_label => "Portuguese",,},
- {value => "ln:rum", language_label => "Română", locale_label => "Romanian",,},
- {value => "ln:rus", language_label => "Русский", locale_label => "Russian",,},
- {value => "ln:spa", language_label => "Español", locale_label => "Spanish",,},
- {value => "ln:swe", language_label => "Svenska", locale_label => "Swedish",,},
- {value => "ln:tha", language_label => "ภาษาไทย", locale_label => "Thai",,},
- {value => "ln:tur", language_label => "Türkçe", locale_label => "Turkish",,},
- {value => "ln:ukr", language_label => "Українська", locale_label => "Ukrainian",,},
+ {
+ value => "",
+ language_label => "No Limit",
+ locale_label => "",
+ selected => "selected",
+ },
+ {
+ value => "ln:ara",
+ language_label =>
+ "العربية",
+ locale_label => "Arabic",
+ ,
+ },
+ {
+ value => "ln:bul",
+ language_label =>
+ "Български",
+ locale_label => "Bulgarian",
+ ,
+ },
+ {
+ value => "ln:chi",
+ language_label => "中文",
+ locale_label => "Chinese",
+ ,
+ },
+ {
+ value => "ln:scr",
+ language_label => "Hrvatski",
+ locale_label => "Croatian",
+ ,
+ },
+ {
+ value => "ln:cze",
+ language_label => "čeština",
+ locale_label => "Czech",
+ ,
+ },
+ {
+ value => "ln:dan",
+ language_label => "Dænsk",
+ locale_label => "Danish",
+ ,
+ },
+ {
+ value => "ln:dut",
+ language_label => "nedərlɑns",
+ locale_label => "Dutch",
+ ,
+ },
+ {
+ value => "ln:eng",
+ language_label => "English",
+ locale_label => "",
+ ,
+ },
+ {
+ value => "ln:fre",
+ language_label => "Français",
+ locale_label => "French",
+ ,
+ },
+ {
+ value => "ln:ger",
+ language_label => "Deutsch",
+ locale_label => "German",
+ ,
+ },
+ {
+ value => "ln:gre",
+ language_label =>
+ "ελληνικά",
+ locale_label => "Greek, Modern [1453- ]",
+ ,
+ },
+ {
+ value => "ln:heb",
+ language_label => "עברית",
+ locale_label => "Hebrew",
+ ,
+ },
+ {
+ value => "ln:hin",
+ language_label => "हिन्दी",
+ locale_label => "Hindi",
+ ,
+ },
+ {
+ value => "ln:hun",
+ language_label => "Magyar",
+ locale_label => "Hungarian",
+ ,
+ },
+ {
+ value => "ln:ind",
+ language_label => "",
+ locale_label => "Indonesian",
+ ,
+ },
+ {
+ value => "ln:ita",
+ language_label => "Italiano",
+ locale_label => "Italian",
+ ,
+ },
+ {
+ value => "ln:jpn",
+ language_label => "日本語",
+ locale_label => "Japanese",
+ ,
+ },
+ {
+ value => "ln:kor",
+ language_label => "한국어",
+ locale_label => "Korean",
+ ,
+ },
+ {
+ value => "ln:lat",
+ language_label => "Latina",
+ locale_label => "Latin",
+ ,
+ },
+ {
+ value => "ln:nor",
+ language_label => "Norsk",
+ locale_label => "Norwegian",
+ ,
+ },
+ {
+ value => "ln:per",
+ language_label => "فارسى",
+ locale_label => "Persian",
+ ,
+ },
+ {
+ value => "ln:pol",
+ language_label => "Polski",
+ locale_label => "Polish",
+ ,
+ },
+ {
+ value => "ln:por",
+ language_label => "Português",
+ locale_label => "Portuguese",
+ ,
+ },
+ {
+ value => "ln:rum",
+ language_label => "Română",
+ locale_label => "Romanian",
+ ,
+ },
+ {
+ value => "ln:rus",
+ language_label =>
+ "Русский",
+ locale_label => "Russian",
+ ,
+ },
+ {
+ value => "ln:spa",
+ language_label => "Español",
+ locale_label => "Spanish",
+ ,
+ },
+ {
+ value => "ln:swe",
+ language_label => "Svenska",
+ locale_label => "Swedish",
+ ,
+ },
+ {
+ value => "ln:tha",
+ language_label =>
+ "ภาษาไทย",
+ locale_label => "Thai",
+ ,
+ },
+ {
+ value => "ln:tur",
+ language_label => "Türkçe",
+ locale_label => "Turkish",
+ ,
+ },
+ {
+ value => "ln:ukr",
+ language_label =>
+"Українська",
+ locale_label => "Ukrainian",
+ ,
+ },
-];
+ ];
return $languages_loop;
}
sub displayLimitTypes {
-my $outer_limit_types_loop = [
+ my $outer_limit_types_loop = [
-{ inner_limit_types_loop => [
- {label => "Books",
+ {
+ inner_limit_types_loop => [
+ {
+ label => "Books",
id => "mc-bks",
name => "limit",
value => "mc:t",
icon => "AF.gif",
- title => "Books, Pamphlets, Technical reports, Manuscripts, Legal papers, Theses and dissertations",},
+ title =>
+"Books, Pamphlets, Technical reports, Manuscripts, Legal papers, Theses and dissertations",
+ },
- {label => "Visual Materials",
+ {
+ label => "Visual Materials",
id => "mc-vis",
name => "limit",
value => "mc:v",
icon => "AV Aids.gif",
- title => "Motion pictures, Videorecordings, Filmstrips, Slides, Transparencies, Photos, Cards, Charts, Drawings",},
+ title =>
+"Motion pictures, Videorecordings, Filmstrips, Slides, Transparencies, Photos, Cards, Charts, Drawings",
+ },
- {label => "Books on Tape",
+ {
+ label => "Books on Tape",
id => "mc-sr",
name => "limit",
value => "mc-rtype:i",
icon => "AF.gif",
- title => "Spoken, Books on CD and Cassette",},
+ title => "Spoken, Books on CD and Cassette",
+ },
],
-},
-{ inner_limit_types_loop => [
- {label => "Computer Files",
+ },
+ {
+ inner_limit_types_loop => [
+ {
+ label => "Computer Files",
id => "mc-cf",
name => "limit",
value => "mc:c",
icon => "CD-ROM software.gif",
- title => "Computer files, Data, Software",},
+ title => "Computer files, Data, Software",
+ },
- {label => "Local History Materials",
+ {
+ label => "Local History Materials",
id => "mc-lh",
name => "limit",
value => "mc-collection:LH",
icon => "Local history.gif",
- title => "Local History Materials",},
+ title => "Local History Materials",
+ },
- {label => "Maps",
+ {
+ label => "Maps",
id => "mc-map",
name => "limit",
value => "mc:a",
icon => "PF.gif ",
- title => "Maps, Globes",},
+ title => "Maps, Globes",
+ },
],
-},
-{ inner_limit_types_loop => [
- {label => "Music",
+ },
+ {
+ inner_limit_types_loop => [
+ {
+ label => "Music",
id => "mc-mus",
name => "limit",
value => "mc-rtype:j",
icon => "CDM.gif",
- title => "Music",},
+ title => "Music",
+ },
- {label => "Kits",
+ {
+ label => "Kits",
id => "mc-kit",
name => "limit",
value => "mc-rtype:o",
icon => "KIT.gif",
- title => "Kits",},
+ title => "Kits",
+ },
- {label => "Reference",
+ {
+ label => "Reference",
id => "mc-ref",
name => "limit",
value => "mc-collection:REF",
icon => "REF.gif",
- title => "Reference",},
+ title => "Reference",
+ },
],
-},
+ },
-];
-return $outer_limit_types_loop;
+ ];
+ return $outer_limit_types_loop;
}
+
sub displayServers {
- my ($position,$type)=@_;
- my $dbh=C4::Context->dbh;
- my $strsth="SELECT * FROM z3950servers where 1";
- $strsth.= " AND position=\"$position\"" if ($position);
- $strsth.= " AND type=\"$type\"" if ($type);
- my $rq=$dbh->prepare($strsth);
+ my ( $position, $type ) = @_;
+ my $dbh = C4::Context->dbh;
+ my $strsth = "SELECT * FROM z3950servers where 1";
+ $strsth .= " AND position=\"$position\"" if ($position);
+ $strsth .= " AND type=\"$type\"" if ($type);
+ my $rq = $dbh->prepare($strsth);
$rq->execute;
my @primaryserverloop;
- while (my $data=$rq->fetchrow_hashref){
+
+ while ( my $data = $rq->fetchrow_hashref ) {
my %cell;
- $cell{label}=$data->{'description'};
- $cell{id}=$data->{'name'};
- $cell{value}=$data->{host}.($data->{port}?":".$data->{port}:"")."/".$data->{database} if ($data->{host});
- $cell{checked}=$data->{checked};
- push @primaryserverloop,{label => $data->{description}, id=>$data->{name}, name=>"server", value=>$data->{host}.":".$data->{port}."/".$data->{database},checked=>"checked",icon => $data->{icon},zed => $data->{type} eq 'zed',opensearch=>$data->{type} eq 'opensearch'};
+ $cell{label} = $data->{'description'};
+ $cell{id} = $data->{'name'};
+ $cell{value} =
+ $data->{host}
+ . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
+ . $data->{database}
+ if ( $data->{host} );
+ $cell{checked} = $data->{checked};
+ push @primaryserverloop,
+ {
+ label => $data->{description},
+ id => $data->{name},
+ name => "server",
+ value => $data->{host} . ":"
+ . $data->{port} . "/"
+ . $data->{database},
+ checked => "checked",
+ icon => $data->{icon},
+ zed => $data->{type} eq 'zed',
+ opensearch => $data->{type} eq 'opensearch'
+ };
}
return \@primaryserverloop;
}
sub displaySecondaryServers {
+
# my $secondary_servers_loop = [
# { inner_sup_servers_loop => [
# {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
@@ -1248,58 +1490,72 @@
# ],
# },
# ];
- return ;#$secondary_servers_loop;
+ return; #$secondary_servers_loop;
}
sub displayLanguages {
my ($cgi) = @_;
my @languages_options;
- my $languages_hash = {en => 'English', es => 'Español',}; #de => 'Deutsch', en => 'English', es => 'Español', fr => 'Français', pl => 'Polski', "zh-TW" => '中文', it => 'Italiano',};
- my $counter=0;
- foreach my $language (GetLanguages("opac")) {
+ my $languages_hash =
+ { en => 'English', es => 'Español',
+ }; #de => 'Deutsch', en => 'English', es => 'Español', fr => 'Français', pl => 'Polski', "zh-TW" => '中文', it => 'Italiano',};
+ my $counter = 0;
+ foreach my $language ( GetLanguages("opac") ) {
next if $language eq 'images';
next if $language eq 'itemtypeimg';
next if $language eq 'CVS';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
+ next if $language =~ /png$/;
+ next if $language =~ /css$/;
my $label = $languages_hash->{$language};
- my $selected='0';
+ my $selected = '0';
my $htdocs = C4::Context->config('opacdocs');
- my ($current_theme,$current_language) = themelanguage("opachtdocs", "default", "opac", $cgi);
- my $current=1 if $current_language eq $language;
+ my ( $current_theme, $current_language ) =
+ themelanguage( "opachtdocs", "prog", "opac", $cgi );
+ my $current = 1 if $current_language eq $language;
+
# next if $currently_selected_languages->{$language};
- push @languages_options, { label => $label, language => $language, counter => $counter, current => $current} if $label;
+ push @languages_options,
+ {
+ label => $label,
+ language => $language,
+ counter => $counter,
+ current => $current
+ }
+ if $label;
$counter++;
}
return @languages_options;
}
-
sub GetDepartements {
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT authorised_value,lib FROM authorised_values WHERE category='DPT'
- ");
+ my $sth = $dbh->prepare(
+ "SELECT authorised_value,lib FROM authorised_values WHERE category='DPT'
+ "
+ );
$sth->execute;
my @getdepartements;
- my $i=0;
- while (my $data=$sth->fetchrow_hashref){
- $getdepartements[$i]=$data;
+ my $i = 0;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ $getdepartements[$i] = $data;
$i++;
}
$sth->finish;
- return(@getdepartements);
- }
+ return (@getdepartements);
+}
sub GetDepartementLib {
- my($authorisedvalue) = @_;
+ my ($authorisedvalue) = @_;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("SELECT lib,authorised_value FROM authorised_values WHERE category='DPT' AND authorised_value=?
- ");
+ my $sth = $dbh->prepare(
+"SELECT lib,authorised_value FROM authorised_values WHERE category='DPT' AND authorised_value=?
+ "
+ );
$sth->execute($authorisedvalue);
- my (@lib)=$sth->fetchrow_array;
+ my (@lib) = $sth->fetchrow_array;
$sth->finish;
- return(@lib);
- }
+ return (@lib);
+}
=head2 GetAuthorisedValues
@@ -1315,13 +1571,13 @@
sub GetAuthorisedValues {
my $category = shift;
my $dbh = C4::Context->dbh;
- my $query ="SELECT * FROM authorised_values";
- $query .=" WHERE category = '".$category."'" if $category;
+ my $query = "SELECT * FROM authorised_values";
+ $query .= " WHERE category = '" . $category . "'" if $category;
my $sth = $dbh->prepare($query);
$sth->execute;
my @authloop;
- while(my $data = $sth->fetchrow_hashref){
+ while ( my $data = $sth->fetchrow_hashref ) {
push @authloop, $data;
}
return \@authloop;
Index: Members.pm
===================================================================
RCS file: /sources/koha/koha/C4/Members.pm,v
retrieving revision 1.32.2.18
retrieving revision 1.32.2.19
diff -u -b -r1.32.2.18 -r1.32.2.19
--- Members.pm 17 Nov 2006 16:06:51 -0000 1.32.2.18
+++ Members.pm 20 Nov 2006 10:26:10 -0000 1.32.2.19
@@ -1,5 +1,3 @@
-# -*- tab-width: 8 -*-
-
package C4::Members;
# Copyright 2000-2003 Katipo Communications
@@ -19,7 +17,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Members.pm,v 1.32.2.18 2006/11/17 16:06:51 toins Exp $
+# $Id: Members.pm,v 1.32.2.19 2006/11/20 10:26:10 toins Exp $
use strict;
require Exporter;
@@ -31,7 +29,7 @@
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = do { my @v = '$Revision: 1.32.2.18 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.32.2.19 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -74,7 +72,6 @@
&GetBorrowersWithIssuesHistoryOlderThan
);
-
=item BornameSearch
($count, $borrowers) = &BornameSearch($env, $searchstring, $type);
@@ -190,7 +187,6 @@
return $sth->fetchrow;
}
-
=item GetMember
$borrower = &GetMember($cardnumber, $borrowernumber);
@@ -269,7 +265,8 @@
$sth->execute($borrowernumber);
}
my $data = $sth->fetchrow_hashref;
-# warn "DATA" . $data->{category_type};
+
+ # warn "DATA" . $data->{category_type};
$sth->finish;
if ($data) {
return ($data);
@@ -309,7 +306,8 @@
sub borrdata2 {
my ( $env, $borrowernumber ) = @_;
my $dbh = C4::Context->dbh;
- my $query = "Select count(*) from issues where borrowernumber='$borrowernumber' and
+ my $query =
+ "Select count(*) from issues where borrowernumber='$borrowernumber' and
returndate is NULL";
# print $query;
@@ -339,17 +337,19 @@
sub modmember {
my (%data) = @_;
my $dbh = C4::Context->dbh;
- $data{'dateofbirth'}=format_date_in_iso($data{'dateofbirth'});
- $data{'dateexpiry'}=format_date_in_iso($data{'dateexpiry'});
- $data{'dateenrolled'}=format_date_in_iso($data{'dateenrolled'});
-# warn "num user".$data{'borrowernumber'};
+ $data{'dateofbirth'} = format_date_in_iso( $data{'dateofbirth'} );
+ $data{'dateexpiry'} = format_date_in_iso( $data{'dateexpiry'} );
+ $data{'dateenrolled'} = format_date_in_iso( $data{'dateenrolled'} );
+
+ # warn "num user".$data{'borrowernumber'};
my $query;
my $sth;
- $data{'userid'}='' if ($data{'password'}eq '');
+ $data{'userid'} = '' if ( $data{'password'} eq '' );
+
# test to know if u must update or not the borrower password
- if ($data{'password'} eq '****'){
+ if ( $data{'password'} eq '****' ) {
- $query="UPDATE borrowers SET
+ $query = "UPDATE borrowers SET
cardnumber = ?,surname = ?,firstname = ?,title = ?,othernames = ?,initials = ?,
streetnumber = ?,streettype = ?,address = ?,address2 = ?,city = ?,zipcode = ?,
email = ?,phone = ?,mobile = ?,fax = ?,emailpro = ?,phonepro = ?,B_streetnumber = ?,
@@ -358,37 +358,39 @@
contactfirstname = ?,contacttitle = ?,guarantorid = ?,borrowernotes = ?,relationship = ?,ethnicity = ?,
ethnotes = ?,sex = ?,userid = ?,opacnote = ?,contactnote = ?,sort1 = ?,sort2 = ?
WHERE borrowernumber=$data{'borrowernumber'}";
- $sth=$dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute(
- $data{'cardnumber'},$data{'surname'},
- $data{'firstname'},$data{'title'},
- $data{'othernames'},$data{'initials'},
- $data{'streetnumber'},$data{'streettype'},
- $data{'address'},$data{'address2'},
- $data{'city'},$data{'zipcode'},
- $data{'email'},$data{'phone'},
- $data{'mobile'},$data{'fax'},
- $data{'emailpro'},$data{'phonepro'},
- $data{'B_streetnumber'},$data{'B_streettype'},
- $data{'B_address'},$data{'B_city'},
- $data{'B_zipcode'},$data{'B_email'},$data{'B_phone'},
- $data{'dateofbirth'},$data{'branchcode'},
- $data{'categorycode'},$data{'dateenrolled'},
- $data{'dateexpiry'},$data{'gonenoaddress'},
- $data{'lost'},$data{'debarred'},
- $data{'contactname'},$data{'contactfirstname'},
- $data{'contacttitle'},$data{'guarantorid'},
- $data{'borrowernotes'},$data{'relationship'},
- $data{'ethnicity'},$data{'ethnotes'},
- $data{'sex'},
- $data{'userid'},
- $data{'opacnote'},$data{'contactnote'},
- $data{'sort1'},$data{'sort2'});
+ $data{'cardnumber'}, $data{'surname'},
+ $data{'firstname'}, $data{'title'},
+ $data{'othernames'}, $data{'initials'},
+ $data{'streetnumber'}, $data{'streettype'},
+ $data{'address'}, $data{'address2'},
+ $data{'city'}, $data{'zipcode'},
+ $data{'email'}, $data{'phone'},
+ $data{'mobile'}, $data{'fax'},
+ $data{'emailpro'}, $data{'phonepro'},
+ $data{'B_streetnumber'}, $data{'B_streettype'},
+ $data{'B_address'}, $data{'B_city'},
+ $data{'B_zipcode'}, $data{'B_email'},
+ $data{'B_phone'}, $data{'dateofbirth'},
+ $data{'branchcode'}, $data{'categorycode'},
+ $data{'dateenrolled'}, $data{'dateexpiry'},
+ $data{'gonenoaddress'}, $data{'lost'},
+ $data{'debarred'}, $data{'contactname'},
+ $data{'contactfirstname'}, $data{'contacttitle'},
+ $data{'guarantorid'}, $data{'borrowernotes'},
+ $data{'relationship'}, $data{'ethnicity'},
+ $data{'ethnotes'}, $data{'sex'},
+ $data{'userid'}, $data{'opacnote'},
+ $data{'contactnote'}, $data{'sort1'},
+ $data{'sort2'}
+ );
}
- else{
+ else {
- ($data{'password'}=md5_base64($data{'password'})) if ($data{'password'} ne '');
- $query="UPDATE borrowers SET
+ ( $data{'password'} = md5_base64( $data{'password'} ) )
+ if ( $data{'password'} ne '' );
+ $query = "UPDATE borrowers SET
cardnumber = ?,surname = ?,firstname = ?,title = ?,othernames = ?,initials = ?,
streetnumber = ?,streettype = ?,address = ?,address2 = ?,city = ?,zipcode = ?,
email = ?,phone = ?,mobile = ?,fax = ?,emailpro = ?,phonepro = ?,B_streetnumber = ?,
@@ -397,47 +399,47 @@
contactfirstname = ?,contacttitle = ?,guarantorid = ?,borrowernotes = ?,relationship = ?,ethnicity = ?,
ethnotes = ?,sex = ?,password = ?,userid = ?,opacnote = ?,contactnote = ?,sort1 = ?,sort2 = ?
WHERE borrowernumber=$data{'borrowernumber'}";
- $sth=$dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute(
- $data{'cardnumber'},$data{'surname'},
- $data{'firstname'},$data{'title'},
- $data{'othernames'},$data{'initials'},
- $data{'streetnumber'},$data{'streettype'},
- $data{'address'},$data{'address2'},
- $data{'city'},$data{'zipcode'},
- $data{'email'},$data{'phone'},
- $data{'mobile'},$data{'fax'},
- $data{'emailpro'},$data{'phonepro'},
- $data{'B_streetnumber'},$data{'B_streettype'},
- $data{'B_address'},$data{'B_city'},
- $data{'B_zipcode'},$data{'B_email'},$data{'B_phone'},
- $data{'dateofbirth'},$data{'branchcode'},
- $data{'categorycode'},$data{'dateenrolled'},
- $data{'dateexpiry'},$data{'gonenoaddress'},
- $data{'lost'},$data{'debarred'},
- $data{'contactname'},$data{'contactfirstname'},
- $data{'contacttitle'},$data{'guarantorid'},
- $data{'borrowernotes'},$data{'relationship'},
- $data{'ethnicity'},$data{'ethnotes'},
- $data{'sex'},$data{'password'},
- $data{'userid'},
- $data{'opacnote'},$data{'contactnote'},
- $data{'sort1'},$data{'sort2'}
+ $data{'cardnumber'}, $data{'surname'},
+ $data{'firstname'}, $data{'title'},
+ $data{'othernames'}, $data{'initials'},
+ $data{'streetnumber'}, $data{'streettype'},
+ $data{'address'}, $data{'address2'},
+ $data{'city'}, $data{'zipcode'},
+ $data{'email'}, $data{'phone'},
+ $data{'mobile'}, $data{'fax'},
+ $data{'emailpro'}, $data{'phonepro'},
+ $data{'B_streetnumber'}, $data{'B_streettype'},
+ $data{'B_address'}, $data{'B_city'},
+ $data{'B_zipcode'}, $data{'B_email'},
+ $data{'B_phone'}, $data{'dateofbirth'},
+ $data{'branchcode'}, $data{'categorycode'},
+ $data{'dateenrolled'}, $data{'dateexpiry'},
+ $data{'gonenoaddress'}, $data{'lost'},
+ $data{'debarred'}, $data{'contactname'},
+ $data{'contactfirstname'}, $data{'contacttitle'},
+ $data{'guarantorid'}, $data{'borrowernotes'},
+ $data{'relationship'}, $data{'ethnicity'},
+ $data{'ethnotes'}, $data{'sex'},
+ $data{'password'}, $data{'userid'},
+ $data{'opacnote'}, $data{'contactnote'},
+ $data{'sort1'}, $data{'sort2'}
);
}
$sth->finish;
- # ok if its an adult (type) it may have borrowers that depend on it as a guarantor
- # so when we update information for an adult we should check for guarantees and update the relevant part
- # of their records, ie addresses and phone numbers
- my ($category_type,undef)=getcategorytype($data{'category_type'});
- if ($category_type eq 'A' ){
+
+# ok if its an adult (type) it may have borrowers that depend on it as a guarantor
+# so when we update information for an adult we should check for guarantees and update the relevant part
+# of their records, ie addresses and phone numbers
+ my ( $category_type, undef ) = getcategorytype( $data{'category_type'} );
+ if ( $category_type eq 'A' ) {
# is adult check guarantees;
updateguarantees(%data);
}
-
}
sub newmember {
@@ -524,27 +526,25 @@
. ",emailpro="
. $dbh->quote( $data{'emailpro'} )
. ",contactfirstname="
- . $dbh->quote( $data{'contactfirstname'} )
- . ",sex="
- . $dbh->quote( $data{'sex'} )
- . ",fax="
+ . $dbh->quote( $data{'contactfirstname'} ) . ",sex="
+ . $dbh->quote( $data{'sex'} ) . ",fax="
. $dbh->quote( $data{'fax'} )
. ",relationship="
. $dbh->quote( $data{'relationship'} )
. ",B_streetnumber="
- . $dbh->quote( $data{'B_streetnumber'})
+ . $dbh->quote( $data{'B_streetnumber'} )
. ",B_streettype="
- . $dbh->quote( $data{'B_streettype'})
+ . $dbh->quote( $data{'B_streettype'} )
. ",gonenoaddress="
- . $dbh->quote( $data{'gonenoaddress'})
+ . $dbh->quote( $data{'gonenoaddress'} )
. ",lost="
- . $dbh->quote( $data{'lost'})
+ . $dbh->quote( $data{'lost'} )
. ",debarred="
- . $dbh->quote( $data{'debarred'})
+ . $dbh->quote( $data{'debarred'} )
. ",ethnicity="
- . $dbh->quote( $data{'ethnicity'})
+ . $dbh->quote( $data{'ethnicity'} )
. ",ethnotes="
- . $dbh->quote( $data{'ethnotes'});
+ . $dbh->quote( $data{'ethnotes'} );
my $sth = $dbh->prepare($query);
$sth->execute;
@@ -605,7 +605,6 @@
$sth3->finish;
}
}
-################################################################################
=item fixup_cardnumber
@@ -903,8 +902,9 @@
#FIXME: sanity-check order and limit
my $dbh = C4::Context->dbh;
- my $count=0;
- my $query = "Select *,items.timestamp AS itemstimestamp from issues,biblio,items,biblioitems
+ my $count = 0;
+ my $query =
+"Select *,items.timestamp AS itemstimestamp from issues,biblio,items,biblioitems
where borrowernumber=? and
items.biblioitemnumber=biblioitems.biblioitemnumber and
items.itemnumber=issues.itemnumber and
@@ -927,23 +927,23 @@
# get all issued items for borrowernumber from oldissues table
# large chunk of older issues data put into table oldissues
# to speed up db calls for issuing items
- if(C4::Context->preference("ReadingHistory")){
- my $query2="SELECT * FROM oldissues,biblio,items,biblioitems
+ if ( C4::Context->preference("ReadingHistory") ) {
+ my $query2 = "SELECT * FROM oldissues,biblio,items,biblioitems
WHERE borrowernumber=?
AND items.biblioitemnumber=biblioitems.biblioitemnumber
AND items.itemnumber=oldissues.itemnumber
AND items.biblionumber=biblio.biblionumber
ORDER BY $order";
- if ($limit !=0){
- $limit=$limit-$count;
- $query2.=" limit $limit";
+ if ( $limit != 0 ) {
+ $limit = $limit - $count;
+ $query2 .= " limit $limit";
}
- my $sth2=$dbh->prepare($query2);
+ my $sth2 = $dbh->prepare($query2);
$sth2->execute($borrowernumber);
- while (my $data2=$sth2->fetchrow_hashref){
- $result[$i]=$data2;
+ while ( my $data2 = $sth2->fetchrow_hashref ) {
+ $result[$i] = $data2;
$i++;
}
$sth2->finish;
@@ -973,7 +973,7 @@
#'
sub getboracctrecord {
- my ( $env, $params) = @_;
+ my ( $env, $params ) = @_;
my $dbh = C4::Context->dbh;
my @acctlines;
my $numlines = 0;
@@ -981,7 +981,7 @@
"Select * from accountlines where
borrowernumber=? order by date desc,timestamp desc"
);
- # print $query;
+
$sth->execute( $params->{'borrowernumber'} );
my $total = 0;
while ( my $data = $sth->fetchrow_hashref ) {
@@ -1004,8 +1004,6 @@
return ( $numlines, \@acctlines, $total );
}
-
-
=head2 GetBorNotifyAcctRecord
($count, $acctlines, $total) = &GetBorNotifyAcctRecord($env, $params,$notifyid);
@@ -1021,10 +1019,11 @@
keys are the fields of the C<accountlines> table in the Koha database.
C<$count> is the number of elements in C<$acctlines>. C<$total> is the
total amount outstanding for all of the account lines.
+
=cut
sub GetBorNotifyAcctRecord {
- my ( $env, $params , $notifyid) = @_;
+ my ( $env, $params, $notifyid ) = @_;
my $dbh = C4::Context->dbh;
my @acctlines;
my $numlines = 0;
@@ -1037,8 +1036,8 @@
ORDER BY notify_id,accounttype
|;
my $sth = $dbh->prepare($query);
- # print $query;
- $sth->execute( $params->{'borrowernumber'},$notifyid );
+
+ $sth->execute( $params->{'borrowernumber'}, $notifyid );
my $total = 0;
while ( my $data = $sth->fetchrow_hashref ) {
$acctlines[$numlines] = $data;
@@ -1049,11 +1048,6 @@
return ( $numlines, \@acctlines, $total );
}
-
-
-
-
-
=head2 checkuniquemember (OUEST-PROVENCE)
$result = &checkuniquemember($collectivity,$surname,$categorycode,$firstname,$dateofbirth);
@@ -1146,7 +1140,9 @@
}
=head2 getdcity (OUEST-PROVENCE)
+
recover cityid with city_name condition
+
=cut
sub getidcity {
@@ -1227,16 +1223,17 @@
sub GetborCatFromCatType {
my ( $category_type, $action ) = @_;
my $dbh = C4::Context->dbh;
- my $request =qq| SELECT categorycode,description
+ my $request = qq| SELECT categorycode,description
FROM categories
$action
ORDER BY categorycode|;
my $sth = $dbh->prepare($request);
- if ($action){
-$sth->execute($category_type);
-}else{
-$sth->execute();
-}
+ if ($action) {
+ $sth->execute($category_type);
+ }
+ else {
+ $sth->execute();
+ }
my %labels;
my @codes;
@@ -1263,15 +1260,16 @@
my $dbh = C4::Context->dbh;
my $sth =
$dbh->prepare(
- "SELECT description,dateofbirthrequired,upperagelimit,category_type FROM categories WHERE categorycode = ?");
+"SELECT description,dateofbirthrequired,upperagelimit,category_type FROM categories WHERE categorycode = ?"
+ );
$sth->execute($catcode);
- my ($description,$dateofbirthrequired,$upperagelimit,$category_type) = $sth->fetchrow();
+ my ( $description, $dateofbirthrequired, $upperagelimit, $category_type ) =
+ $sth->fetchrow();
$sth->finish();
- return ($description,$dateofbirthrequired,$upperagelimit,$category_type);
+ return ( $description, $dateofbirthrequired, $upperagelimit,
+ $category_type );
} # sub getborrowercategory
-
-
=head2 ethnicitycategories
($codes_arrayref, $labels_hashref) = ðnicitycategories();
@@ -1322,8 +1320,6 @@
return $data->{'name'};
} # sub fixEthnicity
-
-
=head2 get_age
$dateofbirth,$date = &get_age($date);
@@ -1331,31 +1327,31 @@
this function return the borrowers age with the value of dateofbirth
=cut
+
#'
sub get_age {
- my ($date, $date_ref) = @_;
+ my ( $date, $date_ref ) = @_;
- if (not defined $date_ref) {
- $date_ref = sprintf('%04d-%02d-%02d', Today());
+ if ( not defined $date_ref ) {
+ $date_ref = sprintf( '%04d-%02d-%02d', Today() );
}
- my ($year1, $month1, $day1) = split /-/, $date;
- my ($year2, $month2, $day2) = split /-/, $date_ref;
+ my ( $year1, $month1, $day1 ) = split /-/, $date;
+ my ( $year2, $month2, $day2 ) = split /-/, $date_ref;
my $age = $year2 - $year1;
- if ($month1.$day1 > $month2.$day2) {
+ if ( $month1 . $day1 > $month2 . $day2 ) {
$age--;
}
return $age;
-}# sub get_age
-
-
+} # sub get_age
=head2 get_institutions
$insitutions = get_institutions();
Just returns a list of all the borrowers of type I, borrownumber and name
+
=cut
#'
@@ -1409,35 +1405,32 @@
=back
=cut
+
sub GetBorrowersFromSurname {
- my ($searchstring)=@_;
+ my ($searchstring) = @_;
my $dbh = C4::Context->dbh;
- $searchstring=~ s/\'/\\\'/g;
- my @data=split(' ',$searchstring);
- my $count=@data;
+ $searchstring =~ s/\'/\\\'/g;
+ my @data = split( ' ', $searchstring );
+ my $count = @data;
my $query = qq|
SELECT surname,firstname
FROM borrowers
WHERE (surname like ?)
ORDER BY surname
|;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute("$data[0]%");
my @results;
- my $count = 0;
- while (my $data=$sth->fetchrow_hashref){
- push(@results,$data);
+ $count = 0;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @results, $data );
$count++;
}
$sth->finish;
- return ($count,\@results);
+ return ( $count, \@results );
}
-
-
-
-
-
=head2 citycaracteristiques (OUEST-PROVENCE)
($id_cityarrayref, $city_hashref) = &citycaracteristic();
@@ -1448,39 +1441,41 @@
WHERE =>OUEST PROVENCE OR EXTERIEUR
=cut
+
sub GetCities {
+
#my ($type_city) = @_;
my $dbh = C4::Context->dbh;
- my $query=qq|SELECT cityid,city_name
+ my $query = qq|SELECT cityid,city_name
FROM cities
ORDER BY city_name|;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
+
#$sth->execute($type_city);
$sth->execute();
my %city;
my @id;
-# insert empty value to create a empty choice in cgi popup
-while (my $data=$sth->fetchrow_hashref){
+ # insert empty value to create a empty choice in cgi popup
+
+ while ( my $data = $sth->fetchrow_hashref ) {
- push @id,$data->{'cityid'};
- $city{$data->{'cityid'}}=$data->{'city_name'};
+ push @id, $data->{'cityid'};
+ $city{ $data->{'cityid'} } = $data->{'city_name'};
}
- #test to know if the table contain some records if no the function return nothing
- my $id=@id;
+#test to know if the table contain some records if no the function return nothing
+ my $id = @id;
$sth->finish;
- if ($id eq 0)
- {
- return();
+ if ( $id eq 0 ) {
+ return ();
}
- else{
- unshift (@id ,"");
- return(\@id,\%city);
+ else {
+ unshift( @id, "" );
+ return ( \@id, \%city );
}
}
-
=head2 GetSortDetails (OUEST-PROVENCE)
($lib) = &GetSortDetails($category,$sortvalue);
@@ -1491,16 +1486,17 @@
C<&$category>this is the value of authorized value category
=cut
+
sub GetSortDetails {
- my ($category,$sortvalue)=@_;
+ my ( $category, $sortvalue ) = @_;
my $dbh = C4::Context->dbh;
- my $query=qq|SELECT lib
+ my $query = qq|SELECT lib
FROM authorised_values
WHERE category=?
AND authorised_value=? |;
- my $sth=$dbh->prepare($query);
- $sth->execute($category,$sortvalue);
- my $lib=$sth->fetchrow;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $category, $sortvalue );
+ my $lib = $sth->fetchrow;
return ($lib);
}
@@ -1513,30 +1509,33 @@
=cut
-sub DeleteBorrower{
- my ($member)=@_;
+sub DeleteBorrower {
+ my ($member) = @_;
my $dbh = C4::Context->dbh;
my $query;
- $query=qq|SELECT *
+ $query = qq|SELECT *
FROM borrowers
WHERE borrowernumber=?|;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute($member);
- my @data=$sth->fetchrow_array;
+ my @data = $sth->fetchrow_array;
$sth->finish;
- $sth=$dbh->prepare("Insert into deletedborrowers values (".("?,"x(scalar(@data)-1))."?)");
+ $sth =
+ $dbh->prepare( "Insert into deletedborrowers values ("
+ . ( "?," x ( scalar(@data) - 1 ) )
+ . "?)" );
$sth->execute(@data);
$sth->finish;
- $query=qq|DELETE
+ $query = qq|DELETE
FROM borrowers
WHERE borrowernumber=?|;
- $sth=$dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute($member);
$sth->finish;
- $query=qq|DELETE
+ $query = qq|DELETE
FROM reserves
WHERE borrowernumber=?|;
- $sth=$dbh->prepare($query);
+ $sth = $dbh->prepare($query);
$sth->execute($member);
$sth->finish;
}
@@ -1571,24 +1570,25 @@
=cut
sub GetMembeReregistration {
- my ($categorycode,$borrowerid) = @_;
+ my ( $categorycode, $borrowerid ) = @_;
my $dbh = C4::Context->dbh;
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
+ my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
+ localtime(time);
$mon++;
- $year=$year+1900;
- if ($mon < '10' ){
- $mon="0".$mon;
- }
- if ($mday < '10' ){
- $mday="0".$mday;
- }
- my $today=format_date("$year-$mon-$mday");
- $today=format_date_in_iso($today);
- my $dateexpiry=calcexpirydate($categorycode,$today);
- my $query=qq| UPDATE borrowers
+ $year = $year + 1900;
+ if ( $mon < '10' ) {
+ $mon = "0" . $mon;
+ }
+ if ( $mday < '10' ) {
+ $mday = "0" . $mday;
+ }
+ my $today = format_date("$year-$mon-$mday");
+ $today = format_date_in_iso($today);
+ my $dateexpiry = calcexpirydate( $categorycode, $today );
+ my $query = qq| UPDATE borrowers
SET dateexpiry='$dateexpiry'
WHERE borrowernumber='$borrowerid'|;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute;
$sth->finish;
return $dateexpiry;
@@ -1607,31 +1607,31 @@
sub GetRoadTypes {
my $dbh = C4::Context->dbh;
- my $query=qq|SELECT roadtypeid,road_type
+ my $query = qq|SELECT roadtypeid,road_type
FROM roadtype
ORDER BY road_type|;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute();
my %roadtype;
my @id;
-# insert empty value to create a empty choice in cgi popup
-while (my $data=$sth->fetchrow_hashref){
+ # insert empty value to create a empty choice in cgi popup
- push @id,$data->{'roadtypeid'};
- $roadtype{$data->{'roadtypeid'}}=$data->{'road_type'};
+ while ( my $data = $sth->fetchrow_hashref ) {
+
+ push @id, $data->{'roadtypeid'};
+ $roadtype{ $data->{'roadtypeid'} } = $data->{'road_type'};
}
- #test to know if the table contain some records if no the function return nothing
- my $id=@id;
+#test to know if the table contain some records if no the function return nothing
+ my $id = @id;
$sth->finish;
- if ($id eq 0)
- {
- return();
+ if ( $id eq 0 ) {
+ return ();
}
- else{
- unshift (@id ,"");
- return(\@id,\%roadtype);
+ else {
+ unshift( @id, "" );
+ return ( \@id, \%roadtype );
}
}
@@ -1646,14 +1646,14 @@
=cut
sub GetRoadTypeDetails {
- my ($roadtypeid)=@_;
+ my ($roadtypeid) = @_;
my $dbh = C4::Context->dbh;
- my $query=qq|SELECT road_type
+ my $query = qq|SELECT road_type
FROM roadtype
WHERE roadtypeid=?|;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute($roadtypeid);
- my $roadtype=$sth->fetchrow;
+ my $roadtype = $sth->fetchrow;
return ($roadtype);
}
@@ -1679,8 +1679,9 @@
my $sth = $dbh->prepare($query);
$sth->execute;
my @results;
- while(my $data = $sth->fetchrow_hashref){
- push @results,$data;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @results, $data;
}
return \@results;
}
@@ -1706,8 +1707,8 @@
my $sth = $dbh->prepare($query);
$sth->execute;
my @results;
- while(my $data = $sth->fetchrow_hashref){
- push @results,$data;
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @results, $data;
}
return \@results;
}
@@ -1736,8 +1737,9 @@
my $sth = $dbh->prepare($query);
$sth->execute($date);
my @results;
- while(my $data = $sth->fetchrow_hashref){
- push @results,$data;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push @results, $data;
}
return \@results;
}
Index: Output.pm
===================================================================
RCS file: /sources/koha/koha/C4/Output.pm,v
retrieving revision 1.56.2.2
retrieving revision 1.56.2.3
diff -u -b -r1.56.2.2 -r1.56.2.3
--- Output.pm 20 Sep 2006 13:33:08 -0000 1.56.2.2
+++ Output.pm 20 Nov 2006 10:26:10 -0000 1.56.2.3
@@ -1,12 +1,11 @@
package C4::Output;
-# $Id: Output.pm,v 1.56.2.2 2006/09/20 13:33:08 toins Exp $
+# $Id: Output.pm,v 1.56.2.3 2006/11/20 10:26:10 toins Exp $
#package to deal with marking up output
#You will need to edit parts of this pm
#set the value of path to be where your html lives
-
# Copyright 2000-2002 Katipo Communications
#
# This file is part of Koha.
@@ -52,43 +51,49 @@
@ISA = qw(Exporter);
@EXPORT = qw(
&themelanguage &gettemplate setlanguagecookie pagination_bar
- );
+);
#FIXME: this is a quick fix to stop rc1 installing broken
#Still trying to figure out the correct fix.
-my $path = C4::Context->config('intrahtdocs')."/default/en/includes/";
+my $path = C4::Context->config('intrahtdocs') . "/default/en/includes/";
#---------------------------------------------------------------------------------------------------------
# FIXME - POD
sub gettemplate {
- my ($tmplbase, $opac, $query) = @_;
-if (!$query){
+ my ( $tmplbase, $opac, $query ) = @_;
+ if ( !$query ) {
warn "no query in gettemplate";
}
my $htdocs;
- if ($opac ne "intranet") {
+ if ( $opac ne "intranet" ) {
$htdocs = C4::Context->config('opachtdocs');
- } else {
+ }
+ else {
$htdocs = C4::Context->config('intrahtdocs');
}
my $path = C4::Context->preference('intranet_includes') || 'includes';
-# warn "PATH : $path";
- my ($theme, $lang) = themelanguage($htdocs, $tmplbase, $opac, $query);
+
+ # warn "PATH : $path";
+ my ( $theme, $lang ) = themelanguage( $htdocs, $tmplbase, $opac, $query );
my $opacstylesheet = C4::Context->preference('opacstylesheet');
- my $template = HTML::Template::Pro->new(filename => "$htdocs/$theme/$lang/$tmplbase",
+ my $template = HTML::Template::Pro->new(
+ filename => "$htdocs/$theme/$lang/$tmplbase",
die_on_bad_params => 0,
global_vars => 1,
case_sensitive => 1,
- path => ["$htdocs/$theme/$lang/$path"]);
+ path => ["$htdocs/$theme/$lang/$path"]
+ );
- $template->param(themelang => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl') . "/$theme/$lang",
- interface => ($opac ne 'intranet'? '/opac-tmpl': '/intranet-tmpl'),
+ $template->param(
+ themelang => ( $opac ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' )
+ . "/$theme/$lang",
+ interface => ( $opac ne 'intranet' ? '/opac-tmpl' : '/intranet-tmpl' ),
theme => $theme,
opacstylesheet => $opacstylesheet,
opaccolorstylesheet => C4::Context->preference('opaccolorstylesheet'),
opacsmallimage => C4::Context->preference('opacsmallimage'),
- lang => $lang);
-
+ lang => $lang
+ );
return $template;
}
@@ -96,27 +101,27 @@
#---------------------------------------------------------------------------------------------------------
# FIXME - POD
sub themelanguage {
- my ($htdocs, $tmpl, $section, $query) = @_;
-# if (!$query) {
-# warn "no query";
-# }
+ my ( $htdocs, $tmpl, $section, $query ) = @_;
+
+ # if (!$query) {
+ # warn "no query";
+ # }
my $dbh = C4::Context->dbh;
my @languages;
my @themes;
- if ( $section eq "intranet")
- {
+ if ( $section eq "intranet" ) {
@languages = split " ", C4::Context->preference("opaclanguages");
@themes = split " ", C4::Context->preference("template");
}
- else
- {
+ else {
+
# we are in the opac here, what im trying to do is let the individual user
# set the theme they want to use.
# and perhaps the them as well.
- my $lang=$query->cookie('KohaOpacLanguage');
- if ($lang){
+ my $lang = $query->cookie('KohaOpacLanguage');
+ if ($lang) {
- push @languages,$lang;
+ push @languages, $lang;
@themes = split " ", C4::Context->preference("opacthemes");
}
else {
@@ -125,15 +130,16 @@
}
}
- my ($theme, $lang);
-# searches through the themes and languages. First template it find it returns.
-# Priority is for getting the theme right.
+ my ( $theme, $lang );
+
+ # searches through the themes and languages. First template it find it returns.
+ # Priority is for getting the theme right.
THEME:
foreach my $th (@themes) {
foreach my $la (@languages) {
- for (my $pass = 1; $pass <= 2; $pass += 1) {
+ for ( my $pass = 1 ; $pass <= 2 ; $pass += 1 ) {
$la =~ s/([-_])/ $1 eq '-'? '_': '-' /eg if $pass == 2;
- if (-e "$htdocs/$th/$la/$tmpl") {
+ if ( -e "$htdocs/$th/$la/$tmpl" ) {
$theme = $th;
$lang = $la;
last THEME;
@@ -142,21 +148,25 @@
}
}
}
- if ($theme and $lang) {
- return ($theme, $lang);
- } else {
- return ('prog', 'en');
+ if ( $theme and $lang ) {
+ return ( $theme, $lang );
+ }
+ else {
+ return ( 'prog', 'en' );
}
}
-
sub setlanguagecookie {
- my ($query,$language,$uri)=@_;
- my $cookie=$query->cookie(-name => 'KohaOpacLanguage',
+ my ( $query, $language, $uri ) = @_;
+ my $cookie = $query->cookie(
+ -name => 'KohaOpacLanguage',
-value => $language,
- -expires => '');
- print $query->redirect(-uri=>$uri,
- -cookie=>$cookie);
+ -expires => ''
+ );
+ print $query->redirect(
+ -uri => $uri,
+ -cookie => $cookie
+ );
}
=item pagination_bar
@@ -179,125 +189,125 @@
=cut
sub pagination_bar {
- my ($base_url, $nb_pages, $current_page, $startfrom_name) = @_;
+ my ( $base_url, $nb_pages, $current_page, $startfrom_name ) = @_;
# how many pages to show before and after the current page?
my $pages_around = 2;
my $url =
- $base_url
- .($base_url =~ m/&/ ? '&' : '?')
- .$startfrom_name.'='
- ;
+ $base_url . ( $base_url =~ m/&/ ? '&' : '?' ) . $startfrom_name . '=';
my $pagination_bar = '';
# current page detection
- if (not defined $current_page) {
+ if ( not defined $current_page ) {
$current_page = 1;
}
# navigation bar useful only if more than one page to display !
- if ($nb_pages > 1) {
+ if ( $nb_pages > 1 ) {
+
# link to first page?
- if ($current_page > 1) {
- $pagination_bar.=
- "\n".' '
- .'<a href="'.$url.'1" rel="start">'
- .'<<'
- .'</a>'
- ;
+ if ( $current_page > 1 ) {
+ $pagination_bar .=
+ "\n" . ' '
+ . '<a href="'
+ . $url
+ . '1" rel="start">'
+ . '<<' . '</a>';
}
else {
- $pagination_bar.=
- "\n".' <span class="inactive"><<</span>';
+ $pagination_bar .=
+ "\n" . ' <span class="inactive"><<</span>';
}
# link on previous page ?
- if ($current_page > 1) {
+ if ( $current_page > 1 ) {
my $previous = $current_page - 1;
- $pagination_bar.=
- "\n".' '
- .'<a href="'
- .$url.$previous
- .'" rel="prev">'
- .'<'
- .'</a>'
- ;
+ $pagination_bar .=
+ "\n" . ' '
+ . '<a href="'
+ . $url
+ . $previous
+ . '" rel="prev">' . '<' . '</a>';
}
else {
- $pagination_bar.=
- "\n".' <span class="inactive"><</span>';
+ $pagination_bar .=
+ "\n" . ' <span class="inactive"><</span>';
}
my $min_to_display = $current_page - $pages_around;
my $max_to_display = $current_page + $pages_around;
my $last_displayed_page = undef;
- for my $page_number (1..$nb_pages) {
- if ($page_number == 1
+ for my $page_number ( 1 .. $nb_pages ) {
+ if (
+ $page_number == 1
or $page_number == $nb_pages
- or ($page_number >= $min_to_display and $page_number <= $max_to_display)
- ) {
- if (defined $last_displayed_page
- and $last_displayed_page != $page_number - 1
- ) {
- $pagination_bar.=
- "\n".' <span class="inactive">...</span>'
- ;
+ or ( $page_number >= $min_to_display
+ and $page_number <= $max_to_display )
+ )
+ {
+ if ( defined $last_displayed_page
+ and $last_displayed_page != $page_number - 1 )
+ {
+ $pagination_bar .=
+ "\n" . ' <span class="inactive">...</span>';
}
- if ($page_number == $current_page) {
- $pagination_bar.=
- "\n".' '
- .'<span class="currentPage">'.$page_number.'</span>'
- ;
+ if ( $page_number == $current_page ) {
+ $pagination_bar .=
+ "\n" . ' '
+ . '<span class="currentPage">'
+ . $page_number
+ . '</span>';
}
else {
- $pagination_bar.=
- "\n".' '
- .'<a href="'.$url.$page_number.'">'.$page_number.'</a>'
- ;
+ $pagination_bar .=
+ "\n" . ' '
+ . '<a href="'
+ . $url
+ . $page_number . '">'
+ . $page_number . '</a>';
}
$last_displayed_page = $page_number;
}
}
# link on next page?
- if ($current_page < $nb_pages) {
+ if ( $current_page < $nb_pages ) {
my $next = $current_page + 1;
- $pagination_bar.=
- "\n".' <a href="'.$url.$next.'" rel="next">'
- .'>'
- .'</a>'
- ;
+ $pagination_bar .= "\n"
+ . ' <a href="'
+ . $url
+ . $next
+ . '" rel="next">' . '>' . '</a>';
}
else {
- $pagination_bar.=
- "\n".' <span class="inactive">></span>'
- ;
+ $pagination_bar .=
+ "\n" . ' <span class="inactive">></span>';
}
# link to last page?
- if ($current_page != $nb_pages) {
- $pagination_bar.=
- "\n".' <a href="'.$url.$nb_pages.'" rel="last">'
- .'>>'
- .'</a>'
- ;
+ if ( $current_page != $nb_pages ) {
+ $pagination_bar .= "\n"
+ . ' <a href="'
+ . $url
+ . $nb_pages
+ . '" rel="last">'
+ . '>>' . '</a>';
}
else {
- $pagination_bar.=
- "\n".' <span class="inactive">>></span>';
+ $pagination_bar .=
+ "\n" . ' <span class="inactive">>></span>';
}
}
return $pagination_bar;
}
-
END { } # module clean-up code here (global destructor)
1;
Index: Print.pm
===================================================================
RCS file: /sources/koha/koha/C4/Print.pm,v
retrieving revision 1.17
retrieving revision 1.17.8.1
diff -u -b -r1.17 -r1.17.8.1
--- Print.pm 28 Nov 2004 08:32:36 -0000 1.17
+++ Print.pm 20 Nov 2006 10:26:10 -0000 1.17.8.1
@@ -1,5 +1,4 @@
-package C4::Print; #assumes C4/Print.pm
-
+package C4::Print;
# Copyright 2000-2002 Katipo Communications
#
@@ -18,9 +17,10 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
+# $Id: Print.pm,v 1.17.8.1 2006/11/20 10:26:10 toins Exp $
+
use strict;
require Exporter;
-#use C4::InterfaceCDK;
use C4::Context;
use C4::Circulation::Circ2;
@@ -28,7 +28,10 @@
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
-$VERSION = 0.01;
+# set the version for version checking
+$VERSION = do { my @v = '$Revision: 1.17.8.1 $' =~ /\d+/g;
+ shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
+};
=head1 NAME
@@ -70,13 +73,16 @@
from C<¤tissues>.
=cut
+
#'
# FIXME - It'd be nifty if this could generate pretty PostScript.
sub remoteprint {
- my ($env,$items,$borrower)=@_;
+ my ( $env, $items, $borrower ) = @_;
- (return) unless (C4::Context->boolean_preference('printcirculationslips'));
+ (return)
+ unless ( C4::Context->boolean_preference('printcirculationslips') );
my $queue = $env->{'queue'};
+
# FIXME - If 'queue' is undefined or empty, then presumably it should
# mean "use the default queue", whatever the default is. Presumably
# the default depends on the physical location of the machine.
@@ -84,59 +90,72 @@
# set the queue to "file" (or " file", if real queues aren't allowed
# to have spaces in them). Or perhaps if $queue eq "" and
# $env->{file} ne "", then that should mean "print to $env->{file}".
- if ($queue eq "" || $queue eq 'nulllp') {
- open (PRINTER,">/tmp/kohaiss");
- } else {
+ if ( $queue eq "" || $queue eq 'nulllp' ) {
+ open( PRINTER, ">/tmp/kohaiss" );
+ }
+ else {
+
# FIXME - This assumes that 'lpr' exists, and works as expected.
# This is a reasonable assumption, but only because every other
# printing package has a wrapper script called 'lpr'. It'd still
# be better to be able to customize this.
- open(PRINTER, "| lpr -P $queue > /dev/null") or die "Couldn't write to queue:$queue!\n";
+ open( PRINTER, "| lpr -P $queue > /dev/null" )
+ or die "Couldn't write to queue:$queue!\n";
}
-# print $queue;
+
+ # print $queue;
#open (FILE,">/tmp/$file");
- my $i=0;
+ my $i = 0;
my $brdata = $env->{'brdata'}; # FIXME - Not used
# FIXME - This is HLT-specific. Put this stuff in a customizable
# site-specific file somewhere.
print PRINTER "Horowhenua Library Trust\r\n";
-# print PRINTER "$brdata->{'branchname'}\r\n";
+
+ # print PRINTER "$brdata->{'branchname'}\r\n";
print PRINTER "Phone: 368-1953\r\n";
print PRINTER "Fax: 367-9218\r\n";
print PRINTER "Email: renewals\@library.org.nz\r\n\r\n\r\n";
print PRINTER "$borrower->{'cardnumber'}\r\n";
- print PRINTER "$borrower->{'title'} $borrower->{'initials'} $borrower->{'surname'}\r\n";
+ print PRINTER
+ "$borrower->{'title'} $borrower->{'initials'} $borrower->{'surname'}\r\n";
+
# FIXME - Use for ($i = 0; $items->[$i]; $i++)
# Or better yet, foreach $item (@{$items})
- while ($items->[$i]){
-# print $i;
+ while ( $items->[$i] ) {
+
+ # print $i;
my $itemdata = $items->[$i];
+
# FIXME - This is just begging for a Perl format.
print PRINTER "$i $itemdata->{'title'}\r\n";
print PRINTER "$itemdata->{'barcode'}";
- print PRINTER " "x15;
+ print PRINTER " " x 15;
print PRINTER "$itemdata->{'date_due'}\r\n";
$i++;
}
print PRINTER "\r\n\r\n\r\n\r\n\r\n\r\n\r\n";
- if ($env->{'printtype'} eq "docket"){
+ if ( $env->{'printtype'} eq "docket" ) {
+
#print chr(27).chr(105);
}
close PRINTER;
+
#system("lpr /tmp/$file");
}
sub printreserve {
- my($env, $branchname, $bordata, $itemdata)=@_;
- my $file=time;
+ my ( $env, $branchname, $bordata, $itemdata ) = @_;
+ my $file = time;
my $printer = $env->{'printer'};
- (return) unless (C4::Context->boolean_preference('printreserveslips'));
- if ($printer eq "" || $printer eq 'nulllp') {
- open (PRINTER,">>/tmp/kohares");
- } else {
- open (PRINTER, "| lpr -P $printer >/dev/null") or die "Couldn't write to queue:$!\n";
+ (return) unless ( C4::Context->boolean_preference('printreserveslips') );
+ if ( $printer eq "" || $printer eq 'nulllp' ) {
+ open( PRINTER, ">>/tmp/kohares" );
+ }
+ else {
+ open( PRINTER, "| lpr -P $printer >/dev/null" )
+ or die "Couldn't write to queue:$!\n";
}
- my @da = localtime(time());
+ my @da = localtime( time() );
my $todaysdate = "$da[2]:$da[1] $da[3]/$da[4]/$da[5]";
#(1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
@@ -174,37 +193,41 @@
print a slip for the given $borrowernumber
=cut
+
#'
sub printslip {
- my ($env,$borrowernumber)=@_;
- my ($borrower, $flags) = getpatroninformation($env,$borrowernumber,0);
- $env->{'todaysissues'}=1;
- my ($borrowerissues) = currentissues($env, $borrower);
- $env->{'nottodaysissues'}=1;
- $env->{'todaysissues'}=0;
- my ($borroweriss2)=currentissues($env, $borrower);
- $env->{'nottodaysissues'}=0;
- my $i=0;
+ my ( $env, $borrowernumber ) = @_;
+ my ( $borrower, $flags ) = getpatroninformation( $env, $borrowernumber, 0 );
+ $env->{'todaysissues'} = 1;
+ my ($borrowerissues) = currentissues( $env, $borrower );
+ $env->{'nottodaysissues'} = 1;
+ $env->{'todaysissues'} = 0;
+ my ($borroweriss2) = currentissues( $env, $borrower );
+ $env->{'nottodaysissues'} = 0;
+ my $i = 0;
my @issues;
- foreach (sort {$a <=> $b} keys %$borrowerissues) {
- $issues[$i]=$borrowerissues->{$_};
- my $dd=$issues[$i]->{'date_due'};
+
+ foreach ( sort { $a <=> $b } keys %$borrowerissues ) {
+ $issues[$i] = $borrowerissues->{$_};
+ my $dd = $issues[$i]->{'date_due'};
+
#convert to nz style dates
#this should be set with some kinda config variable
- my @tempdate=split(/-/,$dd);
- $issues[$i]->{'date_due'}="$tempdate[2]/$tempdate[1]/$tempdate[0]";
+ my @tempdate = split( /-/, $dd );
+ $issues[$i]->{'date_due'} = "$tempdate[2]/$tempdate[1]/$tempdate[0]";
$i++;
}
- foreach (sort {$a <=> $b} keys %$borroweriss2) {
- $issues[$i]=$borroweriss2->{$_};
- my $dd=$issues[$i]->{'date_due'};
+ foreach ( sort { $a <=> $b } keys %$borroweriss2 ) {
+ $issues[$i] = $borroweriss2->{$_};
+ my $dd = $issues[$i]->{'date_due'};
+
#convert to nz style dates
#this should be set with some kinda config variable
- my @tempdate=split(/-/,$dd);
- $issues[$i]->{'date_due'}="$tempdate[2]/$tempdate[1]/$tempdate[0]";
+ my @tempdate = split( /-/, $dd );
+ $issues[$i]->{'date_due'} = "$tempdate[2]/$tempdate[1]/$tempdate[0]";
$i++;
}
- remoteprint($env,\@issues,$borrower);
+ remoteprint( $env, \@issues, $borrower );
}
END { } # module clean-up code here (global destructor)
Index: Reserves2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Reserves2.pm,v
retrieving revision 1.46.2.6
retrieving revision 1.46.2.7
diff -u -b -r1.46.2.6 -r1.46.2.7
--- Reserves2.pm 17 Nov 2006 14:57:21 -0000 1.46.2.6
+++ Reserves2.pm 20 Nov 2006 10:26:10 -0000 1.46.2.7
@@ -20,7 +20,7 @@
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-# $Id: Reserves2.pm,v 1.46.2.6 2006/11/17 14:57:21 tipaul Exp $
+# $Id: Reserves2.pm,v 1.46.2.7 2006/11/20 10:26:10 toins Exp $
use strict;
require Exporter;
@@ -31,7 +31,7 @@
my $library_name = C4::Context->preference("LibraryName");
# set the version for version checking
-$VERSION = do { my @v = '$Revision: 1.46.2.6 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
+$VERSION = do { my @v = '$Revision: 1.46.2.7 $' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
@@ -52,6 +52,7 @@
=cut
@ISA = qw(Exporter);
+
# FIXME Take out CalcReserveFee after it can be removed from opac-reserves.pl
@EXPORT = qw(
&FindReserves
@@ -87,15 +88,15 @@
sub GlobalCancel {
my $messages;
my $nextreservinfo;
- my ($itemnumber,$borrowernumber)=@_;
+ my ( $itemnumber, $borrowernumber ) = @_;
#step 1 : cancel the reservation
- my $CancelReserve = CancelReserve(0,$itemnumber,$borrowernumber);
+ my $CancelReserve = CancelReserve( 0, $itemnumber, $borrowernumber );
#step 2 launch the subroutine of the others reserves
- my ($messages,$nextreservinfo) = OtherReserves($itemnumber);
+ ( $messages, $nextreservinfo ) = OtherReserves($itemnumber);
- return ($messages,$nextreservinfo);
+ return ( $messages, $nextreservinfo );
}
=item OtherReserves
@@ -108,31 +109,46 @@
#'
sub OtherReserves {
- my ($itemnumber)=@_;
+ my ($itemnumber) = @_;
my $messages;
my $nextreservinfo;
- my ($restype,$checkreserves) = CheckReserves($itemnumber);
- if ($checkreserves){
+ my ( $restype, $checkreserves ) = CheckReserves($itemnumber);
+ if ($checkreserves) {
my $iteminfo = C4::Circulation::Circ2::getiteminformation($itemnumber);
- if ($iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'}){
+ if ( $iteminfo->{'holdingbranch'} ne $checkreserves->{'branchcode'} ) {
$messages->{'transfert'} = $checkreserves->{'branchcode'};
+
#minus priorities of others reservs
- MinusPriority($itemnumber,$checkreserves->{'borrowernumber'},$iteminfo->{'biblionumber'});
+ MinusPriority(
+ $itemnumber,
+ $checkreserves->{'borrowernumber'},
+ $iteminfo->{'biblionumber'}
+ );
+
#launch the subroutine dotransfer
- C4::Circulation::Circ2::dotransfer($itemnumber,$iteminfo->{'holdingbranch'},$checkreserves->{'branchcode'}),
+ C4::Circulation::Circ2::dotransfer(
+ $itemnumber,
+ $iteminfo->{'holdingbranch'},
+ $checkreserves->{'branchcode'}
+ ),
+ ;
}
#step 2b : case of a reservation on the same branch, set the waiting status
- else{
+ else {
$messages->{'waiting'} = 1;
- MinusPriority($itemnumber,$checkreserves->{'borrowernumber'},$iteminfo->{'biblionumber'});
+ MinusPriority(
+ $itemnumber,
+ $checkreserves->{'borrowernumber'},
+ $iteminfo->{'biblionumber'}
+ );
SetWaitingStatus($itemnumber);
}
$nextreservinfo = $checkreserves->{'borrowernumber'};
}
- return ($messages,$nextreservinfo);
+ return ( $messages, $nextreservinfo );
}
=item MinusPriority
@@ -144,8 +160,9 @@
=cut
#'
-sub MinusPriority{
- my ($itemnumber,$borrowernumber,$biblionumber)=@_;
+sub MinusPriority {
+ my ( $itemnumber, $borrowernumber, $biblionumber ) = @_;
+
#first step update the value of the first person on reserv
my $dbh = C4::Context->dbh;
my $query = qq/
@@ -155,8 +172,8 @@
AND borrowernumber=?
AND biblionumber=?
/;
- my $sth_upd=$dbh->prepare($query);
- $sth_upd->execute($itemnumber,$borrowernumber,$biblionumber);
+ my $sth_upd = $dbh->prepare($query);
+ $sth_upd->execute( $itemnumber, $borrowernumber, $biblionumber );
$sth_upd->finish;
# second step update all others reservs
@@ -166,9 +183,11 @@
WHERE priority !='0'
AND cancellationdate IS NULL
/;
- my $sth_oth=$dbh->prepare($query);
+ my $sth_oth = $dbh->prepare($query);
$sth_oth->execute;
- while (my ($priority,$borrowernumber,$biblionumber,$reservedate)=$sth_oth->fetchrow_array){
+ while ( my ( $priority, $borrowernumber, $biblionumber, $reservedate ) =
+ $sth_oth->fetchrow_array )
+ {
$priority--;
$query = qq/
UPDATE reserves
@@ -178,7 +197,8 @@
AND reservedate = ?
/;
my $sth_upd_oth = $dbh->prepare($query);
- $sth_upd_oth->execute($priority,$biblionumber,$borrowernumber,$reservedate);
+ $sth_upd_oth->execute( $priority, $biblionumber, $borrowernumber,
+ $reservedate );
$sth_upd_oth->finish;
}
$sth_oth->finish;
@@ -193,8 +213,9 @@
=cut
sub SetWaitingStatus {
+
#first : check if we have a reservation for this item .
- my ($itemnumber)=@_;
+ my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
my $query = qq/
SELECT priority,borrowernumber
@@ -203,13 +224,13 @@
AND cancellationdate IS NULL
AND found IS NULL AND priority='0'
/;
- my $sth_find=$dbh->prepare($query);
+ my $sth_find = $dbh->prepare($query);
$sth_find->execute($itemnumber);
- my ($priority,$borrowernumber) = $sth_find->fetchrow_array;
+ my ( $priority, $borrowernumber ) = $sth_find->fetchrow_array;
$sth_find->finish;
return unless $borrowernumber;
- # step 2 : if we have a borrowernumber, we update the value found to 'W' to notify the borrower
+# step 2 : if we have a borrowernumber, we update the value found to 'W' to notify the borrower
$query = qq/
UPDATE reserves
SET found='W',waitingdate = now()
@@ -217,8 +238,8 @@
AND itemnumber=?
AND found IS NULL
/;
- my $sth_set=$dbh->prepare($query);
- $sth_set->execute($borrowernumber,$itemnumber);
+ my $sth_set = $dbh->prepare($query);
+ $sth_set->execute( $borrowernumber, $itemnumber );
$sth_set->finish;
}
@@ -232,8 +253,8 @@
=cut
sub GetReservations {
- my ($itemnumber,$borrowernumber)=@_;
- if ($itemnumber){
+ my ( $itemnumber, $borrowernumber ) = @_;
+ if ($itemnumber) {
my $dbh = C4::Context->dbh;
my $query = qq/
SELECT reservedate,borrowernumber
@@ -242,12 +263,12 @@
AND cancellationdate IS NULL
AND (found <> 'F' OR found IS NULL)
/;
- my $sth_res=$dbh->prepare($query);
+ my $sth_res = $dbh->prepare($query);
$sth_res->execute($itemnumber);
- my ($reservedate,$borrowernumber)=$sth_res->fetchrow_array;
- return($reservedate,$borrowernumber);
+ my ( $reservedate, $borrowernumber ) = $sth_res->fetchrow_array;
+ return ( $reservedate, $borrowernumber );
}
- if ($borrowernumber){
+ if ($borrowernumber) {
my $dbh = C4::Context->dbh;
my $query = qq/
SELECT *
@@ -258,11 +279,11 @@
ORDER BY reservedate
/;
- my $sth_find=$dbh->prepare($query);
+ my $sth_find = $dbh->prepare($query);
$sth_find->execute($borrowernumber);
my @borrowerreserv;
- while (my $data=$sth_find->fetchrow_hashref){
- push @borrowerreserv,$data;
+ while ( my $data = $sth_find->fetchrow_hashref ) {
+ push @borrowerreserv, $data;
}
return @borrowerreserv;
}
@@ -296,7 +317,7 @@
#'
sub FindReserves {
- my ($biblionumber, $bor) = @_;
+ my ( $biblionumber, $bor ) = @_;
my $dbh = C4::Context->dbh;
my @bind;
@@ -315,30 +336,31 @@
AND (found <> \'F\' OR found IS NULL)
/;
- if ($biblionumber ne '') {
- $query.= '
+ if ( $biblionumber ne '' ) {
+ $query .= '
AND biblionumber = ?
';
push @bind, $biblionumber;
}
- if ($bor ne '') {
- $query.= '
+ if ( $bor ne '' ) {
+ $query .= '
AND borrowernumber = ?
';
push @bind, $bor;
}
- $query.= '
+ $query .= '
ORDER BY priority
';
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute(@bind);
my @results;
my $i = 0;
- while (my $data = $sth->fetchrow_hashref){
+ while ( my $data = $sth->fetchrow_hashref ) {
+
# FIXME - What is this if-statement doing? How do constraints work?
- if ($data->{constrainttype} eq 'o') {
+ if ( $data->{constrainttype} eq 'o' ) {
$query = '
SELECT biblioitemnumber
FROM reserveconstraints
@@ -346,35 +368,35 @@
AND borrowernumber = ?
AND reservedate = ?
';
- my $csth=$dbh->prepare($query);
- $csth->execute(
- $data->{biblionumber},
- $data->{borrowernumber},
- $data->{reservedate},
- );
+ my $csth = $dbh->prepare($query);
+ $csth->execute( $data->{biblionumber}, $data->{borrowernumber},
+ $data->{reservedate}, );
my @bibitemno;
- while (my $bibitemnos = $csth->fetchrow_array){
- push (@bibitemno,$bibitemnos);
+ while ( my $bibitemnos = $csth->fetchrow_array ) {
+ push( @bibitemno, $bibitemnos );
}
my $count = @bibitemno;
# if we have two or more different specific itemtypes
# reserved by same person on same day
my $bdata;
- if($count > 1){
+ if ( $count > 1 ) {
warn "bibitemno $bibitemno[$i]";
- $bdata = bibitemdata($bibitemno[$i]);
+ $bdata = bibitemdata( $bibitemno[$i] );
$i++;
- } else {
+ }
+ else {
+
# Look up the book we just found.
- $bdata = bibitemdata($bibitemno[0]);
+ $bdata = bibitemdata( $bibitemno[0] );
}
$csth->finish;
+
# Add the results of this latest search to the current
# results.
# FIXME - An 'each' would probably be more efficient.
- foreach my $key (keys %$bdata) {
+ foreach my $key ( keys %$bdata ) {
$data->{$key} = $bdata->{$key};
}
}
@@ -382,7 +404,7 @@
}
$sth->finish;
- return($#results+1,\@results);
+ return ( $#results + 1, \@results );
}
#-------------------------------------------------------------------------------------
@@ -479,23 +501,27 @@
#'
sub CheckReserves {
- my ($item, $barcode) = @_;
+ my ( $item, $barcode ) = @_;
+
# warn "In CheckReserves: itemnumber = $item";
my $dbh = C4::Context->dbh;
my $sth;
if ($item) {
- my $qitem=$dbh->quote($item);
+ my $qitem = $dbh->quote($item);
+
# Look up the item by itemnumber
- my $query =qq/
+ my $query = qq/
SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan
FROM items, biblioitems, itemtypes
WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
AND biblioitems.itemtype = itemtypes.itemtype
AND itemnumber=$qitem
/;
- $sth=$dbh->prepare($query);
- } else {
- my $qbc=$dbh->quote($barcode);
+ $sth = $dbh->prepare($query);
+ }
+ else {
+ my $qbc = $dbh->quote($barcode);
+
# Look up the item by barcode
my $query = qq(
SELECT items.biblionumber, items.biblioitemnumber, itemtypes.notforloan
@@ -504,18 +530,22 @@
AND biblioitems.itemtype = itemtypes.itemtype
AND barcode=$qbc
);
- $sth=$dbh->prepare($query);
+ $sth = $dbh->prepare($query);
+
# FIXME - This function uses $item later on. Ought to set it here.
}
$sth->execute;
- my ($biblio, $bibitem, $notforloan) = $sth->fetchrow_array;
+ my ( $biblio, $bibitem, $notforloan ) = $sth->fetchrow_array;
$sth->finish;
+
# if item is not for loan it cannot be reserved either.....
- return (0,0) if $notforloan;
+ return ( 0, 0 ) if $notforloan;
+
# get the reserves...
# Find this item in the reserves
- my @reserves = Findgroupreserve($bibitem, $biblio);
+ my @reserves = Findgroupreserve( $bibitem, $biblio );
my $count = scalar @reserves;
+
# $priority and $highest are used to find the most important item
# in the list returned by &Findgroupreserve. (The lower $priority,
# the more important the item.)
@@ -524,15 +554,20 @@
my $highest;
if ($count) {
foreach my $res (@reserves) {
+
# FIXME - $item might be undefined or empty: the caller
# might be searching by barcode.
- if ($res->{'itemnumber'} == $item) {
+ if ( $res->{'itemnumber'} == $item ) {
+
# Found it
- return ("Waiting", $res);
- } else {
+ return ( "Waiting", $res );
+ }
+ else {
+
# See if this item is more important than what we've got
# so far.
- if ($res->{'priority'} != 0 && $res->{'priority'} < $priority) {
+ if ( $res->{'priority'} != 0 && $res->{'priority'} < $priority )
+ {
$priority = $res->{'priority'};
$highest = $res;
}
@@ -545,9 +580,10 @@
# next in line to get this book.
if ($highest) { # FIXME - $highest might be undefined
$highest->{'itemnumber'} = $item;
- return ("Reserved", $highest);
- } else {
- return (0, 0);
+ return ( "Reserved", $highest );
+ }
+ else {
+ return ( 0, 0 );
}
}
@@ -573,10 +609,11 @@
#'
sub CancelReserve {
- my ($biblio, $item, $borr) = @_;
+ my ( $biblio, $item, $borr ) = @_;
my $dbh = C4::Context->dbh;
- if (($item and $borr) and (not $biblio)) {
+ if ( ( $item and $borr ) and ( not $biblio ) ) {
+
# removing a waiting reserve record....
# update the database...
my $query = qq/
@@ -588,10 +625,11 @@
AND borrowernumber = ?
/;
my $sth = $dbh->prepare($query);
- $sth->execute($item,$borr);
+ $sth->execute( $item, $borr );
$sth->finish;
}
- if (($biblio and $borr) and (not $item)) {
+ if ( ( $biblio and $borr ) and ( not $item ) ) {
+
# removing a reserve record....
# get the prioritiy on this record....
my $priority;
@@ -602,8 +640,8 @@
AND cancellationdate IS NULL
AND (found <> 'F' OR found IS NULL)
/;
- my $sth=$dbh->prepare($query);
- $sth->execute($biblio,$borr);
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $borr );
($priority) = $sth->fetchrow_array;
$sth->finish;
$query = qq/
@@ -616,12 +654,14 @@
AND cancellationdate IS NULL
AND (found <> 'F' or found IS NULL)
/;
+
# update the database, removing the record...
$sth = $dbh->prepare($query);
- $sth->execute($biblio,$borr);
+ $sth->execute( $biblio, $borr );
$sth->finish;
+
# now fix the priority on the others....
- fixpriority($priority, $biblio);
+ fixpriority( $priority, $biblio );
}
}
@@ -656,27 +696,27 @@
WHERE biblionumber = ?
AND borrowernumber = ?
AND reservedate = ?";
- my $sth=$dbh->prepare($query);
- $sth->execute($qbiblio,$borr,$resdate);
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $qbiblio, $borr, $resdate );
($priority) = $sth->fetchrow_array;
$sth->finish;
# update the database...
- my $query = "UPDATE reserves
+ $query = "UPDATE reserves
SET found = 'F',
priority = 0
WHERE biblionumber = ?
AND reservedate = ?
AND borrowernumber = ?
";
- my $sth = $dbh->prepare($query);
- $sth->execute($qbiblio,$resdate,$borr);
+ $sth = $dbh->prepare($query);
+ $sth->execute( $qbiblio, $resdate, $borr );
$sth->finish;
# now fix the priority on the others (if the priority wasn't
# already sorted!)....
- unless ($priority == 0) {
- FixPriority($priority, $qbiblio);
+ unless ( $priority == 0 ) {
+ FixPriority( $priority, $qbiblio );
}
}
@@ -696,13 +736,14 @@
=cut
sub FixPriority {
- my ($biblio,$borrowernumber,$rank) = @_;
+ my ( $biblio, $borrowernumber, $rank ) = @_;
my $dbh = C4::Context->dbh;
- if($rank eq "del"){
- CancelReserve($biblio,undef,$borrowernumber);
+ if ( $rank eq "del" ) {
+ CancelReserve( $biblio, undef, $borrowernumber );
}
- if($rank eq "W" || $rank eq "0"){
+ if ( $rank eq "W" || $rank eq "0" ) {
+
# make sure priority for waiting items is 0
my $query = qq/
UPDATE reserves
@@ -712,11 +753,12 @@
AND cancellationdate IS NULL
AND found ='W'
/;
- my $sth=$dbh->prepare($query);
- $sth->execute($biblio,$borrowernumber);
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $borrowernumber );
}
my @priority;
my @reservedates;
+
# get whats left
my $query = qq/
SELECT borrowernumber, reservedate, constrainttype
@@ -726,39 +768,47 @@
AND ((found <> 'F' and found <> 'W') or found is NULL)
ORDER BY priority ASC
/;
- my $sth=$dbh->prepare($query);
+ my $sth = $dbh->prepare($query);
$sth->execute($biblio);
- while(my $line = $sth->fetchrow_hashref){
- push(@reservedates,$line);
- push(@priority,$line);
+ while ( my $line = $sth->fetchrow_hashref ) {
+ push( @reservedates, $line );
+ push( @priority, $line );
}
+
# To find the matching index
my $i;
my $key = -1; # to allow for 0 to be a valid result
- for ($i = 0; $i < @priority; $i++) {
- if ($borrowernumber == $priority[$i]->{'borrowernumber'}) {
+ for ( $i = 0 ; $i < @priority ; $i++ ) {
+ if ( $borrowernumber == $priority[$i]->{'borrowernumber'} ) {
$key = $i; # save the index
last;
}
}
+
# if index exists in array then move it to new position
- if($key>-1 && $rank ne 'del' && $rank > 0){
- my $new_rank = $rank-1; # $new_rank is what you want the new index to be in the array
- my $moving_item = splice(@priority, $key, 1);
- splice(@priority, $new_rank, 0, $moving_item);
+ if ( $key > -1 && $rank ne 'del' && $rank > 0 ) {
+ my $new_rank = $rank -
+ 1; # $new_rank is what you want the new index to be in the array
+ my $moving_item = splice( @priority, $key, 1 );
+ splice( @priority, $new_rank, 0, $moving_item );
}
+
# now fix the priority on those that are left....
- my $query = qq/
+ $query = "
UPDATE reserves
SET priority = ?
WHERE biblionumber = ?
AND borrowernumber = ?
AND reservedate = ?
AND found IS NULL
- /;
- my $sth = $dbh->prepare($query);
- for(my $j=0;$j<@priority;$j++){
- $sth->execute($j+1,$biblio,$priority[$j]->{'borrowernumber'},$priority[$j]->{'reservedate'});
+ ";
+ $sth = $dbh->prepare($query);
+ for ( my $j = 0 ; $j < @priority ; $j++ ) {
+ $sth->execute(
+ $j + 1, $biblio,
+ $priority[$j]->{'borrowernumber'},
+ $priority[$j]->{'reservedate'}
+ );
$sth->finish;
}
}
@@ -773,8 +823,9 @@
=cut
sub ReserveWaiting {
- my ($item, $borr) = @_;
+ my ( $item, $borr ) = @_;
my $dbh = C4::Context->dbh;
+
# get priority and biblionumber....
my $query = qq/
SELECT reserves.priority as priority,
@@ -789,11 +840,12 @@
AND (reserves.found <> 'F' OR reserves.found IS NULL)
/;
my $sth = $dbh->prepare($query);
- $sth->execute($item,$borr);
+ $sth->execute( $item, $borr );
my $data = $sth->fetchrow_hashref;
$sth->finish;
my $biblio = $data->{'biblionumber'};
my $timestamp = $data->{'timestamp'};
+
# update reserves record....
$query = qq/
UPDATE reserves
@@ -806,10 +858,11 @@
AND timestamp = ?
/;
$sth = $dbh->prepare($query);
- $sth->execute($item,$borr,$biblio,$timestamp);
+ $sth->execute( $item, $borr, $biblio, $timestamp );
$sth->finish;
+
# now fix up the remaining priorities....
- FixPriority($data->{'priority'}, $biblio);
+ FixPriority( $data->{'priority'}, $biblio );
my $branchcode = $data->{'branchcode'};
return $branchcode;
}
@@ -825,7 +878,7 @@
=cut
sub GetWaitingReserves {
- my ($borr)=@_;
+ my ($borr) = @_;
my $dbh = C4::Context->dbh;
my @itemswaiting;
my $query = qq/
@@ -837,8 +890,8 @@
/;
my $sth = $dbh->prepare($query);
$sth->execute($borr);
- while (my $data=$sth->fetchrow_hashref) {
- push(@itemswaiting,$data);
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @itemswaiting, $data );
}
$sth->finish;
return \@itemswaiting;
@@ -866,7 +919,7 @@
#'
sub Findgroupreserve {
- my ($bibitem,$biblio)=@_;
+ my ( $bibitem, $biblio ) = @_;
my $dbh = C4::Context->dbh;
my $query = qq/
SELECT reserves.biblionumber AS biblionumber,
@@ -890,17 +943,16 @@
AND reserves.cancellationdate is NULL
AND (reserves.found <> 'F' or reserves.found is NULL)
/;
- my $sth=$dbh->prepare($query);
- $sth->execute($biblio, $bibitem);
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $bibitem );
my @results;
- while (my $data=$sth->fetchrow_hashref){
- push(@results,$data);
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @results, $data );
}
$sth->finish;
return @results;
}
-
=item CreateReserve
CreateReserve($env,$branch,$borrowernumber,$biblionumber,$constraint,$bibitems,$priority,$notes,$title,$checkitem,$found)
@@ -911,36 +963,50 @@
=cut
sub CreateReserve {
- my ($env,$branch,$borrowernumber,$biblionumber,$constraint,$bibitems,$priority,$notes,$title,$checkitem,$found)= @_;
+ my (
+ $env, $branch, $borrowernumber, $biblionumber,
+ $constraint, $bibitems, $priority, $notes,
+ $title, $checkitem, $found
+ ) = @_;
my $fee;
- if($library_name =~ /Horowhenua/){
- $fee = CalcHLTReserveFee($env,$borrowernumber,$biblionumber,$constraint,$bibitems);
- } else {
- $fee = CalcReserveFee($env,$borrowernumber,$biblionumber,$constraint,$bibitems);
+ if ( $library_name =~ /Horowhenua/ ) {
+ $fee =
+ CalcHLTReserveFee( $env, $borrowernumber, $biblionumber, $constraint,
+ $bibitems );
+ }
+ else {
+ $fee =
+ CalcReserveFee( $env, $borrowernumber, $biblionumber, $constraint,
+ $bibitems );
}
my $dbh = C4::Context->dbh;
- my $const = lc substr($constraint,0,1);
+ my $const = lc substr( $constraint, 0, 1 );
my @datearr = localtime(time);
- my $resdate =(1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ my $resdate =
+ ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
my $waitingdate;
-# If the reserv had the waiting status, we had the value of the resdate
- if ($found eq 'W'){
+
+ # If the reserv had the waiting status, we had the value of the resdate
+ if ( $found eq 'W' ) {
$waitingdate = $resdate;
}
+
#eval {
# updates take place here
- if ($fee > 0) {
- my $nextacctno = &getnextacctno($env,$borrowernumber,$dbh);
- my $query =qq/
+ if ( $fee > 0 ) {
+ my $nextacctno = &getnextacctno( $env, $borrowernumber, $dbh );
+ my $query = qq/
INSERT INTO accountlines
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
VALUES
(?,?,now(),?,?,'Res',?)
/;
my $usth = $dbh->prepare($query);
- $usth->execute($borrowernumber,$nextacctno,$fee,"Reserve Charge - $title",$fee);
+ $usth->execute( $borrowernumber, $nextacctno, $fee,
+ "Reserve Charge - $title", $fee );
$usth->finish;
}
+
#if ($const eq 'a'){
my $query = qq/
INSERT INTO reserves
@@ -951,13 +1017,18 @@
?,?,?,?,?)
/;
my $sth = $dbh->prepare($query);
- $sth->execute($borrowernumber,$biblionumber,$resdate,$branch,$const,$priority,$notes,$checkitem,$found,$waitingdate);
+ $sth->execute(
+ $borrowernumber, $biblionumber, $resdate, $branch,
+ $const, $priority, $notes, $checkitem,
+ $found, $waitingdate
+ );
$sth->finish;
+
#}
- if (($const eq "o") || ($const eq "e")) {
+ if ( ( $const eq "o" ) || ( $const eq "e" ) ) {
my $numitems = @$bibitems;
my $i = 0;
- while ($i < $numitems) {
+ while ( $i < $numitems ) {
my $biblioitem = @$bibitems[$i];
my $query = qq/
INSERT INTO reserveconstraints
@@ -966,7 +1037,8 @@
(?,?,?,?)
/;
my $sth = $dbh->prepare("");
- $sth->execute($borrowernumber,$biblionumber,$resdate,$biblioitem);
+ $sth->execute( $borrowernumber, $biblionumber, $resdate,
+ $biblioitem );
$sth->finish;
$i++;
}
@@ -980,10 +1052,11 @@
# FIXME - opac-reserves.pl need to use it, temporarily put into @EXPORT
sub CalcReserveFee {
- my ($env,$borrowernumber,$biblionumber,$constraint,$bibitems) = @_;
+ my ( $env, $borrowernumber, $biblionumber, $constraint, $bibitems ) = @_;
+
#check for issues;
my $dbh = C4::Context->dbh;
- my $const = lc substr($constraint,0,1);
+ my $const = lc substr( $constraint, 0, 1 );
my $query = qq/
SELECT * FROM borrowers,categories
WHERE borrowernumber = ?
@@ -994,34 +1067,42 @@
my $data = $sth->fetchrow_hashref;
$sth->finish();
my $fee = $data->{'reservefee'};
- my $cntitems = @->$bibitems;
- if ($fee > 0) {
+ my $cntitems = @- > $bibitems;
+
+ if ( $fee > 0 ) {
+
# check for items on issue
# first find biblioitem records
my @biblioitems;
- my $sth1 = $dbh->prepare("SELECT * FROM biblio,biblioitems
+ my $sth1 = $dbh->prepare(
+ "SELECT * FROM biblio,biblioitems
WHERE (biblio.biblionumber = ?)
- AND (biblio.biblionumber = biblioitems.biblionumber)");
+ AND (biblio.biblionumber = biblioitems.biblionumber)"
+ );
$sth1->execute($biblionumber);
- while (my $data1=$sth1->fetchrow_hashref) {
- if ($const eq "a") {
- push @biblioitems,$data1;
- } else {
+ while ( my $data1 = $sth1->fetchrow_hashref ) {
+ if ( $const eq "a" ) {
+ push @biblioitems, $data1;
+ }
+ else {
my $found = 0;
my $x = 0;
- while ($x < $cntitems) {
- if (@$bibitems->{'biblioitemnumber'} == $data->{'biblioitemnumber'}) {
+ while ( $x < $cntitems ) {
+ if ( @$bibitems->{'biblioitemnumber'} ==
+ $data->{'biblioitemnumber'} )
+ {
$found = 1;
}
$x++;
}
- if ($const eq 'o') {
- if ( $found == 1) {
- push @biblioitems,$data1;
- }
- } else {
- if ($found == 0) {
- push @biblioitems,$data1;
+ if ( $const eq 'o' ) {
+ if ( $found == 1 ) {
+ push @biblioitems, $data1;
+ }
+ }
+ else {
+ if ( $found == 0 ) {
+ push @biblioitems, $data1;
}
}
}
@@ -1031,33 +1112,41 @@
my $issues = 0;
my $x = 0;
my $allissued = 1;
- while ($x < $cntitemsfound) {
+ while ( $x < $cntitemsfound ) {
my $bitdata = $biblioitems[$x];
- my $sth2 = $dbh->prepare("SELECT * FROM items
- WHERE biblioitemnumber = ?");
- $sth2->execute($bitdata->{'biblioitemnumber'});
- while (my $itdata=$sth2->fetchrow_hashref) {
- my $sth3 = $dbh->prepare("SELECT * FROM issues
+ my $sth2 = $dbh->prepare(
+ "SELECT * FROM items
+ WHERE biblioitemnumber = ?"
+ );
+ $sth2->execute( $bitdata->{'biblioitemnumber'} );
+ while ( my $itdata = $sth2->fetchrow_hashref ) {
+ my $sth3 = $dbh->prepare(
+ "SELECT * FROM issues
WHERE itemnumber = ?
- AND returndate IS NULL");
- $sth3->execute($itdata->{'itemnumber'});
- if (my $isdata=$sth3->fetchrow_hashref) {
- } else {
+ AND returndate IS NULL"
+ );
+ $sth3->execute( $itdata->{'itemnumber'} );
+ if ( my $isdata = $sth3->fetchrow_hashref ) {
+ }
+ else {
$allissued = 0;
}
}
$x++;
}
- if ($allissued == 0) {
- my $rsth = $dbh->prepare("SELECT * FROM reserves WHERE biblionumber = ?");
+ if ( $allissued == 0 ) {
+ my $rsth =
+ $dbh->prepare("SELECT * FROM reserves WHERE biblionumber = ?");
$rsth->execute($biblionumber);
- if (my $rdata = $rsth->fetchrow_hashref) {
- } else {
+ if ( my $rdata = $rsth->fetchrow_hashref ) {
+ }
+ else {
$fee = 0;
}
}
}
-# print "fee $fee";
+
+ # print "fee $fee";
return $fee;
}
@@ -1071,32 +1160,37 @@
#
# All other item types should incur a reserve charge.
sub CalcHLTReserveFee {
- my ($env,$borrowernumber,$biblionumber,$constraint,$bibitems) = @_;
+ my ( $env, $borrowernumber, $biblionumber, $constraint, $bibitems ) = @_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM borrowers,categories
+ my $sth = $dbh->prepare(
+ "SELECT * FROM borrowers,categories
WHERE (borrowernumber = ?)
- AND (borrowers.categorycode = categories.categorycode)");
+ AND (borrowers.categorycode = categories.categorycode)"
+ );
$sth->execute($borrowernumber);
my $data = $sth->fetchrow_hashref;
$sth->finish();
my $fee = $data->{'reservefee'};
my $matchno;
- my @nocharge = qw/BJC BJCN BJF BJK BJM BJN BJP BJSF BJSN DJ DJP FJ NJ CJ VJ VJP PJ TJ TJP BYF BYN BYP DY DYP PY PYP TY TYP VY VYP/;
- my $sth = $dbh->prepare("SELECT * FROM biblio,biblioitems
+ my @nocharge =
+ qw/BJC BJCN BJF BJK BJM BJN BJP BJSF BJSN DJ DJP FJ NJ CJ VJ VJP PJ TJ TJP BYF BYN BYP DY DYP PY PYP TY TYP VY VYP/;
+ $sth = $dbh->prepare(
+ "SELECT * FROM biblio,biblioitems
WHERE (biblio.biblionumber = ?)
- AND (biblio.biblionumber = biblioitems.biblionumber)");
+ AND (biblio.biblionumber = biblioitems.biblionumber)"
+ );
$sth->execute($biblionumber);
- my $data=$sth->fetchrow_hashref;
+ $data = $sth->fetchrow_hashref;
my $itemtype = $data->{'itemtype'};
- for (my $i = 0; $i < @nocharge; $i++) {
- if ($itemtype eq $nocharge[$i]) {
+ for ( my $i = 0 ; $i < @nocharge ; $i++ ) {
+ if ( $itemtype eq $nocharge[$i] ) {
$matchno++;
last;
}
}
- if($matchno>0){
+ if ( $matchno > 0 ) {
$fee = 0;
}
warn "BOB DEBUG: Fee is $fee";
@@ -1108,18 +1202,21 @@
GetNextAccountNumber()
=cut
+
sub GetNextAccountNumber {
- my ($env,$borrowernumber,$dbh)=@_;
+ my ( $env, $borrowernumber, $dbh ) = @_;
my $nextaccntno = 1;
- my $sth = $dbh->prepare("select * from accountlines
+ my $sth = $dbh->prepare(
+ "select * from accountlines
where (borrowernumber = ?)
- order by accountno desc");
+ order by accountno desc"
+ );
$sth->execute($borrowernumber);
- if (my $accdata=$sth->fetchrow_hashref){
+ if ( my $accdata = $sth->fetchrow_hashref ) {
$nextaccntno = $accdata->{'accountno'} + 1;
}
$sth->finish;
- return($nextaccntno);
+ return ($nextaccntno);
}
#-------------------------------------------------------------------------------------
@@ -1131,12 +1228,13 @@
=cut
sub UpdateReserve {
+
#subroutine to update a reserve
- my ($rank,$biblio,$borrower,$branch)=@_;
+ my ( $rank, $biblio, $borrower, $branch ) = @_;
return if $rank eq "W";
return if $rank eq "n";
my $dbh = C4::Context->dbh;
- if ($rank eq "del") {
+ if ( $rank eq "del" ) {
my $query = qq/
UPDATE reserves
SET cancellationdate=now()
@@ -1145,10 +1243,11 @@
AND cancellationdate is NULL
AND (found <> 'F' or found is NULL)
/;
- my $sth=$dbh->prepare($query);
- $sth->execute($biblio, $borrower);
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $borrower );
$sth->finish;
- } else {
+ }
+ else {
my $query = qq/
UPDATE reserves SET priority = ? ,branchcode = ?, itemnumber = NULL, found = NULL
WHERE biblionumber = ?
@@ -1156,8 +1255,8 @@
AND cancellationdate is NULL
AND (found <> 'F' or found is NULL)
/;
- my $sth=$dbh->prepare($query);
- $sth->execute($rank, $branch, $biblio, $borrower);
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $rank, $branch, $biblio, $borrower );
$sth->finish;
}
}
@@ -1169,7 +1268,7 @@
=cut
sub GetReserveTitle {
- my ($biblio,$bor,$date,$timestamp)=@_;
+ my ( $biblio, $bor, $date, $timestamp ) = @_;
my $dbh = C4::Context->dbh;
my $query = qq/
SELECT *
@@ -1180,9 +1279,9 @@
AND reserveconstraints.reservedate=?
AND reserveconstraints.timestamp=?
/;
- my $sth=$dbh->prepare($query);
- $sth->execute($biblio,$bor,$date,$timestamp);
- my $data=$sth->fetchrow_hashref;
+ my $sth = $dbh->prepare($query);
+ $sth->execute( $biblio, $bor, $date, $timestamp );
+ my $data = $sth->fetchrow_hashref;
$sth->finish;
return $data;
}
More information about the Koha-cvs
mailing list