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