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
 395         my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
 396 closedate,surname,firstname,aqorders.title
 397 from aqorders
 398 left join aqbasket on aqbasket.basketno=aqorders.basketno
 399 left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
 400 where booksellerid=? and (quantity > quantityreceived or
 401 quantityreceived is NULL) and datecancellationprinted is NULL ";
 402
 403         if (C4::Context->preference("IndependantBranches")) {
 404                 my $userenv = C4::Context->userenv;
 405                 unless ($userenv->{flags} == 1){
 406                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 407                 }
 408         }
 409         $strsth.=" group by basketno order by aqbasket.basketno";
 410         my $sth=$dbh->prepare($strsth);
 411         $sth->execute($supplierid);
 412         my @results = ();
 413         while (my $data=$sth->fetchrow_hashref){
 414                 push(@results,$data);
 415         }
 416         $sth->finish;
 417         return (scalar(@results),\@results);
 418 }
 419
 420 =item getorder
 421
 422   ($order, $ordernumber) = &getorder($biblioitemnumber, $biblionumber);
 423
 424 Looks up the order with the given biblionumber and biblioitemnumber.
 425
 426 Returns a two-element array. C<$ordernumber> is the order number.
 427 C<$order> is a reference-to-hash describing the order; its keys are
 428 fields from the biblio, biblioitems, aqorders, and aqorderbreakdown
 429 tables of the Koha database.
 430
 431 =cut
 432
 433 sub getorder{
 434   my ($bi,$bib)=@_;
 435   my $dbh = C4::Context->dbh;
 436   my $sth=$dbh->prepare("Select ordernumber from aqorders where biblionumber=? and biblioitemnumber=?");
 437   $sth->execute($bib,$bi);
 438   # FIXME - Use fetchrow_array(), since we're only interested in the one
 439   # value.
 440   my $ordnum=$sth->fetchrow_hashref;
 441   $sth->finish;
 442   my $order=getsingleorder($ordnum->{'ordernumber'});
 443   return ($order,$ordnum->{'ordernumber'});
 444 }
 445
 446 =item getsingleorder
 447
 448   $order = &getsingleorder($ordernumber);
 449
 450 Looks up an order by order number.
 451
 452 Returns a reference-to-hash describing the order. The keys of
 453 C<$order> are fields from the biblio, biblioitems, aqorders, and
 454 aqorderbreakdown tables of the Koha database.
 455
 456 =cut
 457
 458 sub getsingleorder {
 459   my ($ordnum)=@_;
 460   my $dbh = C4::Context->dbh;
 461   my $sth=$dbh->prepare("Select * from biblio,biblioitems,aqorders left join aqorderbreakdown
 462   on aqorders.ordernumber=aqorderbreakdown.ordernumber
 463   where aqorders.ordernumber=?
 464   and biblio.biblionumber=aqorders.biblionumber and
 465   biblioitems.biblioitemnumber=aqorders.biblioitemnumber");
 466   $sth->execute($ordnum);
 467   my $data=$sth->fetchrow_hashref;
 468   $sth->finish;
 469   return($data);
 470 }
 471
 472 =item getallorders
 473
 474   ($count, @results) = &getallorders($booksellerid);
 475
 476 Looks up all of the pending orders from the supplier with the given
 477 bookseller ID. Ignores cancelled and completed orders.
 478
 479 C<$count> is the number of elements in C<@results>. C<@results> is an
 480 array of references-to-hash. The keys of each element are fields from
 481 the aqorders, biblio, and biblioitems tables of the Koha database.
 482
 483 C<@results> is sorted alphabetically by book title.
 484
 485 =cut
 486 #'
 487 sub getallorders {
 488   #gets all orders from a certain supplier, orders them alphabetically
 489   my ($supid)=@_;
 490   my $dbh = C4::Context->dbh;
 491   my @results = ();
 492   my $strsth="Select *,aqorders.title as suggestedtitle,biblio.title as truetitle from aqorders,biblio,biblioitems,aqbasket,aqbooksellers ";
 493         $strsth .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
 494         $strsth .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 495         $strsth .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
 496         $strsth.=" and booksellerid=? and (cancelledby is NULL or cancelledby = '')
 497   and (quantityreceived < quantity or quantityreceived is NULL)
 498   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 499   aqorders.biblioitemnumber ";
 500         if (C4::Context->preference("IndependantBranches")) {
 501                 my $userenv = C4::Context->userenv;
 502                 unless ($userenv->{flags} == 1){
 503                         $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 504                 }
 505         }
 506         $strsth .= " group by aqorders.biblioitemnumber order by biblio.title";
 507   my $sth=$dbh->prepare($strsth);
 508   $sth->execute($supid);
 509   while (my $data=$sth->fetchrow_hashref){
 510     push(@results,$data);
 511   }
 512   $sth->finish;
 513   return(scalar(@results),@results);
 514 }
 515
 516 # FIXME - Never used
 517 sub getrecorders {
 518   #gets all orders from a certain supplier, orders them alphabetically
 519   my ($supid)=@_;
 520   my $dbh = C4::Context->dbh;
 521   my @results= ();
 522   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where booksellerid=?
 523   and (cancelledby is NULL or cancelledby = '')
 524   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 525   aqorders.biblioitemnumber and
 526   aqorders.quantityreceived>0
 527   and aqorders.datereceived >=now()
 528   group by aqorders.biblioitemnumber
 529   order by
 530   biblio.title");
 531   $sth->execute($supid);
 532   while (my $data=$sth->fetchrow_hashref){
 533     push(@results,$data);
 534   }
 535   $sth->finish;
 536   return(scalar(@results),@results);
 537 }
 538
 539 =item ordersearch
 540
 541   ($count, @results) = &ordersearch($search, $biblionumber, $complete);
 542
 543 Searches for orders.
 544
 545 C<$search> may take one of several forms: if it is an ISBN,
 546 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
 547 order number, C<&ordersearch> returns orders with that order number
 548 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
 549 to be a space-separated list of search terms; in this case, all of the
 550 terms must appear in the title (matching the beginning of title
 551 words).
 552
 553 If C<$complete> is C<yes>, the results will include only completed
 554 orders. In any case, C<&ordersearch> ignores cancelled orders.
 555
 556 C<&ordersearch> returns an array. C<$count> is the number of elements
 557 in C<@results>. C<@results> is an array of references-to-hash with the
 558 following keys:
 559
 560 =over 4
 561
 562 =item C<author>
 563
 564 =item C<seriestitle>
 565
 566 =item C<branchcode>
 567
 568 =item C<bookfundid>
 569
 570 =back
 571
 572 =cut
 573 #'
 574 sub ordersearch {
 575         my ($search,$id,$biblio,$catview) = @_;
 576         my $dbh   = C4::Context->dbh;
 577         my @data  = split(' ',$search);
 578         my @searchterms = ($id);
 579         map { push(@searchterms,"$_%","% $_%") } @data;
 580         push(@searchterms,$search,$search,$biblio);
 581         my $sth=$dbh->prepare("Select biblio.*,biblioitems.*,aqorders.*,aqbasket.* from aqorders,biblioitems,biblio,aqbasket
 582                 where aqorders.biblioitemnumber = biblioitems.biblioitemnumber and
 583                 aqorders.basketno = aqbasket.basketno
 584                 and aqbasket.booksellerid = ?
 585                 and biblio.biblionumber=aqorders.biblionumber
 586                 and ((datecancellationprinted is NULL)
 587                 or (datecancellationprinted = '0000-00-00'))
 588                 and (("
 589                 .(join(" and ",map { "(biblio.title like ? or biblio.title like ?)" } @data))
 590                 .") or biblioitems.isbn=? or (aqorders.ordernumber=? and aqorders.biblionumber=?)) "
 591                 .(($catview ne 'yes')?" and (quantityreceived < quantity or quantityreceived is NULL)":"")
 592                 ." group by aqorders.ordernumber");
 593         $sth->execute(@searchterms);
 594         my @results = ();
 595         my $sth2=$dbh->prepare("Select * from biblio where biblionumber=?");
 596         my $sth3=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 597         while (my $data=$sth->fetchrow_hashref){
 598                 $sth2->execute($data->{'biblionumber'});
 599                 my $data2=$sth2->fetchrow_hashref;
 600                 $data->{'author'}=$data2->{'author'};
 601                 $data->{'seriestitle'}=$data2->{'seriestitle'};
 602                 $sth3->execute($data->{'ordernumber'});
 603                 my $data3=$sth3->fetchrow_hashref;
 604                 $data->{'branchcode'}=$data3->{'branchcode'};
 605                 $data->{'bookfundid'}=$data3->{'bookfundid'};
 606                 push(@results,$data);
 607         }
 608         $sth->finish;
 609         $sth2->finish;
 610         $sth3->finish;
 611         return(scalar(@results),@results);
 612 }
 613
 614
 615 sub histsearch {
 616         my ($title,$author,$name,$from_placed_on,$to_placed_on)=@_;
 617         my $dbh= C4::Context->dbh;
 618         my $query = "select biblio.title,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
 619
 620         $query .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
 621         $query .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
 622         $query .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
 623         $query .= " and biblio.title like ".$dbh->quote("%".$title."%") if $title;
 624         $query .= " and biblio.author like ".$dbh->quote("%".$author."%") if $author;
 625         $query .= " and name like ".$dbh->quote("%".$name."%") if $name;
 626         $query .= " and creationdate >" .$dbh->quote($from_placed_on) if $from_placed_on;
 627         $query .= " and creationdate<".$dbh->quote($to_placed_on) if $to_placed_on;
 628         if (C4::Context->preference("IndependantBranches")) {
 629                 my $userenv = C4::Context->userenv;
 630                 unless ($userenv->{flags} == 1){
 631                         $query .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
 632                 }
 633         }
 634 #       warn "C4:Acquisition : ".$query;
 635         my $sth = $dbh->prepare($query);
 636         $sth->execute;
 637         my @order_loop;
 638         while (my $line = $sth->fetchrow_hashref) {
 639                 push @order_loop, $line;
 640         }
 641         return \@order_loop;
 642 }
 643
 644 #
 645 #
 646 # MONEY
 647 #
 648 #
 649 =item invoice
 650
 651   ($count, @results) = &invoice($booksellerinvoicenumber);
 652
 653 Looks up orders by invoice number.
 654
 655 Returns an array. C<$count> is the number of elements in C<@results>.
 656 C<@results> is an array of references-to-hash; the keys of each
 657 elements are fields from the aqorders, biblio, and biblioitems tables
 658 of the Koha database.
 659
 660 =cut
 661 #'
 662 sub invoice {
 663   my ($invoice)=@_;
 664   my $dbh = C4::Context->dbh;
 665   my @results = ();
 666   my $sth=$dbh->prepare("Select * from aqorders,biblio,biblioitems where
 667   booksellerinvoicenumber=?
 668   and biblio.biblionumber=aqorders.biblionumber and biblioitems.biblioitemnumber=
 669   aqorders.biblioitemnumber group by aqorders.ordernumber,aqorders.biblioitemnumber");
 670   $sth->execute($invoice);
 671   while (my $data=$sth->fetchrow_hashref){
 672     push(@results,$data);
 673   }
 674   $sth->finish;
 675   return(scalar(@results),@results);
 676 }
 677
 678 =item bookfunds
 679
 680   ($count, @results) = &bookfunds();
 681
 682 Returns a list of all book funds.
 683
 684 C<$count> is the number of elements in C<@results>. C<@results> is an
 685 array of references-to-hash, whose keys are fields from the aqbookfund
 686 and aqbudget tables of the Koha database. Results are ordered
 687 alphabetically by book fund name.
 688
 689 =cut
 690 #'
 691 sub bookfunds {
 692   my ($branch)=@_;
 693   my $dbh = C4::Context->dbh;
 694   my $strsth;
 695
 696   if ($branch eq '') {
 697       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 698       =aqbudget.bookfundid
 699       group by aqbookfund.bookfundid order by bookfundname";
 700   } else {
 701       $strsth="Select * from aqbookfund,aqbudget where aqbookfund.bookfundid
 702       =aqbudget.bookfundid and (aqbookfund.branchcode is null or aqbookfund.branchcode='' or aqbookfund.branchcode= ? )
 703       group by aqbookfund.bookfundid order by bookfundname";
 704   }
 705   my $sth=$dbh->prepare($strsth);
 706   if ($branch){
 707       $sth->execute($branch);
 708   } else {
 709       $sth->execute;
 710   }
 711   my @results = ();
 712   while (my $data=$sth->fetchrow_hashref){
 713     push(@results,$data);
 714   }
 715   $sth->finish;
 716   return(scalar(@results),@results);
 717 }
 718
 719 =item bookfundbreakdown
 720
 721         returns the total comtd & spent for a given bookfund
 722         used in acqui-home.pl
 723 =cut
 724 #'
 725
 726 sub bookfundbreakdown {
 727   my ($id)=@_;
 728   my $dbh = C4::Context->dbh;
 729   my $sth=$dbh->prepare("Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived,subscription
 730   from aqorders,aqorderbreakdown where bookfundid=? and
 731   aqorders.ordernumber=aqorderbreakdown.ordernumber
 732   and (datecancellationprinted is NULL or
 733   datecancellationprinted='0000-00-00')");
 734   $sth->execute($id);
 735   my $comtd=0;
 736   my $spent=0;
 737   while (my $data=$sth->fetchrow_hashref){
 738     if ($data->{'subscription'} == 1){
 739       $spent+=$data->{'quantity'}*$data->{'unitprice'};
 740     } else {
 741       my $leftover=$data->{'quantity'}-$data->{'quantityreceived'};
 742       $comtd+=($data->{'ecost'})*$leftover;
 743       $spent+=($data->{'unitprice'})*$data->{'quantityreceived'};
 744     }
 745   }
 746   $sth->finish;
 747   return($spent,$comtd);
 748 }
 749
 750
 751
 752 =item curconvert
 753
 754   $foreignprice = &curconvert($currency, $localprice);
 755
 756 Converts the price C<$localprice> to foreign currency C<$currency> by
 757 dividing by the exchange rate, and returns the result.
 758
 759 If no exchange rate is found, C<&curconvert> assumes the rate is one
 760 to one.
 761
 762 =cut
 763 #'
 764 sub curconvert {
 765   my ($currency,$price)=@_;
 766   my $dbh = C4::Context->dbh;
 767   my $sth=$dbh->prepare("Select rate from currency where currency=?");
 768   $sth->execute($currency);
 769   my $cur=($sth->fetchrow_array())[0];
 770   $sth->finish;
 771   if ($cur==0){
 772     $cur=1;
 773   }
 774   return($price / $cur);
 775 }
 776
 777 =item getcurrencies
 778
 779   ($count, $currencies) = &getcurrencies();
 780
 781 Returns the list of all known currencies.
 782
 783 C<$count> is the number of elements in C<$currencies>. C<$currencies>
 784 is a reference-to-array; its elements are references-to-hash, whose
 785 keys are the fields from the currency table in the Koha database.
 786
 787 =cut
 788 #'
 789 sub getcurrencies {
 790   my $dbh = C4::Context->dbh;
 791   my $sth=$dbh->prepare("Select * from currency");
 792   $sth->execute;
 793   my @results = ();
 794   while (my $data=$sth->fetchrow_hashref){
 795     push(@results,$data);
 796   }
 797   $sth->finish;
 798   return(scalar(@results),\@results);
 799 }
 800
 801 =item updatecurrencies
 802
 803   &updatecurrencies($currency, $newrate);
 804
 805 Sets the exchange rate for C<$currency> to be C<$newrate>.
 806
 807 =cut
 808 #'
 809 sub updatecurrencies {
 810   my ($currency,$rate)=@_;
 811   my $dbh = C4::Context->dbh;
 812   my $sth=$dbh->prepare("update currency set rate=? where currency=?");
 813   $sth->execute($rate,$currency);
 814   $sth->finish;
 815 }
 816
 817 #
 818 #
 819 # OTHERS
 820 #
 821 #
 822
 823 =item bookseller
 824
 825   ($count, @results) = &bookseller($searchstring);
 826
 827 Looks up a book seller. C<$searchstring> may be either a book seller
 828 ID, or a string to look for in the book seller's name.
 829
 830 C<$count> is the number of elements in C<@results>. C<@results> is an
 831 array of references-to-hash, whose keys are the fields of of the
 832 aqbooksellers table in the Koha database.
 833
 834 =cut
 835 #'
 836 sub bookseller {
 837   my ($searchstring)=@_;
 838   my $dbh = C4::Context->dbh;
 839   my $sth=$dbh->prepare("Select * from aqbooksellers where name like ? or id = ?");
 840   $sth->execute("$searchstring%",$searchstring);
 841   my @results;
 842   while (my $data=$sth->fetchrow_hashref){
 843     push(@results,$data);
 844   }
 845   $sth->finish;
 846   return(scalar(@results),@results);
 847 }
 848
 849 =item breakdown
 850
 851   ($count, $results) = &breakdown($ordernumber);
 852
 853 Looks up an order by order ID, and returns its breakdown.
 854
 855 C<$count> is the number of elements in C<$results>. C<$results> is a
 856 reference-to-array; its elements are references-to-hash, whose keys
 857 are the fields of the aqorderbreakdown table in the Koha database.
 858
 859 =cut
 860 #'
 861 sub breakdown {
 862   my ($id)=@_;
 863   my $dbh = C4::Context->dbh;
 864   my $sth=$dbh->prepare("Select * from aqorderbreakdown where ordernumber=?");
 865   $sth->execute($id);
 866   my @results = ();
 867   while (my $data=$sth->fetchrow_hashref){
 868     push(@results,$data);
 869   }
 870   $sth->finish;
 871   return(scalar(@results),\@results);
 872 }
 873
 874 =item branches
 875
 876   ($count, @results) = &branches();
 877
 878 Returns a list of all library branches.
 879
 880 C<$count> is the number of elements in C<@results>. C<@results> is an
 881 array of references-to-hash, whose keys are the fields of the branches
 882 table of the Koha database.
 883
 884 =cut
 885 #'
 886 sub branches {
 887     my $dbh   = C4::Context->dbh;
 888     my $sth   = $dbh->prepare("Select * from branches order by branchname");
 889     my @results = ();
 890
 891     $sth->execute();
 892     while (my $data = $sth->fetchrow_hashref) {
 893         push(@results,$data);
 894     } # while
 895
 896     $sth->finish;
 897     return(scalar(@results), @results);
 898 } # sub branches
 899
 900 =item updatesup
 901
 902   &updatesup($bookseller);
 903
 904 Updates the information for a given bookseller. C<$bookseller> is a
 905 reference-to-hash whose keys are the fields of the aqbooksellers table
 906 in the Koha database. It must contain entries for all of the fields.
 907 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
 908
 909 The easiest way to get all of the necessary fields is to look up a
 910 book seller with C<&booksellers>, modify what's necessary, then call
 911 C<&updatesup> with the result.
 912
 913 =cut
 914 #'
 915 sub updatesup {
 916    my ($data)=@_;
 917    my $dbh = C4::Context->dbh;
 918    my $sth=$dbh->prepare("Update aqbooksellers set
 919    name=?,address1=?,address2=?,address3=?,address4=?,postal=?,
 920    phone=?,fax=?,url=?,contact=?,contpos=?,contphone=?,contfax=?,contaltphone=?,
 921    contemail=?,contnotes=?,active=?,
 922    listprice=?, invoiceprice=?,gstreg=?, listincgst=?,
 923    invoiceincgst=?, specialty=?,discount=?,invoicedisc=?,
 924    nocalc=?
 925    where id=?");
 926    $sth->execute($data->{'name'},$data->{'address1'},$data->{'address2'},
 927    $data->{'address3'},$data->{'address4'},$data->{'postal'},$data->{'phone'},
 928    $data->{'fax'},$data->{'url'},$data->{'contact'},$data->{'contpos'},
 929    $data->{'contphone'},$data->{'contfax'},$data->{'contaltphone'},
 930    $data->{'contemail'},
 931    $data->{'contnote'},$data->{'active'},$data->{'listprice'},
 932    $data->{'invoiceprice'},$data->{'gstreg'},$data->{'listincgst'},
 933    $data->{'invoiceincgst'},$data->{'specialty'},$data->{'discount'},
 934    $data->{'invoicedisc'},$data->{'nocalc'},$data->{'id'});
 935    $sth->finish;
 936 }
 937
 938 =item insertsup
 939
 940   $id = &insertsup($bookseller);
 941
 942 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
 943 keys are the fields of the aqbooksellers table in the Koha database.
 944 All fields must be present.
 945
 946 Returns the ID of the newly-created bookseller.
 947
 948 =cut
 949 #'
 950 sub insertsup {
 951   my ($data)=@_;
 952   my $dbh = C4::Context->dbh;
 953   my $sth=$dbh->prepare("Select max(id) from aqbooksellers");
 954   $sth->execute;
 955   my $data2=$sth->fetchrow_hashref;
 956   $sth->finish;
 957   $data2->{'max(id)'}++;
 958   $sth=$dbh->prepare("Insert into aqbooksellers (id) values (?)");
 959   $sth->execute($data2->{'max(id)'});
 960   $sth->finish;
 961   $data->{'id'}=$data2->{'max(id)'};
 962   updatesup($data);
 963   return($data->{'id'});
 964 }
 965
 966 END { }       # module clean-up code here (global destructor)
 967
 968 1;
 969 __END__
 970
 971 =back
 972
 973 =head1 AUTHOR
 974
 975 Koha Developement team <info@koha.org>
 976
 977 =cut