C4/Catalogue.pm

   1 package C4::Catalogue; #assumes C4/Acquisitions.pm
   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
  12
  13 # Copyright 2000-2002 Katipo Communications
  14 #
  15 # This file is part of Koha.
  16 #
  17 # Koha is free software; you can redistribute it and/or modify it under the
  18 # terms of the GNU General Public License as published by the Free Software
  19 # Foundation; either version 2 of the License, or (at your option) any later
  20 # version.
  21 #
  22 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  23 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  24 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  25 #
  26 # You should have received a copy of the GNU General Public License along with
  27 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  28 # Suite 330, Boston, MA  02111-1307 USA
  29
  30 use strict;
  31 require Exporter;
  32 use C4::Context;
  33 use MARC::Record;
  34 use C4::Biblio;
  35
  36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  37
  38 # set the version for version checking
  39 $VERSION = 0.01;
  40
  41 =head1 NAME
  42
  43 C4::Catalogue - Koha functions for dealing with orders and acquisitions
  44
  45 =head1 SYNOPSIS
  46
  47   use C4::Catalogue;
  48
  49 =head1 DESCRIPTION
  50
  51 The functions in this module deal with acquisitions, managing book
  52 orders, converting money to different currencies, and so forth.
  53
  54 =head1 FUNCTIONS
  55
  56 =over 2
  57
  58 =cut
  59
  60 @ISA = qw(Exporter);
  61 @EXPORT = qw(
  62              &basket &newbasket
  63
  64              &getorders &getallorders &getrecorders
  65              &getorder &neworder &delorder
  66              &ordersearch
  67              &modorder &getsingleorder &invoice &receiveorder
  68              &updaterecorder &newordernum
  69
  70              &bookfunds &bookfundbreakdown &updatecost
  71              &curconvert &getcurrencies &updatecurrencies &getcurrency
  72
  73              &findall &needsmod &branches &updatesup &insertsup
  74              &bookseller &breakdown &checkitems
  75              &websitesearch &addwebsite &updatewebsite &deletewebsite
  76 );
  77 %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],
  78
  79 # your exported package globals go here,
  80 # as well as any optionally exported functions
  81
  82 @EXPORT_OK   = qw($Var1 %Hashit);       # FIXME - Unused
  83
  84
  85 # non-exported package globals go here
  86 use vars qw(@more $stuff);              # FIXME - Unused
  87
  88 # initalize package globals, first exported ones
  89 # FIXME - Unused
  90 my $Var1   = '';
  91 my %Hashit = ();
  92
  93
  94 # then the others (which are still accessible as $Some::Module::stuff)
  95 # FIXME - Unused
  96 my $stuff  = '';
  97 my @more   = ();
  98
  99 # all file-scoped lexicals must be created before
 100 # the functions below that use them.
 101
 102 # file-private lexicals go here
 103 # FIXME - Unused
 104 my $priv_var    = '';
 105 my %secret_hash = ();
 106
 107 # here's a file-private function as a closure,
 108 # callable as &$priv_func;  it cannot be prototyped.
 109 # FIXME - Unused
 110 my $priv_func = sub {
 111   # stuff goes here.
 112   };
 113
 114 # make all your functions, whether exported or not;
 115
 116
 117 #
 118 #
 119 #
 120 # BASKETS
 121 #
 122 #
 123 #
 124 =item basket
 125
 126   ($count, @orders) = &basket($basketnumber, $booksellerID);
 127
 128 Looks up the pending (non-cancelled) orders with the given basket
 129 number. If C<$booksellerID> is non-empty, only orders from that seller
 130 are returned.
 131
 132 C<&basket> returns a two-element array. C<@orders> is an array of
 133 references-to-hash, whose keys are the fields from the aqorders,
 134 biblio, and biblioitems tables in the Koha database. C<$count> is the
 135 number of elements in C<@orders>.
 136
 137 =cut
 138 #'
 139 sub basket {
 140   my ($basketno,$supplier)=@_;
 141   my $dbh = C4::Context->dbh;
 142   my $query="Select *,biblio.title from aqorders,biblio,biblioitems
 143   where basketno='$basketno'
 144   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
 145   =aqorders.biblioitemnumber
 146   and (datecancellationprinted is NULL or datecancellationprinted =
 147   '0000-00-00')";
 148   if ($supplier ne ''){
 149     $query.=" and aqorders.booksellerid='$supplier'";
 150   }
 151   $query.=" group by aqorders.ordernumber";
 152   my $sth=$dbh->prepare($query);
 153   $sth->execute;
 154   my @results;
 155 #  print $query;
 156   my $i=0;
 157   while (my $data=$sth->fetchrow_hashref){
 158     $results[$i]=$data;
 159     $i++;
 160   }
 161   $sth->finish;
 162   return($i,@results);
 163 }
 164
 165 =item newbasket
 166
 167   $basket = &newbasket();
 168
 169 Finds the next unused basket number in the aqorders table of the Koha
 170 database, and returns it.
 171
 172 =cut
 173 #'
 174 # FIXME - There's a race condition here:
 175 #       A calls &newbasket
 176 #       B calls &newbasket (gets the same number as A)
 177 #       A updates the basket
 178 #       B updates the basket, and clobbers A's result.
 179 # A better approach might be to create a dummy order (with, say,
 180 # requisitionedby == "Dummy-$$" or notes == "dummy <time> <pid>"), and
 181 # see which basket number it gets. Then have a cron job periodically
 182 # remove out-of-date dummy orders.
 183 sub newbasket {
 184   my $dbh = C4::Context->dbh;
 185   my $query="Select max(basketno) from aqorders";
 186   my $sth=$dbh->prepare($query);
 187   $sth->execute;
 188   my $data=$sth->fetchrow_arrayref;
 189   my $basket=$$data[0];
 190   $basket++;
 191   $sth->finish;
 192   return($basket);
 193 }
 194
 195 =item neworder
 196
 197   &neworder($biblionumber, $title, $ordnum, $basket, $quantity, $listprice,
 198         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 199         $ecost, $gst, $budget, $unitprice, $subscription,
 200         $booksellerinvoicenumber);
 201
 202 Adds a new order to the database. Any argument that isn't described
 203 below is the new value of the field with the same name in the aqorders
 204 table of the Koha database.
 205
 206 C<$ordnum> is a "minimum order number." After adding the new entry to
 207 the aqorders table, C<&neworder> finds the first entry in aqorders
 208 with order number greater than or equal to C<$ordnum>, and adds an
 209 entry to the aqorderbreakdown table, with the order number just found,
 210 and the book fund ID of the newly-added order.
 211
 212 C<$budget> is effectively ignored.
 213
 214 C<$subscription> may be either "yes", or anything else for "no".
 215
 216 =cut
 217 #'
 218 sub neworder {
 219   my ($bibnum,$title,$ordnum,$basket,$quantity,$listprice,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice)=@_;
 220   if ($budget eq 'now'){
 221     $budget="now()";
 222   } else {
 223     $budget="'2001-07-01'";
 224   }
 225   if ($sub eq 'yes'){
 226     $sub=1;
 227   } else {
 228     $sub=0;
 229   }
 230   my $dbh = C4::Context->dbh;
 231   my $query="insert into aqorders (biblionumber,title,basketno,
 232   quantity,listprice,booksellerid,entrydate,requisitionedby,authorisedby,notes,
 233   biblioitemnumber,rrp,ecost,gst,unitprice,subscription,booksellerinvoicenumber)
 234
 235   values
 236   ($bibnum,'$title',$basket,$quantity,$listprice,'$supplier',now(),
 237   '$who','$who','$notes',$bibitemnum,'$rrp','$ecost','$gst','$cost',
 238   '$sub','$invoice')";
 239   my $sth=$dbh->prepare($query);
 240 #  print $query;
 241   $sth->execute;
 242   $sth->finish;
 243   $query="select * from aqorders where
 244   biblionumber=$bibnum and basketno=$basket and ordernumber >=$ordnum";
 245   $sth=$dbh->prepare($query);
 246   $sth->execute;
 247   my $data=$sth->fetchrow_hashref;
 248   $sth->finish;
 249   $ordnum=$data->{'ordernumber'};
 250   $query="insert into aqorderbreakdown (ordernumber,bookfundid) values
 251   ($ordnum,'$bookfund')";
 252   $sth=$dbh->prepare($query);
 253 #  print $query;
 254   $sth->execute;
 255   $sth->finish;
 256 }
 257
 258 =item delorder
 259
 260   &delorder($biblionumber, $ordernumber);
 261
 262 Cancel the order with the given order and biblio numbers. It does not
 263 delete any entries in the aqorders table, it merely marks them as
 264 cancelled.
 265
 266 If there are no items remaining with the given biblionumber,
 267 C<&delorder> also deletes them from the marc_subfield_table and
 268 marc_biblio tables of the Koha database.
 269
 270 =cut
 271 #'
 272 sub delorder {
 273   my ($bibnum,$ordnum)=@_;
 274   my $dbh = C4::Context->dbh;
 275   my $query="update aqorders set datecancellationprinted=now()
 276   where biblionumber='$bibnum' and
 277   ordernumber='$ordnum'";
 278   my $sth=$dbh->prepare($query);
 279   #print $query;
 280   $sth->execute;
 281   $sth->finish;
 282   my $count=itemcount($bibnum);
 283   if ($count == 0){
 284     delbiblio($bibnum);         # This is C4::Biblio::delbiblio, not
 285                                 # C4::Acquisitions::delbiblio
 286   }
 287 }
 288
 289 =item modorder
 290
 291   &modorder($title, $ordernumber, $quantity, $listprice,
 292         $biblionumber, $basketno, $supplier, $who, $notes,
 293         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 294         $unitprice, $booksellerinvoicenumber);
 295
 296 Modifies an existing order. Updates the order with order number
 297 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 298 update the fields with the same name in the aqorders table of the Koha
 299 database.
 300
 301 Entries with order number C<$ordernumber> in the aqorderbreakdown
 302 table are also updated to the new book fund ID.
 303
 304 =cut
 305 #'
 306 # FIXME - This function appears in C4::Acquisitions
 307 sub modorder {
 308   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice)=@_;
 309   my $dbh = C4::Context->dbh;
 310   my $query="update aqorders set title='$title',
 311   quantity='$quantity',listprice='$listprice',basketno='$basketno',
 312   rrp='$rrp',ecost='$ecost',unitprice='$cost',
 313   booksellerinvoicenumber='$invoice'
 314   where
 315   ordernumber=$ordnum and biblionumber=$bibnum";
 316   my $sth=$dbh->prepare($query);
 317 #  print $query;
 318   $sth->execute;
 319   $sth->finish;
 320   $query="update aqorderbreakdown set bookfundid=$bookfund where
 321   ordernumber=$ordnum";
 322   $sth=$dbh->prepare($query);
 323 #  print $query;
 324   $sth->execute;
 325   $sth->finish;
 326 }
 327
 328 =item newordernum
 329
 330   $order = &newordernum();
 331
 332 Finds the next unused order number in the aqorders table of the Koha
 333 database, and returns it.
 334
 335 =cut
 336 #'
 337 # FIXME - Race condition
 338 sub newordernum {
 339   my $dbh = C4::Context->dbh;
 340   my $query="Select max(ordernumber) from aqorders";
 341   my $sth=$dbh->prepare($query);
 342   $sth->execute;
 343   my $data=$sth->fetchrow_arrayref;
 344   my $ordnum=$$data[0];
 345   $ordnum++;
 346   $sth->finish;
 347   return($ordnum);
 348 }
 349
 350 =item receiveorder
 351
 352   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
 353         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 354         $freight, $bookfund, $rrp);
 355
 356 Updates an order, to reflect the fact that it was received, at least
 357 in part. All arguments not mentioned below update the fields with the
 358 same name in the aqorders table of the Koha database.
 359
 360 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 361 C<$ordernumber>.
 362
 363 Also updates the book fund ID in the aqorderbreakdown table.
 364
 365 =cut
 366 #'
 367 sub receiveorder {
 368   my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$bibitemno,$freight,$bookfund,$rrp)=@_;
 369   my $dbh = C4::Context->dbh;
 370   my $query="update aqorders set quantityreceived='$quantrec',
 371   datereceived=now(),booksellerinvoicenumber='$invoiceno',
 372   biblioitemnumber=$bibitemno,unitprice='$cost',freight='$freight',
 373   rrp='$rrp'
 374   where biblionumber=$biblio and ordernumber=$ordnum
 375   ";
 376 #  print $query;
 377   my $sth=$dbh->prepare($query);
 378   $sth->execute;
 379   $sth->finish;
 380   $query="update aqorderbreakdown set bookfundid=$bookfund where
 381   ordernumber=$ordnum";
 382   $sth=$dbh->prepare($query);
 383 #  print $query;
 384   $sth->execute;
 385   $sth->finish;
 386 }
 387
 388 =item updaterecorder
 389
 390   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 391         $bookfundid, $rrp);
 392
 393 Updates the order with biblionumber C<$biblionumber> and order number
 394 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 395 in the aqorderbreakdown table of the Koha database. All other
 396 arguments update the fields with the same name in the aqorders table.
 397
 398 C<$user> is ignored.
 399
 400 =cut
 401 #'
 402 sub updaterecorder{
 403   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
 404   my $dbh = C4::Context->dbh;
 405   my $query="update aqorders set
 406   unitprice='$cost', rrp='$rrp'
 407   where biblionumber=$biblio and ordernumber=$ordnum
 408   ";
 409 #  print $query;
 410   my $sth=$dbh->prepare($query);
 411   $sth->execute;
 412   $sth->finish;
 413   $query="update aqorderbreakdown set bookfundid=$bookfund where
 414   ordernumber=$ordnum";
 415   $sth=$dbh->prepare($query);
 416 #  print $query;
 417   $sth->execute;
 418   $sth->finish;
 419 }
 420
 421 #
 422 #
 423 # ORDERS
 424 #
 425 #
 426
 427 =item getorders
 428
 429   ($count, $orders) = &getorders($booksellerid);
 430
 431 Finds pending orders from the bookseller with the given ID. Ignores
 432 completed and cancelled orders.
 433
 434 C<$count> is the number of elements in C<@{$orders}>.
 435
 436 C<$orders> is a reference-to-array; each element is a
 437 reference-to-hash with the following fields:
 438
 439 =over 4
 440
 441 =item C<count(*)>
 442
 443 Gives the number of orders in with this basket number.
 444
 445 =item C<authorizedby>
 446
 447 =item C<entrydate>
 448
 449 =item C<basketno>
 450
 451 These give the value of the corresponding field in the aqorders table
 452 of the Koha database.
 453
 454 =back
 455
 456 Results are ordered from most to least recent.
 457
 458 =cut
 459 #'
 460 sub getorders {
 461   my ($supplierid)=@_;
 462   my $dbh = C4::Context->dbh;
 463   my $query = "Select count(*),authorisedby,entrydate,basketno from aqorders where
 464   booksellerid='$supplierid' and (quantity > quantityreceived or
 465   quantityreceived is NULL)
 466   and (datecancellationprinted is NULL or datecancellationprinted = '0000-00-00')";
 467   $query.=" group by basketno order by entrydate desc";
 468   #print $query;
 469   my $sth=$dbh->prepare($query);
 470   $sth->execute;
 471   my @results;
 472   my $i=0;
 473   while (my $data=$sth->fetchrow_hashref){
 474     $results[$i]=$data;
 475     $i++;
 476   }
 477   $sth->finish;
 478   return ($i,\@results);
 479 }
 480
 481 =item getorder
 482
 483   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 484
 485 Looks up the order with the given biblionumber and biblioitemnumber.
 486
 487 Returns a two-element array. C<$ordernumber> is the order number.
 488 C<$order> is a reference-to-hash describing the order; its keys are
 489 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 490 tables of the Koha database.
 491
 492 =cut
 493 #'
 494 sub getorder{
 495   my ($bi,$bib)=@_;
 496   my $dbh = C4::Context->dbh;
 497   my $query="Select ordernumber from aqorders where biblionumber=$bib and
 498   biblioitemnumber='$bi'";
 499   my $sth=$dbh->prepare($query);
 500   $sth->execute;
 501   # FIXME - Use fetchrow_array(), since we're only interested in the one
 502   # value.
 503   my $ordnum=$sth->fetchrow_hashref;
 504   $sth->finish;
 505   my $order=getsingleorder($ordnum->{'ordernumber'});
 506 #  print $query;
 507   return ($order,$ordnum->{'ordernumber'});
 508 }
 509
 510 =item getsingleorder
 511
 512   $order = &getsingleorder($ordernumber);
 513
 514 Looks up an order by order number.
 515
 516 Returns a reference-to-hash describing the order. The keys of
 517 C<$order> are fields from the biblio, biblioitems, aqorders, and
 518 aqorderbreakdown tables of the Koha database.
 519
 520 =cut
 521 #'
 522 # FIXME - This is basically the same thing as
 523 # C4::Acquisitions::getsingleorder. Figure out where it goes and nuke
 524 # the other one.
 525 sub getsingleorder {
 526   my ($ordnum)=@_;
 527   my $dbh = C4::Context->dbh;
 528   my $query="Select * from biblio,biblioitems,aqorders,aqorderbreakdown
 529   where aqorders.ordernumber='$ordnum'
 530   and biblio.biblionumber=aqorders.biblionumber and
 531   biblioitems.biblioitemnumber=aqorders.biblioitemnumber and
 532   aqorders.ordernumber=aqorderbreakdown.ordernumber";
 533   my $sth=$dbh->prepare($query);
 534   $sth->execute;
 535   my $data=$sth->fetchrow_hashref;
 536   $sth->finish;
 537   return($data);
 538 }
 539
 540 =item getallorders
 541
 542   ($count, @results) = &getallorders($booksellerid);
 543
 544 Looks up all of the pending orders from the supplier with the given
 545 bookseller ID. Ignores cancelled and completed orders.
 546
 547 C<$count> is the number of elements in C<@results>. C<@results> is an
 548 array of references-to-hash. The keys of each element are fields from
 549 the aqorders, biblio, and biblioitems tables of the Koha database.
 550
 551 C<@results> is sorted alphabetically by book title.
 552
 553 =cut
 554 #'
 555 sub getallorders {
 556   #gets all orders from a certain supplier, orders them alphabetically
 557   my ($supid)=@_;
 558   my $dbh = C4::Context->dbh;
 559   my $query="Select * from aqorders,biblio,biblioitems where booksellerid='$supid'
 560   and (cancelledby is NULL or cancelledby = '')
 561   and (quantityreceived < quantity or quantityreceived is NULL)
 562   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 563   aqorders.biblioitemnumber
 564   group by aqorders.biblioitemnumber
 565   order by
 566   biblio.title";
 567   my $i=0;
 568   my @results;
 569   my $sth=$dbh->prepare($query);
 570   $sth->execute;
 571   while (my $data=$sth->fetchrow_hashref){
 572     $results[$i]=$data;
 573     $i++;
 574   }
 575   $sth->finish;
 576   return($i,@results);
 577 }
 578
 579 # FIXME - Never used
 580 sub getrecorders {
 581   #gets all orders from a certain supplier, orders them alphabetically
 582   my ($supid)=@_;
 583   my $dbh = C4::Context->dbh;
 584   my $query="Select * from aqorders,biblio,biblioitems where booksellerid='$supid'
 585   and (cancelledby is NULL or cancelledby = '')
 586   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 587   aqorders.biblioitemnumber and
 588   aqorders.quantityreceived>0
 589   and aqorders.datereceived >=now()
 590   group by aqorders.biblioitemnumber
 591   order by
 592   biblio.title";
 593   my $i=0;
 594   my @results;
 595   my $sth=$dbh->prepare($query);
 596   $sth->execute;
 597   while (my $data=$sth->fetchrow_hashref){
 598     $results[$i]=$data;
 599     $i++;
 600   }
 601   $sth->finish;
 602   return($i,@results);
 603 }
 604
 605 =item ordersearch
 606
 607   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
 608
 609 Searches for orders.
 610
 611 C<$search> may take one of several forms: if it is an ISBN,
 612 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 613 order number, C<&ordersearch> returns orders with that order number
 614 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 615 to be a space-separated list of search terms; in this case, all of the
 616 terms must appear in the title (matching the beginning of title
 617 words).
 618
 619 If C<$complete> is C<yes>, the results will include only completed
 620 orders. In any case, C<&ordersearch> ignores cancelled orders.
 621
 622 C<&ordersearch> returns an array. C<$count> is the number of elements
 623 in C<@results>. C<@results> is an array of references-to-hash with the
 624 following keys:
 625
 626 =over 4
 627
 628 =item C<author>
 629
 630 =item C<seriestitle>
 631
 632 =item C<branchcode>
 633
 634 =item C<bookfundid>
 635
 636 =back
 637
 638 =cut
 639 #'
 640 sub ordersearch {
 641   my ($search,$biblio,$catview) = @_;
 642   my $dbh   = C4::Context->dbh;
 643   my $query = "Select *,biblio.title from aqorders,biblioitems,biblio
 644 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber
 645 and biblio.biblionumber=aqorders.biblionumber
 646 and ((datecancellationprinted is NULL)
 647 or (datecancellationprinted = '0000-00-00'))
 648 and ((";
 649   my @data  = split(' ',$search);
 650   my $count = @data;
 651   for (my $i = 0; $i < $count; $i++) {
 652     $query .= "(biblio.title like '$data[$i]%' or biblio.title like '% $data[$i]%') and ";
 653   }
 654   $query=~ s/ and $//;
 655                 # FIXME - Redo this properly instead of hacking off the
 656                 # trailing 'and'.
 657   $query.=" ) or biblioitems.isbn='$search'
 658   or (aqorders.ordernumber='$search' and aqorders.biblionumber='$biblio')) ";
 659   if ($catview ne 'yes'){
 660     $query.=" and (quantityreceived < quantity or quantityreceived is NULL)";
 661   }
 662   $query.=" group by aqorders.ordernumber";
 663   my $sth=$dbh->prepare($query);
 664   $sth->execute;
 665   my $i=0;
 666   my @results;
 667   while (my $data=$sth->fetchrow_hashref){
 668      my $sth2=$dbh->prepare("Select * from biblio where
 669      biblionumber='$data->{'biblionumber'}'");
 670      $sth2->execute;
 671      my $data2=$sth2->fetchrow_hashref;
 672      $sth2->finish;
 673      $data->{'author'}=$data2->{'author'};
 674      $data->{'seriestitle'}=$data2->{'seriestitle'};
 675      $sth2=$dbh->prepare("Select * from aqorderbreakdown where
 676     ordernumber=$data->{'ordernumber'}");
 677     $sth2->execute;
 678     $data2=$sth2->fetchrow_hashref;
 679     $sth2->finish;
 680     $data->{'branchcode'}=$data2->{'branchcode'};
 681     $data->{'bookfundid'}=$data2->{'bookfundid'};
 682     $results[$i]=$data;
 683     $i++;
 684   }
 685   $sth->finish;
 686   return($i,@results);
 687 }
 688
 689 #
 690 #
 691 # MONEY
 692 #
 693 #
 694 =item invoice
 695
 696   ($count, @results) = &invoice($booksellerinvoicenumber);
 697
 698 Looks up orders by invoice number.
 699
 700 Returns an array. C<$count> is the number of elements in C<@results>.
 701 C<@results> is an array of references-to-hash; the keys of each
 702 elements are fields from the aqorders, biblio, and biblioitems tables
 703 of the Koha database.
 704
 705 =cut
 706 #'
 707 sub invoice {
 708   my ($invoice)=@_;
 709   my $dbh = C4::Context->dbh;
 710   my $query="Select * from aqorders,biblio,biblioitems where
 711   booksellerinvoicenumber='$invoice'
 712   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 713   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber";
 714   my $i=0;
 715   my @results;
 716   my $sth=$dbh->prepare($query);
 717   $sth->execute;
 718   while (my $data=$sth->fetchrow_hashref){
 719     $results[$i]=$data;
 720     $i++;
 721   }
 722   $sth->finish;
 723   return($i,@results);
 724 }
 725
 726 =item bookfunds
 727
 728   ($count, @results) = &bookfunds();
 729
 730 Returns a list of all book funds.
 731
 732 C<$count> is the number of elements in C<@results>. C<@results> is an
 733 array of references-to-hash, whose keys are fields from the aqbookfund
 734 and aqbudget tables of the Koha database. Results are ordered
 735 alphabetically by book fund name.
 736
 737 =cut
 738 #'
 739 sub bookfunds {
 740   my $dbh = C4::Context->dbh;
 741   my $query="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 742   =aqbudget.bookfundid
 743   group by aqbookfund.bookfundid order by bookfundname";
 744   my $sth=$dbh->prepare($query);
 745   $sth->execute;
 746   my @results;
 747   my $i=0;
 748   while (my $data=$sth->fetchrow_hashref){
 749     $results[$i]=$data;
 750     $i++;
 751   }
 752   $sth->finish;
 753   return($i,@results);
 754 }
 755
 756 # FIXME - POD. I can't figure out what this function is doing. Then
 757 # again, I don't think it's being used (anymore).
 758 sub bookfundbreakdown {
 759   my ($id)=@_;
 760   my $dbh = C4::Context->dbh;
 761   my $query="Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
 762   from aqorders,aqorderbreakdown where bookfundid='$id' and
 763   aqorders.ordernumber=aqorderbreakdown.ordernumber
 764   and (datecancellationprinted is NULL or
 765   datecancellationprinted='0000-00-00')";
 766   my $sth=$dbh->prepare($query);
 767   $sth->execute;
 768   my $comtd=0;
 769   my $spent=0;
 770   while (my $data=$sth->fetchrow_hashref){
 771     if ($data->{'subscription'} == 1){
 772       $spent+=$data->{'quantity'}*$data->{'unitprice'};
 773     } else {
 774       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
 775       $comtd+=($data->{'ecost'})*$leftover;
 776       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
 777     }
 778   }
 779   $sth->finish;
 780   return($spent,$comtd);
 781 }
 782
 783 =item curconvert
 784
 785   $foreignprice = &curconvert($currency, $localprice);
 786
 787 Converts the price C<$localprice> to foreign currency C<$currency> by
 788 dividing by the exchange rate, and returns the result.
 789
 790 If no exchange rate is found, C<&curconvert> assumes the rate is one
 791 to one.
 792
 793 =cut
 794 #'
 795 sub curconvert {
 796   my ($currency,$price)=@_;
 797   my $dbh = C4::Context->dbh;
 798   my $query="Select rate from currency where currency='$currency'";
 799   my $sth=$dbh->prepare($query);
 800   $sth->execute;
 801   my $data=$sth->fetchrow_hashref;
 802   $sth->finish;
 803   my $cur=$data->{'rate'};
 804   if ($cur==0){
 805     $cur=1;
 806   }
 807   return($price / $cur);
 808 }
 809
 810 =item getcurrencies
 811
 812   ($count, $currencies) = &getcurrencies();
 813
 814 Returns the list of all known currencies.
 815
 816 C<$count> is the number of elements in C<$currencies>. C<$currencies>
 817 is a reference-to-array; its elements are references-to-hash, whose
 818 keys are the fields from the currency table in the Koha database.
 819
 820 =cut
 821 #'
 822 sub getcurrencies {
 823   my $dbh = C4::Context->dbh;
 824   my $query="Select * from currency";
 825   my $sth=$dbh->prepare($query);
 826   $sth->execute;
 827   my @results;
 828   my $i=0;
 829   while (my $data=$sth->fetchrow_hashref){
 830     $results[$i]=$data;
 831     $i++;
 832   }
 833   $sth->finish;
 834   return($i,\@results);
 835 }
 836
 837 # FIXME - Never used
 838 sub getcurrency {
 839   my ($cur)=@_;
 840   my $dbh = C4::Context->dbh;
 841   my $query="Select * from currency where currency='$cur'";
 842   my $sth=$dbh->prepare($query);
 843   $sth->execute;
 844
 845   my $data=$sth->fetchrow_hashref;
 846   $sth->finish;
 847   return($data);
 848 }
 849
 850 =item updatecurrencies
 851
 852   &updatecurrencies($currency, $newrate);
 853
 854 Sets the exchange rate for C<$currency> to be C<$newrate>.
 855
 856 =cut
 857 #'
 858 sub updatecurrencies {
 859   my ($currency,$rate)=@_;
 860   my $dbh = C4::Context->dbh;
 861   my $query="update currency set rate=$rate where currency='$currency'";
 862   my $sth=$dbh->prepare($query);
 863   $sth->execute;
 864   $sth->finish;
 865 }
 866
 867 # FIXME - Identical to &C4::Acquisitions::updatecost. Neither one is
 868 # used
 869 sub updatecost{
 870   my($price,$rrp,$itemnum)=@_;
 871   my $dbh = C4::Context->dbh;
 872   my $query="update items set price='$price',replacementprice='$rrp'
 873   where itemnumber=$itemnum";
 874   my $sth=$dbh->prepare($query);
 875   $sth->execute;
 876   $sth->finish;
 877 }
 878
 879 #
 880 #
 881 # OTHERS
 882 #
 883 #
 884
 885 =item bookseller
 886
 887   ($count, @results) = &bookseller($searchstring);
 888
 889 Looks up a book seller. C<$searchstring> may be either a book seller
 890 ID, or a string to look for in the book seller's name.
 891
 892 C<$count> is the number of elements in C<@results>. C<@results> is an
 893 array of references-to-hash, whose keys are the fields of of the
 894 aqbooksellers table in the Koha database.
 895
 896 =cut
 897 #'
 898 sub bookseller {
 899   my ($searchstring)=@_;
 900   my $dbh = C4::Context->dbh;
 901   my $query="Select * from aqbooksellers where name like '%$searchstring%' or
 902   id = '$searchstring'";
 903   my $sth=$dbh->prepare($query);
 904   $sth->execute;
 905   my @results;
 906   my $i=0;
 907   while (my $data=$sth->fetchrow_hashref){
 908     $results[$i]=$data;
 909     $i++;
 910   }
 911   $sth->finish;
 912   return($i,@results);
 913 }
 914
 915 =item breakdown
 916
 917   ($count, $results) = &breakdown($ordernumber);
 918
 919 Looks up an order by order ID, and returns its breakdown.
 920
 921 C<$count> is the number of elements in C<$results>. C<$results> is a
 922 reference-to-array; its elements are references-to-hash, whose keys
 923 are the fields of the aqorderbreakdown table in the Koha database.
 924
 925 =cut
 926 #'
 927 sub breakdown {
 928   my ($id)=@_;
 929   my $dbh = C4::Context->dbh;
 930   my $query="Select * from aqorderbreakdown where ordernumber='$id'";
 931   my $sth=$dbh->prepare($query);
 932   $sth->execute;
 933   my @results;
 934   my $i=0;
 935   while (my $data=$sth->fetchrow_hashref){
 936     $results[$i]=$data;
 937     $i++;
 938   }
 939   $sth->finish;
 940   return($i,\@results);
 941 }
 942
 943 =item branches
 944
 945   ($count, @results) = &branches();
 946
 947 Returns a list of all library branches.
 948
 949 C<$count> is the number of elements in C<@results>. C<@results> is an
 950 array of references-to-hash, whose keys are the fields of the branches
 951 table of the Koha database.
 952
 953 =cut
 954 #'
 955 sub branches {
 956     my $dbh   = C4::Context->dbh;
 957     my $query = "Select * from branches";
 958     my $sth   = $dbh->prepare($query);
 959     my $i     = 0;
 960     my @results;
 961
 962     $sth->execute;
 963     while (my $data = $sth->fetchrow_hashref) {
 964         $results[$i] = $data;
 965         $i++;
 966     } # while
 967
 968     $sth->finish;
 969     return($i, @results);
 970 } # sub branches
 971
 972 # FIXME - Never used
 973 sub findall {
 974   my ($biblionumber)=@_;
 975   my $dbh = C4::Context->dbh;
 976   my $query="Select * from biblioitems,items,itemtypes where
 977   biblioitems.biblionumber=$biblionumber
 978   and biblioitems.biblioitemnumber=items.biblioitemnumber and
 979   itemtypes.itemtype=biblioitems.itemtype
 980   order by items.biblioitemnumber";
 981   my $sth=$dbh->prepare($query);
 982   $sth->execute;
 983   my @results;
 984   my $i;
 985   while (my $data=$sth->fetchrow_hashref){
 986     $results[$i]=$data;
 987     $i++;
 988   }
 989   $sth->finish;
 990   return(@results);
 991 }
 992
 993 # FIXME - Never used
 994 sub needsmod{
 995   my ($bibitemnum,$itemtype)=@_;
 996   my $dbh = C4::Context->dbh;
 997   my $query="Select * from biblioitems where biblioitemnumber=$bibitemnum
 998   and itemtype='$itemtype'";
 999   my $sth=$dbh->prepare($query);
1000   $sth->execute;
1001   my $result=0;
1002   if (my $data=$sth->fetchrow_hashref){
1003     $result=1;
1004   }
1005   $sth->finish;
1006   return($result);
1007 }
1008
1009 =item updatesup
1010
1011   &updatesup($bookseller);
1012
1013 Updates the information for a given bookseller. C<$bookseller> is a
1014 reference-to-hash whose keys are the fields of the aqbooksellers table
1015 in the Koha database. It must contain entries for all of the fields.
1016 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
1017
1018 The easiest way to get all of the necessary fields is to look up a
1019 book seller with C<&booksellers>, modify what's necessary, then call
1020 C<&updatesup> with the result.
1021
1022 =cut
1023 #'
1024 sub updatesup {
1025    my ($data)=@_;
1026    my $dbh = C4::Context->dbh;
1027    my $query="Update aqbooksellers set
1028    name='$data->{'name'}',address1='$data->{'address1'}',address2='$data->{'address2'}',
1029    address3='$data->{'address3'}',address4='$data->{'address4'}',postal='$data->{'postal'}',
1030    phone='$data->{'phone'}',fax='$data->{'fax'}',url='$data->{'url'}',
1031    contact='$data->{'contact'}',contpos='$data->{'contpos'}',
1032    contphone='$data->{'contphone'}', contfax='$data->{'contfax'}', contaltphone=
1033    '$data->{'contaltphone'}', contemail='$data->{'contemail'}', contnotes=
1034    '$data->{'contnotes'}', active=$data->{'active'},
1035    listprice='$data->{'listprice'}', invoiceprice='$data->{'invoiceprice'}',
1036    gstreg=$data->{'gstreg'}, listincgst=$data->{'listincgst'},
1037    invoiceincgst=$data->{'invoiceincgst'}, specialty='$data->{'specialty'}',
1038    discount='$data->{'discount'}',invoicedisc='$data->{'invoicedisc'}',
1039    nocalc='$data->{'nocalc'}'
1040    where id='$data->{'id'}'";
1041    my $sth=$dbh->prepare($query);
1042    $sth->execute;
1043    $sth->finish;
1044 #   print $query;
1045 }
1046
1047 =item insertsup
1048
1049   $id = &insertsup($bookseller);
1050
1051 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
1052 keys are the fields of the aqbooksellers table in the Koha database.
1053 All fields must be present.
1054
1055 Returns the ID of the newly-created bookseller.
1056
1057 =cut
1058 #'
1059 sub insertsup {
1060   my ($data)=@_;
1061   my $dbh = C4::Context->dbh;
1062   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
1063   $sth->execute;
1064   my $data2=$sth->fetchrow_hashref;
1065   $sth->finish;
1066   $data2->{'max(id)'}++;
1067   $sth=$dbh->prepare("Insert into aqbooksellers (id) values ($data2->{'max(id)'})");
1068   $sth->execute;
1069   $sth->finish;
1070   $data->{'id'}=$data2->{'max(id)'};
1071   updatesup($data);
1072   return($data->{'id'});
1073 }
1074
1075 =item websitesearch
1076
1077   ($count, @results) = &websitesearch($keywordlist);
1078
1079 Looks up biblioitems by URL.
1080
1081 C<$keywordlist> is a space-separated list of search terms.
1082 C<&websitesearch> returns those biblioitems whose URL contains at
1083 least one of the search terms.
1084
1085 C<$count> is the number of elements in C<@results>. C<@results> is an
1086 array of references-to-hash, whose keys are the fields of the biblio
1087 and biblioitems tables in the Koha database.
1088
1089 =cut
1090 #'
1091 sub websitesearch {
1092     my ($keywordlist) = @_;
1093     my $dbh   = C4::Context->dbh;
1094     my $query = "Select distinct biblio.* from biblio, biblioitems where
1095 biblio.biblionumber = biblioitems.biblionumber and (";
1096     my $count = 0;
1097     my $sth;
1098     my @results;
1099     my @keywords = split(/ +/, $keywordlist);
1100     my $keyword = shift(@keywords);
1101
1102     # FIXME - Can use
1103     #   $query .= join(" and ",
1104     #           apply { url like "%$_%" } @keywords
1105
1106     $keyword =~ s/%/\\%/g;
1107     $keyword =~ s/_/\\_/;
1108     $keyword = "%" . $keyword . "%";
1109     $keyword = $dbh->quote($keyword);
1110     $query  .= " (url like $keyword)";
1111
1112     foreach $keyword (@keywords) {
1113         $keyword =~ s/%/\\%/;
1114         $keyword =~ s/_/\\_/;
1115         $keyword = "%" . $keyword . "%";
1116         $keyword = $dbh->quote($keyword);
1117         $query  .= " or (url like $keyword)";
1118     } # foreach
1119
1120     $query .= ")";
1121     $sth    = $dbh->prepare($query);
1122     $sth->execute;
1123
1124     while (my $data = $sth->fetchrow_hashref) {
1125         $results[$count] = $data;
1126         $count++;
1127     } # while
1128
1129     $sth->finish;
1130     return($count, @results);
1131 } # sub websitesearch
1132
1133 =item addwebsite
1134
1135   &addwebsite($website);
1136
1137 Adds a new web site. C<$website> is a reference-to-hash, with the keys
1138 C<biblionumber>, C<title>, C<description>, and C<url>. All of these
1139 are mandatory.
1140
1141 =cut
1142 #'
1143 sub addwebsite {
1144     my ($website) = @_;
1145     my $dbh = C4::Context->dbh;
1146     my $query;
1147
1148     # FIXME -
1149     #   for (qw( biblionumber title description url )) # and any others
1150     #   {
1151     #           $website->{$_} = $dbh->quote($_);
1152     #   }
1153     # Perhaps extend this to building the query as well. This might allow
1154     # some of the fields to be optional.
1155     $website->{'biblionumber'} = $dbh->quote($website->{'biblionumber'});
1156     $website->{'title'}        = $dbh->quote($website->{'title'});
1157     $website->{'description'}  = $dbh->quote($website->{'description'});
1158     $website->{'url'}          = $dbh->quote($website->{'url'});
1159
1160     $query = "Insert into websites set
1161 biblionumber = $website->{'biblionumber'},
1162 title        = $website->{'title'},
1163 description  = $website->{'description'},
1164 url          = $website->{'url'}";
1165
1166     $dbh->do($query);
1167 } # sub website
1168
1169 =item updatewebsite
1170
1171   &updatewebsite($website);
1172
1173 Updates an existing web site. C<$website> is a reference-to-hash with
1174 the keys C<websitenumber>, C<title>, C<description>, and C<url>. All
1175 of these are mandatory. C<$website-E<gt>{websitenumber}> identifies
1176 the entry to update.
1177
1178 =cut
1179 #'
1180 sub updatewebsite {
1181     my ($website) = @_;
1182     my $dbh = C4::Context->dbh;
1183     my $query;
1184
1185     $website->{'title'}      = $dbh->quote($website->{'title'});
1186     $website->{'description'} = $dbh->quote($website->{'description'});
1187     $website->{'url'}        = $dbh->quote($website->{'url'});
1188
1189     $query = "Update websites set
1190 title       = $website->{'title'},
1191 description = $website->{'description'},
1192 url         = $website->{'url'}
1193 where websitenumber = $website->{'websitenumber'}";
1194
1195     $dbh->do($query);
1196 } # sub updatewebsite
1197
1198 =item deletewebsite
1199
1200   &deletewebsite($websitenumber);
1201
1202 Deletes the web site with number C<$websitenumber>.
1203
1204 =cut
1205 #'
1206 sub deletewebsite {
1207     my ($websitenumber) = @_;
1208     my $dbh = C4::Context->dbh;
1209     # FIXME - $query is unneeded
1210     my $query = "Delete from websites where websitenumber = $websitenumber";
1211
1212     $dbh->do($query);
1213 } # sub deletewebsite
1214
1215 END { }       # module clean-up code here (global destructor)
1216
1217 1;
1218 __END__
1219
1220 =back
1221
1222 =head1 AUTHOR
1223
1224 Koha Developement team <info@koha.org>
1225
1226 =cut