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