1 package C4
::Acquisition
;
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
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
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.
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
24 use C4
::Dates
qw(format_date format_date_in_iso);
32 use vars
qw($VERSION @ISA @EXPORT);
35 # set the version for version checking
40 &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket
41 &ModBasketHeader &GetBasketsByBookseller &GetBasketsByBasketgroup
42 &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup
45 &GetPendingOrders &GetOrder &GetOrders
46 &GetOrderNumber &GetLateOrders &NewOrder &DelOrder
47 &SearchOrder &GetHistory &GetRecentAcqui
48 &ModOrder &ModOrderItem &ModReceiveOrder &ModOrderBiblioitemNumber
52 &GetParcels &GetParcel
53 &GetContracts &GetContract
55 &GetOrderFromItemnumber
63 sub GetOrderFromItemnumber
{
64 my ($itemnumber) = @_;
65 my $dbh = C4
::Context
->dbh;
68 SELECT
* from aqorders LEFT JOIN aqorders_items
69 ON
( aqorders
.ordernumber
= aqorders_items
.ordernumber
)
70 WHERE itemnumber
= ?
|;
72 my $sth = $dbh->prepare($query);
76 $sth->execute($itemnumber);
78 my $order = $sth->fetchrow_hashref;
91 C4::Acquisition - Koha functions for dealing with orders and acquisitions
99 The functions in this module deal with acquisitions, managing book
100 orders, basket and parcels.
104 =head2 FUNCTIONS ABOUT BASKETS
110 $aqbasket = &GetBasket($basketnumber);
112 get all basket informations in aqbasket for a given basket
115 informations for a given basket returned as a hashref.
123 my $dbh = C4
::Context
->dbh;
126 concat( b.firstname,' ',b.surname) AS authorisedbyname,
127 b.branchcode AS branch
129 LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber
132 my $sth=$dbh->prepare($query);
133 $sth->execute($basketno);
134 my $basket = $sth->fetchrow_hashref;
138 #------------------------------------------------------------#
144 $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber );
146 Create a new basket in aqbasket table
148 =item C<$booksellerid> is a foreign key in the aqbasket table
150 =item C<$authorizedby> is the username of who created the basket
152 The other parameters are optional, see ModBasketHeader for more info on them.
158 # FIXME : this function seems to be unused.
161 my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber ) = @_;
162 my $dbh = C4
::Context
->dbh;
165 (creationdate,booksellerid,authorisedby)
166 VALUES (now(),'$booksellerid','$authorisedby')
170 #find & return basketno MYSQL dependant, but $dbh->last_insert_id always returns null :-(
171 my $basket = $dbh->{'mysql_insertid'};
172 ModBasketHeader
($basket, $basketname || '', $basketnote || '', $basketbooksellernote || '', $basketcontractnumber || undef);
176 #------------------------------------------------------------#
182 &CloseBasket($basketno);
184 close a basket (becomes unmodifiable,except for recieves)
192 my $dbh = C4
::Context
->dbh;
198 my $sth = $dbh->prepare($query);
199 $sth->execute($basketno);
202 #------------------------------------------------------------#
208 &DelBasket($basketno);
210 Deletes the basket that has basketno field $basketno in the aqbasket table.
214 =item C<$basketno> is the primary key of the basket in the aqbasket table.
222 my ( $basketno ) = @_;
223 my $query = "DELETE FROM aqbasket WHERE basketno=?";
224 my $dbh = C4
::Context
->dbh;
225 my $sth = $dbh->prepare($query);
226 $sth->execute($basketno);
230 #------------------------------------------------------------#
236 &ModBasket($basketinfo);
238 Modifies a basket, using a hashref $basketinfo for the relevant information, only $basketinfo->{'basketno'} is required.
242 =item C<$basketno> is the primary key of the basket in the aqbasket table.
250 my $basketinfo = shift;
251 my $query = "UPDATE aqbasket SET ";
253 foreach my $key (keys %$basketinfo){
254 if ($key ne 'basketno'){
255 $query .= "$key=?, ";
256 push(@params, $basketinfo->{$key} || undef );
259 # get rid of the "," at the end of $query
260 if (substr($query, length($query)-2) eq ', '){
265 $query .= "WHERE basketno=?";
266 push(@params, $basketinfo->{'basketno'});
267 my $dbh = C4
::Context
->dbh;
268 my $sth = $dbh->prepare($query);
269 $sth->execute(@params);
273 #------------------------------------------------------------#
275 =head3 ModBasketHeader
279 &ModBasketHeader($basketno, $basketname, $note, $booksellernote, $contractnumber);
281 Modifies a basket's header.
285 =item C<$basketno> is the "basketno" field in the "aqbasket" table;
287 =item C<$basketname> is the "basketname" field in the "aqbasket" table;
289 =item C<$note> is the "note" field in the "aqbasket" table;
291 =item C<$booksellernote> is the "booksellernote" field in the "aqbasket" table;
293 =item C<$contractnumber> is the "contractnumber" (foreign) key in the "aqbasket" table.
300 sub ModBasketHeader
{
301 my ($basketno, $basketname, $note, $booksellernote, $contractnumber) = @_;
302 my $query = "UPDATE aqbasket SET basketname=?, note=?, booksellernote=? WHERE basketno=?";
303 my $dbh = C4
::Context
->dbh;
304 my $sth = $dbh->prepare($query);
305 $sth->execute($basketname,$note,$booksellernote,$basketno);
306 if ( $contractnumber ) {
307 my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?";
308 my $sth2 = $dbh->prepare($query2);
309 $sth2->execute($contractnumber,$basketno);
315 #------------------------------------------------------------#
317 =head3 GetBasketsByBookseller
321 @results = &GetBasketsByBookseller($booksellerid, $extra);
323 Returns a list of hashes of all the baskets that belong to bookseller 'booksellerid'.
327 =item C<$booksellerid> is the 'id' field of the bookseller in the aqbooksellers table
329 =item C<$extra> is the extra sql parameters, can be
331 - $extra->{groupby}: group baskets by column
332 ex. $extra->{groupby} = aqbasket.basketgroupid
333 - $extra->{orderby}: order baskets by column
334 - $extra->{limit}: limit number of results (can be helpful for pagination)
342 sub GetBasketsByBookseller
{
343 my ($booksellerid, $extra) = @_;
344 my $query = "SELECT * FROM aqbasket WHERE booksellerid=?";
346 if ($extra->{groupby
}) {
347 $query .= " GROUP by $extra->{groupby}";
349 if ($extra->{orderby
}){
350 $query .= " ORDER by $extra->{orderby}";
352 if ($extra->{limit
}){
353 $query .= " LIMIT $extra->{limit}";
356 my $dbh = C4
::Context
->dbh;
357 my $sth = $dbh->prepare($query);
358 $sth->execute($booksellerid);
359 my $results = $sth->fetchall_arrayref({});
364 #------------------------------------------------------------#
366 =head3 GetBasketsByBasketgroup
370 $baskets = &GetBasketsByBasketgroup($basketgroupid);
374 Returns a reference to all baskets that belong to basketgroup $basketgroupid.
382 sub GetBasketsByBasketgroup
{
383 my $basketgroupid = shift;
384 my $query = "SELECT * FROM aqbasket
385 LEFT JOIN aqcontract USING(contractnumber) WHERE basketgroupid=?";
386 my $dbh = C4
::Context
->dbh;
387 my $sth = $dbh->prepare($query);
388 $sth->execute($basketgroupid);
389 my $results = $sth->fetchall_arrayref({});
394 #------------------------------------------------------------#
396 =head3 NewBasketgroup
400 $basketgroupid = NewBasketgroup(\%hashref);
404 Adds a basketgroup to the aqbasketgroups table, and add the initial baskets to it.
406 $hashref->{'booksellerid'} is the 'id' field of the bookseller in the aqbooksellers table,
408 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
410 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
412 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
421 my $basketgroupinfo = shift;
422 die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'};
423 my $query = "INSERT INTO aqbasketgroups (";
425 foreach my $field ('name', 'closed') {
426 if ( $basketgroupinfo->{$field} ) {
427 $query .= "$field, ";
428 push(@params, $basketgroupinfo->{$field});
431 $query .= "booksellerid) VALUES (";
436 push(@params, $basketgroupinfo->{'booksellerid'});
437 my $dbh = C4
::Context
->dbh;
438 my $sth = $dbh->prepare($query);
439 $sth->execute(@params);
440 my $basketgroupid = $dbh->{'mysql_insertid'};
441 if( $basketgroupinfo->{'basketlist'} ) {
442 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
443 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
444 my $sth2 = $dbh->prepare($query2);
445 $sth2->execute($basketgroupid, $basketno);
448 return $basketgroupid;
451 #------------------------------------------------------------#
453 =head3 ModBasketgroup
457 ModBasketgroup(\%hashref);
461 Modifies a basketgroup in the aqbasketgroups table, and add the baskets to it.
463 $hashref->{'id'} is the 'id' field of the basketgroup in the aqbasketgroup table, this parameter is mandatory,
465 $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups table,
467 $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group,
469 $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise.
478 my $basketgroupinfo = shift;
479 die "basketgroup id is required to edit a basketgroup" unless $basketgroupinfo->{'id'};
480 my $dbh = C4
::Context
->dbh;
481 my $query = "UPDATE aqbasketgroups SET ";
483 foreach my $field (qw(name closed)) {
484 if ( $basketgroupinfo->{$field} ne undef) {
485 $query .= "$field=?, ";
486 push(@params, $basketgroupinfo->{$field});
491 $query .= " WHERE id=?";
492 push(@params, $basketgroupinfo->{'id'});
493 my $sth = $dbh->prepare($query);
494 $sth->execute(@params);
495 if($basketgroupinfo->{'basketlist'} && @
{$basketgroupinfo->{'basketlist'}}){
496 foreach my $basketno (@
{$basketgroupinfo->{'basketlist'}}) {
497 my $query2 = "UPDATE aqbasket SET basketgroupid=? WHERE basketno=?";
498 my $sth2 = $dbh->prepare($query2);
499 $sth2->execute($basketgroupinfo->{'id'}, $basketno);
506 #------------------------------------------------------------#
508 =head3 DelBasketgroup
512 DelBasketgroup($basketgroupid);
516 Deletes a basketgroup in the aqbasketgroups table, and removes the reference to it from the baskets,
518 =item C<$basketgroupid> is the 'id' field of the basket in the aqbasketgroup table
527 my $basketgroupid = shift;
528 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
529 my $query = "DELETE FROM aqbasketgroups WHERE id=?";
530 my $dbh = C4
::Context
->dbh;
531 my $sth = $dbh->prepare($query);
532 $sth->execute($basketgroupid);
536 #------------------------------------------------------------#
540 =head2 FUNCTIONS ABOUT ORDERS
546 =head3 GetBasketgroup
550 $basketgroup = &GetBasketgroup($basketgroupid);
554 Returns a reference to the hash containing all infermation about the basketgroup.
563 my $basketgroupid = shift;
564 die "basketgroup id is required to edit a basketgroup" unless $basketgroupid;
565 my $query = "SELECT * FROM aqbasketgroups WHERE id=?";
566 my $dbh = C4
::Context
->dbh;
567 my $sth = $dbh->prepare($query);
568 $sth->execute($basketgroupid);
569 my $result = $sth->fetchrow_hashref;
574 #------------------------------------------------------------#
576 =head3 GetBasketgroups
580 $basketgroups = &GetBasketgroups($booksellerid);
584 Returns a reference to the array of all the basketgroups of bookseller $booksellerid.
592 sub GetBasketgroups
{
593 my $booksellerid = shift;
594 die "bookseller id is required to edit a basketgroup" unless $booksellerid;
595 my $query = "SELECT * FROM aqbasketgroups WHERE booksellerid=?";
596 my $dbh = C4
::Context
->dbh;
597 my $sth = $dbh->prepare($query);
598 $sth->execute($booksellerid);
599 my $results = $sth->fetchall_arrayref({});
604 #------------------------------------------------------------#
608 =head2 FUNCTIONS ABOUT ORDERS
614 #------------------------------------------------------------#
616 =head3 GetPendingOrders
620 $orders = &GetPendingOrders($booksellerid, $grouped, $owner);
622 Finds pending orders from the bookseller with the given ID. Ignores
623 completed and cancelled orders.
625 C<$booksellerid> contains the bookseller identifier
626 C<$grouped> contains 0 or 1. 0 means returns the list, 1 means return the total
627 C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself.
629 C<$orders> is a reference-to-array; each element is a
630 reference-to-hash with the following fields:
631 C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket
632 in a single result line
636 =item C<authorizedby>
642 These give the value of the corresponding field in the aqorders table
643 of the Koha database.
649 Results are ordered from most to least recent.
653 sub GetPendingOrders
{
654 my ($supplierid,$grouped,$owner,$basketno) = @_;
655 my $dbh = C4
::Context
->dbh;
657 SELECT ".($grouped?
"count(*),":"")."aqbasket.basketno,
658 surname,firstname,aqorders.*,biblio.*,biblioitems.isbn,
659 aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname
661 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
662 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
663 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber
664 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
666 AND (quantity > quantityreceived OR quantityreceived is NULL)
667 AND datecancellationprinted IS NULL
668 AND (to_days(now())-to_days(closedate) < 180 OR closedate IS NULL)
670 ## FIXME Why 180 days ???
671 my @query_params = ( $supplierid );
672 my $userenv = C4
::Context
->userenv;
673 if ( C4
::Context
->preference("IndependantBranches") ) {
674 if ( ($userenv) && ( $userenv->{flags
} != 1 ) ) {
675 $strsth .= " and (borrowers.branchcode = ?
676 or borrowers.branchcode = '')";
677 push @query_params, $userenv->{branch
};
681 $strsth .= " AND aqbasket.authorisedby=? ";
682 push @query_params, $userenv->{'number'};
685 $strsth .= " AND aqbasket.basketno=? ";
686 push @query_params, $basketno;
688 $strsth .= " group by aqbasket.basketno" if $grouped;
689 $strsth .= " order by aqbasket.basketno";
691 my $sth = $dbh->prepare($strsth);
692 $sth->execute( @query_params );
693 my $results = $sth->fetchall_arrayref({});
698 #------------------------------------------------------------#
704 @orders = &GetOrders($basketnumber, $orderby);
706 Looks up the pending (non-cancelled) orders with the given basket
707 number. If C<$booksellerID> is non-empty, only orders from that seller
711 C<&basket> returns a two-element array. C<@orders> is an array of
712 references-to-hash, whose keys are the fields from the aqorders,
713 biblio, and biblioitems tables in the Koha database.
720 my ( $basketno, $orderby ) = @_;
721 my $dbh = C4
::Context
->dbh;
723 SELECT biblio.*,biblioitems.*,
728 LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id
729 LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber
730 LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber
732 AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')
735 $orderby = "biblioitems.publishercode,biblio.title" unless $orderby;
736 $query .= " ORDER BY $orderby";
737 my $sth = $dbh->prepare($query);
738 $sth->execute($basketno);
739 my $results = $sth->fetchall_arrayref({});
744 #------------------------------------------------------------#
746 =head3 GetOrderNumber
750 $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber);
754 Looks up the ordernumber with the given biblionumber and biblioitemnumber.
756 Returns the number of this order.
760 =item C<$ordernumber> is the order number.
766 my ( $biblionumber,$biblioitemnumber ) = @_;
767 my $dbh = C4
::Context
->dbh;
772 AND biblioitemnumber=?
774 my $sth = $dbh->prepare($query);
775 $sth->execute( $biblionumber, $biblioitemnumber );
777 return $sth->fetchrow;
780 #------------------------------------------------------------#
786 $order = &GetOrder($ordernumber);
788 Looks up an order by order number.
790 Returns a reference-to-hash describing the order. The keys of
791 C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha database.
799 my $dbh = C4
::Context
->dbh;
801 SELECT biblioitems.*, biblio.*, aqorders.*
803 LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber
804 LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber
805 WHERE aqorders.ordernumber=?
808 my $sth= $dbh->prepare($query);
809 $sth->execute($ordnum);
810 my $data = $sth->fetchrow_hashref;
815 #------------------------------------------------------------#
821 &NewOrder(\%hashref);
823 Adds a new order to the database. Any argument that isn't described
824 below is the new value of the field with the same name in the aqorders
825 table of the Koha database.
829 =item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory
832 =item $hashref->{'ordnum'} is a "minimum order number."
834 =item $hashref->{'budgetdate'} is effectively ignored.
835 If it's undef (anything false) or the string 'now', the current day is used.
836 Else, the upcoming July 1st is used.
838 =item $hashref->{'subscription'} may be either "yes", or anything else for "no".
840 =item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain"
842 The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gst", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "bookfundid".
851 my $orderinfo = shift;
852 #### ------------------------------
853 my $dbh = C4
::Context
->dbh;
857 # if these parameters are missing, we can't continue
858 for my $key (qw
/basketno quantity biblionumber budget_id/) {
859 die "Mandatory parameter $key missing" unless $orderinfo->{$key};
862 if ( $orderinfo->{'subscription'} eq 'yes' ) {
863 $orderinfo->{'subscription'} = 1;
865 $orderinfo->{'subscription'} = 0;
868 my $query = "INSERT INTO aqorders (";
869 foreach my $orderinfokey (keys %{$orderinfo}) {
870 next if $orderinfokey =~ m/branchcode|entrydate/; # skip branchcode and entrydate, branchcode isnt a vaild col, entrydate we add manually with NOW()
871 $query .= "$orderinfokey,";
872 push(@params, $orderinfo->{$orderinfokey});
875 $query .= "entrydate) VALUES (";
879 $query .= " NOW() )"; #ADDING CURRENT DATE TO 'budgetdate, entrydate, purchaseordernumber'...
881 my $sth = $dbh->prepare($query);
883 $sth->execute(@params);
886 #get ordnum MYSQL dependant, but $dbh->last_insert_id returns null
887 my $ordnum = $dbh->{'mysql_insertid'};
890 return ( $orderinfo->{'basketno'}, $ordnum );
895 #------------------------------------------------------------#
909 #my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
910 my ($itemnumber, $ordernumber) = @_;
911 my $dbh = C4
::Context
->dbh;
913 INSERT INTO aqorders_items
914 (itemnumber
, ordernumber
)
917 my $sth = $dbh->prepare($query);
918 $sth->execute( $itemnumber, $ordernumber);
921 #------------------------------------------------------------#
927 &ModOrder(\%hashref);
931 Modifies an existing order. Updates the order with order number
932 $hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All other keys of the hash
933 update the fields with the same name in the aqorders table of the Koha database.
942 my $orderinfo = shift;
944 die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ;
945 die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq '';
947 my $dbh = C4
::Context
->dbh;
949 # delete($orderinfo->{'branchcode'});
950 # the hash contains a lot of entries not in aqorders, so get the columns ...
951 my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;");
953 my $colnames = $sth->{NAME
};
954 my $query = "UPDATE aqorders SET ";
956 foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){
957 # ... and skip hash entries that are not in the aqorders table
958 # FIXME : probably not the best way to do it (would be better to have a correct hash)
959 next unless grep(/^$orderinfokey$/, @
$colnames);
960 $query .= "$orderinfokey=?, ";
961 push(@params, $orderinfo->{$orderinfokey});
964 $query .= "timestamp=NOW() WHERE ordernumber=?";
965 # push(@params, $specorderinfo{'ordernumber'});
966 push(@params, $orderinfo->{'ordernumber'} );
967 $sth = $dbh->prepare($query);
968 $sth->execute(@params);
972 #------------------------------------------------------------#
978 &ModOrderItem(\%hashref);
982 Modifies the itemnumber in the aqorders_items table. The input hash needs three entities:
983 - itemnumber: the old itemnumber
984 - ordernumber: the order this item is attached to
985 - newitemnumber: the new itemnumber we want to attach the line to
994 my $orderiteminfo = shift;
995 if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){
996 die "Ordernumber, itemnumber and newitemnumber is required";
999 my $dbh = C4
::Context
->dbh;
1001 my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?";
1002 my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'});
1004 warn Data
::Dumper
::Dumper
(@params);
1005 my $sth = $dbh->prepare($query);
1006 $sth->execute(@params);
1010 #------------------------------------------------------------#
1013 =head3 ModOrderBibliotemNumber
1017 &ModOrderBiblioitemNumber($biblioitemnumber,$ordnum, $biblionumber);
1019 Modifies the biblioitemnumber for an existing order.
1020 Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>.
1026 #FIXME: is this used at all?
1027 sub ModOrderBiblioitemNumber
{
1028 my ($biblioitemnumber,$ordnum, $biblionumber) = @_;
1029 my $dbh = C4
::Context
->dbh;
1032 SET biblioitemnumber = ?
1033 WHERE ordernumber = ?
1034 AND biblionumber = ?";
1035 my $sth = $dbh->prepare($query);
1036 $sth->execute( $biblioitemnumber, $ordnum, $biblionumber );
1039 #------------------------------------------------------------#
1041 =head3 ModReceiveOrder
1045 &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user,
1046 $unitprice, $booksellerinvoicenumber, $biblioitemnumber,
1047 $freight, $bookfund, $rrp);
1049 Updates an order, to reflect the fact that it was received, at least
1050 in part. All arguments not mentioned below update the fields with the
1051 same name in the aqorders table of the Koha database.
1053 If a partial order is received, splits the order into two. The received
1054 portion must have a booksellerinvoicenumber.
1056 Updates the order with bibilionumber C<$biblionumber> and ordernumber
1064 sub ModReceiveOrder
{
1066 $biblionumber, $ordnum, $quantrec, $user, $cost,
1067 $invoiceno, $freight, $rrp, $budget_id, $datereceived
1070 my $dbh = C4
::Context
->dbh;
1071 # warn "DATE BEFORE : $daterecieved";
1072 # $daterecieved=POSIX::strftime("%Y-%m-%d",CORE::localtime) unless $daterecieved;
1073 # warn "DATE REC : $daterecieved";
1074 $datereceived = C4
::Dates
->output('iso') unless $datereceived;
1075 my $suggestionid = GetSuggestionFromBiblionumber
( $dbh, $biblionumber );
1076 if ($suggestionid) {
1077 ModStatus
( $suggestionid, 'AVAILABLE', '', $biblionumber );
1080 my $sth=$dbh->prepare("
1081 SELECT * FROM aqorders
1082 WHERE biblionumber=? AND aqorders.ordernumber=?");
1084 $sth->execute($biblionumber,$ordnum);
1085 my $order = $sth->fetchrow_hashref();
1088 if ( $order->{quantity
} > $quantrec ) {
1089 $sth=$dbh->prepare("
1091 SET quantityreceived=?
1093 , booksellerinvoicenumber=?
1097 , quantityreceived=?
1098 WHERE biblionumber=? AND ordernumber=?");
1100 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$quantrec,$biblionumber,$ordnum);
1103 # create a new order for the remaining items, and set its bookfund.
1104 foreach my $orderkey ( "linenumber", "allocation" ) {
1105 delete($order->{'$orderkey'});
1107 my $newOrder = NewOrder
($order);
1109 $sth=$dbh->prepare("update aqorders
1110 set quantityreceived=?,datereceived=?,booksellerinvoicenumber=?,
1111 unitprice=?,freight=?,rrp=?
1112 where biblionumber=? and ordernumber=?");
1113 $sth->execute($quantrec,$datereceived,$invoiceno,$cost,$freight,$rrp,$biblionumber,$ordnum);
1116 return $datereceived;
1118 #------------------------------------------------------------#
1122 @results = &SearchOrder($search, $biblionumber, $complete);
1124 Searches for orders.
1126 C<$search> may take one of several forms: if it is an ISBN,
1127 C<&ordersearch> returns orders with that ISBN. If C<$search> is an
1128 order number, C<&ordersearch> returns orders with that order number
1129 and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered
1130 to be a space-separated list of search terms; in this case, all of the
1131 terms must appear in the title (matching the beginning of title
1134 If C<$complete> is C<yes>, the results will include only completed
1135 orders. In any case, C<&ordersearch> ignores cancelled orders.
1137 C<&ordersearch> returns an array.
1138 C<@results> is an array of references-to-hash with the following keys:
1144 =item C<seriestitle>
1155 #### -------- SearchOrder-------------------------------
1156 my ($ordernumber, $search) = @_;
1159 my $dbh = C4
::Context
->dbh;
1163 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1164 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1165 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1166 WHERE ((datecancellationprinted is NULL)
1167 AND (aqorders.ordernumber=?))";
1168 my $sth = $dbh->prepare($query);
1169 $sth->execute($ordernumber);
1170 my $results = $sth->fetchall_arrayref({});
1174 my $dbh = C4
::Context
->dbh;
1178 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1179 LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber
1180 LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno
1181 WHERE ((datecancellationprinted is NULL)
1182 AND (biblio.title like ? OR biblioitems.isbn like ?))";
1183 my $sth = $dbh->prepare($query);
1184 $sth->execute("%$search%","%$search%");
1185 my $results = $sth->fetchall_arrayref({});
1191 #------------------------------------------------------------#
1197 &DelOrder($biblionumber, $ordernumber);
1199 Cancel the order with the given order and biblio numbers. It does not
1200 delete any entries in the aqorders table, it merely marks them as
1208 my ( $bibnum, $ordnum ) = @_;
1209 my $dbh = C4
::Context
->dbh;
1212 SET datecancellationprinted=now()
1213 WHERE biblionumber=? AND ordernumber=?
1215 my $sth = $dbh->prepare($query);
1216 $sth->execute( $bibnum, $ordnum );
1220 =head2 FUNCTIONS ABOUT PARCELS
1224 #------------------------------------------------------------#
1230 @results = &GetParcel($booksellerid, $code, $date);
1232 Looks up all of the received items from the supplier with the given
1233 bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders.
1235 C<@results> is an array of references-to-hash. The keys of each element are fields from
1236 the aqorders, biblio, and biblioitems tables of the Koha database.
1238 C<@results> is sorted alphabetically by book title.
1245 #gets all orders from a certain supplier, orders them alphabetically
1246 my ( $supplierid, $code, $datereceived ) = @_;
1247 my $dbh = C4
::Context
->dbh;
1250 if $code; # add % if we search on a given code (otherwise, let him empty)
1252 SELECT authorisedby,
1257 aqorders.biblionumber,
1258 aqorders.ordernumber,
1260 aqorders.quantityreceived,
1267 LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno
1268 LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber
1269 LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber
1271 aqbasket.booksellerid = ?
1272 AND aqorders.booksellerinvoicenumber LIKE ?
1273 AND aqorders.datereceived = ? ";
1275 my @query_params = ( $supplierid, $code, $datereceived );
1276 if ( C4
::Context
->preference("IndependantBranches") ) {
1277 my $userenv = C4
::Context
->userenv;
1278 if ( ($userenv) && ( $userenv->{flags
} != 1 ) ) {
1279 $strsth .= " and (borrowers.branchcode = ?
1280 or borrowers.branchcode = '')";
1281 push @query_params, $userenv->{branch
};
1284 $strsth .= " ORDER BY aqbasket.basketno";
1285 # ## parcelinformation : $strsth
1286 my $sth = $dbh->prepare($strsth);
1287 $sth->execute( @query_params );
1288 while ( my $data = $sth->fetchrow_hashref ) {
1289 push( @results, $data );
1291 # ## countparcelbiblio: scalar(@results)
1297 #------------------------------------------------------------#
1303 $results = &GetParcels($bookseller, $order, $code, $datefrom, $dateto);
1304 get a lists of parcels.
1313 is the bookseller this function has to get parcels.
1316 To know on what criteria the results list has to be ordered.
1319 is the booksellerinvoicenumber.
1321 =item $datefrom & $dateto
1322 to know on what date this function has to filter its search.
1325 a pointer on a hash list containing parcel informations as such :
1329 =item Last operation
1331 =item Number of biblio
1333 =item Number of items
1340 my ($bookseller,$order, $code, $datefrom, $dateto) = @_;
1341 my $dbh = C4
::Context
->dbh;
1342 my @query_params = ();
1344 SELECT aqorders.booksellerinvoicenumber,
1345 datereceived,purchaseordernumber,
1346 count(DISTINCT biblionumber) AS biblio,
1347 sum(quantity) AS itemsexpected,
1348 sum(quantityreceived) AS itemsreceived
1349 FROM aqorders LEFT JOIN aqbasket ON aqbasket.basketno = aqorders.basketno
1350 WHERE aqbasket.booksellerid = $bookseller and datereceived IS NOT NULL
1353 if ( defined $code ) {
1354 $strsth .= ' and aqorders.booksellerinvoicenumber like ? ';
1355 # add a % to the end of the code to allow stemming.
1356 push @query_params, "$code%";
1359 if ( defined $datefrom ) {
1360 $strsth .= ' and datereceived >= ? ';
1361 push @query_params, $datefrom;
1364 if ( defined $dateto ) {
1365 $strsth .= 'and datereceived <= ? ';
1366 push @query_params, $dateto;
1369 $strsth .= "group by aqorders.booksellerinvoicenumber,datereceived ";
1371 # can't use a placeholder to place this column name.
1372 # but, we could probably be checking to make sure it is a column that will be fetched.
1373 $strsth .= "order by $order " if ($order);
1375 my $sth = $dbh->prepare($strsth);
1377 $sth->execute( @query_params );
1378 my $results = $sth->fetchall_arrayref({});
1383 #------------------------------------------------------------#
1385 =head3 GetLateOrders
1389 @results = &GetLateOrders;
1391 Searches for bookseller with late orders.
1394 the table of supplier with late issues. This table is full of hashref.
1402 my $supplierid = shift;
1405 my $dbh = C4
::Context
->dbh;
1407 #BEWARE, order of parenthesis and LEFT JOIN is important for speed
1408 my $dbdriver = C4
::Context
->config("db_scheme") || "mysql";
1410 my @query_params = ($delay); # delay is the first argument regardless
1412 SELECT aqbasket.basketno,
1413 aqorders.ordernumber,
1414 DATE(aqbasket.closedate) AS orderdate,
1415 aqorders.rrp AS unitpricesupplier,
1416 aqorders.ecost AS unitpricelib,
1417 aqbudgets.budget_name AS budget,
1418 borrowers.branchcode AS branch,
1419 aqbooksellers.name AS supplier,
1421 biblioitems.publishercode AS publisher,
1422 biblioitems.publicationyear,
1426 (aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber)
1427 LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber)
1428 LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id),
1429 (aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber)
1430 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
1431 WHERE aqorders.basketno = aqbasket.basketno
1432 AND ( (datereceived = '' OR datereceived IS NULL)
1433 OR (aqorders.quantityreceived < aqorders.quantity)
1437 if ($dbdriver eq "mysql") {
1439 aqorders.quantity - IFNULL(aqorders.quantityreceived,0) AS quantity,
1440 (aqorders.quantity - IFNULL(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal,
1441 DATEDIFF(CURDATE( ),closedate) AS latesince
1443 $from .= " AND (closedate <= DATE_SUB(CURDATE( ),INTERVAL ? DAY)) ";
1445 HAVING quantity <> 0
1446 AND unitpricesupplier <> 0
1447 AND unitpricelib <> 0
1450 # FIXME: account for IFNULL as above
1452 aqorders.quantity AS quantity,
1453 aqorders.quantity * aqorders.rrp AS subtotal,
1454 (CURDATE - closedate) AS latesince
1456 $from .= " AND (closedate <= (CURDATE -(INTERVAL ? DAY)) ";
1458 if (defined $supplierid) {
1459 $from .= ' AND aqbasket.booksellerid = ? ';
1460 push @query_params, $supplierid;
1462 if (defined $branch) {
1463 $from .= ' AND borrowers.branchcode LIKE ? ';
1464 push @query_params, $branch;
1466 if (C4
::Context
->preference("IndependantBranches")
1467 && C4
::Context
->userenv
1468 && C4
::Context
->userenv->{flags
} != 1 ) {
1469 $from .= ' AND borrowers.branchcode LIKE ? ';
1470 push @query_params, C4
::Context
->userenv->{branch
};
1472 my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier";
1473 $debug and print STDERR
"GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params);
1474 my $sth = $dbh->prepare($query);
1475 $sth->execute(@query_params);
1477 while (my $data = $sth->fetchrow_hashref) {
1478 $data->{orderdate
} = format_date
($data->{orderdate
});
1479 push @results, $data;
1484 #------------------------------------------------------------#
1490 (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( $title, $author, $name, $from_placed_on, $to_placed_on );
1492 Retreives some acquisition history information
1495 $order_loop is a list of hashrefs that each look like this:
1497 'author' => 'Twain, Mark',
1499 'biblionumber' => '215',
1501 'creationdate' => 'MM/DD/YYYY',
1502 'datereceived' => undef,
1505 'invoicenumber' => undef,
1507 'ordernumber' => '1',
1509 'quantityreceived' => undef,
1510 'title' => 'The Adventures of Huckleberry Finn'
1512 $total_qty is the sum of all of the quantities in $order_loop
1513 $total_price is the cost of each in $order_loop times the quantity
1514 $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop
1521 my ( $title, $author, $name, $from_placed_on, $to_placed_on ) = @_;
1524 my $total_qtyreceived = 0;
1525 my $total_price = 0;
1527 # don't run the query if there are no parameters (list would be too long for sure !)
1528 if ( $title || $author || $name || $from_placed_on || $to_placed_on ) {
1529 my $dbh = C4
::Context
->dbh;
1535 name,aqbasket.creationdate,
1536 aqorders.datereceived,
1538 aqorders.quantityreceived,
1540 aqorders.ordernumber,
1541 aqorders.booksellerinvoicenumber as invoicenumber,
1542 aqbooksellers.id as id,
1543 aqorders.biblionumber
1545 LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
1546 LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id
1547 LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber";
1549 $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber"
1550 if ( C4
::Context
->preference("IndependantBranches") );
1552 $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') ";
1554 my @query_params = ();
1556 if ( defined $title ) {
1557 $query .= " AND biblio.title LIKE ? ";
1558 push @query_params, "%$title%";
1561 if ( defined $author ) {
1562 $query .= " AND biblio.author LIKE ? ";
1563 push @query_params, "%$author%";
1566 if ( defined $name ) {
1567 $query .= " AND name LIKE ? ";
1568 push @query_params, "%$name%";
1571 if ( defined $from_placed_on ) {
1572 $query .= " AND creationdate >= ? ";
1573 push @query_params, $from_placed_on;
1576 if ( defined $to_placed_on ) {
1577 $query .= " AND creationdate <= ? ";
1578 push @query_params, $to_placed_on;
1581 if ( C4
::Context
->preference("IndependantBranches") ) {
1582 my $userenv = C4
::Context
->userenv;
1583 if ( ($userenv) && ( $userenv->{flags
} != 1 ) ) {
1584 $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) ";
1585 push @query_params, $userenv->{branch
};
1588 $query .= " ORDER BY booksellerid";
1589 my $sth = $dbh->prepare($query);
1590 $sth->execute( @query_params );
1592 while ( my $line = $sth->fetchrow_hashref ) {
1593 $line->{count
} = $cnt++;
1594 $line->{toggle
} = 1 if $cnt % 2;
1595 push @order_loop, $line;
1596 $line->{creationdate
} = format_date
( $line->{creationdate
} );
1597 $line->{datereceived
} = format_date
( $line->{datereceived
} );
1598 $total_qty += $line->{'quantity'};
1599 $total_qtyreceived += $line->{'quantityreceived'};
1600 $total_price += $line->{'quantity'} * $line->{'ecost'};
1603 return \
@order_loop, $total_qty, $total_price, $total_qtyreceived;
1606 =head2 GetRecentAcqui
1608 $results = GetRecentAcqui($days);
1610 C<$results> is a ref to a table which containts hashref
1614 sub GetRecentAcqui
{
1616 my $dbh = C4
::Context
->dbh;
1620 ORDER BY timestamp DESC
1623 my $sth = $dbh->prepare($query);
1625 my $results = $sth->fetchall_arrayref({});
1633 $contractlist = &GetContracts($booksellerid, $activeonly);
1635 Looks up the contracts that belong to a bookseller
1637 Returns a list of contracts
1639 =item C<$booksellerid> is the "id" field in the "aqbooksellers" table.
1641 =item C<$activeonly> if exists get only contracts that are still active.
1647 my ( $booksellerid, $activeonly ) = @_;
1648 my $dbh = C4
::Context
->dbh;
1650 if (! $activeonly) {
1654 WHERE booksellerid=?
1659 WHERE booksellerid=?
1660 AND contractenddate >= CURDATE( )";
1662 my $sth = $dbh->prepare($query);
1663 $sth->execute( $booksellerid );
1665 while (my $data = $sth->fetchrow_hashref ) {
1666 push(@results, $data);
1672 #------------------------------------------------------------#
1678 $contract = &GetContract($contractID);
1680 Looks up the contract that has PRIMKEY (contractnumber) value $contractID
1688 my ( $contractno ) = @_;
1689 my $dbh = C4
::Context
->dbh;
1693 WHERE contractnumber=?
1696 my $sth = $dbh->prepare($query);
1697 $sth->execute( $contractno );
1698 my $result = $sth->fetchrow_hashref;
1707 Koha Developement team <info@koha.org>