X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FAcquisition.pm;h=7d493c928023a6dc0e2c15ecdbc05517cf28d4c1;hb=bd3b1c1a33e4bb14bbcd10a0fcf871b39362430d;hp=597345651526bee43d4f317c273f4c770d71e412;hpb=3cd9293b6a89faf4cd4308ea0f411770e779ce34;p=koha_ffzg diff --git a/C4/Acquisition.pm b/C4/Acquisition.pm index 5973456515..ebbe44b106 100644 --- a/C4/Acquisition.pm +++ b/C4/Acquisition.pm @@ -4,65 +4,74 @@ package C4::Acquisition; # # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. # -# You should have received a copy of the GNU General Public License along -# with Koha; if not, write to the Free Software Foundation, Inc., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . -use strict; -use warnings; +use Modern::Perl; use Carp; use C4::Context; use C4::Debug; -use C4::Dates qw(format_date format_date_in_iso); -use MARC::Record; use C4::Suggestions; use C4::Biblio; +use C4::Contract; use C4::Debug; -use C4::SQLHelper qw(InsertInTable); -use C4::Bookseller qw(GetBookSellerFromId); use C4::Templates qw(gettemplate); +use Koha::DateUtils qw( dt_from_string output_pref ); +use Koha::Acquisition::Order; +use Koha::Acquisition::Booksellers; +use Koha::Biblios; +use Koha::Items; +use Koha::Number::Price; +use Koha::Libraries; +use Koha::CsvProfiles; +use Koha::Patrons; + +use C4::Koha; + +use MARC::Field; +use MARC::Record; use Time::localtime; -use HTML::Entities; -use vars qw($VERSION @ISA @EXPORT); +use vars qw(@ISA @EXPORT); BEGIN { - # set the version for version checking - $VERSION = 3.07.00.049; require Exporter; @ISA = qw(Exporter); @EXPORT = qw( - &GetBasket &NewBasket &CloseBasket &DelBasket &ModBasket + &GetBasket &NewBasket &CloseBasket &ReopenBasket &DelBasket &ModBasket &GetBasketAsCSV &GetBasketGroupAsCSV &GetBasketsByBookseller &GetBasketsByBasketgroup &GetBasketsInfosByBookseller + &GetBasketUsers &ModBasketUsers + &CanUserManageBasket + &ModBasketHeader &ModBasketgroup &NewBasketgroup &DelBasketgroup &GetBasketgroup &CloseBasketgroup &GetBasketgroups &ReOpenBasketgroup - &NewOrder &DelOrder &ModOrder &GetPendingOrders &GetOrder &GetOrders - &GetOrderNumber &GetLateOrders &GetOrderFromItemnumber - &SearchOrder &GetHistory &GetRecentAcqui - &ModReceiveOrder &CancelReceipt &ModOrderBiblioitemNumber - &GetCancelledOrders + &DelOrder &ModOrder &GetOrder &GetOrders &GetOrdersByBiblionumber + &GetLateOrders &GetOrderFromItemnumber + &SearchOrders &GetHistory &GetRecentAcqui + &ModReceiveOrder &CancelReceipt + &TransferOrder &GetLastOrderNotReceivedFromSubscriptionid &GetLastOrderReceivedFromSubscriptionid - &NewOrderItem &ModOrderItem &ModItemOrder + &ModItemOrder - &GetParcels &GetParcel - &GetContracts &GetContract + &GetParcels &GetInvoices &GetInvoice @@ -71,10 +80,19 @@ BEGIN { &ModInvoice &CloseInvoice &ReopenInvoice + &DelInvoice + &MergeInvoices &GetItemnumbersFromOrder &AddClaim + &GetBiblioCountByBasketno + + &GetOrderUsers + &ModOrderUsers + &NotifyOrderUsers + + &FillWithDefaultValues ); } @@ -156,8 +174,7 @@ sub GetBasket { my $dbh = C4::Context->dbh; my $query = " SELECT aqbasket.*, - concat( b.firstname,' ',b.surname) AS authorisedbyname, - b.branchcode AS branch + concat( b.firstname,' ',b.surname) AS authorisedbyname FROM aqbasket LEFT JOIN borrowers b ON aqbasket.authorisedby=b.borrowernumber WHERE basketno=? @@ -172,8 +189,8 @@ sub GetBasket { =head3 NewBasket - $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, - $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace ); + $basket = &NewBasket( $booksellerid, $authorizedby, $basketname, + $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, $billingplace, $is_standing ); Create a new basket in aqbasket table @@ -192,7 +209,7 @@ The other parameters are optional, see ModBasketHeader for more info on them. sub NewBasket { my ( $booksellerid, $authorisedby, $basketname, $basketnote, $basketbooksellernote, $basketcontractnumber, $deliveryplace, - $billingplace ) = @_; + $billingplace, $is_standing ) = @_; my $dbh = C4::Context->dbh; my $query = 'INSERT INTO aqbasket (creationdate,booksellerid,authorisedby) ' @@ -204,7 +221,7 @@ sub NewBasket { $basketnote ||= q{}; $basketbooksellernote ||= q{}; ModBasketHeader( $basket, $basketname, $basketnote, $basketbooksellernote, - $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace ); + $basketcontractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing ); return $basket; } @@ -214,20 +231,40 @@ sub NewBasket { &CloseBasket($basketno); -close a basket (becomes unmodifiable,except for recieves) +close a basket (becomes unmodifiable, except for receives) =cut sub CloseBasket { my ($basketno) = @_; my $dbh = C4::Context->dbh; - my $query = " - UPDATE aqbasket - SET closedate=now() - WHERE basketno=? - "; - my $sth = $dbh->prepare($query); - $sth->execute($basketno); + $dbh->do('UPDATE aqbasket SET closedate=now() WHERE basketno=?', {}, $basketno ); + + $dbh->do( q{UPDATE aqorders SET orderstatus = 'ordered' WHERE basketno = ? AND orderstatus != 'complete'}, + {}, $basketno); + return; +} + +=head3 ReopenBasket + + &ReopenBasket($basketno); + +reopen a basket + +=cut + +sub ReopenBasket { + my ($basketno) = @_; + my $dbh = C4::Context->dbh; + $dbh->do( q{UPDATE aqbasket SET closedate=NULL WHERE basketno=?}, {}, $basketno ); + + $dbh->do( q{ + UPDATE aqorders + SET orderstatus = 'new' + WHERE basketno = ? + AND orderstatus != 'complete' + }, {}, $basketno); + return; } #------------------------------------------------------------# @@ -243,109 +280,169 @@ $cgi parameter is needed for column name translation =cut sub GetBasketAsCSV { - my ($basketno, $cgi) = @_; + my ($basketno, $cgi, $csv_profile_id) = @_; my $basket = GetBasket($basketno); my @orders = GetOrders($basketno); - my $contract = GetContract($basket->{'contractnumber'}); - - my $template = C4::Templates::gettemplate("acqui/csv/basket.tmpl", "intranet", $cgi); + my $contract = GetContract({ + contractnumber => $basket->{'contractnumber'} + }); + my $template = C4::Templates::gettemplate("acqui/csv/basket.tt", "intranet", $cgi); my @rows; - foreach my $order (@orders) { - my $bd = GetBiblioData( $order->{'biblionumber'} ); - my $row = { - contractname => $contract->{'contractname'}, - ordernumber => $order->{'ordernumber'}, - entrydate => $order->{'entrydate'}, - isbn => $order->{'isbn'}, - author => $bd->{'author'}, - title => $bd->{'title'}, - publicationyear => $bd->{'publicationyear'}, - publishercode => $bd->{'publishercode'}, - collectiontitle => $bd->{'collectiontitle'}, - notes => $order->{'notes'}, - quantity => $order->{'quantity'}, - rrp => $order->{'rrp'}, - deliveryplace => C4::Branch::GetBranchName( $basket->{'deliveryplace'} ), - billingplace => C4::Branch::GetBranchName( $basket->{'billingplace'} ), - }; - foreach(qw( - contractname author title publishercode collectiontitle notes - deliveryplace billingplace - ) ) { - # Double the quotes to not be interpreted as a field end - $row->{$_} =~ s/"/""/g if $row->{$_}; + if ($csv_profile_id) { + my $csv_profile = Koha::CsvProfiles->find( $csv_profile_id ); + die "There is no valid csv profile given" unless $csv_profile; + + my $csv = Text::CSV_XS->new({'quote_char'=>'"','escape_char'=>'"','sep_char'=>$csv_profile->csv_separator,'binary'=>1}); + my $csv_profile_content = $csv_profile->content; + my ( @headers, @fields ); + while ( $csv_profile_content =~ / + ([^=\|]+) # header + =? + ([^\|]*) # fieldname (table.row or row) + \|? /gxms + ) { + my $header = $1; + my $field = ($2 eq '') ? $1 : $2; + + $header =~ s/^\s+|\s+$//g; # Trim whitespaces + push @headers, $header; + + $field =~ s/[^\.]*\.{1}//; # Remove the table name if exists. + $field =~ s/^\s+|\s+$//g; # Trim whitespaces + push @fields, $field; + } + for my $order (@orders) { + my @row; + my $biblio = Koha::Biblios->find( $order->{biblionumber} ); + my $biblioitem = $biblio->biblioitem; + $order = { %$order, %{ $biblioitem->unblessed } }; + if ($contract) { + $order = {%$order, %$contract}; + } + $order = {%$order, %$basket, %{ $biblio->unblessed }}; + for my $field (@fields) { + push @row, $order->{$field}; + } + push @rows, \@row; } - push @rows, $row; + my $content = join( $csv_profile->csv_separator, @headers ) . "\n"; + for my $row ( @rows ) { + $csv->combine(@$row); + my $string = $csv->string; + $content .= $string . "\n"; + } + return $content; } + else { + foreach my $order (@orders) { + my $biblio = Koha::Biblios->find( $order->{biblionumber} ); + my $biblioitem = $biblio->biblioitem; + my $row = { + contractname => $contract->{'contractname'}, + ordernumber => $order->{'ordernumber'}, + entrydate => $order->{'entrydate'}, + isbn => $order->{'isbn'}, + author => $biblio->author, + title => $biblio->title, + publicationyear => $biblioitem->publicationyear, + publishercode => $biblioitem->publishercode, + collectiontitle => $biblioitem->collectiontitle, + notes => $order->{'order_vendornote'}, + quantity => $order->{'quantity'}, + rrp => $order->{'rrp'}, + }; + for my $place ( qw( deliveryplace billingplace ) ) { + if ( my $library = Koha::Libraries->find( $row->{deliveryplace} ) ) { + $row->{$place} = $library->branchname + } + } + foreach(qw( + contractname author title publishercode collectiontitle notes + deliveryplace billingplace + ) ) { + # Double the quotes to not be interpreted as a field end + $row->{$_} =~ s/"/""/g if $row->{$_}; + } + push @rows, $row; + } - @rows = sort { - if(defined $a->{publishercode} and defined $b->{publishercode}) { - $a->{publishercode} cmp $b->{publishercode}; - } - } @rows; + @rows = sort { + if(defined $a->{publishercode} and defined $b->{publishercode}) { + $a->{publishercode} cmp $b->{publishercode}; + } + } @rows; - $template->param(rows => \@rows); + $template->param(rows => \@rows); - return $template->output; + return $template->output; + } } =head3 GetBasketGroupAsCSV -=over 4 - -&GetBasketGroupAsCSV($basketgroupid); + &GetBasketGroupAsCSV($basketgroupid); Export a basket group as CSV $cgi parameter is needed for column name translation -=back - =cut sub GetBasketGroupAsCSV { my ($basketgroupid, $cgi) = @_; my $baskets = GetBasketsByBasketgroup($basketgroupid); - my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tmpl', 'intranet', $cgi); + my $template = C4::Templates::gettemplate('acqui/csv/basketgroup.tt', 'intranet', $cgi); my @rows; for my $basket (@$baskets) { - my @orders = GetOrders( $$basket{basketno} ); - my $contract = GetContract( $$basket{contractnumber} ); - my $bookseller = GetBookSellerFromId( $$basket{booksellerid} ); + my @orders = GetOrders( $basket->{basketno} ); + my $contract = GetContract({ + contractnumber => $basket->{contractnumber} + }); + my $bookseller = Koha::Acquisition::Booksellers->find( $basket->{booksellerid} ); my $basketgroup = GetBasketgroup( $$basket{basketgroupid} ); foreach my $order (@orders) { - my $bd = GetBiblioData( $order->{'biblionumber'} ); + my $biblio = Koha::Biblios->find( $order->{biblionumber} ); + my $biblioitem = $biblio->biblioitem; my $row = { - clientnumber => $bookseller->{accountnumber}, + clientnumber => $bookseller->accountnumber, basketname => $basket->{basketname}, ordernumber => $order->{ordernumber}, - author => $bd->{author}, - title => $bd->{title}, - publishercode => $bd->{publishercode}, - publicationyear => $bd->{publicationyear}, - collectiontitle => $bd->{collectiontitle}, + author => $biblio->author, + title => $biblio->title, + publishercode => $biblioitem->publishercode, + publicationyear => $biblioitem->publicationyear, + collectiontitle => $biblioitem->collectiontitle, isbn => $order->{isbn}, quantity => $order->{quantity}, - rrp => $order->{rrp}, - discount => $bookseller->{discount}, - ecost => $order->{ecost}, - notes => $order->{notes}, + rrp_tax_included => $order->{rrp_tax_included}, + rrp_tax_excluded => $order->{rrp_tax_excluded}, + discount => $bookseller->discount, + ecost_tax_included => $order->{ecost_tax_included}, + ecost_tax_excluded => $order->{ecost_tax_excluded}, + notes => $order->{order_vendornote}, entrydate => $order->{entrydate}, - booksellername => $bookseller->{name}, - bookselleraddress => $bookseller->{address1}, - booksellerpostal => $bookseller->{postal}, + booksellername => $bookseller->name, + bookselleraddress => $bookseller->address1, + booksellerpostal => $bookseller->postal, contractnumber => $contract->{contractnumber}, contractname => $contract->{contractname}, - basketgroupdeliveryplace => C4::Branch::GetBranchName( $basketgroup->{deliveryplace} ), - basketgroupbillingplace => C4::Branch::GetBranchName( $basketgroup->{billingplace} ), - basketdeliveryplace => C4::Branch::GetBranchName( $basket->{deliveryplace} ), - basketbillingplace => C4::Branch::GetBranchName( $basket->{billingplace} ), }; + my $temp = { + basketgroupdeliveryplace => $basketgroup->{deliveryplace}, + basketgroupbillingplace => $basketgroup->{billingplace}, + basketdeliveryplace => $basket->{deliveryplace}, + basketbillingplace => $basket->{billingplace}, + }; + for my $place (qw( basketgroupdeliveryplace basketgroupbillingplace basketdeliveryplace basketbillingplace )) { + if ( my $library = Koha::Libraries->find( $temp->{$place} ) ) { + $row->{$place} = $library->branchname; + } + } foreach(qw( basketname author title publishercode collectiontitle notes booksellername bookselleraddress booksellerpostal contractname @@ -427,7 +524,7 @@ sub DelBasket { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare($query); $sth->execute($basketno); - $sth->finish; + return; } #------------------------------------------------------------# @@ -467,7 +564,8 @@ sub ModBasket { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare($query); $sth->execute(@params); - $sth->finish; + + return; } #------------------------------------------------------------# @@ -496,29 +594,30 @@ Modifies a basket's header. =item C<$billingplace> is the "billingplace" field in the aqbasket table. +=item C<$is_standing> is the "is_standing" field in the aqbasket table. + =back =cut sub ModBasketHeader { - my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace) = @_; + my ($basketno, $basketname, $note, $booksellernote, $contractnumber, $booksellerid, $deliveryplace, $billingplace, $is_standing) = @_; my $query = qq{ UPDATE aqbasket - SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=? + SET basketname=?, note=?, booksellernote=?, booksellerid=?, deliveryplace=?, billingplace=?, is_standing=? WHERE basketno=? }; my $dbh = C4::Context->dbh; my $sth = $dbh->prepare($query); - $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $basketno); + $sth->execute($basketname, $note, $booksellernote, $booksellerid, $deliveryplace, $billingplace, $is_standing, $basketno); if ( $contractnumber ) { my $query2 ="UPDATE aqbasket SET contractnumber=? WHERE basketno=?"; my $sth2 = $dbh->prepare($query2); $sth2->execute($contractnumber,$basketno); - $sth2->finish; } - $sth->finish; + return; } #------------------------------------------------------------# @@ -561,14 +660,16 @@ sub GetBasketsByBookseller { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare($query); $sth->execute($booksellerid); - my $results = $sth->fetchall_arrayref({}); - $sth->finish; - return $results + return $sth->fetchall_arrayref({}); } =head3 GetBasketsInfosByBookseller - my $baskets = GetBasketsInfosByBookseller($supplierid); + my $baskets = GetBasketsInfosByBookseller($supplierid, $allbaskets); + +The optional second parameter allbaskets is a boolean allowing you to +select all baskets from the supplier; by default only active baskets (open or +closed but still something to receive) are returned. Returns in a arrayref of hashref all about booksellers baskets, plus: total_biblios: Number of distinct biblios in basket @@ -578,14 +679,17 @@ Returns in a arrayref of hashref all about booksellers baskets, plus: =cut sub GetBasketsInfosByBookseller { - my ($supplierid) = @_; + my ($supplierid, $allbaskets) = @_; return unless $supplierid; my $dbh = C4::Context->dbh; - my $query = qq{ + my $query = q{ SELECT aqbasket.*, SUM(aqorders.quantity) AS total_items, + SUM( + IF ( aqorders.orderstatus = 'cancelled', aqorders.quantity, 0 ) + ) AS total_items_cancelled, COUNT(DISTINCT aqorders.biblionumber) AS total_biblios, SUM( IF(aqorders.datereceived IS NULL @@ -595,14 +699,178 @@ sub GetBasketsInfosByBookseller { ) AS expected_items FROM aqbasket LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno + WHERE booksellerid = ?}; + + unless ( $allbaskets ) { + $query.=" AND (closedate IS NULL OR (aqorders.quantity > aqorders.quantityreceived AND datecancellationprinted IS NULL))"; + } + $query.=" GROUP BY aqbasket.basketno"; + + my $sth = $dbh->prepare($query); + $sth->execute($supplierid); + my $baskets = $sth->fetchall_arrayref({}); + + # Retrieve the number of biblios cancelled + my $cancelled_biblios = $dbh->selectall_hashref( q| + SELECT COUNT(DISTINCT(biblionumber)) AS total_biblios_cancelled, aqbasket.basketno + FROM aqbasket + LEFT JOIN aqorders ON aqorders.basketno = aqbasket.basketno WHERE booksellerid = ? + AND aqorders.orderstatus = 'cancelled' GROUP BY aqbasket.basketno + |, 'basketno', {}, $supplierid ); + map { + $_->{total_biblios_cancelled} = $cancelled_biblios->{$_->{basketno}}{total_biblios_cancelled} || 0 + } @$baskets; + + return $baskets; +} + +=head3 GetBasketUsers + + $basketusers_ids = &GetBasketUsers($basketno); + +Returns a list of all borrowernumbers that are in basket users list + +=cut + +sub GetBasketUsers { + my $basketno = shift; + + return unless $basketno; + + my $query = qq{ + SELECT borrowernumber + FROM aqbasketusers + WHERE basketno = ? }; + my $dbh = C4::Context->dbh; my $sth = $dbh->prepare($query); - $sth->execute($supplierid); - return $sth->fetchall_arrayref({}); + $sth->execute($basketno); + my $results = $sth->fetchall_arrayref( {} ); + + my @borrowernumbers; + foreach (@$results) { + push @borrowernumbers, $_->{'borrowernumber'}; + } + + return @borrowernumbers; +} + +=head3 ModBasketUsers + + my @basketusers_ids = (1, 2, 3); + &ModBasketUsers($basketno, @basketusers_ids); + +Delete all users from basket users list, and add users in C<@basketusers_ids> +to this users list. + +=cut + +sub ModBasketUsers { + my ($basketno, @basketusers_ids) = @_; + + return unless $basketno; + + my $dbh = C4::Context->dbh; + my $query = qq{ + DELETE FROM aqbasketusers + WHERE basketno = ? + }; + my $sth = $dbh->prepare($query); + $sth->execute($basketno); + + $query = qq{ + INSERT INTO aqbasketusers (basketno, borrowernumber) + VALUES (?, ?) + }; + $sth = $dbh->prepare($query); + foreach my $basketuser_id (@basketusers_ids) { + $sth->execute($basketno, $basketuser_id); + } + return; } +=head3 CanUserManageBasket + + my $bool = CanUserManageBasket($borrower, $basket[, $userflags]); + my $bool = CanUserManageBasket($borrowernumber, $basketno[, $userflags]); + +Check if a borrower can manage a basket, according to system preference +AcqViewBaskets, user permissions and basket properties (creator, users list, +branch). + +First parameter can be either a borrowernumber or a hashref as returned by +Koha::Patron->unblessed + +Second parameter can be either a basketno or a hashref as returned by +C4::Acquisition::GetBasket. + +The third parameter is optional. If given, it should be a hashref as returned +by C4::Auth::getuserflags. If not, getuserflags is called. + +If user is authorised to manage basket, returns 1. +Otherwise returns 0. + +=cut + +sub CanUserManageBasket { + my ($borrower, $basket, $userflags) = @_; + + if (!ref $borrower) { + # FIXME This needs to be replaced + # We should not accept both scalar and array + # Tests need to be updated + $borrower = Koha::Patrons->find( $borrower )->unblessed; + } + if (!ref $basket) { + $basket = GetBasket($basket); + } + + return 0 unless ($basket and $borrower); + + my $borrowernumber = $borrower->{borrowernumber}; + my $basketno = $basket->{basketno}; + + my $AcqViewBaskets = C4::Context->preference('AcqViewBaskets'); + + if (!defined $userflags) { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT flags FROM borrowers WHERE borrowernumber = ?"); + $sth->execute($borrowernumber); + my ($flags) = $sth->fetchrow_array; + $sth->finish; + + $userflags = C4::Auth::getuserflags($flags, $borrower->{userid}, $dbh); + } + + unless ($userflags->{superlibrarian} + || (ref $userflags->{acquisition} && $userflags->{acquisition}->{order_manage_all}) + || (!ref $userflags->{acquisition} && $userflags->{acquisition})) + { + if (not exists $userflags->{acquisition}) { + return 0; + } + + if ( (ref $userflags->{acquisition} && !$userflags->{acquisition}->{order_manage}) + || (!ref $userflags->{acquisition} && !$userflags->{acquisition}) ) { + return 0; + } + + if ($AcqViewBaskets eq 'user' + && $basket->{authorisedby} != $borrowernumber + && ! grep { $borrowernumber eq $_ } GetBasketUsers($basketno)) { + return 0; + } + + if ($AcqViewBaskets eq 'branch' && defined $basket->{branch} + && $basket->{branch} ne $borrower->{branchcode}) { + return 0; + } + } + + return 1; +} #------------------------------------------------------------# @@ -624,9 +892,7 @@ sub GetBasketsByBasketgroup { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare($query); $sth->execute($basketgroupid); - my $results = $sth->fetchall_arrayref({}); - $sth->finish; - return $results + return $sth->fetchall_arrayref({}); } #------------------------------------------------------------# @@ -643,8 +909,12 @@ $hashref->{'name'} is the 'name' field of the basketgroup in the aqbasketgroups $hashref->{'basketlist'} is a list reference of the 'id's of the baskets that belong to this group, +$hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the aqbasketgroups table, + $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table, +$hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table, + $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table, $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise. @@ -656,8 +926,8 @@ sub NewBasketgroup { die "booksellerid is required to create a basketgroup" unless $basketgroupinfo->{'booksellerid'}; my $query = "INSERT INTO aqbasketgroups ("; my @params; - foreach my $field ('name', 'deliveryplace', 'deliverycomment', 'closed') { - if ( $basketgroupinfo->{$field} ) { + foreach my $field (qw(name billingplace deliveryplace freedeliveryplace deliverycomment closed)) { + if ( defined $basketgroupinfo->{$field} ) { $query .= "$field, "; push(@params, $basketgroupinfo->{$field}); } @@ -700,6 +970,8 @@ $hashref->{'billingplace'} is the 'billingplace' field of the basketgroup in the $hashref->{'deliveryplace'} is the 'deliveryplace' field of the basketgroup in the aqbasketgroups table, +$hashref->{'freedeliveryplace'} is the 'freedeliveryplace' field of the basketgroup in the aqbasketgroups table, + $hashref->{'deliverycomment'} is the 'deliverycomment' field of the basketgroup in the aqbasketgroups table, $hashref->{'closed'} is the 'closed' field of the aqbasketgroups table, it is false if 0, true otherwise. @@ -732,10 +1004,9 @@ sub ModBasketgroup { $sth = $dbh->prepare("UPDATE aqbasket SET basketgroupid=? WHERE basketno=?"); foreach my $basketno (@{$basketgroupinfo->{'basketlist'}}) { $sth->execute($basketgroupinfo->{'id'}, $basketno); - $sth->finish; } } - $sth->finish; + return; } #------------------------------------------------------------# @@ -761,7 +1032,7 @@ sub DelBasketgroup { my $dbh = C4::Context->dbh; my $sth = $dbh->prepare($query); $sth->execute($basketgroupid); - $sth->finish; + return; } #------------------------------------------------------------# @@ -773,20 +1044,20 @@ sub DelBasketgroup { $basketgroup = &GetBasketgroup($basketgroupid); -Returns a reference to the hash containing all infermation about the basketgroup. +Returns a reference to the hash containing all information about the basketgroup. =cut sub GetBasketgroup { my $basketgroupid = shift; die "basketgroup id is required to edit a basketgroup" unless $basketgroupid; - my $query = "SELECT * FROM aqbasketgroups WHERE id=?"; my $dbh = C4::Context->dbh; - my $sth = $dbh->prepare($query); - $sth->execute($basketgroupid); - my $result = $sth->fetchrow_hashref; - $sth->finish; - return $result + my $result_set = $dbh->selectall_arrayref( + 'SELECT * FROM aqbasketgroups WHERE id=?', + { Slice => {} }, + $basketgroupid + ); + return $result_set->[0]; # id is unique } #------------------------------------------------------------# @@ -813,167 +1084,113 @@ sub GetBasketgroups { =head2 FUNCTIONS ABOUT ORDERS -=cut - -#------------------------------------------------------------# - -=head3 GetPendingOrders - -$orders = &GetPendingOrders($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean); - -Finds pending orders from the bookseller with the given ID. Ignores -completed and cancelled orders. - -C<$booksellerid> contains the bookseller identifier -C<$owner> contains 0 or 1. 0 means any owner. 1 means only the list of orders entered by the user itself. -C<$grouped> is a boolean that, if set to 1 will group all order lines of the same basket -in a single result line -C<$orders> is a reference-to-array; each element is a reference-to-hash. - -Used also by the filter in parcel.pl -I have added: - -C<$ordernumber> -C<$search> -C<$ean> - -These give the value of the corresponding field in the aqorders table -of the Koha database. - -Results are ordered from most to least recent. - -=cut - -sub GetPendingOrders { - my ($supplierid,$grouped,$owner,$basketno,$ordernumber,$search,$ean) = @_; - my $dbh = C4::Context->dbh; - my $strsth = " - SELECT ".($grouped?"count(*),":"")."aqbasket.basketno, - surname,firstname,biblio.*,biblioitems.isbn, - aqbasket.closedate, aqbasket.creationdate, aqbasket.basketname, - aqorders.* - FROM aqorders - LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno - LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber - LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber - LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber - WHERE (quantity > quantityreceived OR quantityreceived is NULL) - AND datecancellationprinted IS NULL"; - my @query_params; - my $userenv = C4::Context->userenv; - if ( C4::Context->preference("IndependantBranches") ) { - if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { - $strsth .= " AND (borrowers.branchcode = ? - or borrowers.branchcode = '')"; - push @query_params, $userenv->{branch}; - } - } - if ($supplierid) { - $strsth .= " AND aqbasket.booksellerid = ?"; - push @query_params, $supplierid; - } - if($ordernumber){ - $strsth .= " AND (aqorders.ordernumber=?)"; - push @query_params, $ordernumber; - } - if($search){ - $strsth .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)"; - push @query_params, ("%$search%","%$search%","%$search%"); - } - if ($ean) { - $strsth .= " AND biblioitems.ean = ?"; - push @query_params, $ean; - } - if ($basketno) { - $strsth .= " AND aqbasket.basketno=? "; - push @query_params, $basketno; - } - if ($owner) { - $strsth .= " AND aqbasket.authorisedby=? "; - push @query_params, $userenv->{'number'}; - } - $strsth .= " group by aqbasket.basketno" if $grouped; - $strsth .= " order by aqbasket.basketno"; - my $sth = $dbh->prepare($strsth); - $sth->execute( @query_params ); - my $results = $sth->fetchall_arrayref({}); - $sth->finish; - return $results; -} - -#------------------------------------------------------------# - =head3 GetOrders - @orders = &GetOrders($basketnumber, $orderby); + @orders = &GetOrders( $basketno, { orderby => 'biblio.title', cancelled => 0|1 } ); Looks up the pending (non-cancelled) orders with the given basket -number. If C<$booksellerID> is non-empty, only orders from that seller -are returned. +number. -return : -C<&basket> returns a two-element array. C<@orders> is an array of -references-to-hash, whose keys are the fields from the aqorders, -biblio, and biblioitems tables in the Koha database. +If cancelled is set, only cancelled orders will be returned. =cut sub GetOrders { - my ( $basketno, $orderby ) = @_; + my ( $basketno, $params ) = @_; + + return () unless $basketno; + + my $orderby = $params->{orderby}; + my $cancelled = $params->{cancelled} || 0; + my $dbh = C4::Context->dbh; - my $query =" + my $query = q| SELECT biblio.*,biblioitems.*, aqorders.*, aqbudgets.*, - biblio.title + |; + $query .= $cancelled + ? q| + aqorders_transfers.ordernumber_to AS transferred_to, + aqorders_transfers.timestamp AS transferred_to_timestamp + | + : q| + aqorders_transfers.ordernumber_from AS transferred_from, + aqorders_transfers.timestamp AS transferred_from_timestamp + |; + $query .= q| FROM aqorders LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber + |; + $query .= $cancelled + ? q| + LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_from = aqorders.ordernumber + | + : q| + LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber + + |; + $query .= q| WHERE basketno=? + |; + + if ($cancelled) { + $orderby ||= q|biblioitems.publishercode, biblio.title|; + $query .= q| + AND (datecancellationprinted IS NOT NULL + AND datecancellationprinted <> '0000-00-00') + |; + } + else { + $orderby ||= + q|aqorders.datecancellationprinted desc, aqorders.timestamp desc|; + $query .= q| AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00') - "; + |; + } - $orderby = "biblioitems.publishercode,biblio.title" unless $orderby; $query .= " ORDER BY $orderby"; - my $sth = $dbh->prepare($query); - $sth->execute($basketno); - my $results = $sth->fetchall_arrayref({}); - $sth->finish; - return @$results; + my $orders = + $dbh->selectall_arrayref( $query, { Slice => {} }, $basketno ); + return @{$orders}; + } #------------------------------------------------------------# -=head3 GetOrderNumber - - $ordernumber = &GetOrderNumber($biblioitemnumber, $biblionumber); +=head3 GetOrdersByBiblionumber -Looks up the ordernumber with the given biblionumber and biblioitemnumber. + @orders = &GetOrdersByBiblionumber($biblionumber); -Returns the number of this order. +Looks up the orders with linked to a specific $biblionumber, including +cancelled orders and received orders. -=over - -=item C<$ordernumber> is the order number. - -=back +return : +C<@orders> is an array of references-to-hash, whose keys are the +fields from the aqorders, biblio, and biblioitems tables in the Koha database. =cut -sub GetOrderNumber { - my ( $biblionumber,$biblioitemnumber ) = @_; - my $dbh = C4::Context->dbh; - my $query = " - SELECT ordernumber - FROM aqorders - WHERE biblionumber=? - AND biblioitemnumber=? +sub GetOrdersByBiblionumber { + my $biblionumber = shift; + return unless $biblionumber; + my $dbh = C4::Context->dbh; + my $query =" + SELECT biblio.*,biblioitems.*, + aqorders.*, + aqbudgets.* + FROM aqorders + LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id + LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber + LEFT JOIN biblioitems ON biblioitems.biblionumber =biblio.biblionumber + WHERE aqorders.biblionumber=? "; - my $sth = $dbh->prepare($query); - $sth->execute( $biblionumber, $biblioitemnumber ); + my $result_set = + $dbh->selectall_arrayref( $query, { Slice => {} }, $biblionumber ); + return @{$result_set}; - return $sth->fetchrow; } #------------------------------------------------------------# @@ -991,20 +1208,47 @@ C<$order> are fields from the biblio, biblioitems, aqorders tables of the Koha d sub GetOrder { my ($ordernumber) = @_; - my $dbh = C4::Context->dbh; - my $query = " - SELECT biblioitems.*, biblio.*, aqorders.* - FROM aqorders - LEFT JOIN biblio on biblio.biblionumber=aqorders.biblionumber - LEFT JOIN biblioitems on biblioitems.biblionumber=aqorders.biblionumber - WHERE aqorders.ordernumber=? + return unless $ordernumber; - "; - my $sth= $dbh->prepare($query); - $sth->execute($ordernumber); - my $data = $sth->fetchrow_hashref; - $sth->finish; - return $data; + my $dbh = C4::Context->dbh; + my $query = qq{SELECT + aqorders.*, + biblio.title, + biblio.author, + aqbasket.basketname, + borrowers.branchcode, + biblioitems.publicationyear, + biblio.copyrightdate, + biblioitems.editionstatement, + biblioitems.isbn, + biblioitems.ean, + biblio.seriestitle, + biblioitems.publishercode, + aqorders.rrp AS unitpricesupplier, + aqorders.ecost AS unitpricelib, + aqorders.claims_count AS claims_count, + aqorders.claimed_date AS claimed_date, + aqbudgets.budget_name AS budget, + aqbooksellers.name AS supplier, + aqbooksellers.id AS supplierid, + biblioitems.publishercode AS publisher, + ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) AS estimateddeliverydate, + DATE(aqbasket.closedate) AS orderdate, + aqorders.quantity - COALESCE(aqorders.quantityreceived,0) AS quantity_to_receive, + (aqorders.quantity - COALESCE(aqorders.quantityreceived,0)) * aqorders.rrp AS subtotal, + DATEDIFF(CURDATE( ),closedate) AS latesince + FROM aqorders LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber + LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber + LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id, + aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber + LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id + WHERE aqorders.basketno = aqbasket.basketno + AND ordernumber=?}; + my $result_set = + $dbh->selectall_arrayref( $query, { Slice => {} }, $ordernumber ); + + # result_set assumed to contain 1 match + return $result_set->[0]; } =head3 GetLastOrderNotReceivedFromSubscriptionid @@ -1026,10 +1270,11 @@ sub GetLastOrderNotReceivedFromSubscriptionid { AND aqorders.datereceived IS NULL LIMIT 1 |; - my $sth = $dbh->prepare( $query ); - $sth->execute( $subscriptionid ); - my $order = $sth->fetchrow_hashref; - return $order; + my $result_set = + $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid ); + + # result_set assumed to contain 1 match + return $result_set->[0]; } =head3 GetLastOrderReceivedFromSubscriptionid @@ -1060,111 +1305,23 @@ sub GetLastOrderReceivedFromSubscriptionid { ORDER BY ordernumber DESC LIMIT 1 |; - my $sth = $dbh->prepare( $query ); - $sth->execute( $subscriptionid, $subscriptionid ); - my $order = $sth->fetchrow_hashref; - return $order; + my $result_set = + $dbh->selectall_arrayref( $query, { Slice => {} }, $subscriptionid, $subscriptionid ); -} + # result_set assumed to contain 1 match + return $result_set->[0]; +} #------------------------------------------------------------# -=head3 NewOrder +=head3 ModOrder - &NewOrder(\%hashref); + &ModOrder(\%hashref); -Adds a new order to the database. Any argument that isn't described -below is the new value of the field with the same name in the aqorders -table of the Koha database. - -=over - -=item $hashref->{'basketno'} is the basketno foreign key in aqorders, it is mandatory - -=item $hashref->{'ordernumber'} is a "minimum order number." - -=item $hashref->{'budgetdate'} is effectively ignored. -If it's undef (anything false) or the string 'now', the current day is used. -Else, the upcoming July 1st is used. - -=item $hashref->{'subscription'} may be either "yes", or anything else for "no". - -=item $hashref->{'uncertainprice'} may be 0 for "the price is known" or 1 for "the price is uncertain" - -=item defaults entrydate to Now - -The following keys are used: "biblionumber", "title", "basketno", "quantity", "notes", "biblioitemnumber", "rrp", "ecost", "gstrate", "unitprice", "subscription", "sort1", "sort2", "booksellerinvoicenumber", "listprice", "budgetdate", "purchaseordernumber", "branchcode", "booksellerinvoicenumber", "budget_id". - -=back - -=cut - -sub NewOrder { - my $orderinfo = shift; -#### ------------------------------ - my $dbh = C4::Context->dbh; - my @params; - - - # if these parameters are missing, we can't continue - for my $key (qw/basketno quantity biblionumber budget_id/) { - croak "Mandatory parameter $key missing" unless $orderinfo->{$key}; - } - - if ( defined $orderinfo->{subscription} && $orderinfo->{'subscription'} eq 'yes' ) { - $orderinfo->{'subscription'} = 1; - } else { - $orderinfo->{'subscription'} = 0; - } - $orderinfo->{'entrydate'} ||= C4::Dates->new()->output("iso"); - if (!$orderinfo->{quantityreceived}) { - $orderinfo->{quantityreceived} = 0; - } - - my $ordernumber=InsertInTable("aqorders",$orderinfo); - if (not $orderinfo->{parent_ordernumber}) { - my $sth = $dbh->prepare(" - UPDATE aqorders - SET parent_ordernumber = ordernumber - WHERE ordernumber = ? - "); - $sth->execute($ordernumber); - } - return ( $orderinfo->{'basketno'}, $ordernumber ); -} - - - -#------------------------------------------------------------# - -=head3 NewOrderItem - - &NewOrderItem(); - -=cut - -sub NewOrderItem { - my ($itemnumber, $ordernumber) = @_; - my $dbh = C4::Context->dbh; - my $query = qq| - INSERT INTO aqorders_items - (itemnumber, ordernumber) - VALUES (?,?) |; - - my $sth = $dbh->prepare($query); - $sth->execute( $itemnumber, $ordernumber); -} - -#------------------------------------------------------------# - -=head3 ModOrder - - &ModOrder(\%hashref); - -Modifies an existing order. Updates the order with order number -$hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All -other keys of the hash update the fields with the same name in the aqorders +Modifies an existing order. Updates the order with order number +$hashref->{'ordernumber'} and biblionumber $hashref->{'biblionumber'}. All +other keys of the hash update the fields with the same name in the aqorders table of the Koha database. =cut @@ -1172,8 +1329,7 @@ table of the Koha database. sub ModOrder { my $orderinfo = shift; - die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq '' ; - die "Biblionumber is required" if $orderinfo->{'biblionumber'} eq ''; + die "Ordernumber is required" if $orderinfo->{'ordernumber'} eq ''; my $dbh = C4::Context->dbh; my @params; @@ -1186,6 +1342,9 @@ sub ModOrder { my $sth = $dbh->prepare("SELECT * FROM aqorders LIMIT 1;"); $sth->execute; my $colnames = $sth->{NAME}; + #FIXME Be careful. If aqorders would have columns with diacritics, + #you should need to decode what you get back from NAME. + #See report 10110 and guided_reports.pl my $query = "UPDATE aqorders SET "; foreach my $orderinfokey (grep(!/ordernumber/, keys %$orderinfo)){ @@ -1197,46 +1356,14 @@ sub ModOrder { } $query .= "timestamp=NOW() WHERE ordernumber=?"; -# push(@params, $specorderinfo{'ordernumber'}); push(@params, $orderinfo->{'ordernumber'} ); $sth = $dbh->prepare($query); $sth->execute(@params); - $sth->finish; + return; } #------------------------------------------------------------# -=head3 ModOrderItem - - &ModOrderItem(\%hashref); - -Modifies the itemnumber in the aqorders_items table. The input hash needs three entities: - -=over - -=item - itemnumber: the old itemnumber -=item - ordernumber: the order this item is attached to -=item - newitemnumber: the new itemnumber we want to attach the line to - -=back - -=cut - -sub ModOrderItem { - my $orderiteminfo = shift; - if (! $orderiteminfo->{'ordernumber'} || ! $orderiteminfo->{'itemnumber'} || ! $orderiteminfo->{'newitemnumber'}){ - die "Ordernumber, itemnumber and newitemnumber is required"; - } - - my $dbh = C4::Context->dbh; - - my $query = "UPDATE aqorders_items set itemnumber=? where itemnumber=? and ordernumber=?"; - my @params = ($orderiteminfo->{'newitemnumber'}, $orderiteminfo->{'itemnumber'}, $orderiteminfo->{'ordernumber'}); - my $sth = $dbh->prepare($query); - $sth->execute(@params); - return 0; -} - =head3 ModItemOrder ModItemOrder($itemnumber, $ordernumber); @@ -1262,94 +1389,44 @@ sub ModItemOrder { #------------------------------------------------------------# - -=head3 ModOrderBibliotemNumber - - &ModOrderBiblioitemNumber($biblioitemnumber,$ordernumber, $biblionumber); - -Modifies the biblioitemnumber for an existing order. -Updates the order with order number C<$ordernum> and biblionumber C<$biblionumber>. - -=cut - -#FIXME: is this used at all? -sub ModOrderBiblioitemNumber { - my ($biblioitemnumber,$ordernumber, $biblionumber) = @_; - my $dbh = C4::Context->dbh; - my $query = " - UPDATE aqorders - SET biblioitemnumber = ? - WHERE ordernumber = ? - AND biblionumber = ?"; - my $sth = $dbh->prepare($query); - $sth->execute( $biblioitemnumber, $ordernumber, $biblionumber ); -} - -=head3 GetCancelledOrders - - my @orders = GetCancelledOrders($basketno, $orderby); - -Returns cancelled orders for a basket - -=cut - -sub GetCancelledOrders { - my ( $basketno, $orderby ) = @_; - - return () unless $basketno; - - my $dbh = C4::Context->dbh; - my $query = " - SELECT biblio.*, biblioitems.*, aqorders.*, aqbudgets.* - FROM aqorders - LEFT JOIN aqbudgets ON aqbudgets.budget_id = aqorders.budget_id - LEFT JOIN biblio ON biblio.biblionumber = aqorders.biblionumber - LEFT JOIN biblioitems ON biblioitems.biblionumber = biblio.biblionumber - WHERE basketno = ? - AND (datecancellationprinted IS NOT NULL - AND datecancellationprinted <> '0000-00-00') - "; - - $orderby = "aqorders.datecancellationprinted desc, aqorders.timestamp desc" - unless $orderby; - $query .= " ORDER BY $orderby"; - my $sth = $dbh->prepare($query); - $sth->execute($basketno); - my $results = $sth->fetchall_arrayref( {} ); - - return @$results; -} - - -#------------------------------------------------------------# - =head3 ModReceiveOrder - &ModReceiveOrder($biblionumber, $ordernumber, $quantityreceived, $user, - $unitprice, $invoiceid, $biblioitemnumber, - $bookfund, $rrp, \@received_itemnumbers); + my ( $date_received, $new_ordernumber ) = ModReceiveOrder( + { + biblionumber => $biblionumber, + order => $order, + quantityreceived => $quantityreceived, + user => $user, + invoice => $invoice, + budget_id => $budget_id, + received_itemnumbers => \@received_itemnumbers, + order_internalnote => $order_internalnote, + } + ); Updates an order, to reflect the fact that it was received, at least -in part. All arguments not mentioned below update the fields with the -same name in the aqorders table of the Koha database. +in part. If a partial order is received, splits the order into two. -Updates the order with bibilionumber C<$biblionumber> and ordernumber -C<$ordernumber>. +Updates the order with biblionumber C<$biblionumber> and ordernumber +C<$order->{ordernumber}>. =cut sub ModReceiveOrder { - my ( - $biblionumber, $ordernumber, $quantrec, $user, $cost, $ecost, - $invoiceid, $rrp, $budget_id, $datereceived, $received_items - ) - = @_; + my ($params) = @_; + my $biblionumber = $params->{biblionumber}; + my $order = { %{ $params->{order} } }; # Copy the order, we don't want to modify it + my $invoice = $params->{invoice}; + my $quantrec = $params->{quantityreceived}; + my $user = $params->{user}; + my $budget_id = $params->{budget_id}; + my $received_items = $params->{received_items}; my $dbh = C4::Context->dbh; - $datereceived = C4::Dates->output('iso') unless $datereceived; + my $datereceived = ( $invoice and $invoice->{datereceived} ) ? $invoice->{datereceived} : dt_from_string; my $suggestionid = GetSuggestionFromBiblionumber( $biblionumber ); if ($suggestionid) { ModSuggestion( {suggestionid=>$suggestionid, @@ -1358,40 +1435,55 @@ sub ModReceiveOrder { ); } - my $sth=$dbh->prepare(" - SELECT * FROM aqorders - WHERE biblionumber=? AND aqorders.ordernumber=?"); - - $sth->execute($biblionumber,$ordernumber); - my $order = $sth->fetchrow_hashref(); - $sth->finish(); + my $result_set = $dbh->selectrow_arrayref( + q{SELECT aqbasket.is_standing + FROM aqbasket + WHERE basketno=?},{ Slice => {} }, $order->{basketno}); + my $is_standing = $result_set->[0]; # we assume we have a unique basket - my $new_ordernumber = $ordernumber; - if ( $order->{quantity} > $quantrec ) { + my $new_ordernumber = $order->{ordernumber}; + if ( $is_standing || $order->{quantity} > $quantrec ) { # Split order line in two parts: the first is the original order line # without received items (the quantity is decreased), # the second part is a new order line with quantity=quantityrec # (entirely received) - $sth=$dbh->prepare(" + my $query = q| UPDATE aqorders - SET quantity = ? - WHERE ordernumber = ? - "); - - $sth->execute($order->{quantity} - $quantrec, $ordernumber); + SET quantity = ?, + orderstatus = 'partial'|; + $query .= q|, order_internalnote = ?| if defined $order->{order_internalnote}; + $query .= q| WHERE ordernumber = ?|; + my $sth = $dbh->prepare($query); - $sth->finish; + $sth->execute( + ( $is_standing ? 1 : ($order->{quantity} - $quantrec) ), + ( defined $order->{order_internalnote} ? $order->{order_internalnote} : () ), + $order->{ordernumber} + ); - delete $order->{'ordernumber'}; - $order->{'quantity'} = $quantrec; - $order->{'quantityreceived'} = $quantrec; - $order->{'datereceived'} = $datereceived; - $order->{'invoiceid'} = $invoiceid; - $order->{'unitprice'} = $cost; - $order->{'rrp'} = $rrp; - $order->{ecost} = $ecost; - $order->{'orderstatus'} = 3; # totally received - $new_ordernumber = NewOrder($order); + # Recalculate tax_value + $dbh->do(q| + UPDATE aqorders + SET + tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering, + tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving + WHERE ordernumber = ? + |, undef, $order->{ordernumber}); + + delete $order->{ordernumber}; + $order->{budget_id} = ( $budget_id || $order->{budget_id} ); + $order->{quantity} = $quantrec; + $order->{quantityreceived} = $quantrec; + $order->{ecost_tax_excluded} //= 0; + $order->{tax_rate_on_ordering} //= 0; + $order->{unitprice_tax_excluded} //= 0; + $order->{tax_rate_on_receiving} //= 0; + $order->{tax_value_on_ordering} = $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering}; + $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving}; + $order->{datereceived} = $datereceived; + $order->{invoiceid} = $invoice->{invoiceid}; + $order->{orderstatus} = 'complete'; + $new_ordernumber = Koha::Acquisition::Order->new($order)->insert->{ordernumber}; if ($received_items) { foreach my $itemnumber (@$received_items) { @@ -1399,12 +1491,59 @@ sub ModReceiveOrder { } } } else { - $sth=$dbh->prepare("update aqorders - set quantityreceived=?,datereceived=?,invoiceid=?, - unitprice=?,rrp=?,ecost=? - where biblionumber=? and ordernumber=?"); - $sth->execute($quantrec,$datereceived,$invoiceid,$cost,$rrp,$ecost,$biblionumber,$ordernumber); - $sth->finish; + my $query = q| + UPDATE aqorders + SET quantityreceived = ?, + datereceived = ?, + invoiceid = ?, + budget_id = ?, + orderstatus = 'complete' + |; + + $query .= q| + , unitprice = ?, unitprice_tax_included = ?, unitprice_tax_excluded = ? + | if defined $order->{unitprice}; + + $query .= q| + ,tax_value_on_receiving = ? + | if defined $order->{tax_value_on_receiving}; + + $query .= q| + ,tax_rate_on_receiving = ? + | if defined $order->{tax_rate_on_receiving}; + + $query .= q| + , order_internalnote = ? + | if defined $order->{order_internalnote}; + + $query .= q| where biblionumber=? and ordernumber=?|; + + my $sth = $dbh->prepare( $query ); + my @params = ( $quantrec, $datereceived, $invoice->{invoiceid}, ( $budget_id ? $budget_id : $order->{budget_id} ) ); + + if ( defined $order->{unitprice} ) { + push @params, $order->{unitprice}, $order->{unitprice_tax_included}, $order->{unitprice_tax_excluded}; + } + + if ( defined $order->{tax_value_on_receiving} ) { + push @params, $order->{tax_value_on_receiving}; + } + + if ( defined $order->{tax_rate_on_receiving} ) { + push @params, $order->{tax_rate_on_receiving}; + } + + if ( defined $order->{order_internalnote} ) { + push @params, $order->{order_internalnote}; + } + + push @params, ( $biblionumber, $order->{ordernumber} ); + + $sth->execute( @params ); + + # All items have been received, sent a notification to users + NotifyOrderUsers( $order->{ordernumber} ); + } return ($datereceived, $new_ordernumber); } @@ -1445,17 +1584,21 @@ sub CancelReceipt { my $parent_ordernumber = $order->{'parent_ordernumber'}; + my @itemnumbers = GetItemnumbersFromOrder( $ordernumber ); + if($parent_ordernumber == $ordernumber || not $parent_ordernumber) { # The order line has no parent, just mark it as not received $query = qq{ UPDATE aqorders SET quantityreceived = ?, datereceived = ?, - invoiceid = ? + invoiceid = ?, + orderstatus = 'ordered' WHERE ordernumber = ? }; $sth = $dbh->prepare($query); $sth->execute(0, undef, undef, $ordernumber); + _cancel_items_receipt( $ordernumber ); } else { # The order line has a parent, increase parent quantity and delete # the order line. @@ -1478,7 +1621,8 @@ sub CancelReceipt { } $query = qq{ UPDATE aqorders - SET quantity = ? + SET quantity = ?, + orderstatus = 'ordered' WHERE ordernumber = ? }; $sth = $dbh->prepare($query); @@ -1491,25 +1635,17 @@ sub CancelReceipt { " receipt"; return; } - if(C4::Context->preference('AcqCreateItem') eq 'receiving') { - # Remove items that were created at receipt - $query = qq{ - DELETE FROM items, aqorders_items - USING items, aqorders_items - WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ? - }; - $sth = $dbh->prepare($query); - my @itemnumbers = GetItemnumbersFromOrder($ordernumber); - foreach my $itemnumber (@itemnumbers) { - $sth->execute($itemnumber, $itemnumber); - } - } else { - # Update items - my @itemnumbers = GetItemnumbersFromOrder($ordernumber); - foreach my $itemnumber (@itemnumbers) { - ModItemOrder($itemnumber, $parent_ordernumber); - } - } + + # Recalculate tax_value + $dbh->do(q| + UPDATE aqorders + SET + tax_value_on_ordering = quantity * ecost_tax_excluded * tax_rate_on_ordering, + tax_value_on_receiving = quantity * unitprice_tax_excluded * tax_rate_on_receiving + WHERE ordernumber = ? + |, undef, $parent_ordernumber); + + _cancel_items_receipt( $ordernumber, $parent_ordernumber ); # Delete order line $query = qq{ DELETE FROM aqorders @@ -1520,85 +1656,215 @@ sub CancelReceipt { } + if(C4::Context->preference('AcqCreateItem') eq 'ordering') { + my @affects = split q{\|}, C4::Context->preference("AcqItemSetSubfieldsWhenReceiptIsCancelled"); + if ( @affects ) { + for my $in ( @itemnumbers ) { + my $item = Koha::Items->find( $in ); + my $biblio = $item->biblio; + my ( $itemfield ) = GetMarcFromKohaField( 'items.itemnumber', $biblio->frameworkcode ); + my $item_marc = C4::Items::GetMarcItem( $biblio->biblionumber, $in ); + for my $affect ( @affects ) { + my ( $sf, $v ) = split q{=}, $affect, 2; + foreach ( $item_marc->field($itemfield) ) { + $_->update( $sf => $v ); + } + } + C4::Items::ModItemFromMarc( $item_marc, $biblio->biblionumber, $in ); + } + } + } + return $parent_ordernumber; } -#------------------------------------------------------------# - -=head3 SearchOrder - -@results = &SearchOrder($search, $biblionumber, $complete); - -Searches for orders. - -C<$search> may take one of several forms: if it is an ISBN, -C<&ordersearch> returns orders with that ISBN. If C<$search> is an -order number, C<&ordersearch> returns orders with that order number -and biblionumber C<$biblionumber>. Otherwise, C<$search> is considered -to be a space-separated list of search terms; in this case, all of the -terms must appear in the title (matching the beginning of title -words). - -If C<$complete> is C, the results will include only completed -orders. In any case, C<&ordersearch> ignores cancelled orders. +sub _cancel_items_receipt { + my ( $ordernumber, $parent_ordernumber ) = @_; + $parent_ordernumber ||= $ordernumber; + + my @itemnumbers = GetItemnumbersFromOrder($ordernumber); + if(C4::Context->preference('AcqCreateItem') eq 'receiving') { + # Remove items that were created at receipt + my $query = qq{ + DELETE FROM items, aqorders_items + USING items, aqorders_items + WHERE items.itemnumber = ? AND aqorders_items.itemnumber = ? + }; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare($query); + foreach my $itemnumber (@itemnumbers) { + $sth->execute($itemnumber, $itemnumber); + } + } else { + # Update items + foreach my $itemnumber (@itemnumbers) { + ModItemOrder($itemnumber, $parent_ordernumber); + } + } +} -C<&ordersearch> returns an array. -C<@results> is an array of references-to-hash with the following keys: +#------------------------------------------------------------# -=over 4 +=head3 SearchOrders -=item C +@results = &SearchOrders({ + ordernumber => $ordernumber, + search => $search, + ean => $ean, + booksellerid => $booksellerid, + basketno => $basketno, + basketname => $basketname, + basketgroupname => $basketgroupname, + owner => $owner, + pending => $pending + ordered => $ordered + biblionumber => $biblionumber, + budget_id => $budget_id +}); -=item C +Searches for orders filtered by criteria. -=item C +C<$ordernumber> Finds matching orders or transferred orders by ordernumber. +C<$search> Finds orders matching %$search% in title, author, or isbn. +C<$owner> Finds order for the logged in user. +C<$pending> Finds pending orders. Ignores completed and cancelled orders. +C<$ordered> Finds orders to receive only (status 'ordered' or 'partial'). -=item C -=back +C<@results> is an array of references-to-hash with the keys are fields +from aqorders, biblio, biblioitems and aqbasket tables. =cut -sub SearchOrder { -#### -------- SearchOrder------------------------------- - my ( $ordernumber, $search, $ean, $supplierid, $basket ) = @_; +sub SearchOrders { + my ( $params ) = @_; + my $ordernumber = $params->{ordernumber}; + my $search = $params->{search}; + my $ean = $params->{ean}; + my $booksellerid = $params->{booksellerid}; + my $basketno = $params->{basketno}; + my $basketname = $params->{basketname}; + my $basketgroupname = $params->{basketgroupname}; + my $owner = $params->{owner}; + my $pending = $params->{pending}; + my $ordered = $params->{ordered}; + my $biblionumber = $params->{biblionumber}; + my $budget_id = $params->{budget_id}; my $dbh = C4::Context->dbh; my @args = (); - my $query = - "SELECT * - FROM aqorders + my $query = q{ + SELECT aqbasket.basketno, + borrowers.surname, + borrowers.firstname, + biblio.*, + biblioitems.isbn, + biblioitems.biblioitemnumber, + biblioitems.publishercode, + biblioitems.publicationyear, + aqbasket.authorisedby, + aqbasket.booksellerid, + aqbasket.closedate, + aqbasket.creationdate, + aqbasket.basketname, + aqbasketgroups.id as basketgroupid, + aqbasketgroups.name as basketgroupname, + aqorders.* + FROM aqorders + LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno + LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id + LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber LEFT JOIN biblioitems ON biblioitems.biblionumber=biblio.biblionumber - LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno - WHERE (datecancellationprinted is NULL)"; + }; - if($ordernumber){ - $query .= " AND (aqorders.ordernumber=?)"; - push @args, $ordernumber; + # If we search on ordernumber, we retrieve the transferred order if a transfer has been done. + $query .= q{ + LEFT JOIN aqorders_transfers ON aqorders_transfers.ordernumber_to = aqorders.ordernumber + } if $ordernumber; + + $query .= q{ + WHERE (datecancellationprinted is NULL) + }; + + if ( $pending or $ordered ) { + $query .= q{ + AND ( + ( aqbasket.is_standing AND aqorders.orderstatus IN ( "new", "ordered", "partial" ) ) + OR ( + ( quantity > quantityreceived OR quantityreceived is NULL ) + }; + + if ( $ordered ) { + $query .= q{ AND aqorders.orderstatus IN ( "ordered", "partial" )}; + } + $query .= q{ + ) + ) + }; } - if($search){ - $query .= " AND (biblio.title like ? OR biblio.author LIKE ? OR biblioitems.isbn like ?)"; + + my $userenv = C4::Context->userenv; + if ( C4::Context->preference("IndependentBranches") ) { + unless ( C4::Context->IsSuperLibrarian() ) { + $query .= q{ + AND ( + borrowers.branchcode = ? + OR borrowers.branchcode = '' + ) + }; + push @args, $userenv->{branch}; + } + } + + if ( $ordernumber ) { + $query .= ' AND ( aqorders.ordernumber = ? OR aqorders_transfers.ordernumber_from = ? ) '; + push @args, ( $ordernumber, $ordernumber ); + } + if ( $biblionumber ) { + $query .= 'AND aqorders.biblionumber = ?'; + push @args, $biblionumber; + } + if( $search ) { + $query .= ' AND (biblio.title LIKE ? OR biblio.author LIKE ? OR biblioitems.isbn LIKE ?)'; push @args, ("%$search%","%$search%","%$search%"); } - if ($ean) { - $query .= " AND biblioitems.ean = ?"; + if ( $ean ) { + $query .= ' AND biblioitems.ean = ?'; push @args, $ean; } - if ($supplierid) { - $query .= "AND aqbasket.booksellerid = ?"; - push @args, $supplierid; + if ( $booksellerid ) { + $query .= 'AND aqbasket.booksellerid = ?'; + push @args, $booksellerid; } - if($basket){ - $query .= "AND aqorders.basketno = ?"; - push @args, $basket; + if( $basketno ) { + $query .= 'AND aqbasket.basketno = ?'; + push @args, $basketno; } + if( $basketname ) { + $query .= 'AND aqbasket.basketname LIKE ?'; + push @args, "%$basketname%"; + } + if( $basketgroupname ) { + $query .= ' AND aqbasketgroups.name LIKE ?'; + push @args, "%$basketgroupname%"; + } + + if ( $owner ) { + $query .= ' AND aqbasket.authorisedby=? '; + push @args, $userenv->{'number'}; + } + + if ( $budget_id ) { + $query .= ' AND aqorders.budget_id = ?'; + push @args, $budget_id; + } + + $query .= ' ORDER BY aqbasket.basketno'; my $sth = $dbh->prepare($query); $sth->execute(@args); - my $results = $sth->fetchall_arrayref({}); - $sth->finish; - return $results; + return $sth->fetchall_arrayref({}); } #------------------------------------------------------------# @@ -1614,100 +1880,116 @@ cancelled. =cut sub DelOrder { - my ( $bibnum, $ordernumber ) = @_; + my ( $bibnum, $ordernumber, $delete_biblio, $reason ) = @_; + + my $error; my $dbh = C4::Context->dbh; my $query = " UPDATE aqorders - SET datecancellationprinted=now() - WHERE biblionumber=? AND ordernumber=? + SET datecancellationprinted=now(), orderstatus='cancelled' + "; + if($reason) { + $query .= ", cancellationreason = ? "; + } + $query .= " + WHERE biblionumber=? AND ordernumber=? "; my $sth = $dbh->prepare($query); - $sth->execute( $bibnum, $ordernumber ); + if($reason) { + $sth->execute($reason, $bibnum, $ordernumber); + } else { + $sth->execute( $bibnum, $ordernumber ); + } $sth->finish; + my @itemnumbers = GetItemnumbersFromOrder( $ordernumber ); foreach my $itemnumber (@itemnumbers){ - C4::Items::DelItem( $dbh, $bibnum, $itemnumber ); + my $delcheck = C4::Items::DelItemCheck( $bibnum, $itemnumber ); + + if($delcheck != 1) { + $error->{'delitem'} = 1; + } } - + + if($delete_biblio) { + # We get the number of remaining items + my $biblio = Koha::Biblios->find( $bibnum ); + my $itemcount = $biblio->items->count; + + # If there are no items left, + if ( $itemcount == 0 ) { + # We delete the record + my $delcheck = DelBiblio($bibnum); + + if($delcheck) { + $error->{'delbiblio'} = 1; + } + } + } + + return $error; } -=head2 FUNCTIONS ABOUT PARCELS +=head3 TransferOrder + + my $newordernumber = TransferOrder($ordernumber, $basketno); + +Transfer an order line to a basket. +Mark $ordernumber as cancelled with an internal note 'Cancelled and transferred +to BOOKSELLER on DATE' and create new order with internal note +'Transferred from BOOKSELLER on DATE'. +Move all attached items to the new order. +Received orders cannot be transferred. +Return the ordernumber of created order. =cut -#------------------------------------------------------------# +sub TransferOrder { + my ($ordernumber, $basketno) = @_; -=head3 GetParcel + return unless ($ordernumber and $basketno); - @results = &GetParcel($booksellerid, $code, $date); + my $order = GetOrder( $ordernumber ); + return if $order->{datereceived}; + my $basket = GetBasket($basketno); + return unless $basket; -Looks up all of the received items from the supplier with the given -bookseller ID at the given date, for the given code (bookseller Invoice number). Ignores cancelled and completed orders. + my $dbh = C4::Context->dbh; + my ($query, $sth, $rv); -C<@results> is an array of references-to-hash. The keys of each element are fields from -the aqorders, biblio, and biblioitems tables of the Koha database. + $query = q{ + UPDATE aqorders + SET datecancellationprinted = CAST(NOW() AS date), orderstatus = ? + WHERE ordernumber = ? + }; + $sth = $dbh->prepare($query); + $rv = $sth->execute('cancelled', $ordernumber); -C<@results> is sorted alphabetically by book title. + delete $order->{'ordernumber'}; + delete $order->{parent_ordernumber}; + $order->{'basketno'} = $basketno; -=cut + my $newordernumber = Koha::Acquisition::Order->new($order)->insert->{ordernumber}; -sub GetParcel { - #gets all orders from a certain supplier, orders them alphabetically - my ( $supplierid, $code, $datereceived ) = @_; - my $dbh = C4::Context->dbh; - my @results = (); - $code .= '%' - if $code; # add % if we search on a given code (otherwise, let him empty) - my $strsth =" - SELECT authorisedby, - creationdate, - aqbasket.basketno, - closedate,surname, - firstname, - aqorders.biblionumber, - aqorders.ordernumber, - aqorders.parent_ordernumber, - aqorders.quantity, - aqorders.quantityreceived, - aqorders.unitprice, - aqorders.listprice, - aqorders.rrp, - aqorders.ecost, - aqorders.gstrate, - biblio.title - FROM aqorders - LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno - LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber - LEFT JOIN biblio ON aqorders.biblionumber=biblio.biblionumber - LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid - WHERE - aqbasket.booksellerid = ? - AND aqinvoices.invoicenumber LIKE ? - AND aqorders.datereceived = ? "; - - my @query_params = ( $supplierid, $code, $datereceived ); - if ( C4::Context->preference("IndependantBranches") ) { - my $userenv = C4::Context->userenv; - if ( ($userenv) && ( $userenv->{flags} != 1 ) ) { - $strsth .= " and (borrowers.branchcode = ? - or borrowers.branchcode = '')"; - push @query_params, $userenv->{branch}; - } - } - $strsth .= " ORDER BY aqbasket.basketno"; - # ## parcelinformation : $strsth - my $sth = $dbh->prepare($strsth); - $sth->execute( @query_params ); - while ( my $data = $sth->fetchrow_hashref ) { - push( @results, $data ); - } - # ## countparcelbiblio: scalar(@results) - $sth->finish; + $query = q{ + UPDATE aqorders_items + SET ordernumber = ? + WHERE ordernumber = ? + }; + $sth = $dbh->prepare($query); + $sth->execute($newordernumber, $ordernumber); - return @results; + $query = q{ + INSERT INTO aqorders_transfers (ordernumber_from, ordernumber_to) + VALUES (?, ?) + }; + $sth = $dbh->prepare($query); + $sth->execute($ordernumber, $newordernumber); + + return $newordernumber; } -#------------------------------------------------------------# +=head2 FUNCTIONS ABOUT PARCELS =head3 GetParcels @@ -1792,8 +2074,7 @@ sub GetParcels { $sth->execute( @query_params ); my $results = $sth->fetchall_arrayref({}); - $sth->finish; - return @$results; + return @{$results}; } #------------------------------------------------------------# @@ -1826,6 +2107,9 @@ sub GetLateOrders { SELECT aqbasket.basketno, aqorders.ordernumber, DATE(aqbasket.closedate) AS orderdate, + aqbasket.basketname AS basketname, + aqbasket.basketgroupid AS basketgroupid, + aqbasketgroups.name AS basketgroupname, aqorders.rrp AS unitpricesupplier, aqorders.ecost AS unitpricelib, aqorders.claims_count AS claims_count, @@ -1846,6 +2130,7 @@ sub GetLateOrders { LEFT JOIN aqbudgets ON aqorders.budget_id = aqbudgets.budget_id, aqbasket LEFT JOIN borrowers ON aqbasket.authorisedby = borrowers.borrowernumber LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id + LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id WHERE aqorders.basketno = aqbasket.basketno AND ( datereceived = '' OR datereceived IS NULL @@ -1865,11 +2150,7 @@ sub GetLateOrders { $from .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? DAY)) " ; push @query_params, $delay; } - $having = " - HAVING quantity <> 0 - AND unitpricesupplier <> 0 - AND unitpricelib <> 0 - "; + $having = "HAVING quantity <> 0"; } else { # FIXME: account for IFNULL as above $select .= " @@ -1905,20 +2186,18 @@ sub GetLateOrders { if ( defined $estimateddeliverydatefrom and not defined $estimateddeliverydateto ) { $from .= ' AND ADDDATE(aqbasket.closedate, INTERVAL aqbooksellers.deliverytime DAY) <= CAST(now() AS date)'; } - if (C4::Context->preference("IndependantBranches") - && C4::Context->userenv - && C4::Context->userenv->{flags} != 1 ) { + if (C4::Context->preference("IndependentBranches") + && !C4::Context->IsSuperLibrarian() ) { $from .= ' AND borrowers.branchcode LIKE ? '; push @query_params, C4::Context->userenv->{branch}; } + $from .= " AND orderstatus <> 'cancelled' "; my $query = "$select $from $having\nORDER BY latesince, basketno, borrowers.branchcode, supplier"; $debug and print STDERR "GetLateOrders query: $query\nGetLateOrders args: " . join(" ",@query_params); my $sth = $dbh->prepare($query); $sth->execute(@query_params); my @results; while (my $data = $sth->fetchrow_hashref) { - $data->{orderdate} = format_date($data->{orderdate}); - $data->{claimed_date} = format_date($data->{claimed_date}); push @results, $data; } return @results; @@ -1928,7 +2207,7 @@ sub GetLateOrders { =head3 GetHistory - (\@order_loop, $total_qty, $total_price, $total_qtyreceived) = GetHistory( %params ); + \@order_loop = GetHistory( %params ); Retreives some acquisition history information @@ -1936,10 +2215,19 @@ params: title author name + isbn + ean from_placed_on to_placed_on basket - search both basket name and number booksellerinvoicenumber + basketgroupname + budget + orderstatus (note that orderstatus '' will retrieve orders + of any status except cancelled) + biblionumber + get_canceled_order (if set to a true value, cancelled orders will + be included) returns: $order_loop is a list of hashrefs that each look like this: @@ -1959,9 +2247,6 @@ returns: 'quantityreceived' => undef, 'title' => 'The Adventures of Huckleberry Finn' } - $total_qty is the sum of all of the quantities in $order_loop - $total_price is the cost of each in $order_loop times the quantity - $total_qtyreceived is the sum of all of the quantityreceived entries in $order_loop =cut @@ -1979,6 +2264,14 @@ sub GetHistory { my $basket = $params{basket}; my $booksellerinvoicenumber = $params{booksellerinvoicenumber}; my $basketgroupname = $params{basketgroupname}; + my $budget = $params{budget}; + my $orderstatus = $params{orderstatus}; + my $biblionumber = $params{biblionumber}; + my $get_canceled_order = $params{get_canceled_order} || 0; + my $ordernumber = $params{ordernumber}; + my $search_children_too = $params{search_children_too} || 0; + my $created_by = $params{created_by} || []; + my @order_loop; my $total_qty = 0; my $total_qtyreceived = 0; @@ -1987,13 +2280,15 @@ sub GetHistory { my $dbh = C4::Context->dbh; my $query =" SELECT - biblio.title, - biblio.author, - biblioitems.isbn, - biblioitems.ean, + COALESCE(biblio.title, deletedbiblio.title) AS title, + COALESCE(biblio.author, deletedbiblio.author) AS author, + COALESCE(biblioitems.isbn, deletedbiblioitems.isbn) AS isbn, + COALESCE(biblioitems.ean, deletedbiblioitems.ean) AS ean, aqorders.basketno, aqbasket.basketname, aqbasket.basketgroupid, + aqbasket.authorisedby, + concat( borrowers.firstname,' ',borrowers.surname) AS authorisedbyname, aqbasketgroups.name as groupname, aqbooksellers.name, aqbasket.creationdate, @@ -2002,24 +2297,42 @@ sub GetHistory { aqorders.quantityreceived, aqorders.ecost, aqorders.ordernumber, + aqorders.invoiceid, aqinvoices.invoicenumber, aqbooksellers.id as id, - aqorders.biblionumber + aqorders.biblionumber, + aqorders.orderstatus, + aqorders.parent_ordernumber, + aqbudgets.budget_name + "; + $query .= ", aqbudgets.budget_id AS budget" if defined $budget; + $query .= " FROM aqorders LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid=aqbasketgroups.id LEFT JOIN aqbooksellers ON aqbasket.booksellerid=aqbooksellers.id - LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber + LEFT JOIN biblioitems ON biblioitems.biblionumber=aqorders.biblionumber LEFT JOIN biblio ON biblio.biblionumber=aqorders.biblionumber - LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid"; + LEFT JOIN aqbudgets ON aqorders.budget_id=aqbudgets.budget_id + LEFT JOIN aqinvoices ON aqorders.invoiceid = aqinvoices.invoiceid + LEFT JOIN deletedbiblio ON deletedbiblio.biblionumber=aqorders.biblionumber + LEFT JOIN deletedbiblioitems ON deletedbiblioitems.biblionumber=aqorders.biblionumber + LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber + "; - $query .= " LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber" - if ( C4::Context->preference("IndependantBranches") ); + $query .= " WHERE 1 "; - $query .= " WHERE (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') "; + unless ($get_canceled_order or (defined $orderstatus and $orderstatus eq 'cancelled')) { + $query .= " AND (datecancellationprinted is NULL or datecancellationprinted='0000-00-00') "; + } my @query_params = (); + if ( $biblionumber ) { + $query .= " AND biblio.biblionumber = ?"; + push @query_params, $biblionumber; + } + if ( $title ) { $query .= " AND biblio.title LIKE ? "; $title =~ s/\s+/%/g; @@ -2035,7 +2348,7 @@ sub GetHistory { $query .= " AND biblioitems.isbn LIKE ? "; push @query_params, "%$isbn%"; } - if ( defined $ean and $ean ) { + if ( $ean ) { $query .= " AND biblioitems.ean = ? "; push @query_params, "$ean"; } @@ -2044,6 +2357,11 @@ sub GetHistory { push @query_params, "%$name%"; } + if ( $budget ) { + $query .= " AND aqbudgets.budget_id = ? "; + push @query_params, "$budget"; + } + if ( $from_placed_on ) { $query .= " AND creationdate >= ? "; push @query_params, $from_placed_on; @@ -2054,6 +2372,11 @@ sub GetHistory { push @query_params, $to_placed_on; } + if ( defined $orderstatus and $orderstatus ne '') { + $query .= " AND aqorders.orderstatus = ? "; + push @query_params, "$orderstatus"; + } + if ($basket) { if ($basket =~ m/^\d+$/) { $query .= " AND aqorders.basketno = ? "; @@ -2074,26 +2397,31 @@ sub GetHistory { push @query_params, "%$basketgroupname%"; } - if ( C4::Context->preference("IndependantBranches") ) { - my $userenv = C4::Context->userenv; - if ( $userenv && ($userenv->{flags} || 0) != 1 ) { + if ($ordernumber) { + $query .= " AND (aqorders.ordernumber = ? "; + push @query_params, $ordernumber; + if ($search_children_too) { + $query .= " OR aqorders.parent_ordernumber = ? "; + push @query_params, $ordernumber; + } + $query .= ") "; + } + + if ( @$created_by ) { + $query .= ' AND aqbasket.authorisedby IN ( ' . join( ',', ('?') x @$created_by ) . ')'; + push @query_params, @$created_by; + } + + + if ( C4::Context->preference("IndependentBranches") ) { + unless ( C4::Context->IsSuperLibrarian() ) { $query .= " AND (borrowers.branchcode = ? OR borrowers.branchcode ='' ) "; - push @query_params, $userenv->{branch}; + push @query_params, C4::Context->userenv->{branch}; } } $query .= " ORDER BY id"; - my $sth = $dbh->prepare($query); - $sth->execute( @query_params ); - my $cnt = 1; - while ( my $line = $sth->fetchrow_hashref ) { - $line->{count} = $cnt++; - $line->{toggle} = 1 if $cnt % 2; - push @order_loop, $line; - $total_qty += $line->{'quantity'}; - $total_qtyreceived += $line->{'quantityreceived'}; - $total_price += $line->{'quantity'} * $line->{'ecost'}; - } - return \@order_loop, $total_qty, $total_price, $total_qtyreceived; + + return $dbh->selectall_arrayref( $query, { Slice => {} }, @query_params ); } =head2 GetRecentAcqui @@ -2119,88 +2447,16 @@ sub GetRecentAcqui { return $results; } -=head3 GetContracts - - $contractlist = &GetContracts($booksellerid, $activeonly); - -Looks up the contracts that belong to a bookseller - -Returns a list of contracts - -=over - -=item C<$booksellerid> is the "id" field in the "aqbooksellers" table. - -=item C<$activeonly> if exists get only contracts that are still active. - -=back - -=cut - -sub GetContracts { - my ( $booksellerid, $activeonly ) = @_; - my $dbh = C4::Context->dbh; - my $query; - if (! $activeonly) { - $query = " - SELECT * - FROM aqcontract - WHERE booksellerid=? - "; - } else { - $query = "SELECT * - FROM aqcontract - WHERE booksellerid=? - AND contractenddate >= CURDATE( )"; - } - my $sth = $dbh->prepare($query); - $sth->execute( $booksellerid ); - my @results; - while (my $data = $sth->fetchrow_hashref ) { - push(@results, $data); - } - $sth->finish; - return @results; -} - #------------------------------------------------------------# -=head3 GetContract - - $contract = &GetContract($contractID); - -Looks up the contract that has PRIMKEY (contractnumber) value $contractID - -Returns a contract - -=cut - -sub GetContract { - my ( $contractno ) = @_; - my $dbh = C4::Context->dbh; - my $query = " - SELECT * - FROM aqcontract - WHERE contractnumber=? - "; - - my $sth = $dbh->prepare($query); - $sth->execute( $contractno ); - my $result = $sth->fetchrow_hashref; - return $result; -} - =head3 AddClaim -=over 4 - -&AddClaim($ordernumber); + &AddClaim($ordernumber); Add a claim for an order -=back - =cut + sub AddClaim { my ($ordernumber) = @_; my $dbh = C4::Context->dbh; @@ -2218,6 +2474,7 @@ sub AddClaim { my @invoices = GetInvoices( invoicenumber => $invoicenumber, + supplierid => $supplierid, suppliername => $suppliername, shipmentdatefrom => $shipmentdatefrom, # ISO format shipmentdateto => $shipmentdateto, # ISO format @@ -2258,10 +2515,19 @@ sub GetInvoices { NULL ) ) AS receivedbiblios, + COUNT( + DISTINCT IF( + aqorders.subscriptionid IS NOT NULL, + aqorders.subscriptionid, + NULL + ) + ) AS is_linked_to_subscriptions, SUM(aqorders.quantityreceived) AS receiveditems FROM aqinvoices LEFT JOIN aqbooksellers ON aqbooksellers.id = aqinvoices.booksellerid LEFT JOIN aqorders ON aqorders.invoiceid = aqinvoices.invoiceid + LEFT JOIN aqbasket ON aqbasket.basketno=aqorders.basketno + LEFT JOIN borrowers ON aqbasket.authorisedby=borrowers.borrowernumber LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber LEFT JOIN subscription ON biblio.biblionumber = subscription.biblionumber @@ -2282,11 +2548,11 @@ sub GetInvoices { push @bind_args, "%$args{suppliername}%"; } if($args{shipmentdatefrom}) { - push @bind_strs, " aqinvoices.shipementdate >= ? "; + push @bind_strs, " aqinvoices.shipmentdate >= ? "; push @bind_args, $args{shipmentdatefrom}; } if($args{shipmentdateto}) { - push @bind_strs, " aqinvoices.shipementdate <= ? "; + push @bind_strs, " aqinvoices.shipmentdate <= ? "; push @bind_args, $args{shipmentdateto}; } if($args{billingdatefrom}) { @@ -2298,29 +2564,33 @@ sub GetInvoices { push @bind_args, $args{billingdateto}; } if($args{isbneanissn}) { - push @bind_strs, " (biblioitems.isbn LIKE ? OR biblioitems.ean LIKE ? OR biblioitems.issn LIKE ? ) "; + push @bind_strs, " (biblioitems.isbn LIKE CONCAT('%', ?, '%') OR biblioitems.ean LIKE CONCAT('%', ?, '%') OR biblioitems.issn LIKE CONCAT('%', ?, '%') ) "; push @bind_args, $args{isbneanissn}, $args{isbneanissn}, $args{isbneanissn}; } if($args{title}) { - push @bind_strs, " biblio.title LIKE ? "; + push @bind_strs, " biblio.title LIKE CONCAT('%', ?, '%') "; push @bind_args, $args{title}; } if($args{author}) { - push @bind_strs, " biblio.author LIKE ? "; + push @bind_strs, " biblio.author LIKE CONCAT('%', ?, '%') "; push @bind_args, $args{author}; } if($args{publisher}) { - push @bind_strs, " biblioitems.publishercode LIKE ? "; + push @bind_strs, " biblioitems.publishercode LIKE CONCAT('%', ?, '%') "; push @bind_args, $args{publisher}; } if($args{publicationyear}) { - push @bind_strs, " biblioitems.publicationyear = ? "; - push @bind_args, $args{publicationyear}; + push @bind_strs, " ((biblioitems.publicationyear LIKE CONCAT('%', ?, '%')) OR (biblio.copyrightdate LIKE CONCAT('%', ?, '%'))) "; + push @bind_args, $args{publicationyear}, $args{publicationyear}; } if($args{branchcode}) { - push @bind_strs, " aqorders.branchcode = ? "; + push @bind_strs, " borrowers.branchcode = ? "; push @bind_args, $args{branchcode}; } + if($args{message_id}) { + push @bind_strs, " aqinvoices.message_id = ? "; + push @bind_args, $args{message_id}; + } $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs; $query .= " GROUP BY aqinvoices.invoiceid "; @@ -2388,7 +2658,7 @@ sub GetInvoiceDetails { } my $dbh = C4::Context->dbh; - my $query = qq{ + my $query = q{ SELECT aqinvoices.*, aqbooksellers.name AS suppliername FROM aqinvoices LEFT JOIN aqbooksellers ON aqinvoices.booksellerid = aqbooksellers.id @@ -2399,10 +2669,21 @@ sub GetInvoiceDetails { my $invoice = $sth->fetchrow_hashref; - $query = qq{ - SELECT aqorders.*, biblio.* + $query = q{ + SELECT aqorders.*, + biblio.*, + biblio.copyrightdate, + biblioitems.isbn, + biblioitems.publishercode, + biblioitems.publicationyear, + aqbasket.basketname, + aqbasketgroups.id AS basketgroupid, + aqbasketgroups.name AS basketgroupname FROM aqorders + LEFT JOIN aqbasket ON aqorders.basketno = aqbasket.basketno + LEFT JOIN aqbasketgroups ON aqbasket.basketgroupid = aqbasketgroups.id LEFT JOIN biblio ON aqorders.biblionumber = biblio.biblionumber + LEFT JOIN biblioitems ON aqorders.biblionumber = biblioitems.biblionumber WHERE invoiceid = ? }; $sth = $dbh->prepare($query); @@ -2435,7 +2716,7 @@ sub AddInvoice { return unless(%invoice and $invoice{invoicenumber}); my @columns = qw(invoicenumber booksellerid shipmentdate billingdate - closedate shipmentcost shipmentcost_budgetid); + closedate shipmentcost shipmentcost_budgetid message_id); my @set_strs; my @set_args; @@ -2536,7 +2817,7 @@ sub CloseInvoice { Reopen an invoice -Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => C4::Dates->new()->output('iso')) +Equivalent to ModInvoice(invoiceid => $invoiceid, closedate => output_pref({ dt=>dt_from_string, dateonly=>1, otputpref=>'iso' })) =cut @@ -2555,6 +2836,324 @@ sub ReopenInvoice { $sth->execute($invoiceid); } +=head3 DelInvoice + + DelInvoice($invoiceid); + +Delete an invoice if there are no items attached to it. + +=cut + +sub DelInvoice { + my ($invoiceid) = @_; + + return unless $invoiceid; + + my $dbh = C4::Context->dbh; + my $query = qq{ + SELECT COUNT(*) + FROM aqorders + WHERE invoiceid = ? + }; + my $sth = $dbh->prepare($query); + $sth->execute($invoiceid); + my $res = $sth->fetchrow_arrayref; + if ( $res && $res->[0] == 0 ) { + $query = qq{ + DELETE FROM aqinvoices + WHERE invoiceid = ? + }; + my $sth = $dbh->prepare($query); + return ( $sth->execute($invoiceid) > 0 ); + } + return; +} + +=head3 MergeInvoices + + MergeInvoices($invoiceid, \@sourceids); + +Merge the invoices identified by the IDs in \@sourceids into +the invoice identified by $invoiceid. + +=cut + +sub MergeInvoices { + my ($invoiceid, $sourceids) = @_; + + return unless $invoiceid; + foreach my $sourceid (@$sourceids) { + next if $sourceid == $invoiceid; + my $source = GetInvoiceDetails($sourceid); + foreach my $order (@{$source->{'orders'}}) { + $order->{'invoiceid'} = $invoiceid; + ModOrder($order); + } + DelInvoice($source->{'invoiceid'}); + } + return; +} + +=head3 GetBiblioCountByBasketno + +$biblio_count = &GetBiblioCountByBasketno($basketno); + +Looks up the biblio's count that has basketno value $basketno + +Returns a quantity + +=cut + +sub GetBiblioCountByBasketno { + my ($basketno) = @_; + my $dbh = C4::Context->dbh; + my $query = " + SELECT COUNT( DISTINCT( biblionumber ) ) + FROM aqorders + WHERE basketno = ? + AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00') + "; + + my $sth = $dbh->prepare($query); + $sth->execute($basketno); + return $sth->fetchrow; +} + +# Note this subroutine should be moved to Koha::Acquisition::Order +# Will do when a DBIC decision will be taken. +sub populate_order_with_prices { + my ($params) = @_; + + my $order = $params->{order}; + my $booksellerid = $params->{booksellerid}; + return unless $booksellerid; + + my $bookseller = Koha::Acquisition::Booksellers->find( $booksellerid ); + + my $receiving = $params->{receiving}; + my $ordering = $params->{ordering}; + my $discount = $order->{discount}; + $discount /= 100 if $discount > 1; + + if ($ordering) { + $order->{tax_rate_on_ordering} //= $order->{tax_rate}; + if ( $bookseller->listincgst ) { + # The user entered the rrp tax included + $order->{rrp_tax_included} = $order->{rrp}; + + # rrp tax excluded = rrp tax included / ( 1 + tax rate ) + $order->{rrp_tax_excluded} = $order->{rrp_tax_included} / ( 1 + $order->{tax_rate_on_ordering} ); + + # ecost tax excluded = rrp tax excluded * ( 1 - discount ) + $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount ); + + # ecost tax included = rrp tax included ( 1 - discount ) + $order->{ecost_tax_included} = $order->{rrp_tax_included} * ( 1 - $discount ); + } + else { + # The user entered the rrp tax excluded + $order->{rrp_tax_excluded} = $order->{rrp}; + + # rrp tax included = rrp tax excluded * ( 1 - tax rate ) + $order->{rrp_tax_included} = $order->{rrp_tax_excluded} * ( 1 + $order->{tax_rate_on_ordering} ); + + # ecost tax excluded = rrp tax excluded * ( 1 - discount ) + $order->{ecost_tax_excluded} = $order->{rrp_tax_excluded} * ( 1 - $discount ); + + # ecost tax included = rrp tax excluded * ( 1 - tax rate ) * ( 1 - discount ) + $order->{ecost_tax_included} = + $order->{rrp_tax_excluded} * + ( 1 + $order->{tax_rate_on_ordering} ) * + ( 1 - $discount ); + } + + # tax value = quantity * ecost tax excluded * tax rate + $order->{tax_value_on_ordering} = + $order->{quantity} * $order->{ecost_tax_excluded} * $order->{tax_rate_on_ordering}; + } + + if ($receiving) { + $order->{tax_rate_on_receiving} //= $order->{tax_rate}; + if ( $bookseller->invoiceincgst ) { + # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value + # we need to keep the exact ecost value + if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_included} )->round ) { + $order->{unitprice} = $order->{ecost_tax_included}; + } + + # The user entered the unit price tax included + $order->{unitprice_tax_included} = $order->{unitprice}; + + # unit price tax excluded = unit price tax included / ( 1 + tax rate ) + $order->{unitprice_tax_excluded} = $order->{unitprice_tax_included} / ( 1 + $order->{tax_rate_on_receiving} ); + } + else { + # Trick for unitprice. If the unit price rounded value is the same as the ecost rounded value + # we need to keep the exact ecost value + if ( Koha::Number::Price->new( $order->{unitprice} )->round == Koha::Number::Price->new( $order->{ecost_tax_excluded} )->round ) { + $order->{unitprice} = $order->{ecost_tax_excluded}; + } + + # The user entered the unit price tax excluded + $order->{unitprice_tax_excluded} = $order->{unitprice}; + + + # unit price tax included = unit price tax included * ( 1 + tax rate ) + $order->{unitprice_tax_included} = $order->{unitprice_tax_excluded} * ( 1 + $order->{tax_rate_on_receiving} ); + } + + # tax value = quantity * unit price tax excluded * tax rate + $order->{tax_value_on_receiving} = $order->{quantity} * $order->{unitprice_tax_excluded} * $order->{tax_rate_on_receiving}; + } + + return $order; +} + +=head3 GetOrderUsers + + $order_users_ids = &GetOrderUsers($ordernumber); + +Returns a list of all borrowernumbers that are in order users list + +=cut + +sub GetOrderUsers { + my ($ordernumber) = @_; + + return unless $ordernumber; + + my $query = q| + SELECT borrowernumber + FROM aqorder_users + WHERE ordernumber = ? + |; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare($query); + $sth->execute($ordernumber); + my $results = $sth->fetchall_arrayref( {} ); + + my @borrowernumbers; + foreach (@$results) { + push @borrowernumbers, $_->{'borrowernumber'}; + } + + return @borrowernumbers; +} + +=head3 ModOrderUsers + + my @order_users_ids = (1, 2, 3); + &ModOrderUsers($ordernumber, @basketusers_ids); + +Delete all users from order users list, and add users in C<@order_users_ids> +to this users list. + +=cut + +sub ModOrderUsers { + my ( $ordernumber, @order_users_ids ) = @_; + + return unless $ordernumber; + + my $dbh = C4::Context->dbh; + my $query = q| + DELETE FROM aqorder_users + WHERE ordernumber = ? + |; + my $sth = $dbh->prepare($query); + $sth->execute($ordernumber); + + $query = q| + INSERT INTO aqorder_users (ordernumber, borrowernumber) + VALUES (?, ?) + |; + $sth = $dbh->prepare($query); + foreach my $order_user_id (@order_users_ids) { + $sth->execute( $ordernumber, $order_user_id ); + } +} + +sub NotifyOrderUsers { + my ($ordernumber) = @_; + + my @borrowernumbers = GetOrderUsers($ordernumber); + return unless @borrowernumbers; + + my $order = GetOrder( $ordernumber ); + for my $borrowernumber (@borrowernumbers) { + my $patron = Koha::Patrons->find( $borrowernumber ); + my $library = $patron->library->unblessed; + my $biblio = Koha::Biblios->find( $order->{biblionumber} )->unblessed; + my $letter = C4::Letters::GetPreparedLetter( + module => 'acquisition', + letter_code => 'ACQ_NOTIF_ON_RECEIV', + branchcode => $library->{branchcode}, + lang => $patron->lang, + tables => { + 'branches' => $library, + 'borrowers' => $patron->unblessed, + 'biblio' => $biblio, + 'aqorders' => $order, + }, + ); + if ( $letter ) { + C4::Letters::EnqueueLetter( + { + letter => $letter, + borrowernumber => $borrowernumber, + LibraryName => C4::Context->preference("LibraryName"), + message_transport_type => 'email', + } + ) or warn "can't enqueue letter $letter"; + } + } +} + +=head3 FillWithDefaultValues + +FillWithDefaultValues( $marc_record ); + +This will update the record with default value defined in the ACQ framework. +For all existing fields, if a default value exists and there are no subfield, it will be created. +If the field does not exist, it will be created too. + +=cut + +sub FillWithDefaultValues { + my ($record) = @_; + my $tagslib = C4::Biblio::GetMarcStructure( 1, 'ACQ', { unsafe => 1 } ); + if ($tagslib) { + my ($itemfield) = + C4::Biblio::GetMarcFromKohaField( 'items.itemnumber', '' ); + for my $tag ( sort keys %$tagslib ) { + next unless $tag; + next if $tag == $itemfield; + for my $subfield ( sort keys %{ $tagslib->{$tag} } ) { + next if IsMarcStructureInternal($tagslib->{$tag}{$subfield}); + my $defaultvalue = $tagslib->{$tag}{$subfield}{defaultvalue}; + if ( defined $defaultvalue and $defaultvalue ne '' ) { + my @fields = $record->field($tag); + if (@fields) { + for my $field (@fields) { + unless ( defined $field->subfield($subfield) ) { + $field->add_subfields( + $subfield => $defaultvalue ); + } + } + } + else { + $record->insert_fields_ordered( + MARC::Field->new( + $tag, '', '', $subfield => $defaultvalue + ) + ); + } + } + } + } + } +} + 1; __END__