C4/Catalogue.pm

   1 package C4::Catalogue;
   2
   3 # Continue working on updateItem!!!!!!
   4 #
   5 # updateItem is looking not bad.  Need to add addSubfield and deleteSubfield
   6 # functions
   7 #
   8 # Trying to track down $dbh's that aren't disconnected....
   9
  10
  11 # Copyright 2000-2002 Katipo Communications
  12 #
  13 # This file is part of Koha.
  14 #
  15 # Koha is free software; you can redistribute it and/or modify it under the
  16 # terms of the GNU General Public License as published by the Free Software
  17 # Foundation; either version 2 of the License, or (at your option) any later
  18 # version.
  19 #
  20 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  21 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  22 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License along with
  25 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  26 # Suite 330, Boston, MA  02111-1307 USA
  27
  28 use strict;
  29 require Exporter;
  30 use C4::Context;
  31 use MARC::Record;
  32 use C4::Biblio;
  33
  34 use vars qw($VERSION @ISA @EXPORT);
  35
  36 # set the version for version checking
  37 $VERSION = 0.01;
  38
  39 =head1 NAME
  40
  41 C4::Catalogue - Koha functions for dealing with orders and acquisitions
  42
  43 =head1 SYNOPSIS
  44
  45   use C4::Catalogue;
  46
  47 =head1 DESCRIPTION
  48
  49 The functions in this module deal with acquisitions, managing book
  50 orders, converting money to different currencies, and so forth.
  51
  52 =head1 FUNCTIONS
  53
  54 =over 2
  55
  56 =cut
  57
  58 @ISA = qw(Exporter);
  59 @EXPORT = qw(
  60              &basket &newbasket
  61
  62              &getorders &getallorders &getrecorders
  63              &getorder &neworder &delorder
  64              &ordersearch
  65              &modorder &getsingleorder &invoice &receiveorder
  66              &updaterecorder &newordernum
  67
  68              &bookfunds &bookfundbreakdown &updatecost
  69              &curconvert &getcurrencies &updatecurrencies &getcurrency
  70
  71              &findall &needsmod &branches &updatesup &insertsup
  72              &bookseller &breakdown &checkitems
  73              &websitesearch &addwebsite &updatewebsite &deletewebsite
  74 );
  75
  76 #
  77 #
  78 #
  79 # BASKETS
  80 #
  81 #
  82 #
  83 =item basket
  84
  85   ($count, @orders) = &basket($basketnumber, $booksellerID);
  86
  87 Looks up the pending (non-cancelled) orders with the given basket
  88 number. If C<$booksellerID> is non-empty, only orders from that seller
  89 are returned.
  90
  91 C<&basket> returns a two-element array. C<@orders> is an array of
  92 references-to-hash, whose keys are the fields from the aqorders,
  93 biblio, and biblioitems tables in the Koha database. C<$count> is the
  94 number of elements in C<@orders>.
  95
  96 =cut
  97 #'
  98 sub basket {
  99   my ($basketno,$supplier)=@_;
 100   my $dbh = C4::Context->dbh;
 101   my $sth=$dbh->prepare("Select *,biblio.title from aqorders,biblio,biblioitems
 102   where basketno=?
 103   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
 104   =aqorders.biblioitemnumber
 105   and (datecancellationprinted is NULL or datecancellationprinted =
 106   '0000-00-00')"
 107   .(($supplier ne '')?" and aqorders.booksellerid=?":"")
 108   ." group by aqorders.ordernumber");
 109   if ($supplier ne '') {
 110     $sth->execute($basketno,$supplier);
 111   } else {
 112     $sth->execute($basketno);
 113   }
 114   my @results = ();
 115   while (my $data=$sth->fetchrow_hashref){
 116     push(@results,$data);
 117   }
 118   $sth->finish;
 119   return(scalar(@results),@results);
 120 }
 121
 122 =item newbasket
 123
 124   $basket = &newbasket();
 125
 126 Finds the next unused basket number in the aqorders table of the Koha
 127 database, and returns it.
 128
 129 =cut
 130 #'
 131 # FIXME - There's a race condition here:
 132 #       A calls &newbasket
 133 #       B calls &newbasket (gets the same number as A)
 134 #       A updates the basket
 135 #       B updates the basket, and clobbers A's result.
 136 # A better approach might be to create a dummy order (with, say,
 137 # requisitionedby == "Dummy-$$" or notes == "dummy <time> <pid>"), and
 138 # see which basket number it gets. Then have a cron job periodically
 139 # remove out-of-date dummy orders.
 140 sub newbasket {
 141   my $dbh = C4::Context->dbh;
 142   my $sth=$dbh->prepare("Select max(basketno) from aqorders");
 143   $sth->execute;
 144   my $data=$sth->fetchrow_arrayref;
 145   my $basket=$$data[0];
 146   $basket++;
 147   $sth->finish;
 148   return($basket);
 149 }
 150
 151 =item neworder
 152
 153   &neworder($biblionumber, $title, $ordnum, $basket, $quantity, $listprice,
 154         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 155         $ecost, $gst, $budget, $unitprice, $subscription,
 156         $booksellerinvoicenumber);
 157
 158 Adds a new order to the database. Any argument that isn't described
 159 below is the new value of the field with the same name in the aqorders
 160 table of the Koha database.
 161
 162 C<$ordnum> is a "minimum order number." After adding the new entry to
 163 the aqorders table, C<&neworder> finds the first entry in aqorders
 164 with order number greater than or equal to C<$ordnum>, and adds an
 165 entry to the aqorderbreakdown table, with the order number just found,
 166 and the book fund ID of the newly-added order.
 167
 168 C<$budget> is effectively ignored.
 169
 170 C<$subscription> may be either "yes", or anything else for "no".
 171
 172 =cut
 173 #'
 174 sub neworder {
 175   my ($bibnum,$title,$ordnum,$basket,$quantity,$listprice,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice)=@_;
 176   if ($budget eq 'now'){
 177     $budget="now()";
 178   } else {
 179     $budget="'2001-07-01'";
 180   }
 181   if ($sub eq 'yes'){
 182     $sub=1;
 183   } else {
 184     $sub=0;
 185   }
 186   my $dbh = C4::Context->dbh;
 187   my $sth=$dbh->prepare("insert into aqorders (biblionumber,title,basketno,
 188   quantity,listprice,booksellerid,entrydate,requisitionedby,authorisedby,notes,
 189   biblioitemnumber,rrp,ecost,gst,unitprice,subscription,booksellerinvoicenumber)
 190   values (?,?,?,?,?,?,now(),?,?,?,?,?,?,?,?,?,?)");
 191   $sth->execute($bibnum,$title,$basket,$quantity,$listprice,$supplier,
 192   $who,$who,$notes,$bibitemnum,$rrp,$ecost,$gst,$cost,
 193   $sub,$invoice);
 194   $sth->finish;
 195   $sth=$dbh->prepare("select * from aqorders where
 196   biblionumber=? and basketno=? and ordernumber >=?");
 197   $sth->execute($bibnum,$basket,$ordnum);
 198   my $data=$sth->fetchrow_hashref;
 199   $sth->finish;
 200   $ordnum=$data->{'ordernumber'};
 201   $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
 202   (?,?)");
 203 #  print $query;
 204   $sth->execute($ordnum,$bookfund);
 205   $sth->finish;
 206 }
 207
 208 =item delorder
 209
 210   &delorder($biblionumber, $ordernumber);
 211
 212 Cancel the order with the given order and biblio numbers. It does not
 213 delete any entries in the aqorders table, it merely marks them as
 214 cancelled.
 215
 216 If there are no items remaining with the given biblionumber,
 217 C<&delorder> also deletes them from the marc_subfield_table and
 218 marc_biblio tables of the Koha database.
 219
 220 =cut
 221 #'
 222 sub delorder {
 223   my ($bibnum,$ordnum)=@_;
 224   my $dbh = C4::Context->dbh;
 225   my $sth=$dbh->prepare("update aqorders set datecancellationprinted=now()
 226   where biblionumber=? and ordernumber=?");
 227   $sth->execute($bibnum,$ordnum);
 228   $sth->finish;
 229   my $count=itemcount($bibnum);
 230   if ($count == 0){
 231     delbiblio($bibnum);
 232   }
 233 }
 234
 235 =item modorder
 236
 237   &modorder($title, $ordernumber, $quantity, $listprice,
 238         $biblionumber, $basketno, $supplier, $who, $notes,
 239         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 240         $unitprice, $booksellerinvoicenumber);
 241
 242 Modifies an existing order. Updates the order with order number
 243 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 244 update the fields with the same name in the aqorders table of the Koha
 245 database.
 246
 247 Entries with order number C<$ordernumber> in the aqorderbreakdown
 248 table are also updated to the new book fund ID.
 249
 250 =cut
 251 #'
 252 sub modorder {
 253   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice)=@_;
 254   my $dbh = C4::Context->dbh;
 255   my $sth=$dbh->prepare("update aqorders set title=?,
 256   quantity=?,listprice=?,basketno=?,
 257   rrp=?,ecost=?,unitprice=?,
 258   booksellerinvoicenumber=?
 259   where
 260   ordernumber=? and biblionumber=?");
 261   $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$invoice,$ordnum,$bibnum);
 262   $sth->finish;
 263   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
 264   ordernumber=?");
 265   $sth->execute($bookfund,$ordnum);
 266   $sth->finish;
 267 }
 268
 269 =item newordernum
 270
 271   $order = &newordernum();
 272
 273 Finds the next unused order number in the aqorders table of the Koha
 274 database, and returns it.
 275
 276 =cut
 277 #'
 278 # FIXME - Race condition
 279 sub newordernum {
 280   my $dbh = C4::Context->dbh;
 281   my $sth=$dbh->prepare("Select max(ordernumber) from aqorders");
 282   $sth->execute;
 283   my $data=$sth->fetchrow_arrayref;
 284   my $ordnum=$$data[0];
 285   $ordnum++;
 286   $sth->finish;
 287   return($ordnum);
 288 }
 289
 290 =item receiveorder
 291
 292   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
 293         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 294         $freight, $bookfund, $rrp);
 295
 296 Updates an order, to reflect the fact that it was received, at least
 297 in part. All arguments not mentioned below update the fields with the
 298 same name in the aqorders table of the Koha database.
 299
 300 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 301 C<$ordernumber>.
 302
 303 Also updates the book fund ID in the aqorderbreakdown table.
 304
 305 =cut
 306 #'
 307 sub receiveorder {
 308   my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$bibitemno,$freight,$bookfund,$rrp)=@_;
 309   my $dbh = C4::Context->dbh;
 310   my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
 311                                                                                 biblioitemnumber=?,unitprice=?,freight=?,rrp=?
 312                                                 where biblionumber=? and ordernumber=?");
 313   $sth->execute($quantrec,$invoiceno,$bibitemno,$cost,$freight,$rrp,$biblio,$ordnum);
 314   $sth->finish;
 315   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
 316   ordernumber=?");
 317   $sth->execute($bookfund,$ordnum);
 318   $sth->finish;
 319 }
 320
 321 =item updaterecorder
 322
 323   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 324         $bookfundid, $rrp);
 325
 326 Updates the order with biblionumber C<$biblionumber> and order number
 327 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 328 in the aqorderbreakdown table of the Koha database. All other
 329 arguments update the fields with the same name in the aqorders table.
 330
 331 C<$user> is ignored.
 332
 333 =cut
 334 #'
 335 sub updaterecorder{
 336   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
 337   my $dbh = C4::Context->dbh;
 338   my $sth=$dbh->prepare("update aqorders set
 339   unitprice=?, rrp=?
 340   where biblionumber=? and ordernumber=?
 341   ");
 342   $sth->execute($cost,$rrp,$biblio,$ordnum);
 343   $sth->finish;
 344   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where ordernumber=?");
 345   $sth->execute($bookfund,$ordnum);
 346   $sth->finish;
 347 }
 348
 349 #
 350 #
 351 # ORDERS
 352 #
 353 #
 354
 355 =item getorders
 356
 357   ($count, $orders) = &getorders($booksellerid);
 358
 359 Finds pending orders from the bookseller with the given ID. Ignores
 360 completed and cancelled orders.
 361
 362 C<$count> is the number of elements in C<@{$orders}>.
 363
 364 C<$orders> is a reference-to-array; each element is a
 365 reference-to-hash with the following fields:
 366
 367 =over 4
 368
 369 =item C<count(*)>
 370
 371 Gives the number of orders in with this basket number.
 372
 373 =item C<authorizedby>
 374
 375 =item C<entrydate>
 376
 377 =item C<basketno>
 378
 379 These give the value of the corresponding field in the aqorders table
 380 of the Koha database.
 381
 382 =back
 383
 384 Results are ordered from most to least recent.
 385
 386 =cut
 387 #'
 388 sub getorders {
 389   my ($supplierid)=@_;
 390   my $dbh = C4::Context->dbh;
 391   my $sth=$dbh->prepare("Select count(*),authorisedby,entrydate,basketno from aqorders where
 392   booksellerid=? and (quantity > quantityreceived or
 393   quantityreceived is NULL)
 394   and (datecancellationprinted is NULL or datecancellationprinted = '0000-00-00')
 395    group by basketno order by entrydate desc");
 396   $sth->execute($supplierid);
 397   my @results = ();
 398   while (my $data=$sth->fetchrow_hashref){
 399     push(@results,$data);
 400   }
 401   $sth->finish;
 402   return (scalar(@results),\@results);
 403 }
 404
 405 =item getorder
 406
 407   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 408
 409 Looks up the order with the given biblionumber and biblioitemnumber.
 410
 411 Returns a two-element array. C<$ordernumber> is the order number.
 412 C<$order> is a reference-to-hash describing the order; its keys are
 413 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 414 tables of the Koha database.
 415
 416 =cut
 417 #'
 418 # FIXME - This is effectively identical to &C4::Biblio::getorder.
 419 # Pick one and stick with it.
 420 sub getorder{
 421   my ($bi,$bib)=@_;
 422   my $dbh = C4::Context->dbh;
 423   my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
 424   $sth->execute($bib,$bi);
 425   # FIXME - Use fetchrow_array(), since we're only interested in the one
 426   # value.
 427   my $ordnum=$sth->fetchrow_hashref;
 428   $sth->finish;
 429   my $order=getsingleorder($ordnum->{'ordernumber'});
 430   return ($order,$ordnum->{'ordernumber'});
 431 }
 432
 433 =item getsingleorder
 434
 435   $order = &getsingleorder($ordernumber);
 436
 437 Looks up an order by order number.
 438
 439 Returns a reference-to-hash describing the order. The keys of
 440 C<$order> are fields from the biblio, biblioitems, aqorders, and
 441 aqorderbreakdown tables of the Koha database.
 442
 443 =cut
 444 #'
 445 # FIXME - This is effectively identical to
 446 # &C4::Biblio::getsingleorder.
 447 # Pick one and stick with it.
 448 sub getsingleorder {
 449   my ($ordnum)=@_;
 450   my $dbh = C4::Context->dbh;
 451   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders,aqorderbreakdown
 452   where aqorders.ordernumber=?
 453   and biblio.biblionumber=aqorders.biblionumber and
 454   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
 455   aqorders.ordernumber=aqorderbreakdown.ordernumber");
 456   $sth->execute($ordnum);
 457   my $data=$sth->fetchrow_hashref;
 458   $sth->finish;
 459   return($data);
 460 }
 461
 462 =item getallorders
 463
 464   ($count, @results) = &getallorders($booksellerid);
 465
 466 Looks up all of the pending orders from the supplier with the given
 467 bookseller ID. Ignores cancelled and completed orders.
 468
 469 C<$count> is the number of elements in C<@results>. C<@results> is an
 470 array of references-to-hash. The keys of each element are fields from
 471 the aqorders, biblio, and biblioitems tables of the Koha database.
 472
 473 C<@results> is sorted alphabetically by book title.
 474
 475 =cut
 476 #'
 477 sub getallorders {
 478   #gets all orders from a certain supplier, orders them alphabetically
 479   my ($supid)=@_;
 480   my $dbh = C4::Context->dbh;
 481   my @results = ();
 482   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
 483   and (cancelledby is NULL or cancelledby = '')
 484   and (quantityreceived < quantity or quantityreceived is NULL)
 485   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 486   aqorders.biblioitemnumber
 487   group by aqorders.biblioitemnumber
 488   order by
 489   biblio.title");
 490   $sth->execute($supid);
 491   while (my $data=$sth->fetchrow_hashref){
 492     push(@results,$data);
 493   }
 494   $sth->finish;
 495   return(scalar(@results),@results);
 496 }
 497
 498 # FIXME - Never used
 499 sub getrecorders {
 500   #gets all orders from a certain supplier, orders them alphabetically
 501   my ($supid)=@_;
 502   my $dbh = C4::Context->dbh;
 503   my @results= ();
 504   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
 505   and (cancelledby is NULL or cancelledby = '')
 506   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 507   aqorders.biblioitemnumber and
 508   aqorders.quantityreceived>0
 509   and aqorders.datereceived >=now()
 510   group by aqorders.biblioitemnumber
 511   order by
 512   biblio.title");
 513   $sth->execute($supid);
 514   while (my $data=$sth->fetchrow_hashref){
 515     push(@results,$data);
 516   }
 517   $sth->finish;
 518   return(scalar(@results),@results);
 519 }
 520
 521 =item ordersearch
 522
 523   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
 524
 525 Searches for orders.
 526
 527 C<$search> may take one of several forms: if it is an ISBN,
 528 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 529 order number, C<&ordersearch> returns orders with that order number
 530 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 531 to be a space-separated list of search terms; in this case, all of the
 532 terms must appear in the title (matching the beginning of title
 533 words).
 534
 535 If C<$complete> is C<yes>, the results will include only completed
 536 orders. In any case, C<&ordersearch> ignores cancelled orders.
 537
 538 C<&ordersearch> returns an array. C<$count> is the number of elements
 539 in C<@results>. C<@results> is an array of references-to-hash with the
 540 following keys:
 541
 542 =over 4
 543
 544 =item C<author>
 545
 546 =item C<seriestitle>
 547
 548 =item C<branchcode>
 549
 550 =item C<bookfundid>
 551
 552 =back
 553
 554 =cut
 555 #'
 556 sub ordersearch {
 557         my ($search,$id,$biblio,$catview) = @_;
 558         my $dbh   = C4::Context->dbh;
 559         my @data  = split(' ',$search);
 560         my @searchterms = ($id);
 561         map { push(@searchterms,"$_%","% $_%") } @data;
 562         push(@searchterms,$search,$search,$biblio);
 563         my $sth=$dbh->prepare("Select *,biblio.title from aqorders,biblioitems,biblio
 564                 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber
 565                 and aqorders.booksellerid = ?
 566                 and biblio.biblionumber=aqorders.biblionumber
 567                 and ((datecancellationprinted is NULL)
 568                 or (datecancellationprinted = '0000-00-00'))
 569                 and (("
 570                 .(join(" and ",map { "(biblio.title like ? or biblio.title like ?)" } @data))
 571                 .") or biblioitems.isbn=? or (aqorders.ordernumber=? and aqorders.biblionumber=?)) "
 572                 .(($catview ne 'yes')?" and (quantityreceived < quantity or quantityreceived is NULL)":"")
 573                 ." group by aqorders.ordernumber");
 574         $sth->execute(@searchterms);
 575         my @results = ();
 576         my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
 577         my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 578         while (my $data=$sth->fetchrow_hashref){
 579                 $sth2->execute($data->{'biblionumber'});
 580                 my $data2=$sth2->fetchrow_hashref;
 581                 $data->{'author'}=$data2->{'author'};
 582                 $data->{'seriestitle'}=$data2->{'seriestitle'};
 583                 $sth3->execute($data->{'ordernumber'});
 584                 my $data3=$sth3->fetchrow_hashref;
 585                 $data->{'branchcode'}=$data3->{'branchcode'};
 586                 $data->{'bookfundid'}=$data3->{'bookfundid'};
 587                 push(@results,$data);
 588         }
 589         $sth->finish;
 590         $sth2->finish;
 591         $sth3->finish;
 592         return(scalar(@results),@results);
 593 }
 594
 595 #
 596 #
 597 # MONEY
 598 #
 599 #
 600 =item invoice
 601
 602   ($count, @results) = &invoice($booksellerinvoicenumber);
 603
 604 Looks up orders by invoice number.
 605
 606 Returns an array. C<$count> is the number of elements in C<@results>.
 607 C<@results> is an array of references-to-hash; the keys of each
 608 elements are fields from the aqorders, biblio, and biblioitems tables
 609 of the Koha database.
 610
 611 =cut
 612 #'
 613 sub invoice {
 614   my ($invoice)=@_;
 615   my $dbh = C4::Context->dbh;
 616   my @results = ();
 617   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
 618   booksellerinvoicenumber=?
 619   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 620   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
 621   $sth->execute($invoice);
 622   while (my $data=$sth->fetchrow_hashref){
 623     push(@results,$data);
 624   }
 625   $sth->finish;
 626   return(scalar(@results),@results);
 627 }
 628
 629 =item bookfunds
 630
 631   ($count, @results) = &bookfunds();
 632
 633 Returns a list of all book funds.
 634
 635 C<$count> is the number of elements in C<@results>. C<@results> is an
 636 array of references-to-hash, whose keys are fields from the aqbookfund
 637 and aqbudget tables of the Koha database. Results are ordered
 638 alphabetically by book fund name.
 639
 640 =cut
 641 #'
 642 sub bookfunds {
 643   my $dbh = C4::Context->dbh;
 644   my $sth=$dbh->prepare("Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 645   =aqbudget.bookfundid
 646   group by aqbookfund.bookfundid order by bookfundname");
 647   $sth->execute;
 648   my @results = ();
 649   while (my $data=$sth->fetchrow_hashref){
 650     push(@results,$data);
 651   }
 652   $sth->finish;
 653   return(scalar(@results),@results);
 654 }
 655
 656 # FIXME - POD. I can't figure out what this function is doing. Then
 657 # again, I don't think it's being used (anymore).
 658 sub bookfundbreakdown {
 659   my ($id)=@_;
 660   my $dbh = C4::Context->dbh;
 661   my $sth=$dbh->prepare("Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
 662   from aqorders,aqorderbreakdown where bookfundid=? and
 663   aqorders.ordernumber=aqorderbreakdown.ordernumber
 664   and (datecancellationprinted is NULL or
 665   datecancellationprinted='0000-00-00')");
 666   $sth->execute($id);
 667   my $comtd=0;
 668   my $spent=0;
 669   while (my $data=$sth->fetchrow_hashref){
 670     if ($data->{'subscription'} == 1){
 671       $spent+=$data->{'quantity'}*$data->{'unitprice'};
 672     } else {
 673       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
 674       $comtd+=($data->{'ecost'})*$leftover;
 675       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
 676     }
 677   }
 678   $sth->finish;
 679   return($spent,$comtd);
 680 }
 681
 682 =item curconvert
 683
 684   $foreignprice = &curconvert($currency, $localprice);
 685
 686 Converts the price C<$localprice> to foreign currency C<$currency> by
 687 dividing by the exchange rate, and returns the result.
 688
 689 If no exchange rate is found, C<&curconvert> assumes the rate is one
 690 to one.
 691
 692 =cut
 693 #'
 694 sub curconvert {
 695   my ($currency,$price)=@_;
 696   my $dbh = C4::Context->dbh;
 697   my $sth=$dbh->prepare("Select rate from currency where currency=?");
 698   $sth->execute($currency);
 699   my $cur=($sth->fetchrow_array())[0];
 700   $sth->finish;
 701   if ($cur==0){
 702     $cur=1;
 703   }
 704   return($price / $cur);
 705 }
 706
 707 =item getcurrencies
 708
 709   ($count, $currencies) = &getcurrencies();
 710
 711 Returns the list of all known currencies.
 712
 713 C<$count> is the number of elements in C<$currencies>. C<$currencies>
 714 is a reference-to-array; its elements are references-to-hash, whose
 715 keys are the fields from the currency table in the Koha database.
 716
 717 =cut
 718 #'
 719 sub getcurrencies {
 720   my $dbh = C4::Context->dbh;
 721   my $sth=$dbh->prepare("Select * from currency");
 722   $sth->execute;
 723   my @results = ();
 724   while (my $data=$sth->fetchrow_hashref){
 725     push(@results,$data);
 726   }
 727   $sth->finish;
 728   return(scalar(@results),\@results);
 729 }
 730
 731 =item updatecurrencies
 732
 733   &updatecurrencies($currency, $newrate);
 734
 735 Sets the exchange rate for C<$currency> to be C<$newrate>.
 736
 737 =cut
 738 #'
 739 sub updatecurrencies {
 740   my ($currency,$rate)=@_;
 741   my $dbh = C4::Context->dbh;
 742   my $sth=$dbh->prepare("update currency set rate=? where currency=?");
 743   $sth->execute($rate,$currency);
 744   $sth->finish;
 745 }
 746
 747 # FIXME - This is never used
 748 sub updatecost{
 749   my($price,$rrp,$itemnum)=@_;
 750   my $dbh = C4::Context->dbh;
 751   my $sth=$dbh->prepare("update items set price=?,replacementprice=? where itemnumber=?");
 752   $sth->execute($price,$rrp,$itemnum);
 753   $sth->finish;
 754 }
 755
 756 #
 757 #
 758 # OTHERS
 759 #
 760 #
 761
 762 =item bookseller
 763
 764   ($count, @results) = &bookseller($searchstring);
 765
 766 Looks up a book seller. C<$searchstring> may be either a book seller
 767 ID, or a string to look for in the book seller's name.
 768
 769 C<$count> is the number of elements in C<@results>. C<@results> is an
 770 array of references-to-hash, whose keys are the fields of of the
 771 aqbooksellers table in the Koha database.
 772
 773 =cut
 774 #'
 775 sub bookseller {
 776   my ($searchstring)=@_;
 777   my $dbh = C4::Context->dbh;
 778   my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
 779   $sth->execute("$searchstring%",$searchstring);
 780   my @results;
 781   while (my $data=$sth->fetchrow_hashref){
 782     push(@results,$data);
 783   }
 784   $sth->finish;
 785   return(scalar(@results),@results);
 786 }
 787
 788 =item breakdown
 789
 790   ($count, $results) = &breakdown($ordernumber);
 791
 792 Looks up an order by order ID, and returns its breakdown.
 793
 794 C<$count> is the number of elements in C<$results>. C<$results> is a
 795 reference-to-array; its elements are references-to-hash, whose keys
 796 are the fields of the aqorderbreakdown table in the Koha database.
 797
 798 =cut
 799 #'
 800 sub breakdown {
 801   my ($id)=@_;
 802   my $dbh = C4::Context->dbh;
 803   my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 804   $sth->execute($id);
 805   my @results = ();
 806   while (my $data=$sth->fetchrow_hashref){
 807     push(@results,$data);
 808   }
 809   $sth->finish;
 810   return(scalar(@results),\@results);
 811 }
 812
 813 =item branches
 814
 815   ($count, @results) = &branches();
 816
 817 Returns a list of all library branches.
 818
 819 C<$count> is the number of elements in C<@results>. C<@results> is an
 820 array of references-to-hash, whose keys are the fields of the branches
 821 table of the Koha database.
 822
 823 =cut
 824 #'
 825 sub branches {
 826     my $dbh   = C4::Context->dbh;
 827     my $sth   = $dbh->prepare("Select * from branches order by branchname");
 828     my @results = ();
 829
 830     $sth->execute();
 831     while (my $data = $sth->fetchrow_hashref) {
 832         push(@results,$data);
 833     } # while
 834
 835     $sth->finish;
 836     return(scalar(@results), @results);
 837 } # sub branches
 838
 839 # FIXME - Never used
 840 sub findall {
 841   my ($biblionumber)=@_;
 842   my $dbh = C4::Context->dbh;
 843   my $sth=$dbh->prepare("Select * from biblioitems,items,itemtypes where
 844   biblioitems.biblionumber=?
 845   and biblioitems.biblioitemnumber=items.biblioitemnumber and
 846   itemtypes.itemtype=biblioitems.itemtype
 847   order by items.biblioitemnumber");
 848   $sth->execute($biblionumber);
 849   my @results;
 850   while (my $data=$sth->fetchrow_hashref){
 851     push(@results,$data);
 852   }
 853   $sth->finish;
 854   return(@results);
 855 }
 856
 857 # FIXME - Never used
 858 sub needsmod{
 859   my ($bibitemnum,$itemtype)=@_;
 860   my $dbh = C4::Context->dbh;
 861   my $sth=$dbh->prepare("Select * from biblioitems where biblioitemnumber=?
 862   and itemtype=?");
 863   $sth->execute($bibitemnum,$itemtype);
 864   my $result=0;
 865   if (my $data=$sth->fetchrow_hashref){
 866     $result=1;
 867   }
 868   $sth->finish;
 869   return($result);
 870 }
 871
 872 =item updatesup
 873
 874   &updatesup($bookseller);
 875
 876 Updates the information for a given bookseller. C<$bookseller> is a
 877 reference-to-hash whose keys are the fields of the aqbooksellers table
 878 in the Koha database. It must contain entries for all of the fields.
 879 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
 880
 881 The easiest way to get all of the necessary fields is to look up a
 882 book seller with C<&booksellers>, modify what's necessary, then call
 883 C<&updatesup> with the result.
 884
 885 =cut
 886 #'
 887 sub updatesup {
 888    my ($data)=@_;
 889    my $dbh = C4::Context->dbh;
 890    my $sth=$dbh->prepare("Update aqbooksellers set
 891    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
 892    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
 893    contemail=?,contnotes=?,active=?,
 894    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
 895    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
 896    nocalc=?
 897    where id=?");
 898    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
 899    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
 900    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
 901    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
 902    $data->{'contemail'},
 903    $data->{'contnote'},$data->{'active'},$data->{'listprice'},
 904    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
 905    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
 906    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
 907    $sth->finish;
 908 #   print $query;
 909 }
 910
 911 =item insertsup
 912
 913   $id = &insertsup($bookseller);
 914
 915 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
 916 keys are the fields of the aqbooksellers table in the Koha database.
 917 All fields must be present.
 918
 919 Returns the ID of the newly-created bookseller.
 920
 921 =cut
 922 #'
 923 sub insertsup {
 924   my ($data)=@_;
 925   my $dbh = C4::Context->dbh;
 926   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
 927   $sth->execute;
 928   my $data2=$sth->fetchrow_hashref;
 929   $sth->finish;
 930   $data2->{'max(id)'}++;
 931   $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
 932   $sth->execute($data2->{'max(id)'});
 933   $sth->finish;
 934   $data->{'id'}=$data2->{'max(id)'};
 935   updatesup($data);
 936   return($data->{'id'});
 937 }
 938
 939 =item websitesearch
 940
 941   ($count, @results) = &websitesearch($keywordlist);
 942
 943 Looks up biblioitems by URL.
 944
 945 C<$keywordlist> is a space-separated list of search terms.
 946 C<&websitesearch> returns those biblioitems whose URL contains at
 947 least one of the search terms.
 948
 949 C<$count> is the number of elements in C<@results>. C<@results> is an
 950 array of references-to-hash, whose keys are the fields of the biblio
 951 and biblioitems tables in the Koha database.
 952
 953 =cut
 954 #'
 955 sub websitesearch {
 956     my ($keywordlist) = @_;
 957     my $dbh   = C4::Context->dbh;
 958     my $sth;
 959     my @results = ();
 960     my @keywords = split(/ +/, $keywordlist);
 961
 962         $sth    = $dbh->prepare("Select distinct biblio.* from biblio, biblioitems where
 963         biblio.biblionumber = biblioitems.biblionumber and ("
 964                 .(join(") or (",map { "url like ?" } @keywords)).")");
 965     $sth->execute(map { s/([%_])/\\\1/g; "%$_%" } @keywords);
 966
 967     while (my $data = $sth->fetchrow_hashref) {
 968         push(@results,$data);
 969     } # while
 970
 971     $sth->finish;
 972     return(scalar(@results), @results);
 973 } # sub websitesearch
 974
 975 =item addwebsite
 976
 977   &addwebsite($website);
 978
 979 Adds a new web site. C<$website> is a reference-to-hash, with the keys
 980 C<biblionumber>, C<title>, C<description>, and C<url>. All of these
 981 are mandatory.
 982
 983 =cut
 984 #'
 985 sub addwebsite {
 986     my ($website) = @_;
 987     my $dbh = C4::Context->dbh;
 988     my $query;
 989
 990     # FIXME -
 991     #   for (qw( biblionumber title description url )) # and any others
 992     #   {
 993     #           $website->{$_} = $dbh->quote($_);
 994     #   }
 995     # Perhaps extend this to building the query as well. This might allow
 996     # some of the fields to be optional.
 997     $website->{'biblionumber'} = $dbh->quote($website->{'biblionumber'});
 998     $website->{'title'}        = $dbh->quote($website->{'title'});
 999     $website->{'description'}  = $dbh->quote($website->{'description'});
1000     $website->{'url'}          = $dbh->quote($website->{'url'});
1001
1002     $query = "Insert into websites set
1003 biblionumber = $website->{'biblionumber'},
1004 title        = $website->{'title'},
1005 description  = $website->{'description'},
1006 url          = $website->{'url'}";
1007
1008     $dbh->do($query);
1009 } # sub website
1010
1011 =item updatewebsite
1012
1013   &updatewebsite($website);
1014
1015 Updates an existing web site. C<$website> is a reference-to-hash with
1016 the keys C<websitenumber>, C<title>, C<description>, and C<url>. All
1017 of these are mandatory. C<$website-E<gt>{websitenumber}> identifies
1018 the entry to update.
1019
1020 =cut
1021 #'
1022 sub updatewebsite {
1023     my ($website) = @_;
1024     my $dbh = C4::Context->dbh;
1025     my $query;
1026
1027     $website->{'title'}      = $dbh->quote($website->{'title'});
1028     $website->{'description'} = $dbh->quote($website->{'description'});
1029     $website->{'url'}        = $dbh->quote($website->{'url'});
1030
1031     $query = "Update websites set
1032 title       = $website->{'title'},
1033 description = $website->{'description'},
1034 url         = $website->{'url'}
1035 where websitenumber = $website->{'websitenumber'}";
1036
1037     $dbh->do($query);
1038 } # sub updatewebsite
1039
1040 =item deletewebsite
1041
1042   &deletewebsite($websitenumber);
1043
1044 Deletes the web site with number C<$websitenumber>.
1045
1046 =cut
1047 #'
1048 sub deletewebsite {
1049     my ($websitenumber) = @_;
1050     my $dbh = C4::Context->dbh;
1051     # FIXME - $query is unneeded
1052     my $query = "Delete from websites where websitenumber = $websitenumber";
1053
1054     $dbh->do($query);
1055 } # sub deletewebsite
1056
1057 END { }       # module clean-up code here (global destructor)
1058
1059 1;
1060 __END__
1061
1062 =back
1063
1064 =head1 AUTHOR
1065
1066 Koha Developement team <info@koha.org>
1067
1068 =cut