Bug 6540 - Add defaultsql command line option
[koha.git] / C4 / Accounts.pm
blob3275099a132a10772f3bde17ef6dbc612f4fb986
1 package C4::Accounts;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 use strict;
22 #use warnings; FIXME - Bug 2505
23 use C4::Context;
24 use C4::Stats;
25 use C4::Members;
26 use C4::Items;
27 use C4::Circulation qw(MarkIssueReturned);
29 use vars qw($VERSION @ISA @EXPORT);
31 BEGIN {
32 # set the version for version checking
33 $VERSION = 3.03;
34 require Exporter;
35 @ISA = qw(Exporter);
36 @EXPORT = qw(
37 &recordpayment &makepayment &manualinvoice
38 &getnextacctno &reconcileaccount &getcharges &ModNote &getcredits
39 &getrefunds &chargelostitem
40 &ReversePayment
41 ); # removed &fixaccounts
44 =head1 NAME
46 C4::Accounts - Functions for dealing with Koha accounts
48 =head1 SYNOPSIS
50 use C4::Accounts;
52 =head1 DESCRIPTION
54 The functions in this module deal with the monetary aspect of Koha,
55 including looking up and modifying the amount of money owed by a
56 patron.
58 =head1 FUNCTIONS
60 =head2 recordpayment
62 &recordpayment($borrowernumber, $payment);
64 Record payment by a patron. C<$borrowernumber> is the patron's
65 borrower number. C<$payment> is a floating-point number, giving the
66 amount that was paid.
68 Amounts owed are paid off oldest first. That is, if the patron has a
69 $1 fine from Feb. 1, another $1 fine from Mar. 1, and makes a payment
70 of $1.50, then the oldest fine will be paid off in full, and $0.50
71 will be credited to the next one.
73 =cut
76 sub recordpayment {
78 #here we update the account lines
79 my ( $borrowernumber, $data ) = @_;
80 my $dbh = C4::Context->dbh;
81 my $newamtos = 0;
82 my $accdata = "";
83 my $branch = C4::Context->userenv->{'branch'};
84 my $amountleft = $data;
86 # begin transaction
87 my $nextaccntno = getnextacctno($borrowernumber);
89 # get lines with outstanding amounts to offset
90 my $sth = $dbh->prepare(
91 "SELECT * FROM accountlines
92 WHERE (borrowernumber = ?) AND (amountoutstanding<>0)
93 ORDER BY date"
95 $sth->execute($borrowernumber);
97 # offset transactions
98 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
99 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
100 $newamtos = 0;
101 $amountleft -= $accdata->{'amountoutstanding'};
103 else {
104 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
105 $amountleft = 0;
107 my $thisacct = $accdata->{accountno};
108 my $usth = $dbh->prepare(
109 "UPDATE accountlines SET amountoutstanding= ?
110 WHERE (borrowernumber = ?) AND (accountno=?)"
112 $usth->execute( $newamtos, $borrowernumber, $thisacct );
113 $usth->finish;
114 # $usth = $dbh->prepare(
115 # "INSERT INTO accountoffsets
116 # (borrowernumber, accountno, offsetaccount, offsetamount)
117 # VALUES (?,?,?,?)"
118 # );
119 # $usth->execute( $borrowernumber, $accdata->{'accountno'},
120 # $nextaccntno, $newamtos );
121 $usth->finish;
124 # create new line
125 my $usth = $dbh->prepare(
126 "INSERT INTO accountlines
127 (borrowernumber, accountno,date,amount,description,accounttype,amountoutstanding)
128 VALUES (?,?,now(),?,'Payment,thanks','Pay',?)"
130 $usth->execute( $borrowernumber, $nextaccntno, 0 - $data, 0 - $amountleft );
131 $usth->finish;
132 UpdateStats( $branch, 'payment', $data, '', '', '', $borrowernumber, $nextaccntno );
133 $sth->finish;
136 =head2 makepayment
138 &makepayment($borrowernumber, $acctnumber, $amount, $branchcode);
140 Records the fact that a patron has paid off the entire amount he or
141 she owes.
143 C<$borrowernumber> is the patron's borrower number. C<$acctnumber> is
144 the account that was credited. C<$amount> is the amount paid (this is
145 only used to record the payment. It is assumed to be equal to the
146 amount owed). C<$branchcode> is the code of the branch where payment
147 was made.
149 =cut
152 # FIXME - I'm not at all sure about the above, because I don't
153 # understand what the acct* tables in the Koha database are for.
154 sub makepayment {
156 #here we update both the accountoffsets and the account lines
157 #updated to check, if they are paying off a lost item, we return the item
158 # from their card, and put a note on the item record
159 my ( $borrowernumber, $accountno, $amount, $user, $branch ) = @_;
160 my $dbh = C4::Context->dbh;
162 # begin transaction
163 my $nextaccntno = getnextacctno($borrowernumber);
164 my $newamtos = 0;
165 my $sth =
166 $dbh->prepare(
167 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno=?");
168 $sth->execute( $borrowernumber, $accountno );
169 my $data = $sth->fetchrow_hashref;
170 $sth->finish;
172 $sth = $dbh->prepare("UPDATE accountlines
173 SET amountoutstanding = 0
174 WHERE borrowernumber = ?
175 AND accountno = ?");
176 $sth->execute($borrowernumber, $accountno);
178 # print $updquery;
179 # $dbh->do( "
180 # INSERT INTO accountoffsets
181 # (borrowernumber, accountno, offsetaccount,
182 # offsetamount)
183 # VALUES ($borrowernumber, $accountno, $nextaccntno, $newamtos)
184 # " );
186 # create new line
187 my $payment = 0 - $amount;
188 $sth = $dbh->prepare("INSERT INTO accountlines
189 (borrowernumber, accountno, date, amount,
190 description, accounttype, amountoutstanding)
191 VALUES (?,?,now(),?,?,'Pay',0)");
192 $sth->execute($borrowernumber, $nextaccntno, $payment, "Payment,thanks - $user");
194 # FIXME - The second argument to &UpdateStats is supposed to be the
195 # branch code.
196 # UpdateStats is now being passed $accountno too. MTJ
197 UpdateStats( $user, 'payment', $amount, '', '', '', $borrowernumber,
198 $accountno );
199 #from perldoc: for SELECT only #$sth->finish;
201 #check to see what accounttype
202 if ( $data->{'accounttype'} eq 'Rep' || $data->{'accounttype'} eq 'L' ) {
203 returnlost( $borrowernumber, $data->{'itemnumber'} );
207 =head2 getnextacctno
209 $nextacct = &getnextacctno($borrowernumber);
211 Returns the next unused account number for the patron with the given
212 borrower number.
214 =cut
217 # FIXME - Okay, so what does the above actually _mean_?
218 sub getnextacctno ($) {
219 my ($borrowernumber) = shift or return undef;
220 my $sth = C4::Context->dbh->prepare(
221 "SELECT accountno+1 FROM accountlines
222 WHERE (borrowernumber = ?)
223 ORDER BY accountno DESC
224 LIMIT 1"
226 $sth->execute($borrowernumber);
227 return ($sth->fetchrow || 1);
230 =head2 fixaccounts (removed)
232 &fixaccounts($borrowernumber, $accountnumber, $amount);
235 # FIXME - I don't understand what this function does.
236 sub fixaccounts {
237 my ( $borrowernumber, $accountno, $amount ) = @_;
238 my $dbh = C4::Context->dbh;
239 my $sth = $dbh->prepare(
240 "SELECT * FROM accountlines WHERE borrowernumber=?
241 AND accountno=?"
243 $sth->execute( $borrowernumber, $accountno );
244 my $data = $sth->fetchrow_hashref;
246 # FIXME - Error-checking
247 my $diff = $amount - $data->{'amount'};
248 my $outstanding = $data->{'amountoutstanding'} + $diff;
249 $sth->finish;
251 $dbh->do(<<EOT);
252 UPDATE accountlines
253 SET amount = '$amount',
254 amountoutstanding = '$outstanding'
255 WHERE borrowernumber = $borrowernumber
256 AND accountno = $accountno
258 # FIXME: exceedingly bad form. Use prepare with placholders ("?") in query and execute args.
261 =cut
263 sub returnlost{
264 my ( $borrowernumber, $itemnum ) = @_;
265 C4::Circulation::MarkIssueReturned( $borrowernumber, $itemnum );
266 my $borrower = C4::Members::GetMember( 'borrowernumber'=>$borrowernumber );
267 my @datearr = localtime(time);
268 my $date = ( 1900 + $datearr[5] ) . "-" . ( $datearr[4] + 1 ) . "-" . $datearr[3];
269 my $bor = "$borrower->{'firstname'} $borrower->{'surname'} $borrower->{'cardnumber'}";
270 ModItem({ paidfor => "Paid for by $bor $date" }, undef, $itemnum);
274 sub chargelostitem{
275 # lost ==1 Lost, lost==2 longoverdue, lost==3 lost and paid for
276 # FIXME: itemlost should be set to 3 after payment is made, should be a warning to the interface that
277 # a charge has been added
278 # FIXME : if no replacement price, borrower just doesn't get charged?
280 my $dbh = C4::Context->dbh();
281 my ($itemnumber) = @_;
282 my $sth=$dbh->prepare("SELECT issues.*,items.*,biblio.title
283 FROM issues
284 JOIN items USING (itemnumber)
285 JOIN biblio USING (biblionumber)
286 WHERE issues.itemnumber=?");
287 $sth->execute($itemnumber);
288 my $issues=$sth->fetchrow_hashref();
290 # if a borrower lost the item, add a replacement cost to the their record
291 if ( $issues->{borrowernumber} ){
293 # first make sure the borrower hasn't already been charged for this item
294 my $sth1=$dbh->prepare("SELECT * from accountlines
295 WHERE borrowernumber=? AND itemnumber=? and accounttype='L'");
296 $sth1->execute($issues->{'borrowernumber'},$itemnumber);
297 my $existing_charge_hashref=$sth1->fetchrow_hashref();
299 # OK, they haven't
300 unless ($existing_charge_hashref) {
301 # This item is on issue ... add replacement cost to the borrower's record and mark it returned
302 # Note that we add this to the account even if there's no replacement price, allowing some other
303 # process (or person) to update it, since we don't handle any defaults for replacement prices.
304 my $accountno = getnextacctno($issues->{'borrowernumber'});
305 my $sth2=$dbh->prepare("INSERT INTO accountlines
306 (borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding,itemnumber)
307 VALUES (?,?,now(),?,?,'L',?,?)");
308 $sth2->execute($issues->{'borrowernumber'},$accountno,$issues->{'replacementprice'},
309 "Lost Item $issues->{'title'} $issues->{'barcode'}",
310 $issues->{'replacementprice'},$itemnumber);
311 $sth2->finish;
312 # FIXME: Log this ?
314 #FIXME : Should probably have a way to distinguish this from an item that really was returned.
315 #warn " $issues->{'borrowernumber'} / $itemnumber ";
316 C4::Circulation::MarkIssueReturned($issues->{borrowernumber},$itemnumber);
317 # Shouldn't MarkIssueReturned do this?
318 C4::Items::ModItem({ onloan => undef }, undef, $itemnumber);
320 $sth->finish;
323 =head2 manualinvoice
325 &manualinvoice($borrowernumber, $itemnumber, $description, $type,
326 $amount, $note);
328 C<$borrowernumber> is the patron's borrower number.
329 C<$description> is a description of the transaction.
330 C<$type> may be one of C<CS>, C<CB>, C<CW>, C<CF>, C<CL>, C<N>, C<L>,
331 or C<REF>.
332 C<$itemnumber> is the item involved, if pertinent; otherwise, it
333 should be the empty string.
335 =cut
338 # FIXME: In Koha 3.0 , the only account adjustment 'types' passed to this function
339 # are :
340 # 'C' = CREDIT
341 # 'FOR' = FORGIVEN (Formerly 'F', but 'F' is taken to mean 'FINE' elsewhere)
342 # 'N' = New Card fee
343 # 'F' = Fine
344 # 'A' = Account Management fee
345 # 'M' = Sundry
346 # 'L' = Lost Item
349 sub manualinvoice {
350 my ( $borrowernumber, $itemnum, $desc, $type, $amount, $note ) = @_;
351 my $manager_id = 0;
352 $manager_id = C4::Context->userenv->{'number'} if C4::Context->userenv;
353 my $dbh = C4::Context->dbh;
354 my $notifyid = 0;
355 my $insert;
356 $itemnum =~ s/ //g;
357 my $accountno = getnextacctno($borrowernumber);
358 my $amountleft = $amount;
360 # if ( $type eq 'CS'
361 # || $type eq 'CB'
362 # || $type eq 'CW'
363 # || $type eq 'CF'
364 # || $type eq 'CL' )
366 # my $amount2 = $amount * -1; # FIXME - $amount2 = -$amount
367 # $amountleft =
368 # fixcredit( $borrowernumber, $amount2, $itemnum, $type, $user );
370 if ( $type eq 'N' ) {
371 $desc .= " New Card";
373 if ( $type eq 'F' ) {
374 $desc .= " Fine";
376 if ( $type eq 'A' ) {
377 $desc .= " Account Management fee";
379 if ( $type eq 'M' ) {
380 $desc .= " Sundry";
383 if ( $type eq 'L' && $desc eq '' ) {
385 $desc = " Lost Item";
387 # if ( $type eq 'REF' ) {
388 # $desc .= " Cash Refund";
389 # $amountleft = refund( '', $borrowernumber, $amount );
391 if ( ( $type eq 'L' )
392 or ( $type eq 'F' )
393 or ( $type eq 'A' )
394 or ( $type eq 'N' )
395 or ( $type eq 'M' ) )
397 $notifyid = 1;
400 if ( $itemnum ne '' ) {
401 $desc .= " " . $itemnum;
402 my $sth = $dbh->prepare(
403 "INSERT INTO accountlines
404 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding, itemnumber,notify_id, note, manager_id)
405 VALUES (?, ?, now(), ?,?, ?,?,?,?,?,?)");
406 $sth->execute($borrowernumber, $accountno, $amount, $desc, $type, $amountleft, $itemnum,$notifyid, $note, $manager_id) || return $sth->errstr;
407 } else {
408 my $sth=$dbh->prepare("INSERT INTO accountlines
409 (borrowernumber, accountno, date, amount, description, accounttype, amountoutstanding,notify_id, note, manager_id)
410 VALUES (?, ?, now(), ?, ?, ?, ?,?,?,?)"
412 $sth->execute( $borrowernumber, $accountno, $amount, $desc, $type,
413 $amountleft, $notifyid, $note, $manager_id );
415 return 0;
418 =head2 fixcredit #### DEPRECATED
420 $amountleft = &fixcredit($borrowernumber, $data, $barcode, $type, $user);
422 This function is only used internally, not exported.
424 =cut
426 # This function is deprecated in 3.0
428 sub fixcredit {
430 #here we update both the accountoffsets and the account lines
431 my ( $borrowernumber, $data, $barcode, $type, $user ) = @_;
432 my $dbh = C4::Context->dbh;
433 my $newamtos = 0;
434 my $accdata = "";
435 my $amountleft = $data;
436 if ( $barcode ne '' ) {
437 my $item = GetBiblioFromItemNumber( '', $barcode );
438 my $nextaccntno = getnextacctno($borrowernumber);
439 my $query = "SELECT * FROM accountlines WHERE (borrowernumber=?
440 AND itemnumber=? AND amountoutstanding > 0)";
441 if ( $type eq 'CL' ) {
442 $query .= " AND (accounttype = 'L' OR accounttype = 'Rep')";
444 elsif ( $type eq 'CF' ) {
445 $query .= " AND (accounttype = 'F' OR accounttype = 'FU' OR
446 accounttype='Res' OR accounttype='Rent')";
448 elsif ( $type eq 'CB' ) {
449 $query .= " and accounttype='A'";
452 # print $query;
453 my $sth = $dbh->prepare($query);
454 $sth->execute( $borrowernumber, $item->{'itemnumber'} );
455 $accdata = $sth->fetchrow_hashref;
456 $sth->finish;
457 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
458 $newamtos = 0;
459 $amountleft -= $accdata->{'amountoutstanding'};
461 else {
462 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
463 $amountleft = 0;
465 my $thisacct = $accdata->{accountno};
466 my $usth = $dbh->prepare(
467 "UPDATE accountlines SET amountoutstanding= ?
468 WHERE (borrowernumber = ?) AND (accountno=?)"
470 $usth->execute( $newamtos, $borrowernumber, $thisacct );
471 $usth->finish;
472 $usth = $dbh->prepare(
473 "INSERT INTO accountoffsets
474 (borrowernumber, accountno, offsetaccount, offsetamount)
475 VALUES (?,?,?,?)"
477 $usth->execute( $borrowernumber, $accdata->{'accountno'},
478 $nextaccntno, $newamtos );
479 $usth->finish;
482 # begin transaction
483 my $nextaccntno = getnextacctno($borrowernumber);
485 # get lines with outstanding amounts to offset
486 my $sth = $dbh->prepare(
487 "SELECT * FROM accountlines
488 WHERE (borrowernumber = ?) AND (amountoutstanding >0)
489 ORDER BY date"
491 $sth->execute($borrowernumber);
493 # print $query;
494 # offset transactions
495 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft > 0 ) ) {
496 if ( $accdata->{'amountoutstanding'} < $amountleft ) {
497 $newamtos = 0;
498 $amountleft -= $accdata->{'amountoutstanding'};
500 else {
501 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
502 $amountleft = 0;
504 my $thisacct = $accdata->{accountno};
505 my $usth = $dbh->prepare(
506 "UPDATE accountlines SET amountoutstanding= ?
507 WHERE (borrowernumber = ?) AND (accountno=?)"
509 $usth->execute( $newamtos, $borrowernumber, $thisacct );
510 $usth->finish;
511 $usth = $dbh->prepare(
512 "INSERT INTO accountoffsets
513 (borrowernumber, accountno, offsetaccount, offsetamount)
514 VALUE (?,?,?,?)"
516 $usth->execute( $borrowernumber, $accdata->{'accountno'},
517 $nextaccntno, $newamtos );
518 $usth->finish;
520 $sth->finish;
521 $type = "Credit " . $type;
522 UpdateStats( $user, $type, $data, $user, '', '', $borrowernumber );
523 $amountleft *= -1;
524 return ($amountleft);
528 =head2 refund
530 #FIXME : DEPRECATED SUB
531 This subroutine tracks payments and/or credits against fines/charges
532 using the accountoffsets table, which is not used consistently in
533 Koha's fines management, and so is not used in 3.0
535 =cut
537 sub refund {
539 #here we update both the accountoffsets and the account lines
540 my ( $borrowernumber, $data ) = @_;
541 my $dbh = C4::Context->dbh;
542 my $newamtos = 0;
543 my $accdata = "";
544 my $amountleft = $data * -1;
546 # begin transaction
547 my $nextaccntno = getnextacctno($borrowernumber);
549 # get lines with outstanding amounts to offset
550 my $sth = $dbh->prepare(
551 "SELECT * FROM accountlines
552 WHERE (borrowernumber = ?) AND (amountoutstanding<0)
553 ORDER BY date"
555 $sth->execute($borrowernumber);
557 # print $amountleft;
558 # offset transactions
559 while ( ( $accdata = $sth->fetchrow_hashref ) and ( $amountleft < 0 ) ) {
560 if ( $accdata->{'amountoutstanding'} > $amountleft ) {
561 $newamtos = 0;
562 $amountleft -= $accdata->{'amountoutstanding'};
564 else {
565 $newamtos = $accdata->{'amountoutstanding'} - $amountleft;
566 $amountleft = 0;
569 # print $amountleft;
570 my $thisacct = $accdata->{accountno};
571 my $usth = $dbh->prepare(
572 "UPDATE accountlines SET amountoutstanding= ?
573 WHERE (borrowernumber = ?) AND (accountno=?)"
575 $usth->execute( $newamtos, $borrowernumber, $thisacct );
576 $usth->finish;
577 $usth = $dbh->prepare(
578 "INSERT INTO accountoffsets
579 (borrowernumber, accountno, offsetaccount, offsetamount)
580 VALUES (?,?,?,?)"
582 $usth->execute( $borrowernumber, $accdata->{'accountno'},
583 $nextaccntno, $newamtos );
584 $usth->finish;
586 $sth->finish;
587 return ($amountleft);
590 sub getcharges {
591 my ( $borrowerno, $timestamp, $accountno ) = @_;
592 my $dbh = C4::Context->dbh;
593 my $timestamp2 = $timestamp - 1;
594 my $query = "";
595 my $sth = $dbh->prepare(
596 "SELECT * FROM accountlines WHERE borrowernumber=? AND accountno = ?"
598 $sth->execute( $borrowerno, $accountno );
600 my @results;
601 while ( my $data = $sth->fetchrow_hashref ) {
602 push @results,$data;
604 return (@results);
607 sub ModNote {
608 my ( $borrowernumber, $accountno, $note ) = @_;
609 my $dbh = C4::Context->dbh;
610 my $sth = $dbh->prepare('UPDATE accountlines SET note = ? WHERE borrowernumber = ? AND accountno = ?');
611 $sth->execute( $note, $borrowernumber, $accountno );
614 sub getcredits {
615 my ( $date, $date2 ) = @_;
616 my $dbh = C4::Context->dbh;
617 my $sth = $dbh->prepare(
618 "SELECT * FROM accountlines,borrowers
619 WHERE amount < 0 AND accounttype <> 'Pay' AND accountlines.borrowernumber = borrowers.borrowernumber
620 AND timestamp >=TIMESTAMP(?) AND timestamp < TIMESTAMP(?)"
623 $sth->execute( $date, $date2 );
624 my @results;
625 while ( my $data = $sth->fetchrow_hashref ) {
626 $data->{'date'} = $data->{'timestamp'};
627 push @results,$data;
629 return (@results);
633 sub getrefunds {
634 my ( $date, $date2 ) = @_;
635 my $dbh = C4::Context->dbh;
637 my $sth = $dbh->prepare(
638 "SELECT *,timestamp AS datetime
639 FROM accountlines,borrowers
640 WHERE (accounttype = 'REF'
641 AND accountlines.borrowernumber = borrowers.borrowernumber
642 AND date >=? AND date <?)"
645 $sth->execute( $date, $date2 );
647 my @results;
648 while ( my $data = $sth->fetchrow_hashref ) {
649 push @results,$data;
652 return (@results);
655 sub ReversePayment {
656 my ( $borrowernumber, $accountno ) = @_;
657 my $dbh = C4::Context->dbh;
659 my $sth = $dbh->prepare('SELECT amountoutstanding FROM accountlines WHERE borrowernumber = ? AND accountno = ?');
660 $sth->execute( $borrowernumber, $accountno );
661 my $row = $sth->fetchrow_hashref();
662 my $amount_outstanding = $row->{'amountoutstanding'};
664 if ( $amount_outstanding <= 0 ) {
665 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = amount * -1, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
666 $sth->execute( $borrowernumber, $accountno );
667 } else {
668 $sth = $dbh->prepare('UPDATE accountlines SET amountoutstanding = 0, description = CONCAT( description, " Reversed -" ) WHERE borrowernumber = ? AND accountno = ?');
669 $sth->execute( $borrowernumber, $accountno );
673 END { } # module clean-up code here (global destructor)
676 __END__
678 =head1 SEE ALSO
680 DBI(3)
682 =cut