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