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