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