[Koha-cvs] koha/C4 Circulation/Circ2.pm Circulation/Fines....
Tumer Garip
tgarip at neu.edu.tr
Fri Aug 25 23:07:09 CEST 2006
CVSROOT: /sources/koha
Module name: koha
Changes by: Tumer Garip <tgarip1957> 06/08/25 21:07:09
Modified files:
C4/Circulation : Circ2.pm Fines.pm
C4/Interface/CGI: Output.pm
Added files:
C4/Calendar : Calendar.pm
Removed files:
C4/Circulation : Returns.pm
C4/Barcodes : PrinterConfig.pm
C4/tests : Record_test.pl
C4/tests/testrecords: marc21_marc8.dat
marc21_marc8_combining_chars.dat
marc21_marc8_errors.dat marc21_utf8.dat
marc21_utf8_combining_chars.dat
marcxml_utf8.xml
marcxml_utf8_entityencoded.xml
Log message:
New set of routines for HEAD.
Uses a complete new ZEBRA Indexing.
ZEBRA is now XML and comprises of a KOHA meta record. Explanatory notes will be on koha-devel
Fixes UTF8 problems
Fixes bug with authorities
SQL database major changes.
Separate biblioograaphic and holdings records. Biblioitems table depreceated
etc. etc.
Wait for explanatory document on koha-devel
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Circ2.pm?cvsroot=koha&r1=1.114&r2=1.115
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Fines.pm?cvsroot=koha&r1=1.14&r2=1.15
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Circulation/Returns.pm?cvsroot=koha&r1=1.10&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Interface/CGI/Output.pm?cvsroot=koha&r1=1.4&r2=1.5
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Calendar/Calendar.pm?cvsroot=koha&rev=1.2
http://cvs.savannah.gnu.org/viewcvs/koha/C4/Barcodes/PrinterConfig.pm?cvsroot=koha&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/tests/Record_test.pl?cvsroot=koha&r1=1.2&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/tests/testrecords/marc21_marc8.dat?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/tests/testrecords/marc21_marc8_combining_chars.dat?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/tests/testrecords/marc21_marc8_errors.dat?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/tests/testrecords/marc21_utf8.dat?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/tests/testrecords/marc21_utf8_combining_chars.dat?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/tests/testrecords/marcxml_utf8.xml?cvsroot=koha&r1=1.1&r2=0
http://cvs.savannah.gnu.org/viewcvs/koha/C4/tests/testrecords/marcxml_utf8_entityencoded.xml?cvsroot=koha&r1=1.1&r2=0
Patches:
Index: Circulation/Circ2.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Circ2.pm,v
retrieving revision 1.114
retrieving revision 1.115
diff -u -b -r1.114 -r1.115
--- Circulation/Circ2.pm 21 Jul 2006 13:57:02 -0000 1.114
+++ Circulation/Circ2.pm 25 Aug 2006 21:07:08 -0000 1.115
@@ -3,7 +3,7 @@
package C4::Circulation::Circ2;
-# $Id: Circ2.pm,v 1.114 2006/07/21 13:57:02 toins Exp $
+# $Id: Circ2.pm,v 1.115 2006/08/25 21:07:08 tgarip1957 Exp $
#package to deal with Returns
#written 3/11/99 by olwen at katipo.co.nz
@@ -29,15 +29,16 @@
use strict;
# use warnings;
require Exporter;
-use DBI;
+
use C4::Context;
use C4::Stats;
use C4::Reserves2;
use C4::Koha;
use C4::Accounts2;
use C4::Biblio;
-use Date::Manip;
-use C4::Biblio;
+use C4::Calendar::Calendar;
+use C4::Search;
+use C4::Members;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@@ -66,7 +67,6 @@
@ISA = qw(Exporter);
@EXPORT = qw(
- &getpatroninformation
¤tissues
&getissues
&getiteminformation
@@ -82,207 +82,188 @@
&listitemsforinventory
&itemseen
&fixdate
+ &itemissues
+ &patronflags
get_current_return_date_of
get_transfert_infos
&checktransferts
&GetReservesForBranch
&GetReservesToBranch
&GetTransfersFromBib
- &getBranchIp
- &dotranfer
- );
-# &GetBranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
-
-=head2 itemseen
-
-&itemseen($itemnum)
-Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
-C<$itemnum> is the item number
-
-=cut
-
-sub itemseen {
- my ($itemnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("update items set itemlost=0, datelastseen = now() where items.itemnumber = ?");
- $sth->execute($itemnum);
- return;
-}
-
-=head2 itemborrowed
-
-&itemseen($itemnum)
-Mark item as borrowed. Is called when an item is issued.
-C<$itemnum> is the item number
-
-=cut
-
-sub itemborrowed {
- my ($itemnum) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("update items set itemlost=0, datelastborrowed = now() where items.itemnumber = ?");
- $sth->execute($itemnum);
- return;
-}
-
-sub listitemsforinventory {
- my ($minlocation,$maxlocation,$datelastseen,$offset,$size) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("select itemnumber,barcode,itemcallnumber,title,author from items,biblio where items.biblionumber=biblio.biblionumber and itemcallnumber>= ? and itemcallnumber <=? and (datelastseen< ? or datelastseen is null) order by itemcallnumber,title");
- $sth->execute($minlocation,$maxlocation,$datelastseen);
- my @results;
- while (my $row = $sth->fetchrow_hashref) {
- $offset-- if ($offset);
- if ((!$offset) && $size) {
- push @results,$row;
- $size--;
- }
- }
- return \@results;
-}
-
-=head2 getpatroninformation
-
- ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, $cardnumber);
+ &getBranchIp);
-Looks up a patron and returns information about him or her. If
-C<$borrowernumber> is true (nonzero), C<&getpatroninformation> looks
-up the borrower by number; otherwise, it looks up the borrower by card
-number.
+# &getbranches &getprinters &getbranch &getprinter => moved to C4::Koha.pm
+=item itemissues
-C<$env> is effectively ignored, but should be a reference-to-hash.
-
-C<$borrower> is a reference-to-hash whose keys are the fields of the
-borrowers table in the Koha database. In addition,
-C<$borrower-E<gt>{flags}> is a hash giving more detailed information
-about the patron. Its keys act as flags :
-
- if $borrower->{flags}->{LOST} {
- # Patron's card was reported lost
- }
+ @issues = &itemissues($biblionumber, $biblio);
-Each flag has a C<message> key, giving a human-readable explanation of
-the flag. If the state of a flag means that the patron should not be
-allowed to borrow any more books, then it will have a C<noissues> key
-with a true value.
+Looks up information about who has borrowed the bookZ<>(s) with the
+given biblionumber.
-The possible flags are:
+C<$biblio> is ignored.
-=head3 CHARGES
+C<&itemissues> returns an array of references-to-hash. The keys
+include the fields from the C<items> table in the Koha database.
+Additional keys include:
=over 4
-Shows the patron's credit or debt, if any.
+=item C<date_due>
-=back
+If the item is currently on loan, this gives the due date.
-=head3 GNA
+If the item is not on loan, then this is either "Available" or
+"Cancelled", if the item has been withdrawn.
-=over 4
+=item C<card>
-(Gone, no address.) Set if the patron has left without giving a
-forwarding address.
+If the item is currently on loan, this gives the card number of the
+patron who currently has the item.
-=back
-
-=head3 LOST
-
-=over 4
+=item C<timestamp0>, C<timestamp1>, C<timestamp2>
-Set if the patron's card has been reported as lost.
+These give the timestamp for the last three times the item was
+borrowed.
-=back
+=item C<card0>, C<card1>, C<card2>
-=head3 DBARRED
+The card number of the last three patrons who borrowed this item.
-=over 4
+=item C<borrower0>, C<borrower1>, C<borrower2>
-Set if the patron has been debarred.
+The borrower number of the last three patrons who borrowed this item.
=back
-=head3 NOTES
+=cut
+#'
+sub itemissues {
+ my ($dbh,$data, $biblio)=@_;
-=over 4
+ my $sth = $dbh->prepare("Select * from items where items.biblionumber = ?");
-Any additional notes about the patron.
+ my $i = 0;
+ my @results;
-=back
+ $sth->execute($biblio);
-=head3 ODUES
-=over 4
-
-Set if the patron has overdue items. This flag has several keys:
+ # Find out who currently has this item.
+ # FIXME - Wouldn't it be better to do this as a left join of
+ # some sort? Currently, this code assumes that if
+ # fetchrow_hashref() fails, then the book is on the shelf.
+ # fetchrow_hashref() can fail for any number of reasons (e.g.,
+ # database server crash), not just because no items match the
+ # search criteria.
+ my $sth2 = $dbh->prepare("select * from issues,borrowers
+where itemnumber = ?
+and returndate is NULL
+and issues.borrowernumber = borrowers.borrowernumber");
+
+ $sth2->execute($data->{'itemnumber'});
+ if (my $data2 = $sth2->fetchrow_hashref) {
+
+ $data->{'date_due'} = $data2->{'date_due'};
+ $data->{'datelastborrowed'} = $data2->{'issue_date'};
+ $data->{'card'} = $data2->{'cardnumber'};
+ $data->{'borrower'} = $data2->{'borrowernumber'};
+ }
-C<$flags-E<gt>{ODUES}{itemlist}> is a reference-to-array listing the
-overdue items. Its elements are references-to-hash, each describing an
-overdue item. The keys are selected fields from the issues, biblio,
-biblioitems, and items tables of the Koha database.
+ $sth2->finish;
-C<$flags-E<gt>{ODUES}{itemlist}> is a string giving a text listing of
-the overdue items, one per line.
+ # Find the last 2 people who borrowed this item.
+ $sth2 = $dbh->prepare("select * from issues, borrowers
+ where itemnumber = ?
+ and issues.borrowernumber = borrowers.borrowernumber
+ and returndate is not NULL
+ order by returndate desc,timestamp desc ,limit 2") ;
+ $sth2->execute($data->{'itemnumber'}) ;
+# for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
+my $i2=0;
+ while (my $data2 = $sth2->fetchrow_hashref) {
+ $data->{"timestamp$i2"} = $data2->{'timestamp'};
+ $data->{"card$i2"} = $data2->{'cardnumber'};
+ $data->{"borrower$i2"} = $data2->{'borrowernumber'};
+$data->{'datelastborrowed'} = $data2->{'issue_date'} unless $data->{'datelastborrowed'};
+ $i2++;
+ } # while
+# } # for
-=back
+ $sth2->finish;
-=head3 WAITING
-=over 4
+ $sth->finish;
+ return($data);
+}
-Set if any items that the patron has reserved are available.
-C<$flags-E<gt>{WAITING}{itemlist}> is a reference-to-array listing the
-available items. Each element is a reference-to-hash whose keys are
-fields from the reserves table of the Koha database.
-=back
+=head2 itemseen
-=back
+&itemseen($dbh,$itemnum)
+Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking
+C<$itemnum> is the item number
=cut
+sub itemseen {
+ my ($dbh,$itemnumber) = @_;
+my $sth=$dbh->prepare("select biblionumber from items where itemnumber=?");
+ $sth->execute($itemnumber);
+my ($biblionumber)=$sth->fetchrow;
+MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'itemlost',"0",1);
+# find today's date
+my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
+ $year += 1900;
+ $mon += 1;
+ my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
+ $year,$mon,$mday,$hour,$min,$sec);
+MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'datelastseen', $timestamp);
+}
+sub itemseenbarcode {
+ my ($dbh,$barcode) = @_;
+my $sth=$dbh->prepare("select biblionumber,itemnumber from items where barcode=$barcode");
+ $sth->execute();
+my ($biblionumber,$itemnumber)=$sth->fetchrow;
+MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'itemlost',"0",1);
+my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
+ $year += 1900;
+ $mon += 1;
+my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",$year,$mon,$mday,$hour,$min,$sec);
+MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'datelastseen', $timestamp);
+}
-sub getpatroninformation {
-# returns
- my ($env, $borrowernumber,$cardnumber) = @_;
- my $dbh = C4::Context->dbh;
- my $query;
- my $sth;
- if ($borrowernumber) {
- $sth = $dbh->prepare("select * from borrowers where borrowernumber=?");
- $sth->execute($borrowernumber);
- } elsif ($cardnumber) {
- $sth = $dbh->prepare("select * from borrowers where cardnumber=?");
- $sth->execute($cardnumber);
- } else {
- $env->{'apierror'} = "invalid borrower information passed to getpatroninformation subroutine";
- return();
- }
- my $borrower = $sth->fetchrow_hashref;
- my $amount = checkaccount($env, $borrowernumber, $dbh);
- $borrower->{'amountoutstanding'} = $amount;
- my $flags = patronflags($env, $borrower, $dbh);
- my $accessflagshash;
-
- $sth=$dbh->prepare("select bit,flag from userflags");
- $sth->execute;
- while (my ($bit, $flag) = $sth->fetchrow) {
- if ($borrower->{'flags'} && $borrower->{'flags'} & 2**$bit) {
- $accessflagshash->{$flag}=1;
- }
+sub listitemsforinventory {
+ my ($minlocation,$datelastseen,$offset,$size) = @_;
+ my $count=0;
+ my @results;
+ my @kohafields;
+ my @values;
+ my @relations;
+ my $sort;
+ my @and_or;
+ if ($datelastseen){
+ push @kohafields, "classification","datelastseen";
+ push @values,$minlocation,$datelastseen;
+ push @relations,"\@attr 5=1 \@attr 6=3 \@attr 4=1 ","\@attr 2=1 ";
+ push @and_or,"\@and";
+ $sort="lcsort";
+ ($count, at results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,0,"",$offset,$size);
+ }else{
+ push @kohafields, "classification";
+ push @values,$minlocation;
+ push @relations,"\@attr 5=1 \@attr 6=3 \@attr 4=1 ";
+ push @and_or,"";
+ $sort="lcsort";
+ ($count, at results)=ZEBRAsearch_kohafields(\@kohafields,\@values,\@relations,$sort,\@and_or,0,"",$offset,$size);
}
- $sth->finish;
- $borrower->{'flags'}=$flags;
- $borrower->{'authflags'} = $accessflagshash;
- # find out how long the membership lasts
- my $sth=$dbh->prepare("select enrolmentperiod from categories where categorycode = ?");
- $sth->execute($borrower->{'categorycode'});
- my $enrolment = $sth->fetchrow;
- $borrower->{'enrolmentperiod'} = $enrolment;
- return ($borrower); #, $flags, $accessflagshash);
+ return @results;
}
+
+
+
=head2 decode
=over 4
@@ -368,37 +349,20 @@
sub getiteminformation {
-# returns a hash of item information given either the itemnumber or the barcode
+# returns a hash of item information together with biblio given either the itemnumber or the barcode
my ($env, $itemnumber, $barcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth;
- if ($itemnumber) {
- $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.itemnumber=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
- $sth->execute($itemnumber);
- } elsif ($barcode) {
- $sth=$dbh->prepare("select * from biblio,items,biblioitems where items.barcode=? and biblio.biblionumber=items.biblionumber and biblioitems.biblioitemnumber = items.biblioitemnumber");
- $sth->execute($barcode);
- } else {
- $env->{'apierror'}="getiteminformation() subroutine must be called with either an itemnumber or a barcode";
- # Error condition.
- return();
- }
- my $iteminformation=$sth->fetchrow_hashref;
- $sth->finish;
+ my $dbh=C4::Context->dbh;
+ my ($itemrecord)=MARCgetitem($dbh,$itemnumber,$barcode);
+ my $iteminformation=MARCmarc2koha($dbh,$itemrecord,"holdings");
+##Now get full biblio details from MARC
if ($iteminformation) {
- $sth=$dbh->prepare("select date_due from issues where itemnumber=? and isnull(returndate)");
- $sth->execute($iteminformation->{'itemnumber'});
- my ($date_due) = $sth->fetchrow;
- $iteminformation->{'date_due'}=$date_due;
- $sth->finish;
+my ($record)=MARCgetbiblio($dbh,$iteminformation->{'biblionumber'});
+my $biblio=MARCmarc2koha($dbh,$record,"biblios");
+ foreach my $field (keys %$biblio){
+ $iteminformation->{$field}=$biblio->{$field};
+ }
+ $iteminformation->{'date_due'}="" if $iteminformation->{'date_due'} eq "0000-00-00";
($iteminformation->{'dewey'} == 0) && ($iteminformation->{'dewey'}='');
- $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
- $sth->execute($iteminformation->{'itemtype'});
- my $itemtype=$sth->fetchrow_hashref;
- # if specific item notforloan, don't use itemtype notforloan field.
- # otherwise, use itemtype notforloan value to see if item can be issued.
- $iteminformation->{'notforloan'}=$itemtype->{'notforloan'} unless $iteminformation->{'notforloan'};
- $sth->finish;
}
return($iteminformation);
}
@@ -462,28 +426,18 @@
=cut
-#'
-# FIXME - This function tries to do too much, and its API is clumsy.
-# If it didn't also return books, it could be used to change the home
-# branch of a book while the book is on loan.
-#
-# Is there any point in returning the item information? The caller can
-# look that up elsewhere if ve cares.
-#
-# This leaves the ($dotransfer, $messages) tuple. This seems clumsy.
-# If the transfer succeeds, that's all the caller should need to know.
-# Thus, this function could simply return 1 or 0 to indicate success
-# or failure, and set $C4::Circulation::Circ2::errmsg in case of
-# failure. Or this function could return undef if successful, and an
-# error message in case of failure (this would feel more like C than
-# Perl, though).
+##This routine is reverted to origional state
+##This routine is used when a book physically arrives at a branch due to user returning it there
+## so record the fact that holdingbranch is changed.
sub transferbook {
# transfer book code....
- my ($tbr, $barcode, $ignoreRs) = @_;
+ my ($tbr, $barcode, $ignoreRs,$user) = @_;
my $messages;
my %env;
+ my $dbh=C4::Context->dbh;
my $dotransfer = 1;
my $branches = GetBranches();
+
my $iteminformation = getiteminformation(\%env, 0, $barcode);
# bad barcode..
if (not $iteminformation) {
@@ -515,55 +469,44 @@
my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
if ($resfound and not $ignoreRs) {
$resrec->{'ResFound'} = $resfound;
-# $messages->{'ResFound'} = $resrec;
- $dotransfer = 1;
+ $messages->{'ResFound'} = $resrec;
+ $dotransfer = 0;
}
-
+ #actually do the transfer....
if ($dotransfer) {
- dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr);
- my $dbh= C4::Context->dbh;
- my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"items.holdingbranch");
- my $bibid = MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $iteminformation->{'biblionumber'} );
- my $marcitem = MARCgetitem($dbh, $bibid, $iteminformation->{'itemnumber'});
- if ($marcitem->field($tagfield)){
- $marcitem->field($tagfield)->update($tagsubfield=> $tbr);
- MARCmoditem($dbh,$marcitem,$bibid,$iteminformation->{'itemnumber'});
- }
+ dotransfer($iteminformation->{'itemnumber'}, $fbr, $tbr,$user);
$messages->{'WasTransfered'} = 1;
}
return ($dotransfer, $messages, $iteminformation);
}
# Not exported
-# FIXME - This is only used in &transferbook. Why bother making it a
-# separate function?
+
sub dotransfer {
- my ($itm, $fbr, $tbr) = @_;
+## The book has arrived at this branch because it has been returned there
+## So we update the fact the book is in that branch not that we want to send the book to that branch
+
+ my ($itm, $fbr, $tbr,$user) = @_;
my $dbh = C4::Context->dbh;
- $itm = $dbh->quote($itm);
- $fbr = $dbh->quote($fbr);
- $tbr = $dbh->quote($tbr);
+
#new entry in branchtransfers....
- $dbh->do("INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
- VALUES ($itm, $fbr, now(), $tbr)");
+ my $sth=$dbh->prepare("INSERT INTO branchtransfers (itemnumber, frombranch, datearrived, tobranch,comments) VALUES (?, ?, now(), ?,?)");
+ $sth->execute($itm, $fbr, $tbr,$user);
#update holdingbranch in items .....
- $dbh->do("UPDATE items set holdingbranch = $tbr WHERE items.itemnumber = $itm");
- &itemseen($itm);
- &domarctransfer($dbh,$itm);
+ &domarctransfer($dbh,$itm,$tbr);
+## Item seen taken out of this loop to optimize ZEBRA updates
+# &itemseen($dbh,$itm);
return;
}
-##New sub to dotransfer in marc tables as well. Not exported -TG 10/04/2006
sub domarctransfer{
-
-my ($dbh,$itemnumber) = @_;
-$itemnumber=~s /\'//g; ##itemnumber seems to come with quotes-TG
-my $sth=$dbh->prepare("select biblionumber,holdingbranch from items where itemnumber=$itemnumber");
+my ($dbh,$itemnumber,$holdingbranch) = @_;
+$itemnumber=~s /\'//g;
+my $sth=$dbh->prepare("select biblionumber from items where itemnumber=$itemnumber");
$sth->execute();
-while (my ($biblionumber,$holdingbranch)=$sth->fetchrow ){
-&MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'items.holdingbranch',$holdingbranch,0);
-}
-return;
+my ($biblionumber)=$sth->fetchrow;
+MARCmoditemonefield($dbh,$biblionumber,$itemnumber,'holdingbranch',$holdingbranch,1);
+ $sth->finish;
}
=head2 canbookbeissued
@@ -657,44 +600,54 @@
# check if a book can be issued.
# returns an array with errors if any
+
+
+
+
+
+
+
+
+
+
sub TooMany ($$){
my $borrower = shift;
my $iteminformation = shift;
my $cat_borrower = $borrower->{'categorycode'};
my $branch_borrower = $borrower->{'branchcode'};
my $dbh = C4::Context->dbh;
-
-
- my $sth = $dbh->prepare('select itemtype from biblioitems where biblionumber = ?');
+ my $sth = $dbh->prepare('select itemtype from biblio where biblionumber = ?');
$sth->execute($iteminformation->{'biblionumber'});
my $type = $sth->fetchrow;
$sth = $dbh->prepare('select * from issuingrules where categorycode = ? and itemtype = ? and branchcode = ?');
-# my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s.biblioitemnumber and s.itemtype like ?");
- my $sth2 = $dbh->prepare("select COUNT(*) from issues i, biblioitems s1, items s2 where i.borrowernumber = ? and i.returndate is null and i.itemnumber = s2.itemnumber and s1.itemtype like ? and s1.biblioitemnumber = s2.biblioitemnumber");
+ my $sth2 = $dbh->prepare("select COUNT(*) from issues i, items it, biblio b where i.borrowernumber = ? and i.returndate is null and i.itemnumber = it.itemnumber and b.biblionumber=it.biblionumber and b.itemtype like ?");
my $sth3 = $dbh->prepare('select COUNT(*) from issues where borrowernumber = ? and returndate is null');
my $alreadyissued;
+
# check the 3 parameters
+ #print "content-type: text/plain \n\n";
+ #print "$cat_borrower, $type, $branch_borrower";
$sth->execute($cat_borrower, $type, $branch_borrower);
my $result = $sth->fetchrow_hashref;
-# warn "==>".$result->{maxissueqty};
-
- # Currently, using defined($result) ie on an entire hash reports whether memory
- # for that aggregate has ever been allocated. As $result is used all over the place
- # it would rarely return as undefined.
if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ # print "content-type: text/plain \n\n";
+ #print "$cat_borrower, $type, $branch_borrower";
+ $sth2->execute($borrower->{'borrowernumber'}, $type);
my $alreadyissued = $sth2->fetchrow;
- if ($result->{'maxissueqty'} <= $alreadyissued){
- return ("a $alreadyissued / ".($result->{maxissueqty}+0));
- } else {
+ # print "***" . $alreadyissued;
+ #print "----". $result->{'maxissueqty'};
+ if ($result->{'maxissueqty'} <= $alreadyissued) {
+ return ("a $alreadyissued /",($result->{'maxissueqty'}+0));
+ }else {
return;
}
}
+
# check for branch=*
$sth->execute($cat_borrower, $type, "");
$result = $sth->fetchrow_hashref;
if (defined($result->{maxissueqty})) {
- $sth2->execute($borrower->{'borrowernumber'}, "%$type%");
+ $sth2->execute($borrower->{'borrowernumber'}, $type);
my $alreadyissued = $sth2->fetchrow;
if ($result->{'maxissueqty'} <= $alreadyissued){
return ("b $alreadyissued / ".($result->{maxissueqty}+0));
@@ -702,6 +655,7 @@
return;
}
}
+
# check for itemtype=*
$sth->execute($cat_borrower, "*", $branch_borrower);
$result = $sth->fetchrow_hashref;
@@ -715,7 +669,8 @@
return;
}
}
- # check for borrowertype=*
+
+ #check for borrowertype=*
$sth->execute("*", $type, $branch_borrower);
$result = $sth->fetchrow_hashref;
if (defined($result->{maxissueqty})) {
@@ -728,6 +683,7 @@
}
}
+ #check for borrowertype=*;itemtype=*
$sth->execute("*", "*", $branch_borrower);
$result = $sth->fetchrow_hashref;
if (defined($result->{maxissueqty})) {
@@ -779,6 +735,8 @@
}
+
+
sub canbookbeissued {
my ($env,$borrower,$barcode,$year,$month,$day,$inprocess) = @_;
my %needsconfirmation; # filled with problems that needs confirmations
@@ -803,7 +761,7 @@
if ($borrower->{flags}->{'DBARRED'}) {
$issuingimpossible{DEBARRED} = 1;
}
- if (&Date_Cmp(&ParseDate($borrower->{dateexpiry}),&ParseDate("today"))<0) {
+ if (DATE_diff($borrower->{expiry},'CURRENT_DATE')<0) {
$issuingimpossible{EXPIRED} = 1;
}
#
@@ -825,6 +783,7 @@
}
}
+
#
# JB34 CHECKS IF BORROWERS DONT HAVE ISSUE TOO MANY BOOKS
#
@@ -837,40 +796,45 @@
unless ($iteminformation->{barcode}) {
$issuingimpossible{UNKNOWN_BARCODE} = 1;
}
- if ($iteminformation->{'notforloan'} && $iteminformation->{'notforloan'} > 0) {
+ if ($iteminformation->{'notforloan'} > 0) {
$issuingimpossible{NOT_FOR_LOAN} = 1;
}
- if ($iteminformation->{'itemtype'} &&$iteminformation->{'itemtype'} eq 'REF') {
+ if ($iteminformation->{'itemtype'} eq 'REF') {
$issuingimpossible{NOT_FOR_LOAN} = 1;
}
- if ($iteminformation->{'wthdrawn'} && $iteminformation->{'wthdrawn'} == 1) {
+ if ($iteminformation->{'wthdrawn'} == 1) {
$issuingimpossible{WTHDRAWN} = 1;
}
- if ($iteminformation->{'restricted'} && $iteminformation->{'restricted'} == 1) {
+ if ($iteminformation->{'restricted'} == 1) {
$issuingimpossible{RESTRICTED} = 1;
}
- if (C4::Context->preference("IndependantBranches")){
+ if ($iteminformation->{'shelf'} eq 'Res') {
+ $issuingimpossible{IN_RESERVE} = 1;
+ }
+if (C4::Context->preference("IndependantBranches")){
my $userenv = C4::Context->userenv;
if (($userenv)&&($userenv->{flags} != 1)){
$issuingimpossible{NOTSAMEBRANCH} = 1 if ($iteminformation->{'holdingbranch'} ne $userenv->{branch} ) ;
}
}
-
-
-
#
# CHECK IF BOOK ALREADY ISSUED TO THIS BORROWER
#
my ($currentborrower) = currentborrower($iteminformation->{'itemnumber'});
- if ($currentborrower && $currentborrower eq $borrower->{'borrowernumber'}) {
+ if ($currentborrower eq $borrower->{'borrowernumber'}) {
# Already issued to current borrower. Ask whether the loan should
# be renewed.
my ($renewstatus) = renewstatus($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
if ($renewstatus == 0) { # no more renewals allowed
$issuingimpossible{NO_MORE_RENEWALS} = 1;
} else {
- # $needsconfirmation{RENEW_ISSUE} = 1;
+ if (C4::Context->preference("strictrenewals")){
+ ###if this is set do not allow automatic renewals
+ ##the new renew script will do same strict checks as issues and return error codes
+ $needsconfirmation{RENEW_ISSUE} = 1;
+ }
+
}
} elsif ($currentborrower) {
# issued to someone else
@@ -878,7 +842,7 @@
# warn "=>.$currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
$needsconfirmation{ISSUED_TO_ANOTHER} = "$currborinfo->{'reservedate'} : $currborinfo->{'firstname'} $currborinfo->{'surname'} ($currborinfo->{'cardnumber'})";
}
-# See if the item is on reserve.
+# See if the item is on RESERVE
my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
if ($restype) {
my $resbor = $res->{'borrowernumber'};
@@ -889,7 +853,7 @@
my $branches = GetBranches();
my $branchname = $branches->{$res->{'branchcode'}}->{'branchname'};
$needsconfirmation{RESERVE_WAITING} = "$resborrower->{'firstname'} $resborrower->{'surname'} ($resborrower->{'cardnumber'}, $branchname)";
- # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'}); Doesn't belong in a checking subroutine.
+ # CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
} elsif ($restype eq "Reserved") {
# The item is on reserve for someone else.
my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
@@ -902,12 +866,10 @@
if ($borrower->{'categorycode'} eq 'W'){
my %issuingimpossible;
return(\%issuingimpossible,\%needsconfirmation);
- } else {
- return(\%issuingimpossible,\%needsconfirmation);
}
- } else {
- return(\%issuingimpossible,\%needsconfirmation);
}
+
+ return(\%issuingimpossible,\%needsconfirmation);
}
=head2 issuebook
@@ -934,9 +896,9 @@
sub issuebook {
my ($env,$borrower,$barcode,$date,$cancelreserve) = @_;
my $dbh = C4::Context->dbh;
-# my ($borrower, $flags) = &getpatroninformation($env, $borrowernumber, 0);
- my $iteminformation = getiteminformation($env, 0, $barcode);
-# warn "B : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'};
+ my ($itemrecord)=MARCgetitem($dbh,"",$barcode);
+ my $iteminformation=MARCmarc2koha($dbh,$itemrecord,"holdings");
+ my $error;
#
# check if we just renew the issue.
#
@@ -948,7 +910,12 @@
$iteminformation->{'charge'} = $charge;
}
&UpdateStats($env,$env->{'branchcode'},'renew',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
+ if (C4::Context->preference("strictrenewals")){
+ $error=renewstatus($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+ renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}) if ($error>1);
+ }else{
renewbook($env, $borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+ }
} else {
#
# NOT a renewal
@@ -957,17 +924,20 @@
# This book is currently on loan, but not to the person
# who wants to borrow it now. mark it returned before issuing to the new borrower
returnbook($iteminformation->{'barcode'}, $env->{'branchcode'});
+#warn "return : ".$borrower->{borrowernumber}." / I : ".$iteminformation->{'itemnumber'};
+
}
# See if the item is on reserve.
my ($restype, $res) = CheckReserves($iteminformation->{'itemnumber'});
+#warn "$restype,$res";
if ($restype) {
my $resbor = $res->{'borrowernumber'};
if ($resbor eq $borrower->{'borrowernumber'}) {
# The item is on reserve to the current patron
FillReserve($res);
- warn "FillReserve";
+# warn "FillReserve";
} elsif ($restype eq "Waiting") {
- warn "Waiting";
+# warn "Waiting";
# The item is on reserve and waiting, but has been
# reserved by some other patron.
my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
@@ -980,7 +950,7 @@
UpdateReserve(1, $res->{'biblionumber'}, $res->{'borrowernumber'}, $res->{'branchcode'});
}
} elsif ($restype eq "Reserved") {
-# warn "Reserved";
+#warn "Reserved";
# The item is on reserve for someone else.
my ($resborrower, $flags)=getpatroninformation($env, $resbor,0);
my $branches = GetBranches();
@@ -989,24 +959,31 @@
# cancel reserves on this item
CancelReserve(0, $res->{'itemnumber'}, $res->{'borrowernumber'});
# also cancel reserve on biblio related to this item
- #my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?");
- #$st_Fbiblio->execute($res->{'itemnumber'});
- #my $biblionumber = $st_Fbiblio->fetchrow;
- #CancelReserve($biblionumber,0,$res->{'borrowernumber'});
- #warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}";
+ # my $st_Fbiblio = $dbh->prepare("select biblionumber from items where itemnumber=?");
+ # $st_Fbiblio->execute($res->{'itemnumber'});
+ # my $biblionumber = $st_Fbiblio->fetchrow;
+# CancelReserve($iteminformation->{'biblionumber'},0,$res->{'borrowernumber'});
+# warn "CancelReserve $res->{'itemnumber'}, $res->{'borrowernumber'}";
} else {
-# my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
-# transferbook($tobrcd,$barcode, 1);
-# warn "transferbook";
+ my $tobrcd = ReserveWaiting($res->{'itemnumber'}, $res->{'borrowernumber'});
+ transferbook($tobrcd,$barcode, 1);
+ warn "transferbook";
}
}
}
- # Record in the database the fact that the book was issued.
- my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode) values (?,?,?,?)");
+
+ my $sth=$dbh->prepare("insert into issues (borrowernumber, itemnumber, date_due, branchcode,issue_date) values (?,?,?,?,NOW())");
my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
- my $datedue=time+($loanlength)*86400;
- my @datearr = localtime($datedue);
- my $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-".$datearr[3];
+ my $dateduef;
+ my @datearr = localtime();
+ $dateduef = (1900+$datearr[5])."-".($datearr[4]+1)."-". $datearr[3];
+
+ my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'});
+ my ($yeardue, $monthdue, $daydue) = split /-/, $dateduef;
+ ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength);
+ $dateduef = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue);
+
+#warn $dateduef;
if ($date) {
$dateduef=$date;
}
@@ -1017,20 +994,30 @@
$sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'}, $dateduef, $env->{'branchcode'});
$sth->finish;
$iteminformation->{'issues'}++;
- $sth=$dbh->prepare("update items set issues=?, holdingbranch=? where itemnumber=?");
- $sth->execute($iteminformation->{'issues'},C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
- $sth->finish;
- &itemseen($iteminformation->{'itemnumber'});
- itemborrowed($iteminformation->{'itemnumber'});
+##Record in MARC the new data ,date_due as due date,issue count and the borrowernumber
+ &MARCkoha2marcOnefield($itemrecord, "issues", $iteminformation->{'issues'},"holdings");
+ &MARCkoha2marcOnefield($itemrecord, "date_due", $dateduef,"holdings");
+ &MARCkoha2marcOnefield($itemrecord, "borrowernumber", $borrower->{'borrowernumber'},"holdings");
+ &MARCkoha2marcOnefield($itemrecord, "itemlost", "0","holdings");
+ # find today's date as timestamp
+ my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
+ $year += 1900;
+ $mon += 1;
+ my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
+ $year,$mon,$mday,$hour,$min,$sec);
+ &MARCkoha2marcOnefield($itemrecord, "datelastseen", $timestamp,"holdings");
+ ##Now update the zebradb
+ NEWmoditem($dbh,$itemrecord,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'});
# If it costs to borrow this book, charge it to the patron's account.
my ($charge,$itemtype)=calc_charges($env, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'});
if ($charge > 0) {
createcharge($env, $dbh, $iteminformation->{'itemnumber'}, $borrower->{'borrowernumber'}, $charge);
$iteminformation->{'charge'}=$charge;
}
- # Record the fact that this book was issued.
+ # Record the fact that this book was issued in SQL
&UpdateStats($env,$env->{'branchcode'},'issue',$charge,'',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
}
+return($error);
}
=head2 getLoanLength
@@ -1049,7 +1036,7 @@
# check with borrowertype, itemtype and branchcode, then without one of those parameters
$sth->execute($borrowertype,$itemtype,$branchcode);
my $loanlength = $sth->fetchrow_hashref;
- return $loanlength->{issuelength} if defined($loanlength) && $loanlength->{issuelength} ne 'NULL';
+ return $loanlength->{issuelength} if defined($loanlength);
$sth->execute($borrowertype,$itemtype,"");
$loanlength = $sth->fetchrow_hashref;
@@ -1153,7 +1140,8 @@
my $doreturn = 1;
die '$branch not defined' unless defined $branch; # just in case (bug 170)
# get information on item
- my ($iteminformation) = getiteminformation(\%env, 0, $barcode);
+ my ($itemrecord)=MARCgetitem($dbh,"",$barcode);
+ my $iteminformation=MARCmarc2koha($dbh,$itemrecord,"holdings");
if (not $iteminformation) {
$messages->{'BadBarcode'} = $barcode;
$doreturn = 0;
@@ -1167,7 +1155,7 @@
# check if the book is in a permanent collection....
my $hbr = $iteminformation->{'homebranch'};
my $branches = GetBranches();
- if ($hbr && $branches->{$hbr}->{'PE'}) {
+ if ($branches->{$hbr}->{'PE'}) {
$messages->{'IsPermanent'} = $hbr;
}
# check that the book has been cancelled
@@ -1175,69 +1163,77 @@
$messages->{'wthdrawn'} = 1;
$doreturn = 0;
}
-# new op dev : if the book returned in an other branch update the holding branch
-
# update issues, thereby returning book (should push this out into another subroutine
my ($borrower) = getpatroninformation(\%env, $currentborrower, 0);
if ($doreturn) {
my $sth = $dbh->prepare("update issues set returndate = now() where (borrowernumber = ?) and (itemnumber = ?) and (returndate is null)");
$sth->execute($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+ $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
-# FIXME the holdingbranch is updated if the document is returned in an other location .
- if ( $iteminformation->{'holdingbranch'} ne C4::Context->userenv->{'branch'}){
- my $sth_upd_location = $dbh->prepare("UPDATE items SET holdingbranch=? WHERE itemnumber=?");
- $sth_upd_location->execute(C4::Context->userenv->{'branch'},$iteminformation->{'itemnumber'});
- $sth_upd_location->finish;
- $iteminformation->{'holdingbranch'} = C4::Context->userenv->{'branch'};
+ $sth->finish;
+ &MARCkoha2marcOnefield($itemrecord, "date_due", "","holdings");
+ &MARCkoha2marcOnefield($itemrecord, "borrowernumber", "","holdings");
}
+ my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
+ my ($sec,$min,$hour,$mday,$mon,$year) = localtime();
+ $year += 1900;
+ $mon += 1;
+ my $timestamp = sprintf("%4d%02d%02d%02d%02d%02d.0",
+ $year,$mon,$mday,$hour,$min,$sec);
+ &MARCkoha2marcOnefield($itemrecord, "datelastseen", $timestamp,"holdings");
+
- $messages->{'WasReturned'} = 1; # FIXME is the "= 1" right?
- }
- itemseen($iteminformation->{'itemnumber'});
($borrower) = getpatroninformation(\%env, $currentborrower, 0);
# transfer book to the current branch
-# FIXME function transfered still always used ????
-# my ($transfered, $mess, $item) = transferbook($branch, $barcode, 1);
-# if ($transfered) {
-# $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
-# }
-
+ if ($transfered) {
+ $messages->{'WasTransfered'} = 1; # FIXME is the "= 1" right?
+ }
# fix up the accounts.....
if ($iteminformation->{'itemlost'}) {
fixaccountforlostandreturned($iteminformation, $borrower);
$messages->{'WasLost'} = 1; # FIXME is the "= 1" right?
+ &MARCkoha2marcOnefield($itemrecord, "itemlost", "","holdings");
}
+####WARNING-- FIXME#########
+### The following new script is commented out
+## I did not understand what it is supposed to do.
+## If a book is returned at one branch it is automatically recorded being in that branch by
+## transferbook script. This scrip tries to find out whether it was sent thre
+## Well whether sent or not it is physically there and transferbook records this fact in MARCrecord as well
+## If this script is trying to do something else it should be uncommented and also add support for updating MARC record --TG
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# check if we have a transfer for this document
- my $checktransfer = checktransferts($iteminformation->{'itemnumber'});
+# my $checktransfer = checktransferts($iteminformation->{'itemnumber'});
# if we have a return, we update the line of transfers with the datearrived
- if ($checktransfer){
- my $sth = $dbh->prepare("update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL");
- $sth->execute($iteminformation->{'itemnumber'});
- $sth->finish;
+# if ($checktransfer){
+# my $sth = $dbh->prepare("update branchtransfers set datearrived = now() where itemnumber= ? AND datearrived IS NULL");
+# $sth->execute($iteminformation->{'itemnumber'});
+# $sth->finish;
# now we check if there is a reservation with the validate of transfer if we have one, we can set it with the status 'W'
- my $updateWaiting = SetWaitingStatus($iteminformation->{'itemnumber'});
- }
+# my $updateWaiting = SetWaitingStatus($iteminformation->{'itemnumber'});
+# }
# if we don't have a transfer on run, we check if the document is not in his homebranch and there is not a reservation, we transfer this one to his home branch directly if system preference Automaticreturn is turn on .
- else {
- my $checkreserves = CheckReserves($iteminformation->{'itemnumber'});
- if (($iteminformation->{'homebranch'} ne $iteminformation->{'holdingbranch'}) and (not $checkreserves) and (C4::Context->preference("AutomaticItemReturn") == 1)){
- my $automatictransfer = dotransfer($iteminformation->{'itemnumber'},$iteminformation->{'holdingbranch'},$iteminformation->{'homebranch'});
- $messages->{'WasTransfered'} = 1;
- }
- }
+# else {
+# my $checkreserves = CheckReserves($iteminformation->{'itemnumber'});
+# if (($iteminformation->{'homebranch'} ne $iteminformation->{'holdingbranch'}) and (not $checkreserves) and (C4::Context->preference("AutomaticItemReturn") == 1)){
+# my $automatictransfer = dotransfer($iteminformation->{'itemnumber'},$iteminformation->{'holdingbranch'},$iteminformation->{'homebranch'});
+# $messages->{'WasTransfered'} = 1;
+# }
+# }
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# fix up the overdues in accounts...
fixoverduesonreturn($borrower->{'borrowernumber'}, $iteminformation->{'itemnumber'});
+ &MARCkoha2marcOnefield($itemrecord, "itemoverdue", "","holdings");
# find reserves.....
-# if we don't have a reserve with the status W, we launch the Checkreserves routine
my ($resfound, $resrec) = CheckReserves($iteminformation->{'itemnumber'});
if ($resfound) {
# my $tobrcd = ReserveWaiting($resrec->{'itemnumber'}, $resrec->{'borrowernumber'});
$resrec->{'ResFound'} = $resfound;
$messages->{'ResFound'} = $resrec;
}
+ ##Now update the zebradb
+ NEWmoditem($dbh,$itemrecord,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'});
# update stats?
# Record the fact that this book was returned.
UpdateStats(\%env, $branch ,'return','0','',$iteminformation->{'itemnumber'},$iteminformation->{'itemtype'},$borrower->{'borrowernumber'});
@@ -1331,9 +1327,9 @@
values (?,?,?,?)");
$usth->execute($borrower->{'borrowernumber'},$data->{'accountno'},$nextaccntno,$offset);
$usth->finish;
- $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?");
- $usth->execute($itm);
- $usth->finish;
+# $usth = $dbh->prepare("update items set paidfor='' where itemnumber=?");
+# $usth->execute($itm);
+# $usth->finish;
}
$sth->finish;
return;
@@ -1359,7 +1355,7 @@
$sth->execute($brn,$itm);
# alter fine to show that the book has been returned
if (my $data = $sth->fetchrow_hashref) {
- my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (acccountno = ?)");
+ my $usth=$dbh->prepare("update accountlines set accounttype='F' where (borrowernumber = ?) and (itemnumber = ?) and (accountno = ?)");
$usth->execute($brn,$itm,$data->{'accountno'});
$usth->finish();
}
@@ -1367,7 +1363,7 @@
return;
}
-# Not exported
+
#
# NOTE!: If you change this function, be sure to update the POD for
# &getpatroninformation.
@@ -1400,7 +1396,7 @@
# Original subroutine for Circ2.pm
my %flags;
my ($env, $patroninformation, $dbh) = @_;
- my $amount = checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
+ my $amount = C4::Accounts2::checkaccount($env, $patroninformation->{'borrowernumber'}, $dbh);
if ($amount > 0) {
my %flaginfo;
my $noissuescharge = C4::Context->preference("noissuescharge");
@@ -1414,25 +1410,25 @@
$flaginfo{'message'} = sprintf "Patron has credit of \$%.02f", -$amount;
$flags{'CHARGES'} = \%flaginfo;
}
- if ($patroninformation->{'gonenoaddress'} && $patroninformation->{'gonenoaddress'} == 1) {
+ if ($patroninformation->{'gonenoaddress'} == 1) {
my %flaginfo;
$flaginfo{'message'} = 'Borrower has no valid address.';
$flaginfo{'noissues'} = 1;
$flags{'GNA'} = \%flaginfo;
}
- if ($patroninformation->{'lost'} && $patroninformation->{'lost'} == 1) {
+ if ($patroninformation->{'lost'} == 1) {
my %flaginfo;
$flaginfo{'message'} = 'Borrower\'s card reported lost.';
$flaginfo{'noissues'} = 1;
$flags{'LOST'} = \%flaginfo;
}
- if ($patroninformation->{'debarred'} && $patroninformation->{'debarred'} == 1) {
+ if ($patroninformation->{'debarred'} == 1) {
my %flaginfo;
$flaginfo{'message'} = 'Borrower is Debarred.';
$flaginfo{'noissues'} = 1;
$flags{'DBARRED'} = \%flaginfo;
}
- if ($patroninformation->{'borrowernotes'} && $patroninformation->{'borrowernotes'}) {
+ if ($patroninformation->{'borrowernotes'}) {
my %flaginfo;
$flaginfo{'message'} = "$patroninformation->{'borrowernotes'}";
$flags{'NOTES'} = \%flaginfo;
@@ -1466,19 +1462,22 @@
#checks whether a borrower has overdue items
my ($env, $bornum, $dbh)=@_;
my @datearr = localtime;
- my $today = ($datearr[5] + 1900)."-".($datearr[4]+1)."-".$datearr[3];
+ my $today = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]);
my @overdueitems;
my $count = 0;
- my $sth = $dbh->prepare("SELECT * FROM issues,biblio,biblioitems,items
- WHERE items.biblioitemnumber = biblioitems.biblioitemnumber
- AND items.biblionumber = biblio.biblionumber
- AND issues.itemnumber = items.itemnumber
+ my $sth = $dbh->prepare("SELECT issues.* , i.biblionumber as biblionumber FROM issues, items i
+ WHERE i.itemnumber=issues.itemnumber
AND issues.borrowernumber = ?
AND issues.returndate is NULL
AND issues.date_due < ?");
$sth->execute($bornum,$today);
while (my $data = $sth->fetchrow_hashref) {
- push (@overdueitems, $data);
+ my ($record)=MARCgetbiblio($dbh,$data->{biblionumber});
+ my $bibliodata=MARCmarc2koha($dbh,$record,"biblios");
+ foreach my $field (keys % $data){
+ $bibliodata->{$field}=$data->{$field};
+ }
+ push (@overdueitems, $bibliodata);
$count++;
}
$sth->finish;
@@ -1502,7 +1501,6 @@
# FIXME - Not exported, but used in 'updateitem.pl' anyway.
sub checkreserve_to_delete {
-# Stolen from Main.pm
# Check for reserves for biblio
my ($env,$dbh,$itemnum)=@_;
my $resbor = "";
@@ -1527,8 +1525,7 @@
where (borrowernumber=?)
and reservedate=?
and reserveconstraints.biblionumber=?
- and (items.itemnumber=? and
- items.biblioitemnumber = reserveconstraints.biblioitemnumber)");
+ and (items.itemnumber=? )");
$csth->execute($data->{'borrowernumber'},$data->{'biblionumber'},$data->{'reservedate'},$itemnum);
if (my $cdata=$csth->fetchrow_hashref) {$found = 1;}
if ($const eq 'o') {
@@ -1591,7 +1588,7 @@
# FIXME - Since $today will be used in either case, move it
# out of the two if-blocks.
my @datearr = localtime(time());
- my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
+ my $today = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]);
# FIXME - MySQL knows about dates. Just use
# and issues.timestamp = curdate();
$crit=" and issues.timestamp like '$today%' ";
@@ -1602,7 +1599,7 @@
# FIXME - Since $today will be used in either case, move it
# out of the two if-blocks.
my @datearr = localtime(time());
- my $today = (1900+$datearr[5]).sprintf "%02d", ($datearr[4]+1).sprintf "%02d", $datearr[3];
+ my $today = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]);
# FIXME - MySQL knows about dates. Just use
# and issues.timestamp < curdate();
$crit=" and !(issues.timestamp like '$today%') ";
@@ -1610,28 +1607,15 @@
# FIXME - Does the caller really need every single field from all
# four tables?
- my $sth=$dbh->prepare("select * from issues,items,biblioitems,biblio where
+ my $sth=$dbh->prepare("select * from issues,items where
borrowernumber=? and issues.itemnumber=items.itemnumber and
- items.biblionumber=biblio.biblionumber and
- items.biblioitemnumber=biblioitems.biblioitemnumber and returndate is null
+ returndate is null
$crit order by issues.date_due");
$sth->execute($borrowernumber);
while (my $data = $sth->fetchrow_hashref) {
- # FIXME - The Dewey code is a string, not a number.
- $data->{'dewey'}=~s/0*$//;
- ($data->{'dewey'} == 0) && ($data->{'dewey'}='');
- # FIXME - Could use
- # $todaysdate = POSIX::strftime("%Y%m%d", localtime)
- # or better yet, just reuse $today which was calculated above.
- # This function isn't going to run until midnight, is it?
- # Alternately, use
- # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime)
- # if ($data->{'date_due'} lt $todaysdate)
- # ...
- # Either way, the date should be be formatted outside of the
- # loop.
+
my @datearr = localtime(time());
- my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
+ my $todaysdate = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]);
my $datedue=$data->{'date_due'};
$datedue=~s/-//g;
if ($datedue < $todaysdate) {
@@ -1666,65 +1650,44 @@
=cut
#'
sub getissues {
-# New subroutine for Circ2.pm
my ($borrower) = @_;
my $dbh = C4::Context->dbh;
my $borrowernumber = $borrower->{'borrowernumber'};
my %currentissues;
- my $select = "SELECT items.*,issues.timestamp AS timestamp,
- issues.date_due AS date_due,
- items.barcode AS barcode,
- biblio.title AS title,
- biblio.author AS author,
- biblioitems.dewey AS dewey,
- itemtypes.description AS itemtype,
- biblioitems.subclass AS subclass,
- biblioitems.classification AS classification
- FROM issues,items,biblioitems,biblio, itemtypes
+ my $bibliodata;
+ my @results;
+ my @datearr = localtime(time());
+ my $todaysdate = (1900+$datearr[5])."-".sprintf ("%0.2d", ($datearr[4]+1))."-".sprintf ("%0.2d", $datearr[3]);
+ my $counter = 0;
+ my $select = "SELECT *
+ FROM issues,items
WHERE issues.borrowernumber = ?
AND issues.itemnumber = items.itemnumber
- AND items.biblionumber = biblio.biblionumber
- AND items.biblioitemnumber = biblioitems.biblioitemnumber
- AND itemtypes.itemtype = biblioitems.itemtype
AND issues.returndate IS NULL
- ORDER BY issues.date_due DESC";
+ ORDER BY issues.date_due";
# print $select;
my $sth=$dbh->prepare($select);
$sth->execute($borrowernumber);
- my $counter = 0;
while (my $data = $sth->fetchrow_hashref) {
- $data->{'dewey'} =~ s/0*$//;
- ($data->{'dewey'} == 0) && ($data->{'dewey'} = '');
- # FIXME - The Dewey code is a string, not a number.
- # FIXME - Use POSIX::strftime to get a text version of today's
- # date. That's what it's for.
- # FIXME - Move the date calculation outside of the loop.
- my @datearr = localtime(time());
- my $todaysdate = (1900+$datearr[5]).sprintf ("%0.2d", ($datearr[4]+1)).sprintf ("%0.2d", $datearr[3]);
-
- # FIXME - Instead of converting the due date to YYYYMMDD, just
- # use
- # $todaysdate = POSIX::strftime("%Y-%m-%d", localtime);
- # ...
- # if ($date->{date_due} lt $todaysdate)
- my $datedue = $data->{'date_due'};
- $datedue =~ s/-//g;
- if ($datedue < $todaysdate) {
- $data->{'overdue'} = 1;
+ my ($record)=MARCgetbiblio($dbh,$data->{biblionumber},1);
+ $bibliodata=MARCmarc2koha($dbh,$record,"biblios");
+ foreach my $field (keys %$data){
+ $bibliodata->{$field}=$data->{$field};
+ }
+ $bibliodata->{'date_due'} = $data->{'date_due'};
+ if ($bibliodata->{'date_due'} lt $todaysdate) {
+ $bibliodata->{'overdue'} = 1;
}
- $currentissues{$counter} = $data;
+ $currentissues{$counter} = $bibliodata;
$counter++;
- # FIXME - This is ludicrous. If you want to return an
- # array of values, just use an array. That's what
- # they're there for.
}
$sth->finish;
+
return(\%currentissues);
}
# Not exported
sub checkwaiting {
-#Stolen from Main.pm
# check for reserves waiting
my ($env,$dbh,$bornum)=@_;
my @itemswaiting;
@@ -1763,49 +1726,100 @@
sub renewstatus {
# check renewal status
- my ($env,$bornum,$itemno)=@_;
- my $dbh = C4::Context->dbh;
+ ##If system preference "strictrenewals" is used This script will try to return $renewok=2 or $renewok=3 as error messages
+ ##
+ my ($env,$bornum,$itemnumber)=@_;
+ my $dbh=C4::Context->dbh;
my $renews = 1;
- my $renewokay = 0;
+ my $resfound;
+ my $resrec;
+ my $renewokay; ##
# Look in the issues table for this item, lent to this borrower,
# and not yet returned.
-
+my $borrower=getpatroninformation($dbh,$bornum,undef);
+ if (C4::Context->preference("LibraryName") eq "NEU Grand Library"){
+ ## faculty members and privileged get renewal whatever the case may be
+ if ($borrower->{'categorycode'} eq 'F' ||$borrower->{'categorycode'} eq 'P'){
+ $renewokay = 1;
+ }
+ }
# FIXME - I think this function could be redone to use only one SQL call.
- my $sth1 = $dbh->prepare("select * from issues
+ my $sth1 = $dbh->prepare("select * from issues,items
where (borrowernumber = ?)
- and (itemnumber = ?)
- and returndate is null");
- $sth1->execute($bornum,$itemno);
+ and (issues.itemnumber = ?)
+ and returndate is null
+ and items.itemnumber=issues.itemnumber");
+ $sth1->execute($bornum,$itemnumber);
if (my $data1 = $sth1->fetchrow_hashref) {
# Found a matching item
- # See if this item may be renewed. This query is convoluted
- # because it's a bit messy: given the item number, we need to find
- # the biblioitem, which gives us the itemtype, which tells us
- # whether it may be renewed.
- my $sth2 = $dbh->prepare("SELECT renewalsallowed from items,biblioitems,itemtypes
- where (items.itemnumber = ?)
- and (items.biblioitemnumber = biblioitems.biblioitemnumber)
- and (biblioitems.itemtype = itemtypes.itemtype)");
- $sth2->execute($itemno);
+ # See if this item may be renewed.
+ my ($record)=MARCgetbiblio($dbh,$data1->{biblionumber});
+
+ my $bibliodata=MARCmarc2koha($dbh,$record,"biblios");
+ my $sth2 = $dbh->prepare("select renewalsallowed from itemtypes where itemtypes.itemtype=?");
+ $sth2->execute($bibliodata->{itemtype});
if (my $data2=$sth2->fetchrow_hashref) {
$renews = $data2->{'renewalsallowed'};
}
- if ($renews && $renews > $data1->{'renewals'}) {
- $renewokay = 1;
+ if ($renews > $data1->{'renewals'}) {
+ $renewokay= 1;
+ }else{
+ if (C4::Context->preference("strictrenewals")){
+ $renewokay=3 unless $renewokay==1;
+ }
}
$sth2->finish;
- my ($resfound, $resrec) = CheckReserves($itemno);
+ ($resfound, $resrec) = CheckReserves($itemnumber);
if ($resfound) {
+ if (C4::Context->preference("strictrenewals")){
+ $renewokay=4;
+ }else{
$renewokay = 0;
}
- ($resfound, $resrec) = CheckReserves($itemno);
+ }
+ }## item found
+ ($resfound, $resrec) = CheckReserves($itemnumber);
if ($resfound) {
+ if (C4::Context->preference("strictrenewals")){
+ $renewokay=4;
+ }else{
$renewokay = 0;
}
-
}
+# }
$sth1->finish;
+if (C4::Context->preference("strictrenewals")){
+ ### A new system pref "allowRenewalsBefore" prevents the renewal before a set amount of days left before expiry
+ ## Try to find whether book can be renewed at this date
+ my $loanlength;
+
+ my $allowRenewalsBefore = C4::Context->preference("allowRenewalsBefore");
+ my @nowarr = localtime(time);
+ my $now = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3];
+
+ # Find the issues record for this book###
+ my $sth=$dbh->prepare("select date_due from issues where itemnumber=? and returndate is null");
+ $sth->execute($itemnumber);
+ my $issuedata=$sth->fetchrow;
+ $sth->finish;
+
+ #calculates the date on the we are allowed to renew the item
+ $sth = $dbh->prepare("SELECT (DATE_SUB( ?, INTERVAL ? DAY))");
+ $sth->execute($issuedata, $allowRenewalsBefore);
+ my $startdate = $sth->fetchrow;
+
+ $sth->finish;
+ ### Fixme we have a Date_diff function use that
+ $sth = $dbh->prepare("SELECT DATEDIFF(CURRENT_DATE,?)");
+ $sth->execute($startdate);
+ my $difference = $sth->fetchrow;
+ $sth->finish;
+
+ if ($difference < 0) {
+ $renewokay=2 unless $renewokay==1;
+ }
+}##strictrenewals
return($renewokay);
}
@@ -1834,50 +1848,82 @@
=cut
sub renewbook {
+ my ($env,$bornum,$itemnumber,$datedue)=@_;
# mark book as renewed
- my ($env,$bornum,$itemno,$datedue)=@_;
- my $dbh = C4::Context->dbh;
- # If the due date wasn't specified, calculate it by adding the
- # book's loan length to today's date.
- if ($datedue eq "" ) {
- #debug_msg($env, "getting date");
- my $iteminformation = getiteminformation($env, $itemno,0);
+ my $loanlength;
+my $dbh=C4::Context->dbh;
+my $iteminformation = getiteminformation($env, $itemnumber,0);
+ my $sth=$dbh->prepare("select date_due from issues where itemnumber=? and returndate is null ");
+ $sth->execute($itemnumber);
+ my $issuedata=$sth->fetchrow;
+ $sth->finish;
+
+
+## We find a new datedue either from today or from the due_date of the book- if "strictrenewals" is in effect
+
+if ($datedue eq "" ) {
+
my $borrower = getpatroninformation($env,$bornum,0);
- my $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
- $datedue = UnixDate(DateCalc("today","$loanlength days"),"%Y-%m-%d");
+ $loanlength = getLoanLength($borrower->{'categorycode'},$iteminformation->{'itemtype'},$borrower->{'branchcode'});
+ if (C4::Context->preference("strictrenewals")){
+ my @nowarr = localtime(time);
+ my $now = (1900+$nowarr[5])."-".($nowarr[4]+1)."-".$nowarr[3];
+ if ($issuedata<=$now){
+
+ $datedue=$issuedata;
+ my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'});
+ my ($yeardue, $monthdue, $daydue) = split /-/, $datedue;
+ ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength);
+ $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue);
+ }
+ }## stricrenewals
+
+ if ($datedue eq "" ){## incase $datedue chnaged above
+
+ my @datearr = localtime();
+ $datedue = (1900+$datearr[5]).sprintf ("%02d", ($datearr[4]+1)).sprintf ("%02d", $datearr[3]);
+ my $calendar = C4::Calendar::Calendar->new(branchcode => $borrower->{'branchcode'});
+ my ($yeardue, $monthdue, $daydue) = split /-/, $datedue;
+ ($daydue, $monthdue, $yeardue) = $calendar->addDate($daydue, $monthdue, $yeardue, $loanlength);
+ $datedue = "$yeardue-".sprintf ("%0.2d", $monthdue)."-". sprintf("%0.2d",$daydue);
+
}
- # Find the issues record for this book
- my $sth=$dbh->prepare("select * from issues where borrowernumber=? and itemnumber=? and returndate is null");
- $sth->execute($bornum,$itemno);
- my $issuedata=$sth->fetchrow_hashref;
- $sth->finish;
+
+
# Update the issues record to have the new due date, and a new count
# of how many times it has been renewed.
- my $renews = $issuedata->{'renewals'} +1;
- $sth=$dbh->prepare("update issues set date_due = ?, renewals = ?
+ #my $renews = $issuedata->{'renewals'} +1;
+ $sth=$dbh->prepare("update issues set date_due = ?, renewals = renewals+1
where borrowernumber=? and itemnumber=? and returndate is null");
- $sth->execute($datedue,$renews,$bornum,$itemno);
+ $sth->execute($datedue,$bornum,$itemnumber);
$sth->finish;
+ ## Update items and marc record with new date -T.G
+ my $iteminformation = getiteminformation($env, $itemnumber,0);
+ &MARCmoditemonefield($dbh,$iteminformation->{'biblionumber'},$iteminformation->{'itemnumber'},'date_due',$datedue);
+
# Log the renewal
- UpdateStats($env,$env->{'branchcode'},'renew','','',$itemno);
+ UpdateStats($env,$env->{'branchcode'},'renew','','',$itemnumber);
# Charge a new rental fee, if applicable?
- my ($charge,$type)=calc_charges($env, $itemno, $bornum);
+ my ($charge,$type)=calc_charges($env, $itemnumber, $bornum);
if ($charge > 0){
my $accountno=getnextacctno($env,$bornum,$dbh);
- my $item=getiteminformation($env, $itemno);
$sth=$dbh->prepare("Insert into accountlines (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
values (?,?,now(),?,?,?,?,?)");
- $sth->execute($bornum,$accountno,$charge,"Renewal of Rental Item $item->{'title'} $item->{'barcode'}",'Rent',$charge,$itemno);
+ $sth->execute($bornum,$accountno,$charge,"Renewal of Rental Item $iteminformation->{'title'} $iteminformation->{'barcode'}",'Rent',$charge,$itemnumber);
$sth->finish;
# print $account;
+ }# end of rental charge
+
+
}
- # return();
+
+
}
@@ -1903,26 +1949,28 @@
sub calc_charges {
# calculate charges due
- my ($env, $itemno, $bornum)=@_;
+ my ($env, $itemnumber, $bornum)=@_;
my $charge=0;
my $dbh = C4::Context->dbh;
my $item_type;
+ my $sth= $dbh->prepare("select biblionumber from items where itemnumber=?");
+ $sth->execute($itemnumber);
+ my $data1=$sth->fetchrow;
+ $sth->finish;
+ my ($record)=MARCgetbiblio($dbh,$data1);
+ my $bibliodata=MARCmarc2koha($dbh,$record,"biblios");
# Get the book's item type and rental charge (via its biblioitem).
- my $sth1= $dbh->prepare("select itemtypes.itemtype,rentalcharge from items,biblioitems,itemtypes
- where (items.itemnumber =?)
- and (biblioitems.biblioitemnumber = items.biblioitemnumber)
- and (biblioitems.itemtype = itemtypes.itemtype)");
- $sth1->execute($itemno);
- if (my $data1=$sth1->fetchrow_hashref) {
- $item_type = $data1->{'itemtype'};
- $charge = $data1->{'rentalcharge'};
+ my $sth1= $dbh->prepare("select rentalcharge from itemtypes where itemtypes.itemtype=?");
+ $sth1->execute($bibliodata->{itemtype});
+
+ $charge = $sth1->fetchrow;
my $q2 = "select rentaldiscount from issuingrules,borrowers
where (borrowers.borrowernumber = ?)
and (borrowers.categorycode = issuingrules.categorycode)
and (issuingrules.itemtype = ?)";
my $sth2=$dbh->prepare($q2);
- $sth2->execute($bornum,$item_type);
+ $sth2->execute($bornum,$bibliodata->{itemtype});
if (my $data2=$sth2->fetchrow_hashref) {
my $discount = $data2->{'rentaldiscount'};
if ($discount eq 'NULL') {
@@ -1932,18 +1980,16 @@
# warn "discount is $discount";
}
$sth2->finish;
- }
$sth1->finish;
- return ($charge,$item_type);
+ return ($charge,$bibliodata->{itemtype});
}
-# FIXME - A virtually identical function appears in
-# C4::Circulation::Issues. Pick one and stick with it.
+
sub createcharge {
-#Stolen from Issues.pm
- my ($env,$dbh,$itemno,$bornum,$charge) = @_;
+
+ my ($env,$dbh,$itemnumber,$bornum,$charge) = @_;
my $nextaccntno = getnextacctno($env,$bornum,$dbh);
my $sth = $dbh->prepare(<<EOT);
INSERT INTO accountlines
@@ -1954,11 +2000,13 @@
now(), ?, 'Rental', 'Rent',
?)
EOT
- $sth->execute($bornum, $itemno, $nextaccntno, $charge, $charge);
+ $sth->execute($bornum, $itemnumber, $nextaccntno, $charge, $charge);
$sth->finish;
}
+
+
=item find_reserves
($status, $record) = &find_reserves($itemnumber);
@@ -1976,39 +2024,25 @@
#'
# FIXME - This API is bogus: just return the record, or undef if none
# was found.
-# FIXME - There's also a &C4::Circulation::Returns::find_reserves, but
-# that one looks rather different.
+
sub find_reserves {
-# Stolen from Returns.pm
- my ($itemno) = @_;
- my %env;
+ my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
- my ($itemdata) = getiteminformation(\%env, $itemno,0);
- my $bibno = $dbh->quote($itemdata->{'biblionumber'});
- my $bibitm = $dbh->quote($itemdata->{'biblioitemnumber'});
+ my ($itemdata) = getiteminformation("", $itemnumber,0);
my $sth = $dbh->prepare("select * from reserves where ((found = 'W') or (found is null)) and biblionumber = ? and cancellationdate is NULL order by priority, reservedate");
- $sth->execute($bibno);
+ $sth->execute($itemdata->{'biblionumber'});
my $resfound = 0;
my $resrec;
my $lastrec;
-# print $query;
# FIXME - I'm not really sure what's going on here, but since we
# only want one result, wouldn't it be possible (and far more
# efficient) to do something clever in SQL that only returns one
# set of values?
- while (($resrec = $sth->fetchrow_hashref) && (not $resfound)) {
- # FIXME - Unlike Pascal, Perl allows you to exit loops
- # early. Take out the "&& (not $resfound)" and just
- # use "last" at the appropriate point in the loop.
- # (Oh, and just in passing: if you'd used "!" instead
- # of "not", you wouldn't have needed the parentheses.)
+while ($resrec = $sth->fetchrow_hashref) {
$lastrec = $resrec;
- my $brn = $dbh->quote($resrec->{'borrowernumber'});
- my $rdate = $dbh->quote($resrec->{'reservedate'});
- my $bibno = $dbh->quote($resrec->{'biblionumber'});
if ($resrec->{'found'} eq "W") {
- if ($resrec->{'itemnumber'} eq $itemno) {
+ if ($resrec->{'itemnumber'} eq $itemnumber) {
$resfound = 1;
}
} else {
@@ -2016,11 +2050,12 @@
if ($resrec->{'constrainttype'} eq "a") {
$resfound = 1;
} else {
- my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?");
- $consth->execute($brn,$rdate,$bibno,$bibitm);
+ my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? ");
+ $consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
if (my $conrec = $consth->fetchrow_hashref) {
if ($resrec->{'constrainttype'} eq "o") {
$resfound = 1;
+
}
}
$consth->finish;
@@ -2028,9 +2063,9 @@
}
if ($resfound) {
my $updsth = $dbh->prepare("update reserves set found = 'W', itemnumber = ? where borrowernumber = ? and reservedate = ? and biblionumber = ?");
- $updsth->execute($itemno,$brn,$rdate,$bibno);
+ $updsth->execute($itemnumber,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
$updsth->finish;
- # FIXME - "last;" here to break out of the loop early.
+ last;
}
}
$sth->finish;
@@ -2041,8 +2076,7 @@
my ($year, $month, $day) = @_;
my $invalidduedate;
my $date;
- if ($year && $month && $day){
- if (($year eq 0 ) && ($month eq 0) && ($year eq 0)) {
+ if (($year eq 0) && ($month eq 0) && ($year eq 0)) {
# $env{'datedue'}='';
} else {
if (($year eq 0) || ($month eq 0) || ($year eq 0)) {
@@ -2050,21 +2084,16 @@
} else {
if (($day>30) && (($month==4) || ($month==6) || ($month==9) || ($month==11))) {
$invalidduedate = 1;
- }
- elsif (($day > 29) && ($month == 2)) {
+ } elsif (($day > 29) && ($month == 2)) {
$invalidduedate=1;
- }
- elsif (($month == 2) && ($day > 28) && (($year%4) && ((!($year%100) || ($year%400))))) {
+ } elsif (($month == 2) && ($day > 28) && (($year%4) && ((!($year%100) || ($year%400))))) {
$invalidduedate=1;
- }
- else {
+ } else {
$date="$year-$month-$day";
}
}
}
- }
return ($date, $invalidduedate);
-
}
sub get_current_return_date_of {
@@ -2182,6 +2211,16 @@
return (@tranferts);
}
+##Utility date function to prevent dependency on Date::Manip
+sub DATE_diff {
+my ($date1,$date2)=@_;
+my $dbh=C4::Context->dbh;
+my $sth = $dbh->prepare("SELECT DATEDIFF(?,?)");
+ $sth->execute($date1,$date2);
+ my $difference = $sth->fetchrow;
+ $sth->finish;
+return $difference;
+}
1;
__END__
@@ -2193,4 +2232,3 @@
Koha Developement team <info at koha.org>
=cut
-
Index: Circulation/Fines.pm
===================================================================
RCS file: /sources/koha/koha/C4/Circulation/Fines.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -b -r1.14 -r1.15
--- Circulation/Fines.pm 12 Jul 2006 09:15:26 -0000 1.14
+++ Circulation/Fines.pm 25 Aug 2006 21:07:08 -0000 1.15
@@ -1,6 +1,6 @@
package C4::Circulation::Fines;
-# $Id: Fines.pm,v 1.14 2006/07/12 09:15:26 rangi Exp $
+# $Id: Fines.pm,v 1.15 2006/08/25 21:07:08 tgarip1957 Exp $
# Copyright 2000-2002 Katipo Communications
#
@@ -21,8 +21,9 @@
use strict;
require Exporter;
-use DBI;
+
use C4::Context;
+use C4::Biblio;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
@@ -48,8 +49,7 @@
=cut
@ISA = qw(Exporter);
- at EXPORT = qw(&Getoverdues &CalcFine &BorType &UpdateFine &ReplacementCost
- GetFine, ReplacementCost2);
+ at EXPORT = qw(&Getoverdues &CalcFine &BorType &UpdateFine &ReplacementCost &GetFine &ReplacementCost2);
=item Getoverdues
@@ -64,28 +64,20 @@
Koha database.
=cut
-
#'
-sub Getoverdues {
+sub Getoverdues{
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "Select * from issues where date_due < now() and returndate is
- NULL order by borrowernumber"
- );
+ my $sth=$dbh->prepare("Select * from issues where date_due < now() and returndate is NULL order by borrowernumber");
$sth->execute;
-
# FIXME - Use push @results
- my $i = 0;
+ my $i=0;
my @results;
- while ( my $data = $sth->fetchrow_hashref ) {
- $results[$i] = $data;
+ while (my $data=$sth->fetchrow_hashref){
+ push @results,$data;
$i++;
}
$sth->finish;
-
- # print @results;
- # FIXME - Bogus API.
- return ( $i, \@results );
+ return($i,\@results);
}
=item CalcFine
@@ -111,7 +103,7 @@
Note that the way this function is currently implemented, it only
returns a nonzero value on the notable days listed above. That is, if
-the categoryitems entry says to send a first reminder 7 days after the
+the issuingruless entry says to send a first reminder 7 days after the
book is due, then if you call C<&CalcFine> 7 days after the book is
due, it will give a nonzero fine. If you call C<&CalcFine> the next
day, however, it will say that the fine is 0.
@@ -129,49 +121,42 @@
C<$amount> is the fine owed by the patron (see above).
C<$chargename> is the chargename field from the applicable record in
-the categoryitem table, whatever that is.
+the issuingrules table, whatever that is.
C<$message> is a text message, either "First Notice", "Second Notice",
or "Final Notice".
=cut
-
#'
sub CalcFine {
- my ( $itemnumber, $bortype, $difference ) = @_;
+ my ($itemnumber,$bortype,$difference)=@_;
my $dbh = C4::Context->dbh;
-
- # Look up the categoryitem record for this book's item type and the
+ # Look up the issuingrules record for this book's item type and the
# given borrwer type.
# The reason this query is so messy is that it's a messy question:
# given the barcode, we can find the book's items record. This gives
- # us the biblioitems record, which gives us a set of categoryitem
+ # us the biblio record, which gives us a set of issuingrules
# records. Then we select the one that corresponds to the desired
# borrower type.
# FIXME - Is it really necessary to get absolutely everything from
# all four tables? It looks as if this code only wants
# firstremind, chargeperiod, accountsent, and chargename from the
- # categoryitem table.
-
- my $sth = $dbh->prepare(
-"SELECT * FROM items,biblioitems,itemtypes,issuingrules
- WHERE items.itemnumber=?
- AND items.biblioitemnumber=biblioitems.biblioitemnumber
- AND biblioitems.itemtype=itemtypes.itemtype
- AND issuingrules.itemtype=itemtypes.itemtype
- AND issuingrules.categorycode=? AND (items.itemlost <> 1 OR items.itemlost is NULL)"
- );
-
- # print $query;
- $sth->execute( $itemnumber, $bortype );
- my $data = $sth->fetchrow_hashref;
+ # issuingrules table.
+ my $sth=$dbh->prepare("Select * from items,biblio,itemtypes,issuingrules where items.itemnumber=?
+ and items.biblionumber=biblio.biblionumber and
+ biblio.itemtype=itemtypes.itemtype and
+ issuingrules.itemtype=itemtypes.itemtype and
+ issuingrules.categorycode=? ");
+# print $query;
+ $sth->execute($itemnumber,$bortype);
+ my $data=$sth->fetchrow_hashref;
# FIXME - Error-checking: the item might be lost, or there
- # might not be an entry in 'categoryitem' for this item type
+ # might not be an entry in 'issuingrules' for this item type
# or borrower type.
$sth->finish;
- my $amount = 0;
+ my $amount=0;
my $printout;
# Is it time to send out the first reminder?
@@ -186,32 +171,29 @@
# the first thing the patron gets is a second notice, but that's a
# week after the server crash, so people may not connect the two
# events.
- if ( $difference == $data->{'firstremind'} ) {
-
+ if ($difference >= $data->{'firstremind'}){
# Yes. Set the fine as listed.
- $amount = $data->{'fine'};
- $printout = "First Notice";
+ $amount=$data->{'fine'}* $difference;
+ $printout="First Notice";
}
# Is it time to send out a second reminder?
- my $second = $data->{'firstremind'} + $data->{'chargeperiod'};
- if ( $difference == $second ) {
-
- # Yes. The fine is double.
- $amount = $data->{'fine'} * 2;
- $printout = "Second Notice";
- }
+# my $second=$data->{'firstremind'}+$data->{'chargeperiod'};
+# if ($difference == $second){
+# # Yes. The fine is double.
+# $amount=$data->{'fine'}*2;
+# $printout="Second Notice";
+# }
# Is it time to send the account to a collection agency?
# FIXME - At least, I *think* that's what this code is doing.
- if ( $difference == $data->{'accountsent'} && $data->{'fine'} > 0 ) {
-
+ if ($difference == $data->{'accountsent'} && $data->{'fine'} > 0){
# Yes. Set the fine at 5 local monetary units.
# FIXME - This '5' shouldn't be hard-wired.
- $amount = 5;
- $printout = "Final Notice";
+ $amount=$data->{'fine'}* $difference;
+ $printout="Final Notice";
}
- return ( $amount, $data->{'chargename'}, $printout );
+ return($amount,$data->{'chargename'},$printout);
}
=item UpdateFine
@@ -239,88 +221,76 @@
accountlines table of the Koha database.
=cut
-
#'
# FIXME - This API doesn't look right: why should the caller have to
# specify both the item number and the borrower number? A book can't
# be on loan to two different people, so the item number should be
# sufficient.
sub UpdateFine {
- my ( $itemnum, $bornum, $amount, $type, $due ) = @_;
+ my ($itemnum,$bornum,$amount,$type,$due)=@_;
my $dbh = C4::Context->dbh;
-
# FIXME - What exactly is this query supposed to do? It looks up an
# entry in accountlines that matches the given item and borrower
# numbers, where the description contains $due, and where the
# account type has one of several values, but what does this _mean_?
# Does it look up existing fines for this item?
# FIXME - What are these various account types? ("FU", "O", "F", "M")
- my $sth = $dbh->prepare(
- "Select * from accountlines where itemnumber=? and
- borrowernumber=? and (accounttype='FU' or accounttype='O' or
- accounttype='F' or accounttype='M') and description like ?"
- );
- $sth->execute( $itemnum, $bornum, "%$due%" );
- if ( my $data = $sth->fetchrow_hashref ) {
+ my $sth=$dbh->prepare("Select * from accountlines where itemnumber=? and
+ borrowernumber=? and (accounttype='FU' or accounttype='O' or
+ accounttype='F' or accounttype='M') ");
+ $sth->execute($itemnum,$bornum);
+ if (my $data=$sth->fetchrow_hashref){
# I think this if-clause deals with the case where we're updating
# an existing fine.
- # print "in accounts ...";
- if ( $data->{'amount'} != $amount ) {
+# print "in accounts ...";
+ if ($data->{'amount'} != $amount){
- # print "updating";
- my $diff = $amount - $data->{'amount'};
- my $out = $data->{'amountoutstanding'} + $diff;
- my $sth2 = $dbh->prepare(
- "update accountlines set date=now(), amount=?,
+# print "updating";
+ my $diff=$amount - $data->{'amount'};
+ my $out=$data->{'amountoutstanding'}+$diff;
+ my $sth2=$dbh->prepare("update accountlines set date=now(), amount=?,
amountoutstanding=?,accounttype='FU' where
- borrowernumber=? and itemnumber=?
- and (accounttype='FU' or accounttype='O') and description like ?"
- );
- $sth2->execute( $amount, $out, $data->{'borrowernumber'},
- $data->{'itemnumber'}, "%$due%" );
+ accountno=?");
+ $sth2->execute($amount,$out,$data->{'accountno'});
$sth2->finish;
+ } else {
+ print "no update needed $data->{'amount'} \n";
}
- else {
-
- # print "no update needed $data->{'amount'}"
- }
- }
- else {
-
+ } else {
# I think this else-clause deals with the case where we're adding
# a new fine.
- my $sth4 = $dbh->prepare(
- "select title from biblio,items where items.itemnumber=?
- and biblio.biblionumber=items.biblionumber"
- );
+ my $sth4=$dbh->prepare("select biblio.marc from biblio ,items where items.itemnumber=?
+ and biblio.biblionumber=items.biblionumber");
$sth4->execute($itemnum);
- my $title = $sth4->fetchrow_hashref;
+ my $marc=$sth4->fetchrow;
$sth4->finish;
-
+my $record=MARC::File::USMARC::decode($marc,\&func_title);
+my $title=$record->title();
# print "not in account";
- my $sth3 = $dbh->prepare("Select max(accountno) from accountlines");
+ my $sth3=$dbh->prepare("Select max(accountno) from accountlines");
$sth3->execute;
-
# FIXME - Make $accountno a scalar.
- my @accountno = $sth3->fetchrow_array;
+ my $accountno=$sth3->fetchrow;
$sth3->finish;
- $accountno[0]++;
- my $sth2 = $dbh->prepare(
- "Insert into accountlines
+ $accountno++;
+ my $sth2=$dbh->prepare("Insert into accountlines
(borrowernumber,itemnumber,date,amount,
description,accounttype,amountoutstanding,accountno) values
- (?,?,now(),?,?,'FU',?,?)"
- );
- $sth2->execute( $bornum, $itemnum, $amount,
- "$type $title->{'title'} $due",
- $amount, $accountno[0] );
+ (?,?,now(),?,?,'FU',?,?)");
+ $sth2->execute($bornum,$itemnum,$amount,"$type $title $due",$amount,$accountno);
$sth2->finish;
}
$sth->finish;
}
+ sub func_title {
+ my ($tagno,$tagdata) = @_;
+ my ($titlef,$subf)=&MARCfind_marc_from_kohafield("title","biblios");
+ return ($tagno == $titlef );
+ }
+
=item BorType
$borrower = &BorType($borrowernumber);
@@ -333,20 +303,17 @@
category he or she belongs to.
=cut
-
#'
sub BorType {
- my ($borrowernumber) = @_;
+ my ($borrowernumber)=@_;
my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare(
- "Select * from borrowers,categories where
+ my $sth=$dbh->prepare("Select * from borrowers,categories where
borrowernumber=? and
-borrowers.categorycode=categories.categorycode"
- );
+borrowers.categorycode=categories.categorycode");
$sth->execute($borrowernumber);
- my $data = $sth->fetchrow_hashref;
+ my $data=$sth->fetchrow_hashref;
$sth->finish;
- return ($data);
+ return($data);
}
=item ReplacementCost
@@ -356,21 +323,14 @@
Returns the replacement cost of the item with the given item number.
=cut
-
#'
-sub ReplacementCost {
- my ($itemnum) = @_;
+sub ReplacementCost{
+ my ($itemnumber)=@_;
my $dbh = C4::Context->dbh;
- my $sth =
- $dbh->prepare("Select replacementprice from items where itemnumber=?");
- $sth->execute($itemnum);
-
- # FIXME - Use fetchrow_array or something.
- my $data = $sth->fetchrow_hashref;
- $sth->finish;
- return ( $data->{'replacementprice'} );
+ my ($itemrecord)=MARCgetitem($dbh,$itemnumber);
+ my $data=MARCmarc2koha($dbh,$itemrecord,"holdings");
+ return($data->{'replacementprice'});
}
-
sub GetFine {
my ( $itemnum, $bornum ) = @_;
my $dbh = C4::Context->dbh();
@@ -397,7 +357,6 @@
$sth->finish();
$dbh->disconnect();
return ( $data->{'amountoutstanding'} );
-}
1;
__END__
Index: Interface/CGI/Output.pm
===================================================================
RCS file: /sources/koha/koha/C4/Interface/CGI/Output.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- Interface/CGI/Output.pm 15 Mar 2006 11:21:56 -0000 1.4
+++ Interface/CGI/Output.pm 25 Aug 2006 21:07:08 -0000 1.5
@@ -1,6 +1,6 @@
package C4::Interface::CGI::Output;
-# $Id: Output.pm,v 1.4 2006/03/15 11:21:56 plg Exp $
+# $Id: Output.pm,v 1.5 2006/08/25 21:07:08 tgarip1957 Exp $
#package to work around problems in HTTP headers
# Note: This is just a utility module; it should not be instantiated.
@@ -22,10 +22,9 @@
# You should have received a copy of the GNU General Public License along with
# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
# Suite 330, Boston, MA 02111-1307 USA
-
use strict;
require Exporter;
-
+use open ':utf8';
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
@@ -37,9 +36,9 @@
=head1 SYNOPSIS
- use C4::CGI::Output;
+ use C4::Interface::CGI::Output;
- print $query->header(-type => C4::CGI::Output::gettype($output)), $output;
+ print $query->header(-type => "text/html"), $output;
=head1 DESCRIPTION
@@ -53,46 +52,12 @@
=cut
@ISA = qw(Exporter);
- at EXPORT = qw(
- &guesscharset
- &guesstype
- &output_html_with_http_headers
+ at EXPORT = qw( &output_html_with_http_headers
);
-=item guesscharset
-
- &guesscharset($output)
-
-"Guesses" the charset from the some HTML that would be output.
-C<$output> is the HTML page to be output. If it contains a META tag
-with a Content-Type, the tag will be scanned for a language code.
-This code is returned if it is found; undef is returned otherwise.
-This function only does sloppy guessing; it will be confused by
-unexpected things like SGML comments. What it basically does is to
-grab something that looks like a META tag and scan it.
-=cut
-
-sub guesscharset ($) {
- my($html) = @_;
- my $charset = undef;
- local($`, $&, $', $1, $2, $3);
- # FIXME... These regular expressions will miss a lot of valid tags!
- if ($html =~ /<meta\s+http-equiv=(["']?)Content-Type\1\s+content=(["'])text\/html\s*;\s*charset=([^\2\s\r\n]+)\2\s*(?:\/?)>/is) {
- $charset = $3;
- } elsif ($html =~ /<meta\s+content=(["'])text\/html\s*;\s*charset=([^\1\s\r\n]+)\1\s+http-equiv=(["']?)Content-Type\3\s*(?:\/?)>/is) {
- $charset = $2;
- }
- return $charset;
-} # guess
-
-sub guesstype ($) {
- my($html) = @_;
- my $charset = guesscharset($html);
- return defined $charset? "text/html; charset=$charset": "text/html";
-}
=item output_html_with_http_headers
@@ -105,9 +70,11 @@
=cut
sub output_html_with_http_headers ($$$) {
+
my($query, $cookie, $html) = @_;
print $query->header(
- -type => guesstype($html),
+ -type => "text/html",
+ -charset=>"UTF-8",
-cookie => $cookie,
), $html;
}
Index: Calendar/Calendar.pm
===================================================================
RCS file: Calendar/Calendar.pm
diff -N Calendar/Calendar.pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ Calendar/Calendar.pm 25 Aug 2006 21:07:09 -0000 1.2
@@ -0,0 +1,582 @@
+package C4::Calendar::Calendar;
+
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+require Exporter;
+use vars qw($VERSION @EXPORT);
+
+use C4::Context;
+
+#use Date::Calc;
+
+# set the version for version checking
+$VERSION = 0.01;
+
+=head1 NAME
+
+C4::Calendar::Calendar - Koha module dealing with holidays.
+
+=head1 SYNOPSIS
+
+ use C4::Calendar::Calendar;
+
+=head1 DESCRIPTION
+
+This package is used to deal with holidays. Through this package, you can set all kind of holidays for the library.
+
+=head1 FUNCTIONS
+
+=over 2
+
+=cut
+
+ at EXPORT = qw(&new
+ &change_branchcode
+ &get_week_days_holidays
+ &get_day_month_holidays
+ &get_exception_holidays
+ &get_single_holidays
+ &insert_week_day_holiday
+ &insert_day_month_holiday
+ &insert_single_holiday
+ &insert_exception_holiday
+ &delete_holiday
+ &isHoliday
+ &addDate
+ &daysBetween);
+
+=item new
+
+ $calendar = C4::Calendar::Calendar->new(branchcode => $branchcode);
+
+C<$branchcode> Is the branch code wich you want to use calendar.
+
+=cut
+
+sub new {
+ my $classname = shift @_;
+ my %options = @_;
+
+ my %hash;
+ my $self = bless(\%hash, $classname);
+
+ foreach my $optionName (keys %options) {
+ $self->{lc($optionName)} = $options{$optionName};
+ }
+
+ $self->_init;
+
+ return $self;
+}
+
+sub _init {
+ my $self = shift @_;
+
+ my $dbh = C4::Context->dbh();
+ my $week_days_sql = $dbh->prepare("select weekday, title, description from repeatable_holidays where ('$self->{branchcode}' = branchcode) and (NOT(ISNULL(weekday)))");
+ $week_days_sql->execute;
+ my %week_days_holidays;
+ while (my ($weekday, $title, $description) = $week_days_sql->fetchrow) {
+ $week_days_holidays{$weekday}{title} = $title;
+ $week_days_holidays{$weekday}{description} = $description;
+ }
+ $week_days_sql->finish;
+ $self->{'week_days_holidays'} = \%week_days_holidays;
+
+ my $day_month_sql = $dbh->prepare("select day, month, title, description from repeatable_holidays where ('$self->{branchcode}' = branchcode) and ISNULL(weekday)");
+ $day_month_sql->execute;
+ my %day_month_holidays;
+ while (my ($day, $month, $title, $description) = $day_month_sql->fetchrow) {
+ $day_month_holidays{"$month/$day"}{title} = $title;
+ $day_month_holidays{"$month/$day"}{description} = $description;
+ }
+ $day_month_sql->finish;
+ $self->{'day_month_holidays'} = \%day_month_holidays;
+
+ my $exception_holidays_sql = $dbh->prepare("select day, month, year, title, description from special_holidays where ('$self->{branchcode}' = branchcode) and (isexception = 1)");
+ $exception_holidays_sql->execute;
+ my %exception_holidays;
+ while (my ($day, $month, $year, $title, $description) = $exception_holidays_sql->fetchrow) {
+ $exception_holidays{"$year/$month/$day"}{title} = $title;
+ $exception_holidays{"$year/$month/$day"}{description} = $description;
+ }
+ $exception_holidays_sql->finish;
+ $self->{'exception_holidays'} = \%exception_holidays;
+
+ my $holidays_sql = $dbh->prepare("select day, month, year, title, description from special_holidays where ('$self->{branchcode}' = branchcode) and (isexception = 0)");
+ $holidays_sql->execute;
+ my %single_holidays;
+ while (my ($day, $month, $year, $title, $description) = $holidays_sql->fetchrow) {
+ $single_holidays{"$year/$month/$day"}{title} = $title;
+ $single_holidays{"$year/$month/$day"}{description} = $description;
+ }
+ $holidays_sql->finish;
+ $self->{'single_holidays'} = \%single_holidays;
+}
+
+=item change_branchcode
+
+ $calendar->change_branchcode(branchcode => $branchcode)
+
+Change the calendar branch code. This means to change the holidays structure.
+
+C<$branchcode> Is the branch code wich you want to use calendar.
+
+=cut
+
+sub change_branchcode {
+ my ($self, $branchcode) = @_;
+ my %options = @_;
+
+ foreach my $optionName (keys %options) {
+ $self->{lc($optionName)} = $options{$optionName};
+ }
+ $self->_init;
+
+ return $self;
+}
+
+=item get_week_days_holidays
+
+ $week_days_holidays = $calendar->get_week_days_holidays();
+
+Returns a hash reference to week days holidays.
+
+=cut
+
+sub get_week_days_holidays {
+ my $self = shift @_;
+ my $week_days_holidays = $self->{'week_days_holidays'};
+ return $week_days_holidays;
+}
+
+=item get_day_month_holidays
+
+ $day_month_holidays = $calendar->get_day_month_holidays();
+
+Returns a hash reference to day month holidays.
+
+=cut
+
+sub get_day_month_holidays {
+ my $self = shift @_;
+ my $day_month_holidays = $self->{'day_month_holidays'};
+ return $day_month_holidays;
+}
+
+=item get_exception_holidays
+
+ $exception_holidays = $calendar->exception_holidays();
+
+Returns a hash reference to exception holidays. This kind of days are those
+which stands for a holiday, but you wanted to make an exception for this particular
+date.
+
+=cut
+
+sub get_exception_holidays {
+ my $self = shift @_;
+ my $exception_holidays = $self->{'exception_holidays'};
+ return $exception_holidays;
+}
+
+=item get_single_holidays
+
+ $single_holidays = $calendar->get_single_holidays();
+
+Returns a hash reference to single holidays. This kind of holidays are those which
+happend just one time.
+
+=cut
+
+sub get_single_holidays {
+ my $self = shift @_;
+ my $single_holidays = $self->{'single_holidays'};
+ return $single_holidays;
+}
+
+=item insert_week_day_holiday
+
+ insert_week_day_holiday(weekday => $weekday,
+ title => $title,
+ description => $description);
+
+Inserts a new week day for $self->{branchcode}.
+
+C<$day> Is the week day to make holiday.
+
+C<$title> Is the title to store for the holiday formed by $year/$month/$day.
+
+C<$description> Is the description to store for the holiday formed by $year/$month/$day.
+
+=cut
+
+sub insert_week_day_holiday {
+ my $self = shift @_;
+ my %options = @_;
+
+ my $dbh = C4::Context->dbh();
+ my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ('', '$self->{branchcode}', $options{weekday}, NULL, NULL, '$options{title}', '$options{description}')");
+ $insertHoliday->execute;
+ $insertHoliday->finish;
+
+ $self->{'week_days_holidays'}->{$options{weekday}}{title} = $options{title};
+ $self->{'week_days_holidays'}->{$options{weekday}}{description} = $options{description};
+ return $self;
+}
+
+=item insert_day_month_holiday
+
+ insert_day_month_holiday(day => $day,
+ month => $month,
+ title => $title,
+ description => $description);
+
+Inserts a new day month holiday for $self->{branchcode}.
+
+C<$day> Is the day month to make the date to insert.
+
+C<$month> Is month to make the date to insert.
+
+C<$title> Is the title to store for the holiday formed by $year/$month/$day.
+
+C<$description> Is the description to store for the holiday formed by $year/$month/$day.
+
+=cut
+
+sub insert_day_month_holiday {
+ my $self = shift @_;
+ my %options = @_;
+
+ my $dbh = C4::Context->dbh();
+ my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ('', '$self->{branchcode}', NULL, $options{day}, $options{month}, '$options{title}', '$options{description}')");
+ $insertHoliday->execute;
+ $insertHoliday->finish;
+
+ $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title} = $options{title};
+ $self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description};
+ return $self;
+}
+
+=item insert_single_holiday
+
+ insert_single_holiday(day => $day,
+ month => $month,
+ year => $year,
+ title => $title,
+ description => $description);
+
+Inserts a new single holiday for $self->{branchcode}.
+
+C<$day> Is the day month to make the date to insert.
+
+C<$month> Is month to make the date to insert.
+
+C<$year> Is year to make the date to insert.
+
+C<$title> Is the title to store for the holiday formed by $year/$month/$day.
+
+C<$description> Is the description to store for the holiday formed by $year/$month/$day.
+
+=cut
+
+sub insert_single_holiday {
+ my $self = shift @_;
+ my %options = @_;
+
+ my $dbh = C4::Context->dbh();
+ my $isexception = 0;
+ my $insertHoliday = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', '$self->{branchcode}', $options{day}, $options{month}, $options{year}, $isexception, '$options{title}', '$options{description}')");
+ $insertHoliday->execute;
+ $insertHoliday->finish;
+
+ $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
+ $self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
+ return $self;
+}
+
+=item insert_exception_holiday
+
+ insert_exception_holiday(day => $day,
+ month => $month,
+ year => $year,
+ title => $title,
+ description => $description);
+
+Inserts a new exception holiday for $self->{branchcode}.
+
+C<$day> Is the day month to make the date to insert.
+
+C<$month> Is month to make the date to insert.
+
+C<$year> Is year to make the date to insert.
+
+C<$title> Is the title to store for the holiday formed by $year/$month/$day.
+
+C<$description> Is the description to store for the holiday formed by $year/$month/$day.
+
+=cut
+
+sub insert_exception_holiday {
+ my $self = shift @_;
+ my %options = @_;
+
+ my $dbh = C4::Context->dbh();
+ my $isexception = 1;
+ my $insertException = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', '$self->{branchcode}', $options{day}, $options{month}, $options{year}, $isexception, '$options{title}', '$options{description}')");
+ $insertException->execute;
+ $insertException->finish;
+
+ $self->{'exceptions_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
+ $self->{'exceptions_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
+ return $self;
+}
+
+=item delete_holiday
+
+ delete_holiday(weekday => $weekday
+ day => $day,
+ month => $month,
+ year => $year);
+
+Delete a holiday for $self->{branchcode}.
+
+C<$weekday> Is the week day to delete.
+
+C<$day> Is the day month to make the date to delete.
+
+C<$month> Is month to make the date to delete.
+
+C<$year> Is year to make the date to delete.
+
+=cut
+
+sub delete_holiday {
+ my $self = shift @_;
+ my %options = @_;
+
+ # Verify what kind of holiday that day is. For example, if it is
+ # a repeatable holiday, this should check if there are some exception
+ # for that holiday rule. Otherwise, if it is a regular holiday, it´s
+ # ok just deleting it.
+
+ my $dbh = C4::Context->dbh();
+ my $isSingleHoliday = $dbh->prepare("select id from special_holidays where (branchcode = '$self->{branchcode}') and (day = $options{day}) and (month = $options{month}) and (year = $options{year})");
+ $isSingleHoliday->execute;
+ if ($isSingleHoliday->rows) {
+ my $id = $isSingleHoliday->fetchrow;
+ $isSingleHoliday->finish; # Close the last query
+
+ my $deleteHoliday = $dbh->prepare("delete from special_holidays where (id = $id)");
+ $deleteHoliday->execute;
+ $deleteHoliday->finish; # Close the last query
+ delete($self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"});
+ } else {
+ $isSingleHoliday->finish; # Close the last query
+
+ my $isWeekdayHoliday = $dbh->prepare("select id from repeatable_holidays where (branchcode = '$self->{branchcode}') and (weekday = $options{weekday})");
+ $isWeekdayHoliday->execute;
+ if ($isWeekdayHoliday->rows) {
+ my $id = $isWeekdayHoliday->fetchrow;
+ $isWeekdayHoliday->finish; # Close the last query
+
+ my $updateExceptions = $dbh->prepare("update special_holidays set isexception = 0 where (WEEKDAY(CONCAT(special_holidays.year,'-',special_holidays.month,'-',special_holidays.day)) = $options{weekday}) and (branchcode = '$self->{branchcode}')");
+ $updateExceptions->execute;
+ $updateExceptions->finish; # Close the last query
+
+ my $deleteHoliday = $dbh->prepare("delete from repeatable_holidays where (id = $id)");
+ $deleteHoliday->execute;
+ $deleteHoliday->finish;
+ delete($self->{'week_days_holidays'}->{$options{weekday}});
+ } else {
+ $isWeekdayHoliday->finish; # Close the last query
+
+ my $isDayMonthHoliday = $dbh->prepare("select id from repeatable_holidays where (branchcode = '$self->{branchcode}') (day = $options{day}) and (month = $options{month})");
+ $isDayMonthHoliday->execute;
+ if ($isDayMonthHoliday->rows) {
+ my $id = $isDayMonthHoliday->fetchrow;
+ $isDayMonthHoliday->finish;
+ my $updateExceptions = $dbh->prepare("update special_holidays set isexception = 0 where (special_holidays.branchcode = '$self->{branchcode}') and (special_holidays.day = $options{day}) and (special_holidays.month = $options{month})");
+ $updateExceptions->execute;
+ $updateExceptions->finish; # Close the last query
+
+ my $deleteHoliday = $dbh->prepare("delete from repeatable_holidays where (id = $id)");
+ $deleteHoliday->execute;
+ $deleteHoliday->finish; # Close the last query
+ $isDayMonthHoliday->finish; # Close the last query
+ delete($self->{'day_month_holidays'}->{"$options{month}/$options{day}"});
+ }
+ }
+ }
+ return $self;
+}
+
+=item isHoliday
+
+ $isHoliday = isHoliday($day, $month $year);
+
+
+C<$day> Is the day to check wether if is a holiday or not.
+
+C<$month> Is the month to check wether its a holiday or not.
+
+C<$year> Is the year to check wether if its a holiday or not.
+
+=cut
+
+sub isHoliday {
+ my ($self, $day, $month, $year) = @_;
+
+ my $weekday = Date_DayOfWeek($month, $day, $year) % 7;
+ my $weekDays = $self->get_week_days_holidays();
+ my $dayMonths = $self->get_day_month_holidays();
+ my $exceptions = $self->get_exception_holidays();
+ my $singles = $self->get_single_holidays();
+
+ if (defined($exceptions->{"$year/$month/$day"})) {
+ return 0;
+ } else {
+ if ((exists($weekDays->{$weekday})) ||
+ (exists($dayMonths->{"$month/$day"})) ||
+ (exists($singles->{"$year/$month/$day"}))) {
+ return 1;
+ } else {
+ return 0;
+ }
+ }
+
+}
+
+=item addDate
+
+ my ($day, $month, $year) = $calendar->addDate($day, $month, $year, $offset)
+
+C<$day> Is the starting day of the interval.
+
+C<$month> Is the starting month of the interval.
+
+C<$year> Is the starting year of the interval.
+
+C<$offset> Is the number of days that this function has to count from $date.
+
+=cut
+
+sub addDate {
+ my ($self, $day, $month, $year, $offset) = @_;
+ if ($offset < 0) { # In case $offset is negative
+ $offset = $offset*(-1);
+ }
+
+ my $daysMode = C4::Context->preference('useDaysMode');
+ if ($daysMode eq 'normal') {
+ ($year, $month, $day) = Add_Delta_Days($year, $month, $day, ($offset - 1));
+ } else {
+ while ($offset > 0) {
+ if (!($self->isHoliday($day, $month, $year))) {
+ $offset = $offset - 1;
+ }
+ if ($offset > 0) {
+ ($year, $month, $day) = Add_Delta_Days($year, $month, $day, 1);
+ }
+ }
+ }
+ return($day, $month, $year);
+}
+
+=item daysBetween
+
+ my $daysBetween = $calendar->daysBetween($dayFrom, $monthFrom, $yearFrom,
+ $dayTo, $monthTo, $yearTo)
+
+C<$dayFrom> Is the starting day of the interval.
+
+C<$monthFrom> Is the starting month of the interval.
+
+C<$yearFrom> Is the starting year of the interval.
+
+C<$dayTo> Is the ending day of the interval.
+
+C<$monthTo> Is the ending month of the interval.
+
+C<$yearTo> Is the ending year of the interval.
+
+=cut
+
+sub daysBetween {
+ my ($self, $dayFrom, $monthFrom, $yearFrom, $dayTo, $monthTo, $yearTo) = @_;
+
+ my $daysMode = C4::Context->preference('useDaysMode');
+ my $count = 1;
+ my $continue = 1;
+ if ($daysMode eq 'normal') {
+ while ($continue) {
+ if (($yearFrom != $yearTo) || ($monthFrom != $monthTo) || ($dayFrom != $dayTo)) {
+ ($yearFrom, $monthFrom, $dayFrom) = Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1);
+ $count++;
+ } else {
+ $continue = 0;
+ }
+ }
+ } else {
+ while ($continue) {
+ if (($yearFrom != $yearTo) || ($monthFrom != $monthTo) || ($dayFrom != $dayTo)) {
+ if (!($self->isHoliday($dayFrom, $monthFrom, $yearFrom))) {
+ $count++;
+ }
+ ($yearFrom, $monthFrom, $dayFrom) = Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1);
+ } else {
+ $continue = 0;
+ }
+ }
+ }
+ return($count);
+}
+
+sub Date_DayOfWeek{
+my ($month, $day, $year)=@_;
+my $date=$year."-".$month."-".$day;
+my $dbh=C4::Context->dbh;
+my $sth=$dbh->prepare("SELECT DAYOFWEEK(?)");
+$sth->execute($date);
+my $dayofweek=$sth->fetchrow;
+return $dayofweek;
+}
+
+sub Add_Delta_Days{
+my ($year, $month, $day, $offset)=@_;
+my $date=$year."-".$month."-".$day;
+my $dbh=C4::Context->dbh;
+my $sth=$dbh->prepare(" SELECT DATE_ADD(?, INTERVAL ? DAY)");
+$sth->execute($date,$offset);
+ $date=$sth->fetchrow;
+ ($year, $month, $day)=split /-/,$date;
+return ($year, $month, $day);
+}
+
+
+
+1;
+
+__END__
+
+=back
+
+=head1 AUTHOR
+
+Koha Physics Library UNLP <matias_veleda at hotmail.com>
+Modified by Tumer Garip NUE Grand Library --No more Date::Manip
+=cut
\ No newline at end of file
Index: Circulation/Returns.pm
===================================================================
RCS file: Circulation/Returns.pm
diff -N Circulation/Returns.pm
--- Circulation/Returns.pm 12 Jul 2006 14:07:03 -0000 1.10
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,334 +0,0 @@
-package C4::Circulation::Returns;
-
-# $Id: Returns.pm,v 1.10 2006/07/12 14:07:03 btoumi Exp $
-
-#package to deal with Returns
-#written 3/11/99 by olwen at katipo.co.nz
-
-
-# Copyright 2000-2002 Katipo Communications
-#
-# This file is part of Koha.
-#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
-#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
-
-# FIXME - None of the functions (certainly none of the exported
-# functions) are used anywhere anymore. Presumably this module is
-# obsolete.
-
-use strict;
-require Exporter;
-use DBI;
-use C4::Context;
-use C4::Accounts2;
-use C4::InterfaceCDK;
-use C4::Circulation::Main;
- # FIXME - C4::Circulation::Main and C4::Circulation::Returns
- # use each other, so functions get redefined.
-use C4::Scan;
-use C4::Stats;
-use C4::Members;
-use C4::Print;
-use C4::Biblio;
-
-use vars qw($VERSION @ISA @EXPORT);
-
-# set the version for version checking
-$VERSION = 0.01;
-
- at ISA = qw(Exporter);
- at EXPORT = qw(&returnrecord &calc_odues &Returns);
-
-# FIXME - This is only used in C4::Circmain and C4::Circulation, both
-# of which appear to be obsolete. Presumably this function is obsolete
-# as well.
-# Otherwise, it needs a POD.
-sub Returns {
- my ($env)=@_;
- my $dbh = C4::Context->dbh;
- my @items;
- @items[0]=" "x50;
- my $reason;
- my $item;
- my $reason;
- my $borrower;
- my $itemno;
- my $itemrec;
- my $bornum;
- my $amt_owing;
- my $odues;
- my $issues;
- my $resp;
-# until (($reason eq "Circ") || ($reason eq "Quit")) {
- until ($reason ne "") {
- ($reason,$item) =
- returnwindow($env,"Enter Returns",
- $item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation
- #debug_msg($env,"item = $item");
- #if (($reason ne "Circ") && ($reason ne "Quit")) {
- if ($reason eq "") {
- $resp = "";
- ($resp,$bornum,$borrower,$itemno,$itemrec,$amt_owing) =
- checkissue($env,$dbh,$item);
- if ($bornum ne "") {
- ($issues,$odues,$amt_owing) = borrdata2($env,$bornum);
- } else {
- $issues = "";
- $odues = "";
- $amt_owing = "";
- }
- if ($resp ne "") {
- #if ($resp eq "Returned") {
- if ($itemno ne "" ) {
- my $item = getbibliofromitemnumber($env,$dbh,$itemno);
- # FIXME - This relies on C4::Circulation::Main to have a
- # "use C4::Circulation::Issues;" line, which is bogus.
- my $fmtitem = C4::Circulation::Issues::formatitem($env,$item,"",$amt_owing);
- unshift @items,$fmtitem;
- if ($items[20] > "") {
- pop @items;
- }
- }
- #} elsif ($resp ne "") {
- # error_msg($env,"$resp");
- #}
- #if ($resp ne "Returned") {
- # error_msg($env,"$resp");
- # $bornum = "";
- #}
- }
- }
- }
-# clearscreen;
- return($reason);
- }
-
-# FIXME - Only used in &Returns and in telnet/doreturns.pl, both of
-# which appear obsolete. Presumably this function is obsolete as well.
-# Otherwise, it needs a POD.
-sub checkissue {
- my ($env,$dbh, $item) = @_;
- my $reason='Circ';
- my $bornum;
- my $borrower;
- my $itemno;
- my $itemrec;
- my $amt_owing;
- $item = uc $item;
- my $sth=$dbh->prepare("select * from items,biblio
- where barcode = ?
- and (biblio.biblionumber=items.biblionumber)");
- $sth->execute($item);
- if ($itemrec=$sth->fetchrow_hashref) {
- $sth->finish;
- $itemno = $itemrec->{'itemnumber'};
- my $sth=$dbh->prepare("select * from issues
- where (itemnumber=?)
- and (returndate is null)");
- $sth->execute($itemrec->{'itemnumber'});
- if (my $issuerec=$sth->fetchrow_hashref) {
- $sth->finish;
- my $sth= $dbh->prepare("select * from borrowers where
- (borrowernumber = ?)");
- $sth->execute($issuerec->{'borrowernumber'});
- $env->{'bornum'}=$issuerec->{'borrowernumber'};
- $borrower = $sth->fetchrow_hashref;
- $bornum = $issuerec->{'borrowernumber'};
- $itemno = $issuerec->{'itemnumber'};
- $amt_owing = returnrecord($env,$dbh,$bornum,$itemno);
- $reason = "Returned";
- } else {
- $sth->finish;
- updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
- $reason = "Item not issued";
- }
- my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
- if ($resfound eq "y") {
- my $btsh = $dbh->prepare("select * from borrowers
- where borrowernumber = ?");
- $btsh->execute($resrec->{'borrowernumber'});
- my $resborrower = $btsh->fetchrow_hashref;
- #printreserve($env,$resrec,$resborrower,$itemrec);
- my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
- C4::InterfaceCDK::error_msg($env,$mess);
- $btsh->finish;
- }
- } else {
- $sth->finish;
- $reason = "Item not found";
- }
- return ($reason,$bornum,$borrower,$itemno,$itemrec,$amt_owing);
- # end checkissue
- }
-
-# FIXME - Only used in &C4::Circulation::Main::previousissue,
-# &checkissue, C4/Circulation.pm, and tkperl/tkcirc, all of which
-# appear to be obsolete. Presumably this function is obsolete as well.
-# Otherwise, it needs a POD.
-sub returnrecord {
- # mark items as returned
- my ($env,$dbh,$bornum,$itemno)=@_;
- #my $amt_owing = calc_odues($env,$dbh,$bornum,$itemno);
- my @datearr = localtime(time);
- my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
- my $sth = $dbh->prepare("update issues set returndate = now(), branchcode = ? where
- (borrowernumber = ?) and (itemnumber = ?)
- and (returndate is null)");
- $sth->execute($env->{'branchcode'},$bornum,$itemno);
- $sth->finish;
- updatelastseen($env,$dbh,$itemno);
- # check for overdue fine
- my $oduecharge;
- my $sth = $dbh->prepare("select * from accountlines
- where (borrowernumber = ?)
- and (itemnumber = ?)
- and (accounttype = 'FU' or accounttype='O')");
- $sth->execute($bornum,$itemno);
- if (my $data = $sth->fetchrow_hashref) {
- # alter fine to show that the book has been returned.
- my $usth = $dbh->prepare("update accountlines
- set accounttype = 'F'
- where (borrowernumber = ?)
- and (itemnumber = ?)
- and (accountno = ?) ");
- $usth->execute($bornum,$itemno,$data->{'accountno'});
- $usth->finish();
- $oduecharge = $data->{'amountoutstanding'};
- }
- $sth->finish;
- # check for charge made for lost book
- my $sth = $dbh->prepare("select * from accountlines
- where (borrowernumber = ?)
- and (itemnumber = ?)
- and (accounttype = 'L')");
- $sth->execute($bornum,$itemno);
- if (my $data = $sth->fetchrow_hashref) {
- # writeoff this amount
- my $offset;
- my $amount = $data->{'amount'};
- my $acctno = $data->{'accountno'};
- my $amountleft;
- if ($data->{'amountoutstanding'} == $amount) {
- $offset = $data->{'amount'};
- $amountleft = 0;
- } else {
- $offset = $amount - $data->{'amountoutstanding'};
- $amountleft = $data->{'amountoutstanding'} - $amount;
- }
- my $usth = $dbh->prepare("update accountlines
- set accounttype = 'LR',amountoutstanding='0'
- where (borrowernumber = ?)
- and (itemnumber = ?)
- and (accountno = ?) ");
- $usth->execute($bornum,$itemno,$acctno);
- $usth->finish;
- my $nextaccntno = C4::Accounts::getnextacctno($env,$bornum,$dbh);
- $usth = $dbh->prepare("insert into accountlines
- (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
- values (?,?,now(),?,'Book Returned','CR',?)");
- $usth->execute($bornum,$nextaccntno,0-$amount,$amountleft);
- $usth->finish;
- $uquery = "insert into accountoffsets
- (borrowernumber, accountno, offsetaccount, offsetamount)
- values (?,?,?,?)";
- $usth = $dbh->prepare("");
- $usth->execute($bornum,$data->{'accountno'},$nextaccntno,$offset);
- $usth->finish;
- }
- $sth->finish;
- UpdateStats($env,'branch','return','0','',$itemno);
- return($oduecharge);
-}
-
-# FIXME - Only used in tkperl/tkcirc. Presumably this function is
-# obsolete.
-# Otherwise, it needs a POD.
-sub calc_odues {
- # calculate overdue fees
- my ($env,$dbh,$bornum,$itemno)=@_;
- my $amt_owing;
- return($amt_owing);
-}
-
-# This function is only used in &checkissue and &returnrecord, both of
-# which appear to be obsolete. So presumably this function is obsolete
-# too.
-# Otherwise, it needs a POD.
-sub updatelastseen {
- my ($env,$dbh,$itemnumber)= @_;
- my $br = $env->{'branchcode'};
- my $sth = $dbh->prepare("update items
- set datelastseen = now(), holdingbranch = ?
- where (itemnumber = ?)");
- $sth->execute($br,$itemnumber);
- $sth->finish;
-
-}
-
-
-# FIXME - There's also a &C4::Circulation::Circ2::find_reserves, but
-# that one looks rather different.
-# FIXME - This is only used in &checkissue, which appears to be
-# obsolete. So presumably this function is obsolete too.
-sub find_reserves {
- my ($env,$dbh,$itemno) = @_;
- my $itemdata = getbibliofromitemnumber($env,$dbh,$itemno);
- my $sth = $dbh->prepare("select * from reserves where found is null
- and biblionumber = ? and cancellationdate is NULL
- order by priority,reservedate ");
- $sth->execute($itemdata->{'biblionumber'};
- my $resfound = "n";
- my $resrec;
- while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
- if ($resrec->{'found'} eq "W") {
- if ($resrec->{'itemnumber'} eq $itemno) {
- $resfound = "y";
- }
- } elsif ($resrec->{'constrainttype'} eq "a") {
- $resfound = "y";
- } else {
- my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?");
- $consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'},$itemdata->{'biblioitemnumber'});
- if (my $conrec=$consth->fetchrow_hashref) {
- if ($resrec->{'constrainttype'} eq "o") {
- $resfound = "y";
- }
- } else {
- if ($resrec->{'constrainttype'} eq "e") {
- $resfound = "y";
- }
- }
- $consth->finish;
- }
- if ($resfound eq "y") {
- my $updsth = $dbh->prepare("update reserves
- set found = 'W',itemnumber = ?
- where borrowernumber = ?
- and reservedate = ?
- and biblionumber = ?");
- $updsth->execute($itemno,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
- $updsth->finish;
- my $itbr = $resrec->{'branchcode'};
- if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
- my $updsth = $dbh->prepare("update items
- set holdingbranch = 'TR'
- where itemnumber = ?");
- $updsth->execute($itemno);
- $updsth->finish;
- }
- }
- }
- $sth->finish;
- return ($resfound,$resrec);
-}
Index: Barcodes/PrinterConfig.pm
===================================================================
RCS file: Barcodes/PrinterConfig.pm
diff -N Barcodes/PrinterConfig.pm
--- Barcodes/PrinterConfig.pm 20 Sep 2004 15:03:28 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,220 +0,0 @@
-package C4::Barcodes::PrinterConfig;
-
-# This file is part of Koha.
-#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
-#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
-
-use strict;
-require Exporter;
-use vars qw($VERSION @EXPORT);
-
-use PDF::API2;
-use PDF::API2::Page;
-
-# set the version for version checking
-$VERSION = 0.01;
-
-=head1 NAME
-
-C4::Barcodes::PrinterConfig - Koha module dealing with labels in a PDF.
-
-=head1 SYNOPSIS
-
- use C4::Barcodes::PrinterConfig;
-
-=head1 DESCRIPTION
-
-This package is used to deal with labels in a pdf file. Giving some parameters,
-this package contains several functions to handle every label considering the
-environment of the pdf file.
-
-=head1 FUNCTIONS
-
-=over 2
-
-=cut
-
- at EXPORT = qw(&labelsPage &getLabelPosition setPositionsForX setPositionsForY);
-
-my @positionsForX; # Takes all the X positions of the pdf file.
-my @positionsForY; # Takes all the Y positions of the pdf file.
-my $firstLabel = 1; # Test if the label passed as a parameter is the first label to be printed into the pdf file.
-
-=item setPositionsForX
-
- C4::Barcodes::PrinterConfig::setPositionsForX($marginLeft, $labelWidth, $columns, $pageType);
-
-Calculate and stores all the X positions across the pdf page.
-
-C<$marginLeft> Indicates how much left margin do you want in your page type.
-
-C<$labelWidth> Indicates the width of the label that you are going to use.
-
-C<$columns> Indicates how many columns do you want in your page type.
-
-C<$pageType> Page type to print (eg: a4, legal, etc).
-
-=cut
-#'
-sub setPositionsForX {
- my ($marginLeft, $labelWidth, $columns, $pageType) = @_;
- my $defaultDpi = 72/25.4; # By default we know 25.4 mm -> 1 inch -> 72 dots per inch
- my $whereToStart = ($marginLeft + ($labelWidth/2));
- my $firstLabel = $whereToStart*$defaultDpi;
- my $spaceBetweenLabels = $labelWidth*$defaultDpi;
- my @positions;
- for (my $i = 0; $i < $columns ; $i++) {
- push @positions, ($firstLabel+($spaceBetweenLabels*$i));
- }
- @positionsForX = @positions;
-}
-
-=item setPositionsForY
-
- C4::Barcodes::PrinterConfig::setPositionsForY($marginBottom, $labelHeigth, $rows, $pageType);
-
-Calculate and stores all tha Y positions across the pdf page.
-
-C<$marginBottom> Indicates how much bottom margin do you want in your page type.
-
-C<$labelHeigth> Indicates the height of the label that you are going to use.
-
-C<$rows> Indicates how many rows do you want in your page type.
-
-C<$pageType> Page type to print (eg: a4, legal, etc).
-
-=cut
-#'
-sub setPositionsForY {
- my ($marginBottom, $labelHeigth, $rows, $pageType) = @_;
- my $defaultDpi = 72/25.4; # By default we know 25.4 mm -> 1 inch -> 72 dots per inch
- my $whereToStart = ($marginBottom + ($labelHeigth/2));
- my $firstLabel = $whereToStart*$defaultDpi;
- my $spaceBetweenLabels = $labelHeigth*$defaultDpi;
- my @positions;
- for (my $i = 0; $i < $rows; $i++) {
- unshift @positions, ($firstLabel+($spaceBetweenLabels*$i));
- }
- @positionsForY = @positions;
-}
-
-=item getLabelPosition
-
- (my $x, my $y, $pdfObject, $pageObject, $gfxObject, $textObject, $coreObject, $labelPosition) =
- C4::Barcodes::PrinterConfig::getLabelPosition($labelPosition,
- $pdfObject,
- $page,
- $gfx,
- $text,
- $fontObject,
- $pageType);
-
-Return the (x,y) position of the label that you are going to print considering the environment.
-
-C<$labelPosition> Indicates which label positions do you want to place by x and y coordinates.
-
-C<$pdfObject> The PDF object in use.
-
-C<$page> The page in use.
-
-C<$gfx> The gfx resource to handle with barcodes objects.
-
-C<$text> The text resource to handle with text.
-
-C<$fontObject> The font object
-
-C<$pageType> Page type to print (eg: a4, legal, etc).
-
-=cut
-#'
-sub getLabelPosition {
- my ($labelNum, $pdf, $page, $gfxObject, $textObject, $fontObject, $pageType) = @_;
- my $indexX = $labelNum % @positionsForX;
- my $indexY = int($labelNum / @positionsForX);
- # Calculates the next label position and return that label number
- my $nextIndexX = $labelNum % @positionsForX;
- my $nextIndexY = $labelNum % @positionsForY;
- if ($firstLabel) {
- $page = $pdf->page;
- $page->mediabox($pageType);
- $gfxObject = $page->gfx;
- $textObject = $page->text;
- $textObject->font($fontObject, 7);
- $firstLabel = 0;
- } elsif (($nextIndexX == 0) && ($nextIndexY == 0)) {
- $page = $pdf->page;
- $page->mediabox($pageType);
- $gfxObject = $page->gfx;
- $textObject = $page->text;
- $textObject->font($fontObject, 7);
- }
- $labelNum = $labelNum + 1;
- if ($labelNum == (@positionsForX*@positionsForY)) {
- $labelNum = 0;
- }
- return ($positionsForX[$indexX], $positionsForY[$indexY], $pdf, $page, $gfxObject, $textObject, $fontObject, $labelNum);
-}
-
-=item labelsPage
-
- my @labelTable = C4::Barcodes::PrinterConfig::labelsPage($rows, $columns);
-
-This function will help you to build the labels panel, where you can choose
-wich label position do you want to start the printer process.
-
-C<$rows> Indicates how many rows do you want in your page type.
-
-C<$columns> Indicates how many rows do you want in your page type.
-
-=cut
-#'
-sub labelsPage{
- my ($rows, $columns) = @_;
- my @pageType;
- my $tagname = 0;
- my $labelname = 1;
- my $check;
- for (my $i = 1; $i <= $rows; $i++) {
- my @column;
- for (my $j = 1; $j <= $columns; $j++) {
- my %cell;
- if ($tagname == 0) {
- $check = 'checked';
- } else {
- $check = '';
- }
- %cell = (check => $check,
- tagname => $tagname,
- labelname => $labelname);
- $tagname = $tagname + 1;
- $labelname = $labelname + 1;
- push @column, \%cell;
- }
- my %columns = (columns => \@column);
- push @pageType, \%columns;
- }
- return @pageType;
-}
-
-1;
-
-__END__
-
-=back
-
-=head1 AUTHOR
-
-Koha Physics Library UNLP <matias_veleda at hotmail.com>
-
-=cut
\ No newline at end of file
Index: tests/Record_test.pl
===================================================================
RCS file: tests/Record_test.pl
diff -N tests/Record_test.pl
--- tests/Record_test.pl 29 May 2006 17:51:16 -0000 1.2
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,142 +0,0 @@
-#!/usr/bin/perl
-#
-# Copyright 2006 (C) LibLime
-# Joshua Ferraro <jmf at liblime.com>
-#
-# This file is part of Koha.
-#
-# Koha is free software; you can redistribute it and/or modify it under the
-# terms of the GNU General Public License as published by the Free Software
-# Foundation; either version 2 of the License, or (at your option) any later
-# version.
-#
-# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
-# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License along with
-# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA 02111-1307 USA
-#
-# $Id: Record_test.pl,v 1.2 2006/05/29 17:51:16 kados Exp $
-#
-use strict; use warnings; #FIXME: turn off warnings before release
-
-# specify the number of tests
-use Test::More tests => 23;
-#use C4::Context;
-use C4::Record;
-
-=head1 NAME
-
-Record_test.pl - test suite for Record.pm
-
-=head1 SYNOPSIS
-
-$ export KOHA_CONF=/path/to/koha.conf
-$ ./Record_test.pl
-
-=cut
-
-## FIXME: Preliminarily grab the modules dir so we can run this in context
-
-ok (1, 'module compiled');
-
-# open some files for testing
-open MARC21MARC8,"testrecords/marc21_marc8.dat" or die $!;
-my $marc21_marc8; # = scalar (MARC21MARC8);
-foreach my $line (<MARC21MARC8>) {
- $marc21_marc8 .= $line;
-}
-$marc21_marc8 =~ s/\n$//;
-close MARC21MARC8;
-
-open (MARC21UTF8,"<:utf8","testrecords/marc21_utf8.dat") or die $!;
-my $marc21_utf8;
-foreach my $line (<MARC21UTF8>) {
- $marc21_utf8 .= $line;
-}
-$marc21_utf8 =~ s/\n$//;
-close MARC21UTF8;
-
-open MARC21MARC8COMBCHARS,"testrecords/marc21_marc8_combining_chars.dat" or die $!;
-my $marc21_marc8_combining_chars;
-foreach my $line(<MARC21MARC8COMBCHARS>) {
- $marc21_marc8_combining_chars.=$line;
-}
-$marc21_marc8_combining_chars =~ s/\n$//; #FIXME: why is a newline ending up here?
-close MARC21MARC8COMBCHARS;
-
-open (MARC21UTF8COMBCHARS,"<:utf8","testrecords/marc21_utf8_combining_chars.dat") or die $!;
-my $marc21_utf8_combining_chars;
-foreach my $line(<MARC21UTF8COMBCHARS>) {
- $marc21_utf8_combining_chars.=$line;
-}
-close MARC21UTF8COMBCHARS;
-
-open (MARCXMLUTF8,"<:utf8","testrecords/marcxml_utf8.xml") or die $!;
-my $marcxml_utf8;
-foreach my $line (<MARCXMLUTF8>) {
- $marcxml_utf8 .= $line;
-}
-close MARCXMLUTF8;
-
-$marcxml_utf8 =~ s/\n//g;
-
-## The Tests:
-my $error; my $marc; my $marcxml; my $dcxml; # some scalars to store values
-## MARC to MARCXML
-print "\n1. Checking conversion of simple ISO-2709 (MARC21) records to MARCXML\n";
-ok (($error,$marcxml) = marc2marcxml($marc21_marc8,'UTF-8','MARC21'), 'marc2marcxml - from MARC-8 to UTF-8 (MARC21)');
-ok (!$error, 'no errors in conversion');
- $marcxml =~ s/\n//g;
- $marcxml =~ s/v\/ s/v\/s/g; # FIXME: bug in new_from_xml_record!!
-is ($marcxml,$marcxml_utf8, 'record matches antitype');
-
-ok (($error,$marcxml) = marc2marcxml($marc21_utf8,'UTF-8','MARC21'), 'marc2marcxml - from UTF-8 to UTF-8 (MARC21)');
-ok (!$error, 'no errors in conversion');
- $marcxml =~ s/\n//g;
- $marcxml =~ s/v\/ s/v\/s/g;
-is ($marcxml,$marcxml_utf8, 'record matches antitype');
-
-print "\n2. checking binary MARC21 records with combining characters to MARCXML\n";
-ok (($error,$marcxml) = marc2marcxml($marc21_marc8_combining_chars,'MARC-8','MARC21'), 'marc2marcxml - from MARC-8 to MARC-8 with combining characters(MARC21)');
-ok (!$error, 'no errors in conversion');
-
-ok (($error,$marcxml) = marc2marcxml($marc21_marc8_combining_chars,'UTF-8','MARC21'), 'marc2marcxml - from MARC-8 to UTF-8 with combining characters (MARC21)');
-ok (!$error, 'no errors in conversion');
-
-ok (($error,$marcxml) = marc2marcxml($marc21_utf8_combining_chars,'UTF-8','MARC21'), 'marc2marcxml - from UTF-8 to UTF-8 with combining characters (MARC21)');
-ok (!$error, 'no errors in conversion');
-
-ok (($error,$dcxml) = marc2dcxml($marc21_utf8), 'marc2dcxml - from ISO-2709 to Dublin Core');
-ok (!$error, 'no errors in conversion');
-
-print "\n3. checking ability to alter encoding\n";
-ok (($error,$marc) = changeEncoding($marc21_marc8,'MARC','MARC21','UTF-8'), 'changeEncoding - MARC21 from MARC-8 to UTF-8');
-ok (!$error, 'no errors in conversion');
-
-ok (($error,$marc) = changeEncoding($marc21_utf8,'MARC','MARC21','MARC-8'), 'changeEncoding - MARC21 from UTF-8 to MARC-8');
-ok (!$error, 'no errors in conversion');
-
-ok (($error,$marc) = changeEncoding($marc21_marc8,'MARC','MARC21','MARC-8'), 'changeEncoding - MARC21 from MARC-8 to MARC-8');
-ok (!$error, 'no errors in conversion');
-
-ok (($error,$marc) = changeEncoding($marc21_utf8,'MARC','MARC21','UTF-8'), 'changeEncoding - MARC21 from UTF-8 to UTF-8');
-ok (!$error, 'no errors in conversion');
-
-__END__
-
-=head1 TODO
-
-Still lots more to test including UNIMARC support
-
-=head1 AUTHOR
-
-Joshua Ferraro <jmf at liblime.com>
-
-=head1 MODIFICATIONS
-
-# $Id: Record_test.pl,v 1.2 2006/05/29 17:51:16 kados Exp $
-
-=cut
Index: tests/testrecords/marc21_marc8.dat
===================================================================
RCS file: tests/testrecords/marc21_marc8.dat
diff -N tests/testrecords/marc21_marc8.dat
--- tests/testrecords/marc21_marc8.dat 29 May 2006 17:43:56 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1 +0,0 @@
-00463 2200169 4500001000600000003000500006005001700011008004100028020001500069090001500084100003400099245005100133250002500184650002200209942002500231952003700256 84893 ACLS 19990324000000.0 930421s19xx xxu 00010 eng d a0854562702 c1738 d1738 1 aChristie, Agatha, d1890-1976. 10 aWhy didn't they ask Evans? / cAgatha Christie. aLarge print edition. 0 aLarge type books. aONe cLP kLP Christie bNPL p31000000010273 r12.00 u2148
Index: tests/testrecords/marc21_marc8_combining_chars.dat
===================================================================
RCS file: tests/testrecords/marc21_marc8_combining_chars.dat
diff -N tests/testrecords/marc21_marc8_combining_chars.dat
--- tests/testrecords/marc21_marc8_combining_chars.dat 29 May 2006 17:43:56 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1 +0,0 @@
-01442cam 2200373 a 4500001001300000003000600013005001700019008004100036010001700077040002500094016001900119020004200138029002100180050002800201082002300229084001500252092001700267049000800284245015300292260007900445300002800524440015300552500003000705500002200735650005600757650007000813650005700883650002500940650002100965650002500986700003001011942001501041994001201056 ocm11030895 OCoLC 20060516100102.0 840720s1984 ne b 001 0 eng a 83048926 aDLC cDLC dMUQ dNLGGC aB8443186 2bccb a0800606035 (Fortress Press) : c$35.95 1 aNLGGC b840375166 00 aBM485 b.L57 1984 vol. 2 00 a296.1 s a296.1 219 a11.37 2bcl 0 a296.1 bST66 aWN3 00 aJewish writings of the Second Temple period : bApocrypha, Pseudepigrapha, Qumran, sectarian writings, Philo, Josephus / cedited by Michael E. Stone. aAssen, Netherlands : bVan Gorcum ; aPhiladelphia : bFortress Press, c1984. axxiii, 697 p. ; c25 cm. 0 aCompendia rerum Iudaicarum ad Novum Testamentum. nSection 2, pLiterature of the Jewish people in the period of the Second Temple and the Talmud ; v2 aBibliography: p. 603-653. aIncludes indexes. 0 aJewish religious literature xHistory and criticism. 0 aJudaism xHistory yPost-exilic period, 586 B.C.-210 A.D. xSources. 6 aLittâerature religieuse juive xHistoire et critique. 17 aOude Testament. 2gtt 17 aApocriefen. 2gtt 17 aDode-Zeerollen. 2gtt 1 aStone, Michael E., d1938- k296.1 ST66 aC0 bWN3
Index: tests/testrecords/marc21_marc8_errors.dat
===================================================================
RCS file: tests/testrecords/marc21_marc8_errors.dat
diff -N tests/testrecords/marc21_marc8_errors.dat
--- tests/testrecords/marc21_marc8_errors.dat 29 May 2006 17:43:56 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1 +0,0 @@
-00462 2200169 4500001000600000003000500006005001700011008004100028020001500069090001500084100003400099245005100133250002500184650002200209942002500231952003700256 84893 ACLS 19990324000000.0 930421s19xx xxu 00010 eng d a0854562702 c1738 d1738 1 aChristie, Agatha, d1890-1976. 10 aWhy didn't they ask Evans? / cAgatha Christie. aLarge print edition. 0 aLarge type books. aONe cLP kLP Christie bNPL p31000000010273 r12.00 u2148
Index: tests/testrecords/marc21_utf8.dat
===================================================================
RCS file: tests/testrecords/marc21_utf8.dat
diff -N tests/testrecords/marc21_utf8.dat
--- tests/testrecords/marc21_utf8.dat 29 May 2006 17:43:56 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1 +0,0 @@
-00463 a2200169 4500001000600000003000500006005001700011008004100028020001500069090001500084100003400099245005100133250002500184650002200209942002500231952003700256 84893 ACLS 19990324000000.0 930421s19xx xxu 00010 eng d a0854562702 c1738 d1738 1 aChristie, Agatha, d1890-1976. 10 aWhy didn't they ask Evans? / cAgatha Christie. aLarge print edition. 0 aLarge type books. aONe cLP kLP Christie bNPL p31000000010273 r12.00 u2148
\ No newline at end of file
Index: tests/testrecords/marc21_utf8_combining_chars.dat
===================================================================
RCS file: tests/testrecords/marc21_utf8_combining_chars.dat
diff -N tests/testrecords/marc21_utf8_combining_chars.dat
--- tests/testrecords/marc21_utf8_combining_chars.dat 29 May 2006 17:43:56 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1 +0,0 @@
-01442cam a2200373 a 4500001001300000003000600013005001700019008004100036010001700077040002500094016001900119020004200138029002100180050002800201082002300229084001500252092001700267049000800284245015300292260007900445300002800524440015300552500003000705500002200735650005600757650007000813650005700883650002500940650002100965650002500986700003001011942001501041994001201056 ocm11030895 OCoLC 20060516100102.0 840720s1984 ne b 001 0 eng a 83048926 aDLC cDLC dMUQ dNLGGC aB8443186 2bccb a0800606035 (Fortress Press) : c$35.95 1 aNLGGC b840375166 00 aBM485 b.L57 1984 vol. 2 00 a296.1 s a296.1 219 a11.37 2bcl 0 a296.1 bST66 aWN3 00 aJewish writings of the Second Temple period : bApocrypha, Pseudepigrapha, Qumran, sectarian writings, Philo, Josephus / cedited by Michael E. Stone. aAssen, Netherlands : bVan Gorcum ; aPhiladelphia : bFortress Press, c1984. axxiii, 697 p. ; c25 cm. 0 aCompendia rerum Iudaicarum ad Novum Testamentum. nSection 2, pLiterature of the Jewish people in the period of the Second Temple and the Talmud ; v2 aBibliography: p. 603-653. aIncludes indexes. 0 aJewish religious literature xHistory and criticism. 0 aJudaism xHistory yPost-exilic period, 586 B.C.-210 A.D. xSources. 6 aLittérature religieuse juive xHistoire et critique. 17 aOude Testament. 2gtt 17 aApocriefen. 2gtt 17 aDode-Zeerollen. 2gtt 1 aStone, Michael E., d1938- k296.1 ST66 aC0 bWN3
\ No newline at end of file
Index: tests/testrecords/marcxml_utf8.xml
===================================================================
RCS file: tests/testrecords/marcxml_utf8.xml
diff -N tests/testrecords/marcxml_utf8.xml
--- tests/testrecords/marcxml_utf8.xml 29 May 2006 17:43:56 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,44 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<record
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
- xmlns="http://www.loc.gov/MARC21/slim">
-
- <leader>00463 a2200169 4500</leader>
- <controlfield tag="001">84893</controlfield>
- <controlfield tag="003">ACLS</controlfield>
- <controlfield tag="005">19990324000000.0</controlfield>
- <controlfield tag="008">930421s19xx xxu 00010 eng d</controlfield>
- <datafield tag="020" ind1=" " ind2=" ">
- <subfield code="a">0854562702</subfield>
- </datafield>
- <datafield tag="090" ind1=" " ind2=" ">
- <subfield code="c">1738</subfield>
- <subfield code="d">1738</subfield>
- </datafield>
- <datafield tag="100" ind1="1" ind2=" ">
- <subfield code="a">Christie, Agatha,</subfield>
- <subfield code="d">1890-1976.</subfield>
- </datafield>
- <datafield tag="245" ind1="1" ind2="0">
- <subfield code="a">Why didn't they ask Evans? /</subfield>
- <subfield code="c">Agatha Christie.</subfield>
- </datafield>
- <datafield tag="250" ind1=" " ind2=" ">
- <subfield code="a">Large print edition.</subfield>
- </datafield>
- <datafield tag="650" ind1=" " ind2="0">
- <subfield code="a">Large type books.</subfield>
- </datafield>
- <datafield tag="942" ind1=" " ind2=" ">
- <subfield code="a">ONe</subfield>
- <subfield code="c">LP</subfield>
- <subfield code="k">LP Christie</subfield>
- </datafield>
- <datafield tag="952" ind1=" " ind2=" ">
- <subfield code="b">NPL</subfield>
- <subfield code="p">31000000010273</subfield>
- <subfield code="r">12.00</subfield>
- <subfield code="u">2148</subfield>
- </datafield>
-</record>
Index: tests/testrecords/marcxml_utf8_entityencoded.xml
===================================================================
RCS file: tests/testrecords/marcxml_utf8_entityencoded.xml
diff -N tests/testrecords/marcxml_utf8_entityencoded.xml
--- tests/testrecords/marcxml_utf8_entityencoded.xml 29 May 2006 17:43:56 -0000 1.1
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,46 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<collection
- xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
- xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
- xmlns="http://www.loc.gov/MARC21/slim">
-
-<record>
- <leader>00463 a2200169 4500</leader>
- <controlfield tag="001">84893</controlfield>
- <controlfield tag="003">ACLS</controlfield>
- <controlfield tag="005">19990324000000.0</controlfield>
- <controlfield tag="008">930421s19xx xxu 00010 eng d</controlfield>
- <datafield tag="020" ind1=" " ind2=" ">
- <subfield code="a">0854562702</subfield>
- </datafield>
- <datafield tag="090" ind1=" " ind2=" ">
- <subfield code="c">1738</subfield>
- <subfield code="d">1738</subfield>
- </datafield>
- <datafield tag="100" ind1="1" ind2=" ">
- <subfield code="a">Christie, Agatha,</subfield>
- <subfield code="d">1890-1976.</subfield>
- </datafield>
- <datafield tag="245" ind1="1" ind2="0">
- <subfield code="a">Why didn't they ask Evans? /</subfield>
- <subfield code="c">Agatha Christie.</subfield>
- </datafield>
- <datafield tag="250" ind1=" " ind2=" ">
- <subfield code="a">Large print edition.</subfield>
- </datafield>
- <datafield tag="650" ind1=" " ind2="0">
- <subfield code="a">Large type books.</subfield>
- </datafield>
- <datafield tag="942" ind1=" " ind2=" ">
- <subfield code="a">ONe</subfield>
- <subfield code="c">LP</subfield>
- <subfield code="k">LP Christie</subfield>
- </datafield>
- <datafield tag="952" ind1=" " ind2=" ">
- <subfield code="b">NPL</subfield>
- <subfield code="p">31000000010273</subfield>
- <subfield code="r">12.00</subfield>
- <subfield code="u">2148</subfield>
- </datafield>
-</record>
-</collection>
More information about the Koha-cvs
mailing list