C4/Acquisition.pm

   1 package C4::Acquisition;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 require Exporter;
  22 use C4::Context;
  23 use MARC::Record;
  24 # use C4::Biblio;
  25
  26 use vars qw($VERSION @ISA @EXPORT);
  27
  28 # set the version for version checking
  29 $VERSION = 0.01;
  30
  31 =head1 NAME
  32
  33 C4::Acquisition - Koha functions for dealing with orders and acquisitions
  34
  35 =head1 SYNOPSIS
  36
  37   use C4::Acquisition;
  38
  39 =head1 DESCRIPTION
  40
  41 The functions in this module deal with acquisitions, managing book
  42 orders, converting money to different currencies, and so forth.
  43
  44 =head1 FUNCTIONS
  45
  46 =over 2
  47
  48 =cut
  49
  50 @ISA = qw(Exporter);
  51 @EXPORT = qw(
  52                 &getbasket &getbasketcontent &newbasket &closebasket
  53
  54                 &getorders &getallorders &getrecorders
  55                 &getorder &neworder &delorder
  56                 &ordersearch &histsearch
  57                 &modorder &getsingleorder &invoice &receiveorder
  58                 &updaterecorder &newordernum
  59
  60                 &bookfunds &curconvert &getcurrencies &bookfundbreakdown
  61                 &updatecurrencies &getcurrency
  62
  63                 &branches &updatesup &insertsup
  64                 &bookseller &breakdown
  65 );
  66
  67 #
  68 #
  69 #
  70 # BASKETS
  71 #
  72 #
  73 #
  74 =item getbasket
  75
  76   $aqbasket = &getbasket($basketnumber);
  77
  78 get all basket informations in aqbasket for a given basket
  79 =cut
  80
  81 sub getbasket {
  82         my ($basketno)=@_;
  83         my $dbh=C4::Context->dbh;
  84         my $sth=$dbh->prepare("select aqbasket.*,borrowers.firstname+' '+borrowers.surname as authorisedbyname, borrowers.branchcode as branch from aqbasket left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber where basketno=?");
  85         $sth->execute($basketno);
  86         return($sth->fetchrow_hashref);
  87 }
  88
  89 =item getbasketcontent
  90
  91   ($count, @orders) = &getbasketcontent($basketnumber, $booksellerID);
  92
  93 Looks up the pending (non-cancelled) orders with the given basket
  94 number. If C<$booksellerID> is non-empty, only orders from that seller
  95 are returned.
  96
  97 C<&basket> returns a two-element array. C<@orders> is an array of
  98 references-to-hash, whose keys are the fields from the aqorders,
  99 biblio, and biblioitems tables in the Koha database. C<$count> is the
 100 number of elements in C<@orders>.
 101
 102 =cut
 103 #'
 104 sub getbasketcontent {
 105         my ($basketno,$supplier,$orderby)=@_;
 106         my $dbh = C4::Context->dbh;
 107         my $query="Select biblio.*,biblioitems.*,aqorders.*,aqorderbreakdown.*,biblio.title from aqorders,biblio,biblioitems
 108         left join aqorderbreakdown on aqorderbreakdown.ordernumber=aqorders.ordernumber
 109         where basketno='$basketno'
 110         and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber
 111         =aqorders.biblioitemnumber
 112         and (datecancellationprinted is NULL or datecancellationprinted =
 113         '0000-00-00')";
 114         if ($supplier ne ''){
 115                 $query.=" and aqorders.booksellerid='$supplier'";
 116         }
 117
 118         $orderby="biblioitems.publishercode" unless $orderby;
 119         $query.=" order by $orderby";
 120         my $sth=$dbh->prepare($query);
 121         $sth->execute;
 122         my @results;
 123         #  print $query;
 124         my $i=0;
 125         while (my $data=$sth->fetchrow_hashref){
 126                 $results[$i]=$data;
 127                 $i++;
 128         }
 129         $sth->finish;
 130         return($i,@results);
 131 }
 132
 133 =item newbasket
 134
 135   $basket = &newbasket();
 136
 137 Create a new basket in aqbasket table
 138 =cut
 139
 140 sub newbasket {
 141         my ($booksellerid,$authorisedby) = @_;
 142         my $dbh = C4::Context->dbh;
 143         my $sth=$dbh->do("insert into aqbasket (creationdate,booksellerid,authorisedby) values(now(),'$booksellerid','$authorisedby')");
 144         #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
 145         my $basket = $dbh->{'mysql_insertid'};
 146         return($basket);
 147 }
 148
 149 =item closebasket
 150
 151   &newbasket($basketno);
 152
 153 close a basket (becomes unmodifiable,except for recieves
 154 =cut
 155
 156 sub closebasket {
 157         my ($basketno) = @_;
 158         my $dbh = C4::Context->dbh;
 159         my $sth=$dbh->prepare("update aqbasket set closedate=now() where basketno=?");
 160         $sth->execute($basketno);
 161 }
 162
 163 =item neworder
 164
 165   &neworder($basket, $biblionumber, $title, $quantity, $listprice,
 166         $booksellerid, $who, $notes, $bookfund, $biblioitemnumber, $rrp,
 167         $ecost, $gst, $budget, $unitprice, $subscription,
 168         $booksellerinvoicenumber);
 169
 170 Adds a new order to the database. Any argument that isn't described
 171 below is the new value of the field with the same name in the aqorders
 172 table of the Koha database.
 173
 174 C<$ordnum> is a "minimum order number." After adding the new entry to
 175 the aqorders table, C<&neworder> finds the first entry in aqorders
 176 with order number greater than or equal to C<$ordnum>, and adds an
 177 entry to the aqorderbreakdown table, with the order number just found,
 178 and the book fund ID of the newly-added order.
 179
 180 C<$budget> is effectively ignored.
 181
 182 C<$subscription> may be either "yes", or anything else for "no".
 183
 184 =cut
 185 #'
 186 sub neworder {
 187         my ($basketno,$bibnum,$title,$quantity,$listprice,$booksellerid,$authorisedby,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$sub,$invoice,$sort1,$sort2)=@_;
 188         if ($budget eq 'now'){
 189                 $budget="now()";
 190         } else {
 191                 $budget="'2001-07-01'";
 192         }
 193         if ($sub eq 'yes'){
 194                 $sub=1;
 195         } else {
 196                 $sub=0;
 197         }
 198         # if $basket empty, it's also a new basket, create it
 199         unless ($basketno) {
 200                 $basketno=newbasket($booksellerid,$authorisedby);
 201         }
 202         my $dbh = C4::Context->dbh;
 203         my $sth=$dbh->prepare("insert into aqorders
 204                                                                 (biblionumber,title,basketno,quantity,listprice,notes,
 205                                                                 biblioitemnumber,rrp,ecost,gst,unitprice,subscription,sort1,sort2)
 206                                                                 values (?,?,?,?,?,?,?,?,?,?,?,?,?,?)");
 207         $sth->execute($bibnum,$title,$basketno,$quantity,$listprice,$notes,
 208                                         $bibitemnum,$rrp,$ecost,$gst,$cost,$sub,$sort1,$sort2);
 209         $sth->finish;
 210         #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
 211         my $ordnum = $dbh->{'mysql_insertid'};
 212         $sth=$dbh->prepare("insert into aqorderbreakdown (ordernumber,bookfundid) values
 213         (?,?)");
 214         $sth->execute($ordnum,$bookfund);
 215         $sth->finish;
 216         return $basketno;
 217 }
 218
 219 =item delorder
 220
 221   &delorder($biblionumber, $ordernumber);
 222
 223 Cancel the order with the given order and biblio numbers. It does not
 224 delete any entries in the aqorders table, it merely marks them as
 225 cancelled.
 226
 227 =cut
 228 #'
 229 sub delorder {
 230   my ($bibnum,$ordnum)=@_;
 231   my $dbh = C4::Context->dbh;
 232   my $sth=$dbh->prepare("update aqorders set datecancellationprinted=now()
 233   where biblionumber=? and ordernumber=?");
 234   $sth->execute($bibnum,$ordnum);
 235   $sth->finish;
 236 }
 237
 238 =item modorder
 239
 240   &modorder($title, $ordernumber, $quantity, $listprice,
 241         $biblionumber, $basketno, $supplier, $who, $notes,
 242         $bookfundid, $bibitemnum, $rrp, $ecost, $gst, $budget,
 243         $unitprice, $booksellerinvoicenumber);
 244
 245 Modifies an existing order. Updates the order with order number
 246 C<$ordernumber> and biblionumber C<$biblionumber>. All other arguments
 247 update the fields with the same name in the aqorders table of the Koha
 248 database.
 249
 250 Entries with order number C<$ordernumber> in the aqorderbreakdown
 251 table are also updated to the new book fund ID.
 252
 253 =cut
 254 #'
 255 sub modorder {
 256   my ($title,$ordnum,$quantity,$listprice,$bibnum,$basketno,$supplier,$who,$notes,$bookfund,$bibitemnum,$rrp,$ecost,$gst,$budget,$cost,$invoice,$sort1,$sort2)=@_;
 257   my $dbh = C4::Context->dbh;
 258   my $sth=$dbh->prepare("update aqorders set title=?,
 259   quantity=?,listprice=?,basketno=?,
 260   rrp=?,ecost=?,unitprice=?,booksellerinvoicenumber=?,
 261   notes=?,sort1=?, sort2=?
 262   where
 263   ordernumber=? and biblionumber=?");
 264   $sth->execute($title,$quantity,$listprice,$basketno,$rrp,$ecost,$cost,$invoice,$notes,$sort1,$sort2,$ordnum,$bibnum);
 265   $sth->finish;
 266   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where
 267   ordernumber=?");
 268   unless ($sth->execute($bookfund,$ordnum)) { # zero rows affected [Bug 734]
 269     my $query="insert into aqorderbreakdown (ordernumber,bookfundid) values (?,?)";
 270     $sth=$dbh->prepare($query);
 271     $sth->execute($ordnum,$bookfund);
 272   }
 273   $sth->finish;
 274 }
 275
 276 =item newordernum
 277
 278   $order = &newordernum();
 279
 280 Finds the next unused order number in the aqorders table of the Koha
 281 database, and returns it.
 282
 283 =cut
 284 #'
 285 # FIXME - Race condition
 286 sub newordernum {
 287   my $dbh = C4::Context->dbh;
 288   my $sth=$dbh->prepare("Select max(ordernumber) from aqorders");
 289   $sth->execute;
 290   my $data=$sth->fetchrow_arrayref;
 291   my $ordnum=$$data[0];
 292   $ordnum++;
 293   $sth->finish;
 294   return($ordnum);
 295 }
 296
 297 =item receiveorder
 298
 299   &receiveorder($biblionumber, $ordernumber, $quantityreceived, $user,
 300         $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
 301         $freight, $bookfund, $rrp);
 302
 303 Updates an order, to reflect the fact that it was received, at least
 304 in part. All arguments not mentioned below update the fields with the
 305 same name in the aqorders table of the Koha database.
 306
 307 Updates the order with bibilionumber C<$biblionumber> and ordernumber
 308 C<$ordernumber>.
 309
 310 Also updates the book fund ID in the aqorderbreakdown table.
 311
 312 =cut
 313 #'
 314 sub receiveorder {
 315         my ($biblio,$ordnum,$quantrec,$user,$cost,$invoiceno,$freight,$rrp)=@_;
 316         my $dbh = C4::Context->dbh;
 317         my $sth=$dbh->prepare("update aqorders set quantityreceived=?,datereceived=now(),booksellerinvoicenumber=?,
 318                                                                                         unitprice=?,freight=?,rrp=?
 319                                                         where biblionumber=? and ordernumber=?");
 320         $sth->execute($quantrec,$invoiceno,$cost,$freight,$rrp,$biblio,$ordnum);
 321         $sth->finish;
 322 }
 323
 324 =item updaterecorder
 325
 326   &updaterecorder($biblionumber, $ordernumber, $user, $unitprice,
 327         $bookfundid, $rrp);
 328
 329 Updates the order with biblionumber C<$biblionumber> and order number
 330 C<$ordernumber>. C<$bookfundid> is the new value for the book fund ID
 331 in the aqorderbreakdown table of the Koha database. All other
 332 arguments update the fields with the same name in the aqorders table.
 333
 334 C<$user> is ignored.
 335
 336 =cut
 337 #'
 338 sub updaterecorder{
 339   my($biblio,$ordnum,$user,$cost,$bookfund,$rrp)=@_;
 340   my $dbh = C4::Context->dbh;
 341   my $sth=$dbh->prepare("update aqorders set
 342   unitprice=?, rrp=?
 343   where biblionumber=? and ordernumber=?
 344   ");
 345   $sth->execute($cost,$rrp,$biblio,$ordnum);
 346   $sth->finish;
 347   $sth=$dbh->prepare("update aqorderbreakdown set bookfundid=? where ordernumber=?");
 348   $sth->execute($bookfund,$ordnum);
 349   $sth->finish;
 350 }
 351
 352 #
 353 #
 354 # ORDERS
 355 #
 356 #
 357
 358 =item getorders
 359
 360   ($count, $orders) = &getorders($booksellerid);
 361
 362 Finds pending orders from the bookseller with the given ID. Ignores
 363 completed and cancelled orders.
 364
 365 C<$count> is the number of elements in C<@{$orders}>.
 366
 367 C<$orders> is a reference-to-array; each element is a
 368 reference-to-hash with the following fields:
 369
 370 =over 4
 371
 372 =item C<count(*)>
 373
 374 Gives the number of orders in with this basket number.
 375
 376 =item C<authorizedby>
 377
 378 =item C<entrydate>
 379
 380 =item C<basketno>
 381
 382 These give the value of the corresponding field in the aqorders table
 383 of the Koha database.
 384
 385 =back
 386
 387 Results are ordered from most to least recent.
 388
 389 =cut
 390 #'
 391 sub getorders {
 392         my ($supplierid)=@_;
 393         my $dbh = C4::Context->dbh;
 394         my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
 395 closedate,surname,firstname,aqorders.title
 396 from aqorders
 397 left join aqbasket on aqbasket.basketno=aqorders.basketno
 398 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 399 where booksellerid=? and (quantity > quantityreceived or
 400 quantityreceived is NULL) and datecancellationprinted is NULL ";
 401
 402         if (C4::Context->preference("IndependantBranches")) {
 403                 my $userenv = C4::Context->userenv;
 404                 unless ($userenv->{flags} == 1){
 405                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 406                 }
 407         }
 408         $strsth.=" group by basketno order by aqbasket.basketno";
 409         my $sth=$dbh->prepare($strsth);
 410         $sth->execute($supplierid);
 411         my @results = ();
 412         while (my $data=$sth->fetchrow_hashref){
 413                 push(@results,$data);
 414         }
 415         $sth->finish;
 416         return (scalar(@results),\@results);
 417 }
 418
 419 =item getorder
 420
 421   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 422
 423 Looks up the order with the given biblionumber and biblioitemnumber.
 424
 425 Returns a two-element array. C<$ordernumber> is the order number.
 426 C<$order> is a reference-to-hash describing the order; its keys are
 427 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 428 tables of the Koha database.
 429
 430 =cut
 431
 432 sub getorder{
 433   my ($bi,$bib)=@_;
 434   my $dbh = C4::Context->dbh;
 435   my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
 436   $sth->execute($bib,$bi);
 437   # FIXME - Use fetchrow_array(), since we're only interested in the one
 438   # value.
 439   my $ordnum=$sth->fetchrow_hashref;
 440   $sth->finish;
 441   my $order=getsingleorder($ordnum->{'ordernumber'});
 442   return ($order,$ordnum->{'ordernumber'});
 443 }
 444
 445 =item getsingleorder
 446
 447   $order = &getsingleorder($ordernumber);
 448
 449 Looks up an order by order number.
 450
 451 Returns a reference-to-hash describing the order. The keys of
 452 C<$order> are fields from the biblio, biblioitems, aqorders, and
 453 aqorderbreakdown tables of the Koha database.
 454
 455 =cut
 456
 457 sub getsingleorder {
 458   my ($ordnum)=@_;
 459   my $dbh = C4::Context->dbh;
 460   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
 461   on aqorders.ordernumber=aqorderbreakdown.ordernumber
 462   where aqorders.ordernumber=?
 463   and biblio.biblionumber=aqorders.biblionumber and
 464   biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
 465   $sth->execute($ordnum);
 466   my $data=$sth->fetchrow_hashref;
 467   $sth->finish;
 468   return($data);
 469 }
 470
 471 =item getallorders
 472
 473   ($count, @results) = &getallorders($booksellerid);
 474
 475 Looks up all of the pending orders from the supplier with the given
 476 bookseller ID. Ignores cancelled and completed orders.
 477
 478 C<$count> is the number of elements in C<@results>. C<@results> is an
 479 array of references-to-hash. The keys of each element are fields from
 480 the aqorders, biblio, and biblioitems tables of the Koha database.
 481
 482 C<@results> is sorted alphabetically by book title.
 483
 484 =cut
 485 #'
 486 sub getallorders {
 487   #gets all orders from a certain supplier, orders them alphabetically
 488   my ($supid)=@_;
 489   my $dbh = C4::Context->dbh;
 490   my @results = ();
 491   my $strsth="Select *,aqorders.title as suggestedtitle,biblio.title as truetitle from aqorders,biblio,biblioitems,aqbasket,aqbooksellers ";
 492         $strsth .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
 493         $strsth .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 494         $strsth .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
 495         $strsth.=" and booksellerid=? and (cancelledby is NULL or cancelledby = '')
 496   and (quantityreceived < quantity or quantityreceived is NULL)
 497   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 498   aqorders.biblioitemnumber ";
 499         if (C4::Context->preference("IndependantBranches")) {
 500                 my $userenv = C4::Context->userenv;
 501                 unless ($userenv->{flags} == 1){
 502                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 503                 }
 504         }
 505         $strsth .= " group by aqorders.biblioitemnumber order by biblio.title";
 506   my $sth=$dbh->prepare($strsth);
 507   $sth->execute($supid);
 508   while (my $data=$sth->fetchrow_hashref){
 509     push(@results,$data);
 510   }
 511   $sth->finish;
 512   return(scalar(@results),@results);
 513 }
 514
 515 # FIXME - Never used
 516 sub getrecorders {
 517   #gets all orders from a certain supplier, orders them alphabetically
 518   my ($supid)=@_;
 519   my $dbh = C4::Context->dbh;
 520   my @results= ();
 521   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
 522   and (cancelledby is NULL or cancelledby = '')
 523   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 524   aqorders.biblioitemnumber and
 525   aqorders.quantityreceived>0
 526   and aqorders.datereceived >=now()
 527   group by aqorders.biblioitemnumber
 528   order by
 529   biblio.title");
 530   $sth->execute($supid);
 531   while (my $data=$sth->fetchrow_hashref){
 532     push(@results,$data);
 533   }
 534   $sth->finish;
 535   return(scalar(@results),@results);
 536 }
 537
 538 =item ordersearch
 539
 540   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
 541
 542 Searches for orders.
 543
 544 C<$search> may take one of several forms: if it is an ISBN,
 545 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 546 order number, C<&ordersearch> returns orders with that order number
 547 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 548 to be a space-separated list of search terms; in this case, all of the
 549 terms must appear in the title (matching the beginning of title
 550 words).
 551
 552 If C<$complete> is C<yes>, the results will include only completed
 553 orders. In any case, C<&ordersearch> ignores cancelled orders.
 554
 555 C<&ordersearch> returns an array. C<$count> is the number of elements
 556 in C<@results>. C<@results> is an array of references-to-hash with the
 557 following keys:
 558
 559 =over 4
 560
 561 =item C<author>
 562
 563 =item C<seriestitle>
 564
 565 =item C<branchcode>
 566
 567 =item C<bookfundid>
 568
 569 =back
 570
 571 =cut
 572 #'
 573 sub ordersearch {
 574         my ($search,$id,$biblio,$catview) = @_;
 575         my $dbh   = C4::Context->dbh;
 576         my @data  = split(' ',$search);
 577         my @searchterms = ($id);
 578         map { push(@searchterms,"$_%","% $_%") } @data;
 579         push(@searchterms,$search,$search,$biblio);
 580         my $sth=$dbh->prepare("Select biblio.*,biblioitems.*,aqorders.*,aqbasket.*,biblio.title from aqorders,biblioitems,biblio,aqbasket
 581                 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber and
 582                 aqorders.basketno = aqbasket.basketno
 583                 and aqbasket.booksellerid = ?
 584                 and biblio.biblionumber=aqorders.biblionumber
 585                 and ((datecancellationprinted is NULL)
 586                 or (datecancellationprinted = '0000-00-00'))
 587                 and (("
 588                 .(join(" and ",map { "(biblio.title like ? or biblio.title like ?)" } @data))
 589                 .") or biblioitems.isbn=? or (aqorders.ordernumber=? and aqorders.biblionumber=?)) "
 590                 .(($catview ne 'yes')?" and (quantityreceived < quantity or quantityreceived is NULL)":"")
 591                 ." group by aqorders.ordernumber");
 592         $sth->execute(@searchterms);
 593         my @results = ();
 594         my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
 595         my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 596         while (my $data=$sth->fetchrow_hashref){
 597                 $sth2->execute($data->{'biblionumber'});
 598                 my $data2=$sth2->fetchrow_hashref;
 599                 $data->{'author'}=$data2->{'author'};
 600                 $data->{'seriestitle'}=$data2->{'seriestitle'};
 601                 $sth3->execute($data->{'ordernumber'});
 602                 my $data3=$sth3->fetchrow_hashref;
 603                 $data->{'branchcode'}=$data3->{'branchcode'};
 604                 $data->{'bookfundid'}=$data3->{'bookfundid'};
 605                 push(@results,$data);
 606         }
 607         $sth->finish;
 608         $sth2->finish;
 609         $sth3->finish;
 610         return(scalar(@results),@results);
 611 }
 612
 613
 614 sub histsearch {
 615         my ($title,$author,$name,$from_placed_on,$to_placed_on)=@_;
 616         my $dbh= C4::Context->dbh;
 617         my $query = "select biblio.title,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
 618
 619         $query .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
 620         $query .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 621         $query .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
 622         $query .= " and biblio.title like ".$dbh->quote("%".$title."%") if $title;
 623         $query .= " and biblio.author like ".$dbh->quote("%".$author."%") if $author;
 624         $query .= " and name like ".$dbh->quote("%".$name."%") if $name;
 625         $query .= " and creationdate >" .$dbh->quote($from_placed_on) if $from_placed_on;
 626         $query .= " and creationdate<".$dbh->quote($to_placed_on) if $to_placed_on;
 627         if (C4::Context->preference("IndependantBranches")) {
 628                 my $userenv = C4::Context->userenv;
 629                 unless ($userenv->{flags} == 1){
 630                         $query .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 631                 }
 632         }
 633         warn "C4:Acquisition : ".$query;
 634         my $sth = $dbh->prepare($query);
 635         $sth->execute;
 636         my @order_loop;
 637         my $cnt=1;
 638         while (my $line = $sth->fetchrow_hashref) {
 639                 $line->{count}=$cnt++;
 640                 push @order_loop, $line;
 641         }
 642         return \@order_loop;
 643 }
 644
 645 #
 646 #
 647 # MONEY
 648 #
 649 #
 650 =item invoice
 651
 652   ($count, @results) = &invoice($booksellerinvoicenumber);
 653
 654 Looks up orders by invoice number.
 655
 656 Returns an array. C<$count> is the number of elements in C<@results>.
 657 C<@results> is an array of references-to-hash; the keys of each
 658 elements are fields from the aqorders, biblio, and biblioitems tables
 659 of the Koha database.
 660
 661 =cut
 662 #'
 663 sub invoice {
 664   my ($invoice)=@_;
 665   my $dbh = C4::Context->dbh;
 666   my @results = ();
 667   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
 668   booksellerinvoicenumber=?
 669   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 670   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
 671   $sth->execute($invoice);
 672   while (my $data=$sth->fetchrow_hashref){
 673     push(@results,$data);
 674   }
 675   $sth->finish;
 676   return(scalar(@results),@results);
 677 }
 678
 679 =item bookfunds
 680
 681   ($count, @results) = &bookfunds();
 682
 683 Returns a list of all book funds.
 684
 685 C<$count> is the number of elements in C<@results>. C<@results> is an
 686 array of references-to-hash, whose keys are fields from the aqbookfund
 687 and aqbudget tables of the Koha database. Results are ordered
 688 alphabetically by book fund name.
 689
 690 =cut
 691 #'
 692 sub bookfunds {
 693   my ($branch)=@_;
 694   my $dbh = C4::Context->dbh;
 695   my $strsth;
 696
 697   if ($branch eq '') {
 698       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 699       =aqbudget.bookfundid
 700       group by aqbookfund.bookfundid order by bookfundname";
 701   } else {
 702       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 703       =aqbudget.bookfundid and (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
 704       group by aqbookfund.bookfundid order by bookfundname";
 705   }
 706   my $sth=$dbh->prepare($strsth);
 707   if ($branch){
 708       $sth->execute($branch);
 709   } else {
 710       $sth->execute;
 711   }
 712   my @results = ();
 713   while (my $data=$sth->fetchrow_hashref){
 714     push(@results,$data);
 715   }
 716   $sth->finish;
 717   return(scalar(@results),@results);
 718 }
 719
 720 =item bookfundbreakdown
 721
 722         returns the total comtd & spent for a given bookfund
 723         used in acqui-home.pl
 724 =cut
 725 #'
 726
 727 sub bookfundbreakdown {
 728   my ($id)=@_;
 729   my $dbh = C4::Context->dbh;
 730   my $sth=$dbh->prepare("Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
 731   from aqorders,aqorderbreakdown where bookfundid=? and
 732   aqorders.ordernumber=aqorderbreakdown.ordernumber
 733   and (datecancellationprinted is NULL or
 734   datecancellationprinted='0000-00-00')");
 735   $sth->execute($id);
 736   my $comtd=0;
 737   my $spent=0;
 738   while (my $data=$sth->fetchrow_hashref){
 739     if ($data->{'subscription'} == 1){
 740       $spent+=$data->{'quantity'}*$data->{'unitprice'};
 741     } else {
 742       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
 743       $comtd+=($data->{'ecost'})*$leftover;
 744       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
 745     }
 746   }
 747   $sth->finish;
 748   return($spent,$comtd);
 749 }
 750
 751
 752
 753 =item curconvert
 754
 755   $foreignprice = &curconvert($currency, $localprice);
 756
 757 Converts the price C<$localprice> to foreign currency C<$currency> by
 758 dividing by the exchange rate, and returns the result.
 759
 760 If no exchange rate is found, C<&curconvert> assumes the rate is one
 761 to one.
 762
 763 =cut
 764 #'
 765 sub curconvert {
 766   my ($currency,$price)=@_;
 767   my $dbh = C4::Context->dbh;
 768   my $sth=$dbh->prepare("Select rate from currency where currency=?");
 769   $sth->execute($currency);
 770   my $cur=($sth->fetchrow_array())[0];
 771   $sth->finish;
 772   if ($cur==0){
 773     $cur=1;
 774   }
 775   return($price / $cur);
 776 }
 777
 778 =item getcurrencies
 779
 780   ($count, $currencies) = &getcurrencies();
 781
 782 Returns the list of all known currencies.
 783
 784 C<$count> is the number of elements in C<$currencies>. C<$currencies>
 785 is a reference-to-array; its elements are references-to-hash, whose
 786 keys are the fields from the currency table in the Koha database.
 787
 788 =cut
 789 #'
 790 sub getcurrencies {
 791   my $dbh = C4::Context->dbh;
 792   my $sth=$dbh->prepare("Select * from currency");
 793   $sth->execute;
 794   my @results = ();
 795   while (my $data=$sth->fetchrow_hashref){
 796     push(@results,$data);
 797   }
 798   $sth->finish;
 799   return(scalar(@results),\@results);
 800 }
 801
 802 =item updatecurrencies
 803
 804   &updatecurrencies($currency, $newrate);
 805
 806 Sets the exchange rate for C<$currency> to be C<$newrate>.
 807
 808 =cut
 809 #'
 810 sub updatecurrencies {
 811   my ($currency,$rate)=@_;
 812   my $dbh = C4::Context->dbh;
 813   my $sth=$dbh->prepare("update currency set rate=? where currency=?");
 814   $sth->execute($rate,$currency);
 815   $sth->finish;
 816 }
 817
 818 #
 819 #
 820 # OTHERS
 821 #
 822 #
 823
 824 =item bookseller
 825
 826   ($count, @results) = &bookseller($searchstring);
 827
 828 Looks up a book seller. C<$searchstring> may be either a book seller
 829 ID, or a string to look for in the book seller's name.
 830
 831 C<$count> is the number of elements in C<@results>. C<@results> is an
 832 array of references-to-hash, whose keys are the fields of of the
 833 aqbooksellers table in the Koha database.
 834
 835 =cut
 836 #'
 837 sub bookseller {
 838   my ($searchstring)=@_;
 839   my $dbh = C4::Context->dbh;
 840   my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
 841   $sth->execute("$searchstring%",$searchstring);
 842   my @results;
 843   while (my $data=$sth->fetchrow_hashref){
 844     push(@results,$data);
 845   }
 846   $sth->finish;
 847   return(scalar(@results),@results);
 848 }
 849
 850 =item breakdown
 851
 852   ($count, $results) = &breakdown($ordernumber);
 853
 854 Looks up an order by order ID, and returns its breakdown.
 855
 856 C<$count> is the number of elements in C<$results>. C<$results> is a
 857 reference-to-array; its elements are references-to-hash, whose keys
 858 are the fields of the aqorderbreakdown table in the Koha database.
 859
 860 =cut
 861 #'
 862 sub breakdown {
 863   my ($id)=@_;
 864   my $dbh = C4::Context->dbh;
 865   my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 866   $sth->execute($id);
 867   my @results = ();
 868   while (my $data=$sth->fetchrow_hashref){
 869     push(@results,$data);
 870   }
 871   $sth->finish;
 872   return(scalar(@results),\@results);
 873 }
 874
 875 =item branches
 876
 877   ($count, @results) = &branches();
 878
 879 Returns a list of all library branches.
 880
 881 C<$count> is the number of elements in C<@results>. C<@results> is an
 882 array of references-to-hash, whose keys are the fields of the branches
 883 table of the Koha database.
 884
 885 =cut
 886 #'
 887 sub branches {
 888     my $dbh   = C4::Context->dbh;
 889     my $sth   = $dbh->prepare("Select * from branches order by branchname");
 890     my @results = ();
 891
 892     $sth->execute();
 893     while (my $data = $sth->fetchrow_hashref) {
 894         push(@results,$data);
 895     } # while
 896
 897     $sth->finish;
 898     return(scalar(@results), @results);
 899 } # sub branches
 900
 901 =item updatesup
 902
 903   &updatesup($bookseller);
 904
 905 Updates the information for a given bookseller. C<$bookseller> is a
 906 reference-to-hash whose keys are the fields of the aqbooksellers table
 907 in the Koha database. It must contain entries for all of the fields.
 908 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
 909
 910 The easiest way to get all of the necessary fields is to look up a
 911 book seller with C<&booksellers>, modify what's necessary, then call
 912 C<&updatesup> with the result.
 913
 914 =cut
 915 #'
 916 sub updatesup {
 917    my ($data)=@_;
 918    my $dbh = C4::Context->dbh;
 919    my $sth=$dbh->prepare("Update aqbooksellers set
 920    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
 921    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
 922    contemail=?,contnotes=?,active=?,
 923    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
 924    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
 925    nocalc=?
 926    where id=?");
 927    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
 928    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
 929    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
 930    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
 931    $data->{'contemail'},
 932    $data->{'contnote'},$data->{'active'},$data->{'listprice'},
 933    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
 934    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
 935    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
 936    $sth->finish;
 937 }
 938
 939 =item insertsup
 940
 941   $id = &insertsup($bookseller);
 942
 943 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
 944 keys are the fields of the aqbooksellers table in the Koha database.
 945 All fields must be present.
 946
 947 Returns the ID of the newly-created bookseller.
 948
 949 =cut
 950 #'
 951 sub insertsup {
 952   my ($data)=@_;
 953   my $dbh = C4::Context->dbh;
 954   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
 955   $sth->execute;
 956   my $data2=$sth->fetchrow_hashref;
 957   $sth->finish;
 958   $data2->{'max(id)'}++;
 959   $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
 960   $sth->execute($data2->{'max(id)'});
 961   $sth->finish;
 962   $data->{'id'}=$data2->{'max(id)'};
 963   updatesup($data);
 964   return($data->{'id'});
 965 }
 966
 967 END { }       # module clean-up code here (global destructor)
 968
 969 1;
 970 __END__
 971
 972 =back
 973
 974 =head1 AUTHOR
 975
 976 Koha Developement team <info@koha.org>
 977
 978 =cut