Bug 12435 - Update MARC21 frameworks to Update No. 18 (April 2014)
[koha.git] / C4 / Bookseller.pm
blob702b37c5349510ad91f330ff8d7db3df0c679477
1 package C4::Bookseller;
3 # Copyright 2000-2002 Katipo Communications
4 # Copyright 2010 PTFS Europe
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
11 # version.
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21 use strict;
22 use warnings;
24 use base qw( Exporter );
26 use C4::Bookseller::Contact;
28 # set the version for version checking
29 our $VERSION = 3.07.00.049;
30 our @EXPORT_OK = qw(
31 GetBookSeller GetBooksellersWithLateOrders GetBookSellerFromId
32 ModBookseller
33 DelBookseller
34 AddBookseller
37 =head1 NAME
39 C4::Bookseller - Koha functions for dealing with booksellers.
41 =head1 SYNOPSIS
43 use C4::Bookseller;
45 =head1 DESCRIPTION
47 The functions in this module deal with booksellers. They allow to
48 add a new bookseller, to modify it or to get some informations around
49 a bookseller.
51 =head1 FUNCTIONS
53 =head2 GetBookSeller
55 @results = GetBookSeller($searchstring);
57 Looks up a book seller. C<$searchstring> is a string to look for in the
58 book seller's name.
60 C<@results> is an array of hash_refs whose keys are the fields of of the
61 aqbooksellers table in the Koha database.
63 =cut
65 sub GetBookSeller {
66 my $searchstring = shift;
67 $searchstring = q{%} . $searchstring . q{%};
68 my $query = "
69 SELECT aqbooksellers.*, count(*) AS basketcount
70 FROM aqbooksellers
71 LEFT JOIN aqbasket ON aqbasket.booksellerid = aqbooksellers.id
72 WHERE name LIKE ? GROUP BY aqbooksellers.id ORDER BY name
75 my $dbh = C4::Context->dbh;
76 my $sth = $dbh->prepare($query);
77 $sth->execute($searchstring);
78 my $resultset_ref = $sth->fetchall_arrayref( {} );
79 return @{$resultset_ref};
82 sub GetBookSellerFromId {
83 my $id = shift or return;
84 my $dbh = C4::Context->dbh;
85 my $vendor =
86 $dbh->selectrow_hashref( 'SELECT * FROM aqbooksellers WHERE id = ?',
87 {}, $id );
88 if ($vendor) {
89 ( $vendor->{basketcount} ) = $dbh->selectrow_array(
90 'SELECT count(*) FROM aqbasket where booksellerid = ?',
91 {}, $id );
92 ( $vendor->{subscriptioncount} ) = $dbh->selectrow_array(
93 'SELECT count(*) FROM subscription WHERE aqbooksellerid = ?',
94 {}, $id );
95 $vendor->{'contacts'} = C4::Bookseller::Contact->get_from_bookseller($id);
97 return $vendor;
100 #-----------------------------------------------------------------#
102 =head2 GetBooksellersWithLateOrders
104 %results = GetBooksellersWithLateOrders( $delay, $estimateddeliverydatefrom, $estimateddeliverydateto );
106 Searches for suppliers with late orders.
108 =cut
110 sub GetBooksellersWithLateOrders {
111 my ( $delay, $estimateddeliverydatefrom, $estimateddeliverydateto ) = @_;
112 my $dbh = C4::Context->dbh;
114 # FIXME NOT quite sure that this operation is valid for DBMs different from Mysql, HOPING so
115 # should be tested with other DBMs
117 my $query;
118 my @query_params = ();
119 my $dbdriver = C4::Context->config("db_scheme") || "mysql";
120 $query = "
121 SELECT DISTINCT aqbasket.booksellerid, aqbooksellers.name
122 FROM aqorders LEFT JOIN aqbasket ON aqorders.basketno=aqbasket.basketno
123 LEFT JOIN aqbooksellers ON aqbasket.booksellerid = aqbooksellers.id
124 WHERE
125 ( datereceived = ''
126 OR datereceived IS NULL
127 OR aqorders.quantityreceived < aqorders.quantity
129 AND aqorders.rrp <> 0
130 AND aqorders.ecost <> 0
131 AND aqorders.quantity - COALESCE(aqorders.quantityreceived,0) <> 0
132 AND aqbasket.closedate IS NOT NULL
134 if ( defined $delay && $delay >= 0 ) {
135 $query .= " AND (closedate <= DATE_SUB(CAST(now() AS date),INTERVAL ? + COALESCE(aqbooksellers.deliverytime,0) DAY)) ";
136 push @query_params, $delay;
137 } elsif ( $delay && $delay < 0 ){
138 warn 'WARNING: GetBooksellerWithLateOrders is called with a negative value';
139 return;
141 if ( defined $estimateddeliverydatefrom ) {
142 $query .= '
143 AND ADDDATE(aqbasket.closedate, INTERVAL COALESCE(aqbooksellers.deliverytime,0) DAY) >= ?';
144 push @query_params, $estimateddeliverydatefrom;
145 if ( defined $estimateddeliverydateto ) {
146 $query .= ' AND ADDDATE(aqbasket.closedate, INTERVAL COALESCE(aqbooksellers.deliverytime, 0) DAY) <= ?';
147 push @query_params, $estimateddeliverydateto;
148 } else {
149 $query .= ' AND ADDDATE(aqbasket.closedate, INTERVAL COALESCE(aqbooksellers.deliverytime, 0) DAY) <= CAST(now() AS date)';
152 if ( defined $estimateddeliverydateto ) {
153 $query .= ' AND ADDDATE(aqbasket.closedate, INTERVAL COALESCE(aqbooksellers.deliverytime,0) DAY) <= ?';
154 push @query_params, $estimateddeliverydateto;
157 my $sth = $dbh->prepare($query);
158 $sth->execute( @query_params );
159 my %supplierlist;
160 while ( my ( $id, $name ) = $sth->fetchrow ) {
161 $supplierlist{$id} = $name;
164 return %supplierlist;
167 #--------------------------------------------------------------------#
169 =head2 AddBookseller
171 $id = &AddBookseller($bookseller);
173 Creates a new bookseller. C<$bookseller> is a reference-to-hash whose
174 keys are the fields of the aqbooksellers table in the Koha database.
175 All fields must be present.
177 Returns the ID of the newly-created bookseller.
179 =cut
181 sub AddBookseller {
182 my ($data, $contacts) = @_;
183 my $dbh = C4::Context->dbh;
184 my $query = q|
185 INSERT INTO aqbooksellers
187 name, address1, address2, address3, address4,
188 postal, phone, accountnumber,fax, url,
189 active, listprice, invoiceprice, gstreg,
190 listincgst,invoiceincgst, gstrate, discount, notes,
191 deliverytime
193 VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |
195 my $sth = $dbh->prepare($query);
196 $sth->execute(
197 $data->{'name'}, $data->{'address1'},
198 $data->{'address2'}, $data->{'address3'},
199 $data->{'address4'}, $data->{'postal'},
200 $data->{'phone'}, $data->{'accountnumber'},
201 $data->{'fax'}, $data->{'url'},
202 $data->{'active'}, $data->{'listprice'},
203 $data->{'invoiceprice'}, $data->{'gstreg'},
204 $data->{'listincgst'}, $data->{'invoiceincgst'},
205 $data->{'gstrate'}, $data->{'discount'},
206 $data->{notes}, $data->{deliverytime},
209 # return the id of this new supplier
210 my $id = $dbh->{'mysql_insertid'};
211 if ($id && $contacts) {
212 foreach my $contact (@$contacts) {
213 $contact = C4::Bookseller::Contact->new( $contact )
214 unless ref $contacts eq 'C4::Bookseller::Contact';
215 $contact->bookseller($id);
216 $contact->save();
219 return $id;
222 #-----------------------------------------------------------------#
224 =head2 ModBookseller
226 ModBookseller($bookseller);
228 Updates the information for a given bookseller. C<$bookseller> is a
229 reference-to-hash whose keys are the fields of the aqbooksellers table
230 in the Koha database. It must contain entries for all of the fields.
231 The entry to modify is determined by C<$bookseller-E<gt>{id}>.
233 The easiest way to get all of the necessary fields is to look up a
234 book seller with C<&GetBookseller>, modify what's necessary, then call
235 C<&ModBookseller> with the result.
237 =cut
239 sub ModBookseller {
240 my ($data, $contacts) = @_;
241 my $dbh = C4::Context->dbh;
242 return unless $data->{'id'};
243 my $query = 'UPDATE aqbooksellers
244 SET name=?,address1=?,address2=?,address3=?,address4=?,
245 postal=?,phone=?,accountnumber=?,fax=?,url=?,
246 active=?,listprice=?, invoiceprice=?,
247 gstreg=?,listincgst=?,invoiceincgst=?,
248 discount=?,notes=?,gstrate=?,deliverytime=?
249 WHERE id=?';
250 my $sth = $dbh->prepare($query);
251 my $cnt = $sth->execute(
252 $data->{'name'}, $data->{'address1'},
253 $data->{'address2'}, $data->{'address3'},
254 $data->{'address4'}, $data->{'postal'},
255 $data->{'phone'}, $data->{'accountnumber'},
256 $data->{'fax'}, $data->{'url'},
257 $data->{'active'}, $data->{'listprice'},
258 $data->{'invoiceprice'}, $data->{'gstreg'},
259 $data->{'listincgst'}, $data->{'invoiceincgst'},
260 $data->{'discount'}, $data->{'notes'},
261 $data->{'gstrate'}, $data->{deliverytime},
262 $data->{'id'}
264 $contacts ||= $data->{'contacts'};
265 my $contactquery = "DELETE FROM aqcontacts WHERE booksellerid = ?";
266 my @contactparams = ($data->{'id'});
267 if ($contacts) {
268 foreach my $contact (@$contacts) {
269 $contact = C4::Bookseller::Contact->new( $contact )
270 unless ref $contacts eq 'C4::Bookseller::Contact';
271 $contact->bookseller($data->{'id'});
272 $contact->save();
273 push @contactparams, $contact->id if $contact->id;
275 if ($#contactparams > 0) {
276 $contactquery .= ' AND id NOT IN (' . ('?, ' x ($#contactparams - 1)) . '?);';
279 $sth = $dbh->prepare($contactquery);
280 $sth->execute(@contactparams);
281 return $cnt;
284 =head2 DelBookseller
286 DelBookseller($booksellerid);
288 delete the supplier record identified by $booksellerid
289 This sub assumes it is called only if the supplier has no order.
291 =cut
293 sub DelBookseller {
294 my $id = shift;
295 my $dbh = C4::Context->dbh;
296 my $sth = $dbh->prepare('DELETE FROM aqbooksellers WHERE id=?');
297 return $sth->execute($id);
302 __END__
304 =head1 AUTHOR
306 Koha Development Team <http://koha-community.org/>
308 =cut