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