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