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