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