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