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);
 244   }
 245 }
 246
 247 =item modorder
 248
 249   &modorder($title, $ordernumber, $quantity, $listprice,
 250         $biblionumber, $basketno, $supplier, $who, $notes,
 251         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 252         $unitprice, $booksellerinvoicenumber);
 253
 254 Modifies an existing order. Updates the order with order number
 255 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 256 update the fields with the same name in the aqorders table of the Koha
 257 database.
 258
 259 Entries with order number C<$ordernumber> in the aqorderbreakdown
 260 table are also updated to the new book fund ID.
 261
 262 =cut
 263 #'
 264 sub modorder {
 265   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice)=@_;
 266   my $dbh = C4::Context->dbh;
 267   my $query="update aqorders set title='$title',
 268   quantity='$quantity',listprice='$listprice',basketno='$basketno',
 269   rrp='$rrp',ecost='$ecost',unitprice='$cost',
 270   booksellerinvoicenumber='$invoice'
 271   where
 272   ordernumber=$ordnum and biblionumber=$bibnum";
 273   my $sth=$dbh->prepare($query);
 274 #  print $query;
 275   $sth->execute;
 276   $sth->finish;
 277   $query="update aqorderbreakdown set bookfundid=$bookfund where
 278   ordernumber=$ordnum";
 279   $sth=$dbh->prepare($query);
 280 #  print $query;
 281   $sth->execute;
 282   $sth->finish;
 283 }
 284
 285 =item newordernum
 286
 287   $order = &newordernum();
 288
 289 Finds the next unused order number in the aqorders table of the Koha
 290 database, and returns it.
 291
 292 =cut
 293 #'
 294 # FIXME - Race condition
 295 sub newordernum {
 296   my $dbh = C4::Context->dbh;
 297   my $query="Select max(ordernumber) from aqorders";
 298   my $sth=$dbh->prepare($query);
 299   $sth->execute;
 300   my $data=$sth->fetchrow_arrayref;
 301   my $ordnum=$$data[0];
 302   $ordnum++;
 303   $sth->finish;
 304   return($ordnum);
 305 }
 306
 307 =item receiveorder
 308
 309   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
 310         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 311         $freight, $bookfund, $rrp);
 312
 313 Updates an order, to reflect the fact that it was received, at least
 314 in part. All arguments not mentioned below update the fields with the
 315 same name in the aqorders table of the Koha database.
 316
 317 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 318 C<$ordernumber>.
 319
 320 Also updates the book fund ID in the aqorderbreakdown table.
 321
 322 =cut
 323 #'
 324 sub receiveorder {
 325   my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$bibitemno,$freight,$bookfund,$rrp)=@_;
 326   my $dbh = C4::Context->dbh;
 327   my $query="update aqorders set quantityreceived='$quantrec',
 328   datereceived=now(),booksellerinvoicenumber='$invoiceno',
 329   biblioitemnumber=$bibitemno,unitprice='$cost',freight='$freight',
 330   rrp='$rrp'
 331   where biblionumber=$biblio and ordernumber=$ordnum
 332   ";
 333 #  print $query;
 334   my $sth=$dbh->prepare($query);
 335   $sth->execute;
 336   $sth->finish;
 337   $query="update aqorderbreakdown set bookfundid=? where
 338   ordernumber=?";
 339   $sth=$dbh->prepare($query);
 340 #  print $query;
 341   $sth->execute($bookfund,$ordnum);
 342   $sth->finish;
 343 }
 344
 345 =item updaterecorder
 346
 347   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 348         $bookfundid, $rrp);
 349
 350 Updates the order with biblionumber C<$biblionumber> and order number
 351 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 352 in the aqorderbreakdown table of the Koha database. All other
 353 arguments update the fields with the same name in the aqorders table.
 354
 355 C<$user> is ignored.
 356
 357 =cut
 358 #'
 359 sub updaterecorder{
 360   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
 361   my $dbh = C4::Context->dbh;
 362   my $query="update aqorders set
 363   unitprice='$cost', rrp='$rrp'
 364   where biblionumber=$biblio and ordernumber=$ordnum
 365   ";
 366 #  print $query;
 367   my $sth=$dbh->prepare($query);
 368   $sth->execute;
 369   $sth->finish;
 370   $query="update aqorderbreakdown set bookfundid=$bookfund where
 371   ordernumber=$ordnum";
 372   $sth=$dbh->prepare($query);
 373 #  print $query;
 374   $sth->execute;
 375   $sth->finish;
 376 }
 377
 378 #
 379 #
 380 # ORDERS
 381 #
 382 #
 383
 384 =item getorders
 385
 386   ($count, $orders) = &getorders($booksellerid);
 387
 388 Finds pending orders from the bookseller with the given ID. Ignores
 389 completed and cancelled orders.
 390
 391 C<$count> is the number of elements in C<@{$orders}>.
 392
 393 C<$orders> is a reference-to-array; each element is a
 394 reference-to-hash with the following fields:
 395
 396 =over 4
 397
 398 =item C<count(*)>
 399
 400 Gives the number of orders in with this basket number.
 401
 402 =item C<authorizedby>
 403
 404 =item C<entrydate>
 405
 406 =item C<basketno>
 407
 408 These give the value of the corresponding field in the aqorders table
 409 of the Koha database.
 410
 411 =back
 412
 413 Results are ordered from most to least recent.
 414
 415 =cut
 416 #'
 417 sub getorders {
 418   my ($supplierid)=@_;
 419   my $dbh = C4::Context->dbh;
 420   my $query = "Select count(*),authorisedby,entrydate,basketno from aqorders where
 421   booksellerid='$supplierid' and (quantity > quantityreceived or
 422   quantityreceived is NULL)
 423   and (datecancellationprinted is NULL or datecancellationprinted = '0000-00-00')";
 424   $query.=" group by basketno order by entrydate desc";
 425   #print $query;
 426   my $sth=$dbh->prepare($query);
 427   $sth->execute;
 428   my @results;
 429   my $i=0;
 430   while (my $data=$sth->fetchrow_hashref){
 431     $results[$i]=$data;
 432     $i++;
 433   }
 434   $sth->finish;
 435   return ($i,\@results);
 436 }
 437
 438 =item getorder
 439
 440   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 441
 442 Looks up the order with the given biblionumber and biblioitemnumber.
 443
 444 Returns a two-element array. C<$ordernumber> is the order number.
 445 C<$order> is a reference-to-hash describing the order; its keys are
 446 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 447 tables of the Koha database.
 448
 449 =cut
 450 #'
 451 # FIXME - This is effectively identical to &C4::Biblio::getorder.
 452 # Pick one and stick with it.
 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 effectively identical to
 482 # &C4::Biblio::getsingleorder.
 483 # Pick one and stick with it.
 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 - This is never used
 827 sub updatecost{
 828   my($price,$rrp,$itemnum)=@_;
 829   my $dbh = C4::Context->dbh;
 830   my $query="update items set price='$price',replacementprice='$rrp'
 831   where itemnumber=$itemnum";
 832   my $sth=$dbh->prepare($query);
 833   $sth->execute;
 834   $sth->finish;
 835 }
 836
 837 #
 838 #
 839 # OTHERS
 840 #
 841 #
 842
 843 =item bookseller
 844
 845   ($count, @results) = &bookseller($searchstring);
 846
 847 Looks up a book seller. C<$searchstring> may be either a book seller
 848 ID, or a string to look for in the book seller's name.
 849
 850 C<$count> is the number of elements in C<@results>. C<@results> is an
 851 array of references-to-hash, whose keys are the fields of of the
 852 aqbooksellers table in the Koha database.
 853
 854 =cut
 855 #'
 856 sub bookseller {
 857   my ($searchstring)=@_;
 858   my $dbh = C4::Context->dbh;
 859   my $query="Select * from aqbooksellers where name like '%$searchstring%' or
 860   id = '$searchstring'";
 861   my $sth=$dbh->prepare($query);
 862   $sth->execute;
 863   my @results;
 864   my $i=0;
 865   while (my $data=$sth->fetchrow_hashref){
 866     $results[$i]=$data;
 867     $i++;
 868   }
 869   $sth->finish;
 870   return($i,@results);
 871 }
 872
 873 =item breakdown
 874
 875   ($count, $results) = &breakdown($ordernumber);
 876
 877 Looks up an order by order ID, and returns its breakdown.
 878
 879 C<$count> is the number of elements in C<$results>. C<$results> is a
 880 reference-to-array; its elements are references-to-hash, whose keys
 881 are the fields of the aqorderbreakdown table in the Koha database.
 882
 883 =cut
 884 #'
 885 sub breakdown {
 886   my ($id)=@_;
 887   my $dbh = C4::Context->dbh;
 888   my $query="Select * from aqorderbreakdown where ordernumber='$id'";
 889   my $sth=$dbh->prepare($query);
 890   $sth->execute;
 891   my @results;
 892   my $i=0;
 893   while (my $data=$sth->fetchrow_hashref){
 894     $results[$i]=$data;
 895     $i++;
 896   }
 897   $sth->finish;
 898   return($i,\@results);
 899 }
 900
 901 =item branches
 902
 903   ($count, @results) = &branches();
 904
 905 Returns a list of all library branches.
 906
 907 C<$count> is the number of elements in C<@results>. C<@results> is an
 908 array of references-to-hash, whose keys are the fields of the branches
 909 table of the Koha database.
 910
 911 =cut
 912 #'
 913 sub branches {
 914     my $dbh   = C4::Context->dbh;
 915     my $query = "Select * from branches";
 916     my $sth   = $dbh->prepare($query);
 917     my $i     = 0;
 918     my @results;
 919
 920     $sth->execute;
 921     while (my $data = $sth->fetchrow_hashref) {
 922         $results[$i] = $data;
 923         $i++;
 924     } # while
 925
 926     $sth->finish;
 927     return($i, @results);
 928 } # sub branches
 929
 930 # FIXME - Never used
 931 sub findall {
 932   my ($biblionumber)=@_;
 933   my $dbh = C4::Context->dbh;
 934   my $query="Select * from biblioitems,items,itemtypes where
 935   biblioitems.biblionumber=$biblionumber
 936   and biblioitems.biblioitemnumber=items.biblioitemnumber and
 937   itemtypes.itemtype=biblioitems.itemtype
 938   order by items.biblioitemnumber";
 939   my $sth=$dbh->prepare($query);
 940   $sth->execute;
 941   my @results;
 942   my $i;
 943   while (my $data=$sth->fetchrow_hashref){
 944     $results[$i]=$data;
 945     $i++;
 946   }
 947   $sth->finish;
 948   return(@results);
 949 }
 950
 951 # FIXME - Never used
 952 sub needsmod{
 953   my ($bibitemnum,$itemtype)=@_;
 954   my $dbh = C4::Context->dbh;
 955   my $query="Select * from biblioitems where biblioitemnumber=$bibitemnum
 956   and itemtype='$itemtype'";
 957   my $sth=$dbh->prepare($query);
 958   $sth->execute;
 959   my $result=0;
 960   if (my $data=$sth->fetchrow_hashref){
 961     $result=1;
 962   }
 963   $sth->finish;
 964   return($result);
 965 }
 966
 967 =item updatesup
 968
 969   &updatesup($bookseller);
 970
 971 Updates the information for a given bookseller. C<$bookseller> is a
 972 reference-to-hash whose keys are the fields of the aqbooksellers table
 973 in the Koha database. It must contain entries for all of the fields.
 974 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
 975
 976 The easiest way to get all of the necessary fields is to look up a
 977 book seller with C<&booksellers>, modify what's necessary, then call
 978 C<&updatesup> with the result.
 979
 980 =cut
 981 #'
 982 sub updatesup {
 983    my ($data)=@_;
 984    my $dbh = C4::Context->dbh;
 985    my $query="Update aqbooksellers set
 986    name='$data->{'name'}',address1='$data->{'address1'}',address2='$data->{'address2'}',
 987    address3='$data->{'address3'}',address4='$data->{'address4'}',postal='$data->{'postal'}',
 988    phone='$data->{'phone'}',fax='$data->{'fax'}',url='$data->{'url'}',
 989    contact='$data->{'contact'}',contpos='$data->{'contpos'}',
 990    contphone='$data->{'contphone'}', contfax='$data->{'contfax'}', contaltphone=
 991    '$data->{'contaltphone'}', contemail='$data->{'contemail'}', contnotes=
 992    '$data->{'contnotes'}', active=$data->{'active'},
 993    listprice='$data->{'listprice'}', invoiceprice='$data->{'invoiceprice'}',
 994    gstreg=$data->{'gstreg'}, listincgst=$data->{'listincgst'},
 995    invoiceincgst=$data->{'invoiceincgst'}, specialty='$data->{'specialty'}',
 996    discount='$data->{'discount'}',invoicedisc='$data->{'invoicedisc'}',
 997    nocalc='$data->{'nocalc'}'
 998    where id='$data->{'id'}'";
 999    my $sth=$dbh->prepare($query);
1000    $sth->execute;
1001    $sth->finish;
1002 #   print $query;
1003 }
1004
1005 =item insertsup
1006
1007   $id = &insertsup($bookseller);
1008
1009 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1010 keys are the fields of the aqbooksellers table in the Koha database.
1011 All fields must be present.
1012
1013 Returns the ID of the newly-created bookseller.
1014
1015 =cut
1016 #'
1017 sub insertsup {
1018   my ($data)=@_;
1019   my $dbh = C4::Context->dbh;
1020   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
1021   $sth->execute;
1022   my $data2=$sth->fetchrow_hashref;
1023   $sth->finish;
1024   $data2->{'max(id)'}++;
1025   $sth=$dbh->prepare("Insert into aqbooksellers (id) values ($data2->{'max(id)'})");
1026   $sth->execute;
1027   $sth->finish;
1028   $data->{'id'}=$data2->{'max(id)'};
1029   updatesup($data);
1030   return($data->{'id'});
1031 }
1032
1033 =item websitesearch
1034
1035   ($count, @results) = &websitesearch($keywordlist);
1036
1037 Looks up biblioitems by URL.
1038
1039 C<$keywordlist> is a space-separated list of search terms.
1040 C<&websitesearch> returns those biblioitems whose URL contains at
1041 least one of the search terms.
1042
1043 C<$count> is the number of elements in C<@results>. C<@results> is an
1044 array of references-to-hash, whose keys are the fields of the biblio
1045 and biblioitems tables in the Koha database.
1046
1047 =cut
1048 #'
1049 sub websitesearch {
1050     my ($keywordlist) = @_;
1051     my $dbh   = C4::Context->dbh;
1052     my $query = "Select distinct biblio.* from biblio, biblioitems where
1053 biblio.biblionumber = biblioitems.biblionumber and (";
1054     my $count = 0;
1055     my $sth;
1056     my @results;
1057     my @keywords = split(/ +/, $keywordlist);
1058     my $keyword = shift(@keywords);
1059
1060     # FIXME - Can use
1061     #   $query .= join(" and ",
1062     #           apply { url like "%$_%" } @keywords
1063
1064     $keyword =~ s/%/\\%/g;
1065     $keyword =~ s/_/\\_/;
1066     $keyword = "%" . $keyword . "%";
1067     $keyword = $dbh->quote($keyword);
1068     $query  .= " (url like $keyword)";
1069
1070     foreach $keyword (@keywords) {
1071         $keyword =~ s/%/\\%/;
1072         $keyword =~ s/_/\\_/;
1073         $keyword = "%" . $keyword . "%";
1074         $keyword = $dbh->quote($keyword);
1075         $query  .= " or (url like $keyword)";
1076     } # foreach
1077
1078     $query .= ")";
1079     $sth    = $dbh->prepare($query);
1080     $sth->execute;
1081
1082     while (my $data = $sth->fetchrow_hashref) {
1083         $results[$count] = $data;
1084         $count++;
1085     } # while
1086
1087     $sth->finish;
1088     return($count, @results);
1089 } # sub websitesearch
1090
1091 =item addwebsite
1092
1093   &addwebsite($website);
1094
1095 Adds a new web site. C<$website> is a reference-to-hash, with the keys
1096 C<biblionumber>, C<title>, C<description>, and C<url>. All of these
1097 are mandatory.
1098
1099 =cut
1100 #'
1101 sub addwebsite {
1102     my ($website) = @_;
1103     my $dbh = C4::Context->dbh;
1104     my $query;
1105
1106     # FIXME -
1107     #   for (qw( biblionumber title description url )) # and any others
1108     #   {
1109     #           $website->{$_} = $dbh->quote($_);
1110     #   }
1111     # Perhaps extend this to building the query as well. This might allow
1112     # some of the fields to be optional.
1113     $website->{'biblionumber'} = $dbh->quote($website->{'biblionumber'});
1114     $website->{'title'}        = $dbh->quote($website->{'title'});
1115     $website->{'description'}  = $dbh->quote($website->{'description'});
1116     $website->{'url'}          = $dbh->quote($website->{'url'});
1117
1118     $query = "Insert into websites set
1119 biblionumber = $website->{'biblionumber'},
1120 title        = $website->{'title'},
1121 description  = $website->{'description'},
1122 url          = $website->{'url'}";
1123
1124     $dbh->do($query);
1125 } # sub website
1126
1127 =item updatewebsite
1128
1129   &updatewebsite($website);
1130
1131 Updates an existing web site. C<$website> is a reference-to-hash with
1132 the keys C<websitenumber>, C<title>, C<description>, and C<url>. All
1133 of these are mandatory. C<$website-E<gt>{websitenumber}> identifies
1134 the entry to update.
1135
1136 =cut
1137 #'
1138 sub updatewebsite {
1139     my ($website) = @_;
1140     my $dbh = C4::Context->dbh;
1141     my $query;
1142
1143     $website->{'title'}      = $dbh->quote($website->{'title'});
1144     $website->{'description'} = $dbh->quote($website->{'description'});
1145     $website->{'url'}        = $dbh->quote($website->{'url'});
1146
1147     $query = "Update websites set
1148 title       = $website->{'title'},
1149 description = $website->{'description'},
1150 url         = $website->{'url'}
1151 where websitenumber = $website->{'websitenumber'}";
1152
1153     $dbh->do($query);
1154 } # sub updatewebsite
1155
1156 =item deletewebsite
1157
1158   &deletewebsite($websitenumber);
1159
1160 Deletes the web site with number C<$websitenumber>.
1161
1162 =cut
1163 #'
1164 sub deletewebsite {
1165     my ($websitenumber) = @_;
1166     my $dbh = C4::Context->dbh;
1167     # FIXME - $query is unneeded
1168     my $query = "Delete from websites where websitenumber = $websitenumber";
1169
1170     $dbh->do($query);
1171 } # sub deletewebsite
1172
1173 END { }       # module clean-up code here (global destructor)
1174
1175 1;
1176 __END__
1177
1178 =back
1179
1180 =head1 AUTHOR
1181
1182 Koha Developement team <info@koha.org>
1183
1184 =cut