Line 0
Link Here
|
|
|
1 |
package C4::EDI; |
2 |
|
3 |
# Copyright 2011 Mark Gavillet |
4 |
# |
5 |
# This file is part of Koha. |
6 |
# |
7 |
# Koha is free software; you can redistribute it and/or modify it under the |
8 |
# terms of the GNU General Public License as published by the Free Software |
9 |
# Foundation; either version 2 of the License, or (at your option) any later |
10 |
# version. |
11 |
# |
12 |
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY |
13 |
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
14 |
# A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
15 |
# |
16 |
# You should have received a copy of the GNU General Public License along |
17 |
# with Koha; if not, write to the Free Software Foundation, Inc., |
18 |
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
19 |
|
20 |
use strict; |
21 |
use warnings; |
22 |
use C4::Context; |
23 |
use C4::Acquisition; |
24 |
use C4::Budgets qw( GetCurrency ); |
25 |
use Net::FTP; |
26 |
use Business::Edifact::Interchange; |
27 |
use C4::Biblio; |
28 |
use C4::Items; |
29 |
use Business::ISBN; |
30 |
use Carp; |
31 |
use parent qw(Exporter); |
32 |
|
33 |
our $VERSION = 3.09.00.53; |
34 |
our @EXPORT_OK = qw( |
35 |
GetEDIAccounts |
36 |
GetEDIAccountDetails |
37 |
CreateEDIDetails |
38 |
UpdateEDIDetails |
39 |
LogEDIFactOrder |
40 |
LogEDIFactQuote |
41 |
DeleteEDIDetails |
42 |
GetVendorList |
43 |
GetEDIfactMessageList |
44 |
GetEDIFTPAccounts |
45 |
LogEDITransaction |
46 |
GetVendorSAN |
47 |
CreateEDIOrder |
48 |
SendEDIOrder |
49 |
SendQueuedEDIOrders |
50 |
ParseEDIQuote |
51 |
GetDiscountedPrice |
52 |
GetBudgetID |
53 |
CheckOrderItemExists |
54 |
GetBranchCode |
55 |
string35escape |
56 |
GetOrderItemInfo |
57 |
CheckVendorFTPAccountExists |
58 |
); |
59 |
|
60 |
=head1 NAME |
61 |
|
62 |
C4::EDI - Perl Module containing functions for Vendor EDI accounts and EDIfact messages |
63 |
|
64 |
=head1 VERSION |
65 |
|
66 |
Version 0.01 |
67 |
|
68 |
=head1 SYNOPSIS |
69 |
|
70 |
use C4::EDI; |
71 |
|
72 |
=head1 DESCRIPTION |
73 |
|
74 |
This module contains routines for adding, modifying and deleting EDI account details for vendors, interacting with vendor FTP sites to send/retrieve quote and order messages, formatting EDIfact orders, and parsing EDIfact quotes to baskets |
75 |
|
76 |
=head2 GetVendorList |
77 |
|
78 |
Returns a list of vendors from aqbooksellers to populate drop down select menu |
79 |
|
80 |
=cut |
81 |
|
82 |
sub GetVendorList { |
83 |
my $dbh = C4::Context->dbh; |
84 |
my $sth; |
85 |
$sth = |
86 |
$dbh->prepare('select id, name from aqbooksellers order by name asc'); |
87 |
$sth->execute(); |
88 |
my $vendorlist = $sth->fetchall_arrayref( {} ); |
89 |
return $vendorlist; |
90 |
} |
91 |
|
92 |
=head2 CreateEDIDetails |
93 |
|
94 |
Inserts a new EDI vendor FTP account |
95 |
|
96 |
=cut |
97 |
|
98 |
sub CreateEDIDetails { |
99 |
my ( $provider, $description, $host, $user, $pass, $in_dir, $san ) = @_; |
100 |
my $dbh = C4::Context->dbh; |
101 |
my $sth; |
102 |
if ($provider) { |
103 |
$sth = $dbh->prepare( |
104 |
'insert into vendor_edi_accounts (description, host, username, password, provider, in_dir, san) values (?,?,?,?,?,?,?)' |
105 |
); |
106 |
$sth->execute( $description, $host, $user, |
107 |
$pass, $provider, $in_dir, $san ); |
108 |
} |
109 |
return; |
110 |
} |
111 |
|
112 |
=head2 GetEDIAccounts |
113 |
|
114 |
Returns all vendor FTP accounts |
115 |
|
116 |
=cut |
117 |
|
118 |
sub GetEDIAccounts { |
119 |
my $dbh = C4::Context->dbh; |
120 |
my $sth; |
121 |
$sth = $dbh->prepare( |
122 |
'select vendor_edi_accounts.id, aqbooksellers.id as providerid, aqbooksellers.name as vendor, vendor_edi_accounts.description, vendor_edi_accounts.last_activity from vendor_edi_accounts inner join aqbooksellers on vendor_edi_accounts.provider = aqbooksellers.id order by aqbooksellers.name asc' |
123 |
); |
124 |
$sth->execute(); |
125 |
my $ediaccounts = $sth->fetchall_arrayref( {} ); |
126 |
return $ediaccounts; |
127 |
} |
128 |
|
129 |
=head2 DeleteEDIDetails |
130 |
|
131 |
Remove a vendor's FTP account |
132 |
|
133 |
=cut |
134 |
|
135 |
sub DeleteEDIDetails { |
136 |
my ($id) = @_; |
137 |
my $dbh = C4::Context->dbh; |
138 |
my $sth; |
139 |
if ($id) { |
140 |
$sth = $dbh->prepare('delete from vendor_edi_accounts where id=?'); |
141 |
$sth->execute($id); |
142 |
} |
143 |
return; |
144 |
} |
145 |
|
146 |
=head2 UpdateEDIDetails |
147 |
|
148 |
Update a vendor's FTP account |
149 |
|
150 |
=cut |
151 |
|
152 |
sub UpdateEDIDetails { |
153 |
my ( $editid, $description, $host, $user, $pass, $provider, $in_dir, $san ) |
154 |
= @_; |
155 |
my $dbh = C4::Context->dbh; |
156 |
if ($editid) { |
157 |
my $sth = $dbh->prepare( |
158 |
'update vendor_edi_accounts set description=?, host=?, username=?, password=?, provider=?, in_dir=?, san=? where id=?' |
159 |
); |
160 |
$sth->execute( $description, $host, $user, $pass, $provider, $in_dir, |
161 |
$san, $editid ); |
162 |
} |
163 |
return; |
164 |
} |
165 |
|
166 |
=head2 LogEDIFactOrder |
167 |
|
168 |
Updates or inserts to the edifact_messages table when processing an order and assigns a status and basket number |
169 |
|
170 |
=cut |
171 |
|
172 |
sub LogEDIFactOrder { |
173 |
my ( $provider, $status, $basketno ) = @_; |
174 |
my $dbh = C4::Context->dbh; |
175 |
my $key; |
176 |
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time); |
177 |
my $date_sent = sprintf '%4d-%02d-%0d', $year + 1900, $mon + 1, $mday; |
178 |
my $sth = $dbh->prepare( |
179 |
'select edifact_messages.id from edifact_messages where basketno=? and provider=?' |
180 |
); |
181 |
$sth->execute( $basketno, $provider ); |
182 |
|
183 |
while ( my @row = $sth->fetchrow_array() ) { |
184 |
$key = $row[0]; |
185 |
} |
186 |
if ($key) { |
187 |
$sth = $dbh->prepare( |
188 |
'update edifact_messages set date_sent=?, status=? where edifact_messages.id=?' |
189 |
); |
190 |
$sth->execute( $date_sent, $status, $key ); |
191 |
} |
192 |
else { |
193 |
$sth = $dbh->prepare( |
194 |
'insert into edifact_messages (message_type,date_sent,provider,status,basketno) values (?,?,?,?,?)' |
195 |
); |
196 |
$sth->execute( 'ORDER', $date_sent, $provider, $status, $basketno ); |
197 |
} |
198 |
return; |
199 |
} |
200 |
|
201 |
=head2 LogEDIFactOrder |
202 |
|
203 |
Updates or inserts to the edifact_messages table when processing a quote and assigns a status and basket number |
204 |
|
205 |
=cut |
206 |
|
207 |
sub LogEDIFactQuote { |
208 |
my ( $provider, $status, $basketno, $key ) = @_; |
209 |
my $dbh = C4::Context->dbh; |
210 |
my $sth; |
211 |
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time); |
212 |
my $date_sent = sprintf '%4d-%02d-%0d', $year + 1900, $mon + 1, $mday; |
213 |
if ( $key != 0 ) { |
214 |
$sth = $dbh->prepare( |
215 |
'update edifact_messages set date_sent=?, status=?, basketno=? where edifact_messages.id=?' |
216 |
); |
217 |
$sth->execute( $date_sent, $status, $basketno, $key ); |
218 |
} |
219 |
else { |
220 |
$sth = $dbh->prepare( |
221 |
'insert into edifact_messages (message_type,date_sent,provider,status,basketno) values (?,?,?,?,?)' |
222 |
); |
223 |
$sth->execute( 'QUOTE', $date_sent, $provider, $status, $basketno ); |
224 |
$key = |
225 |
$dbh->last_insert_id( undef, undef, qw(edifact_messages id), undef ); |
226 |
} |
227 |
return $key; |
228 |
} |
229 |
|
230 |
=head2 GetEDIAccountDetails |
231 |
|
232 |
Returns FTP account details for a given vendor |
233 |
|
234 |
=cut |
235 |
|
236 |
sub GetEDIAccountDetails { |
237 |
my ($id) = @_; |
238 |
my $dbh = C4::Context->dbh; |
239 |
my $sth; |
240 |
if ($id) { |
241 |
$sth = $dbh->prepare('select * from vendor_edi_accounts where id=?'); |
242 |
$sth->execute($id); |
243 |
return $sth->fetchrow_hashref; |
244 |
} |
245 |
return; |
246 |
} |
247 |
|
248 |
=head2 GetEDIfactMessageList |
249 |
|
250 |
Returns a list of edifact_messages that have been processed, including the type (quote/order) and status |
251 |
|
252 |
=cut |
253 |
|
254 |
sub GetEDIfactMessageList { |
255 |
my $dbh = C4::Context->dbh; |
256 |
my $sth; |
257 |
$sth = $dbh->prepare( |
258 |
q|select edifact_messages.id, edifact_messages.message_type, DATE_FORMAT(edifact_messages.date_sent,'%d/%m/%Y') as date_sent, aqbooksellers.id as providerid, aqbooksellers.name as providername, edifact_messages.status, edifact_messages.basketno from edifact_messages inner join aqbooksellers on edifact_messages.provider = aqbooksellers.id order by edifact_messages.date_sent desc, edifact_messages.id desc| |
259 |
); |
260 |
$sth->execute(); |
261 |
return $sth->fetchall_arrayref( {} ); |
262 |
} |
263 |
|
264 |
=head2 GetEDIFTPAccounts |
265 |
|
266 |
Returns all vendor FTP accounts. Used when retrieving quotes messages overnight |
267 |
|
268 |
=cut |
269 |
|
270 |
sub GetEDIFTPAccounts { |
271 |
my $dbh = C4::Context->dbh; |
272 |
my $sth = $dbh->prepare( |
273 |
'select id, host, username, password, provider, in_dir from vendor_edi_accounts order by id asc' |
274 |
); |
275 |
$sth->execute(); |
276 |
return $sth->fetchall_arrayref( {} ); |
277 |
} |
278 |
|
279 |
=head2 LogEDITransaction |
280 |
|
281 |
Updates the timestamp for a given vendor FTP account whenever there is activity |
282 |
|
283 |
=cut |
284 |
|
285 |
sub LogEDITransaction { |
286 |
my $id = shift; |
287 |
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time); |
288 |
my $datestamp = sprintf '%4d/%02d/%0d', $year + 1900, $mon + 1, $mday; |
289 |
my $dbh = C4::Context->dbh; |
290 |
my $sth = $dbh->prepare( |
291 |
'update vendor_edi_accounts set last_activity=? where id=?'); |
292 |
$sth->execute( $datestamp, $id ); |
293 |
return; |
294 |
} |
295 |
|
296 |
=head2 GetVendorSAN |
297 |
|
298 |
Returns the stored SAN number for a given vendor |
299 |
|
300 |
=cut |
301 |
|
302 |
sub GetVendorSAN { |
303 |
my $booksellerid = shift; |
304 |
my $dbh = C4::Context->dbh; |
305 |
my $san; |
306 |
my $sth = |
307 |
$dbh->prepare('select san from vendor_edi_accounts where provider=?'); |
308 |
$sth->execute($booksellerid); |
309 |
while ( my @result = $sth->fetchrow_array() ) { |
310 |
$san = $result[0]; |
311 |
} |
312 |
return $san; |
313 |
} |
314 |
|
315 |
=head2 CreateEDIOrder |
316 |
|
317 |
Formats an EDIfact order message from a given basket and stores as a file on the server |
318 |
|
319 |
=cut |
320 |
|
321 |
sub CreateEDIOrder { |
322 |
my ( $basketno, $booksellerid ) = @_; |
323 |
my @datetime = localtime(time); |
324 |
my $longyear = $datetime[5] + 1900; |
325 |
my $shortyear = sprintf '%02d', $datetime[5] - 100; |
326 |
my $date = sprintf '%02d%02d', $datetime[4] + 1, $datetime[3]; |
327 |
my $hourmin = sprintf '%02d%02d', $datetime[2], $datetime[1]; |
328 |
my $year = $datetime[5] - 100; |
329 |
my $month = sprintf '%02d', $datetime[4] + 1; |
330 |
my $linecount = 0; |
331 |
my $filename = "ediorder_$basketno.CEP"; |
332 |
my $exchange = int( rand(99999999999999) ); |
333 |
my $ref = int( rand(99999999999999) ); |
334 |
my $san = GetVendorSAN($booksellerid); |
335 |
my $message_type = GetMessageType($basketno); |
336 |
my $output_file = C4::Context->config('intranetdir'); |
337 |
|
338 |
# Currencies must be the 3 upper case alpha codes |
339 |
# Koha soes not currently enforce this |
340 |
my $default_currency = GetCurrency(); |
341 |
if ( $default_currency->{currency} =~ m/^[[:upper:]]{3}$/ ) { |
342 |
$default_currency = $default_currency->{currency}; |
343 |
} |
344 |
else { |
345 |
$default_currency = 'GBP'; |
346 |
} |
347 |
|
348 |
$output_file .= "/misc/edi_files/$filename"; |
349 |
|
350 |
open my $fh, '>', $output_file |
351 |
or croak "Unable to create $output_file : $!"; |
352 |
|
353 |
print $fh q{UNA:+.? '}; # print opening header |
354 |
print $fh q{UNB+UNOC:2+} |
355 |
. C4::Context->preference("EDIfactEAN") |
356 |
. ":14+$san:31B+$shortyear$date:$hourmin+" |
357 |
. $exchange |
358 |
. "++ORDERS+++EANCOM'" |
359 |
; # print identifying EANs/SANs, date/time, exchange reference number |
360 |
print $fh 'UNH+' . $ref |
361 |
. q{+ORDERS:D:96A:UN:EAN008'}; # print message reference number |
362 |
|
363 |
if ( $message_type eq 'QUOTE' ) { |
364 |
print $fh 'BGM+22V+' |
365 |
. $basketno |
366 |
. q{+9'}; # print order number and quote confirmation ref |
367 |
} |
368 |
else { |
369 |
print $fh 'BGM+220+', $basketno, "+9'"; # print order number |
370 |
} |
371 |
print $fh "DTM+137:$longyear$date:102'"; # print date of message |
372 |
print $fh "NAD+BY+" |
373 |
. C4::Context->preference("EDIfactEAN") |
374 |
. "::9'"; # print buyer EAN |
375 |
print $fh 'NAD+SU+', $san, "::31B'"; # print vendor SAN |
376 |
print $fh 'NAD+SU+', $booksellerid, "::92'"; # print internal ID |
377 |
|
378 |
# get items from basket |
379 |
my @results = GetOrders($basketno); |
380 |
foreach my $item (@results) { |
381 |
$linecount++; |
382 |
my $price; |
383 |
my $title = string35escape( escape( $item->{title} ) ); |
384 |
my $author = string35escape( escape( $item->{author} ) ); |
385 |
my $publisher = string35escape( escape( $item->{publishercode} ) ); |
386 |
$price = sprintf '%.2f', $item->{listprice}; |
387 |
my $isbn; |
388 |
if ( length( $item->{isbn} ) == 10 |
389 |
|| substr( $item->{isbn}, 0, 3 ) eq '978' |
390 |
|| index( $item->{isbn}, '|' ) != -1 ) |
391 |
{ |
392 |
$isbn = cleanisbn( $item->{isbn} ); |
393 |
$isbn = Business::ISBN->new($isbn); |
394 |
if ($isbn) { |
395 |
if ( $isbn->is_valid ) { |
396 |
$isbn = ( $isbn->as_isbn13 )->isbn; |
397 |
} |
398 |
else { |
399 |
$isbn = '0'; |
400 |
} |
401 |
} |
402 |
else { |
403 |
$isbn = 0; |
404 |
} |
405 |
} |
406 |
else { |
407 |
$isbn = $item->{isbn}; |
408 |
} |
409 |
my $copyrightdate = escape( $item->{publicationyear} ); |
410 |
my $quantity = escape( $item->{quantity} ); |
411 |
my $ordernumber = escape( $item->{ordernumber} ); |
412 |
my $notes; |
413 |
if ( $item->{notes} ) { |
414 |
$notes = $item->{notes}; |
415 |
$notes =~ s/[\r\n]+//g; |
416 |
$notes = string35escape( escape($notes) ); |
417 |
} |
418 |
|
419 |
my ( $branchcode, $callnumber, $itype, $lsqccode, $fund ) = |
420 |
GetOrderItemInfo( $item->{'ordernumber'} ); |
421 |
$callnumber = escape($callnumber); |
422 |
|
423 |
print $fh "LIN+$linecount++" . $isbn . ":EN'"; # line number, isbn |
424 |
print $fh "PIA+5+" . $isbn |
425 |
. ":IB'"; # isbn as main product identification |
426 |
print $fh "IMD+L+050+:::$title'"; # title |
427 |
print $fh "IMD+L+009+:::$author'"; # full name of author |
428 |
print $fh "IMD+L+109+:::$publisher'"; # publisher |
429 |
print $fh "IMD+L+170+:::$copyrightdate'"; # date of publication |
430 |
print $fh "IMD+L+220+:::O'"; # binding (e.g. PB) (O if not specified) |
431 |
if ( $callnumber ne '' ) { |
432 |
print $fh "IMD+L+230+:::$callnumber'"; # shelfmark |
433 |
} |
434 |
print $fh "QTY+21:$quantity'"; # quantity |
435 |
if ( $message_type ne 'QUOTE' && $quantity > 1 ) { |
436 |
print $fh "GIR+001+$quantity:LQT+$branchcode:LLO+$fund:LFN+" |
437 |
; # branchcode, fund code |
438 |
} |
439 |
else { |
440 |
print $fh |
441 |
"GIR+001+$branchcode:LLO+$fund:LFN+"; # branchcode, fund code |
442 |
} |
443 |
if ( $callnumber ne '' ) { |
444 |
print $fh "$callnumber:LCL+"; # shelfmark |
445 |
} |
446 |
print $fh $itype . ":LST+$lsqccode:LSQ'"; # stock category, sequence |
447 |
if ($notes) { |
448 |
print $fh "FTX+LIN+++:::$notes'"; |
449 |
} |
450 |
###REQUEST ORDERS TO REVISIT |
451 |
#if ($message_type ne 'QUOTE') |
452 |
#{ |
453 |
# print $fh "FTX+LIN++$linecount:10B:28'"; # freetext ** used for request orders to denote priority (to revisit) |
454 |
#} |
455 |
print $fh "PRI+AAB:$price'"; # price per item |
456 |
my $currency = |
457 |
$item->{currency} =~ m/^[[:upper:]]{3}$/ |
458 |
? $item->{currency} |
459 |
: $default_currency; |
460 |
print $fh "CUX+2:$currency:9'"; # currency (e.g. GBP, EUR, USD) |
461 |
print $fh "RFF+LI:$ordernumber'"; # Local order number |
462 |
if ( $message_type eq 'QUOTE' ) { |
463 |
print $fh "RFF+QLI:" |
464 |
. $item->{booksellerinvoicenumber} |
465 |
. q{'}; # If QUOTE confirmation, include booksellerinvoicenumber |
466 |
} |
467 |
} |
468 |
print $fh "UNS+S'"; # print summary section header |
469 |
print $fh "CNT+2:$linecount'"; # print number of line items in the message |
470 |
my $segments = ( ( $linecount * 13 ) + 9 ); |
471 |
print $fh "UNT+$segments+" |
472 |
. $ref . "'" |
473 |
; # No. of segments in message (UNH+UNT elements included, UNA, UNB, UNZ excluded) |
474 |
# Message ref number |
475 |
print $fh "UNZ+1+" . $exchange . "'\n"; # Exchange ref number |
476 |
|
477 |
close $fh; |
478 |
|
479 |
LogEDIFactOrder( $booksellerid, 'Queued', $basketno ); |
480 |
|
481 |
return $filename; |
482 |
|
483 |
} |
484 |
|
485 |
sub GetMessageType { |
486 |
my $basketno = shift; |
487 |
my $dbh = C4::Context->dbh; |
488 |
my $sth; |
489 |
my $message_type; |
490 |
my @row; |
491 |
$sth = $dbh->prepare( |
492 |
'select message_type from edifact_messages where basketno=?'); |
493 |
$sth->execute($basketno); |
494 |
while ( @row = $sth->fetchrow_array() ) { |
495 |
$message_type = $row[0]; |
496 |
} |
497 |
return $message_type; |
498 |
} |
499 |
|
500 |
sub cleanisbn { |
501 |
my $isbn = shift; |
502 |
if ($isbn) { |
503 |
my $i = index( $isbn, '(' ); |
504 |
if ( $i > 1 ) { |
505 |
$isbn = substr( $isbn, 0, ( $i - 1 ) ); |
506 |
} |
507 |
if ( $isbn =~ /\|/ ) { |
508 |
my @isbns = split( /\|/, $isbn ); |
509 |
$isbn = $isbns[0]; |
510 |
} |
511 |
$isbn = escape($isbn); |
512 |
$isbn =~ s/^\s+//; |
513 |
$isbn =~ s/\s+$//; |
514 |
return $isbn; |
515 |
} |
516 |
return; |
517 |
} |
518 |
|
519 |
sub escape { |
520 |
my $string = shift; |
521 |
if ($string) { |
522 |
$string =~ s/\?/\?\?/g; |
523 |
$string =~ s/\'/\?\'/g; |
524 |
$string =~ s/\:/\?\:/g; |
525 |
$string =~ s/\+/\?\+/g; |
526 |
return $string; |
527 |
} |
528 |
return; |
529 |
} |
530 |
|
531 |
=head2 GetBranchCode |
532 |
|
533 |
Return branchcode for an order when formatting an EDIfact order message |
534 |
|
535 |
=cut |
536 |
|
537 |
sub GetBranchCode { |
538 |
my $biblioitemnumber = shift; |
539 |
my $dbh = C4::Context->dbh; |
540 |
my $branchcode; |
541 |
my @row; |
542 |
my $sth = |
543 |
$dbh->prepare("select homebranch from items where biblioitemnumber=?"); |
544 |
$sth->execute($biblioitemnumber); |
545 |
while ( @row = $sth->fetchrow_array() ) { |
546 |
$branchcode = $row[0]; |
547 |
} |
548 |
return $branchcode; |
549 |
} |
550 |
|
551 |
=head2 SendEDIOrder |
552 |
|
553 |
Transfers an EDIfact order message to the relevant vendor's FTP site |
554 |
|
555 |
=cut |
556 |
|
557 |
sub SendEDIOrder { |
558 |
my ( $basketno, $booksellerid ) = @_; |
559 |
my $newerr; |
560 |
my $result; |
561 |
|
562 |
# check edi order file exists |
563 |
my $edi_files = C4::Context->config('intranetdir'); |
564 |
$edi_files .= '/misc/edi_files/'; |
565 |
if ( -e "${edi_files}ediorder_$basketno.CEP" ) { |
566 |
my $dbh = C4::Context->dbh; |
567 |
my $sth; |
568 |
$sth = $dbh->prepare( |
569 |
"select id, host, username, password, provider, in_dir from vendor_edi_accounts where provider=?" |
570 |
); |
571 |
$sth->execute($booksellerid); |
572 |
my $ftpaccount = $sth->fetchrow_hashref; |
573 |
|
574 |
#check vendor edi account exists |
575 |
if ($ftpaccount) { |
576 |
|
577 |
# connect to ftp account |
578 |
my $ftp = Net::FTP->new( $ftpaccount->{host}, Timeout => 10 ) |
579 |
or $newerr = 1; |
580 |
if ( !$newerr ) { |
581 |
$newerr = 0; |
582 |
|
583 |
# login |
584 |
$ftp->login( $ftpaccount->{username}, $ftpaccount->{password} ) |
585 |
or $newerr = 1; |
586 |
$ftp->quit if $newerr; |
587 |
if ( !$newerr ) { |
588 |
|
589 |
# cd to directory |
590 |
$ftp->cwd( $ftpaccount->{in_dir} ) or $newerr = 1; |
591 |
$ftp->quit if $newerr; |
592 |
|
593 |
# put file |
594 |
if ( !$newerr ) { |
595 |
$newerr = 0; |
596 |
$ftp->put("${edi_files}ediorder_$basketno.CEP") |
597 |
or $newerr = 1; |
598 |
$ftp->quit if $newerr; |
599 |
if ( !$newerr ) { |
600 |
$result = |
601 |
"File: ediorder_$basketno.CEP transferred successfully"; |
602 |
$ftp->quit; |
603 |
unlink "${edi_files}ediorder_$basketno.CEP"; |
604 |
LogEDITransaction( $ftpaccount->{id} ); |
605 |
LogEDIFactOrder( $booksellerid, 'Sent', $basketno ); |
606 |
return $result; |
607 |
} |
608 |
else { |
609 |
$result = |
610 |
"Could not transfer the file ${edi_files}ediorder_$basketno.CEP to $ftpaccount->{host}: $_"; |
611 |
FTPError($result); |
612 |
LogEDIFactOrder( $booksellerid, 'Failed', |
613 |
$basketno ); |
614 |
return $result; |
615 |
} |
616 |
} |
617 |
else { |
618 |
$result = |
619 |
"Cannot get remote directory ($ftpaccount->{in_dir}) on $ftpaccount->{host}"; |
620 |
FTPError($result); |
621 |
LogEDIFactOrder( $booksellerid, 'Failed', $basketno ); |
622 |
return $result; |
623 |
} |
624 |
} |
625 |
else { |
626 |
$result = "Cannot log in to $ftpaccount->{host}: $!"; |
627 |
FTPError($result); |
628 |
LogEDIFactOrder( $booksellerid, 'Failed', $basketno ); |
629 |
return $result; |
630 |
} |
631 |
} |
632 |
else { |
633 |
$result = |
634 |
"Cannot make an FTP connection to $ftpaccount->{host}: $!"; |
635 |
FTPError($result); |
636 |
LogEDIFactOrder( $booksellerid, 'Failed', $basketno ); |
637 |
return $result; |
638 |
} |
639 |
} |
640 |
else { |
641 |
$result = |
642 |
"Vendor ID: $booksellerid does not have a current EDIfact FTP account"; |
643 |
FTPError($result); |
644 |
LogEDIFactOrder( $booksellerid, 'Failed', $basketno ); |
645 |
return $result; |
646 |
} |
647 |
} |
648 |
else { |
649 |
$result = 'There is no EDIfact order for this basket'; |
650 |
return $result; |
651 |
} |
652 |
} |
653 |
|
654 |
sub FTPError { |
655 |
my $error = shift; |
656 |
my $log_file = C4::Context->config('intranetdir'); |
657 |
$log_file .= '/misc/edi_files/edi_ftp_error.log'; |
658 |
open my $log_fh, '>>', $log_file |
659 |
or croak "Could not open $log_file: $!"; |
660 |
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time); |
661 |
printf $log_fh "%4d-%02d-%02d %02d:%02d:%02d\n-----\n", |
662 |
$year + 1900, $mon + 1, $mday, $hour, $min, $sec; |
663 |
print $log_fh "$error\n\n"; |
664 |
close $log_fh; |
665 |
return; |
666 |
} |
667 |
|
668 |
=head2 SendQueuedEDIOrders |
669 |
|
670 |
Sends all EDIfact orders that are held in the Queued |
671 |
|
672 |
=cut |
673 |
|
674 |
sub SendQueuedEDIOrders { |
675 |
my $dbh = C4::Context->dbh; |
676 |
my @orders; |
677 |
my $sth = $dbh->prepare( |
678 |
q|select basketno, provider from edifact_messages where status='Queued'| |
679 |
); |
680 |
$sth->execute(); |
681 |
while ( @orders = $sth->fetchrow_array() ) { |
682 |
SendEDIOrder( $orders[0], $orders[1] ); |
683 |
} |
684 |
return; |
685 |
} |
686 |
|
687 |
=head2 ParseEDIQuote |
688 |
|
689 |
Uses Business::Edifact::Interchange to parse a stored EDIfact quote message, creates basket, biblios, biblioitems, and items |
690 |
|
691 |
=cut |
692 |
|
693 |
sub ParseEDIQuote { |
694 |
my ( $filename, $booksellerid ) = @_; |
695 |
my $basketno; |
696 |
my $ParseEDIQuoteItem; |
697 |
|
698 |
my $edi = Business::Edifact::Interchange->new; |
699 |
my $path = C4::Context->config('intranetdir'); |
700 |
$path .= '/misc/edi_files/'; |
701 |
$edi->parse_file("$path$filename"); |
702 |
my $messages = $edi->messages(); |
703 |
my $msg_cnt = @{$messages}; |
704 |
|
705 |
# create default edifact_messages entry |
706 |
my $messagekey = LogEDIFactQuote( $booksellerid, 'Failed', 0, 0 ); |
707 |
|
708 |
#create basket |
709 |
if ( $msg_cnt > 0 && $booksellerid ) { |
710 |
$basketno = NewBasket( $booksellerid, 0, $filename, q{}, q{}, q{} ); |
711 |
} |
712 |
|
713 |
$ParseEDIQuoteItem = sub { |
714 |
my ( $item, $gir, $bookseller_id ) = @_; |
715 |
my $relnos = $item->{related_numbers}; |
716 |
my $author = $item->author_surname . ", " . $item->author_firstname; |
717 |
|
718 |
my $ecost = |
719 |
GetDiscountedPrice( $bookseller_id, $item->{price}->{price} ); |
720 |
|
721 |
my $ftxlin; |
722 |
my $ftxlno; |
723 |
if ( $item->{free_text}->{qualifier} eq 'LIN' ) { |
724 |
$ftxlin = $item->{free_text}->{text}; |
725 |
} |
726 |
if ( $item->{free_text}->{qualifier} eq 'LNO' ) { |
727 |
$ftxlno = $item->{free_text}->{text}; |
728 |
} |
729 |
|
730 |
my ( $llo, $lfn, $lsq, $lst, $lfs, $lcl, $id ); |
731 |
my $relcount = 0; |
732 |
foreach my $rel ( @{$relnos} ) { |
733 |
if ( $rel->{id} == ( $gir + 1 ) ) { |
734 |
if ( $item->{related_numbers}->[$relcount]->{LLO}->[0] ) { |
735 |
$llo = $item->{related_numbers}->[$relcount]->{LLO}->[0]; |
736 |
} |
737 |
if ( $item->{related_numbers}->[$relcount]->{LFN}->[0] ) { |
738 |
$lfn = $item->{related_numbers}->[$relcount]->{LFN}->[0]; |
739 |
} |
740 |
if ( $item->{related_numbers}->[$relcount]->{LSQ}->[0] ) { |
741 |
$lsq = $item->{related_numbers}->[$relcount]->{LSQ}->[0]; |
742 |
} |
743 |
if ( $item->{related_numbers}->[$relcount]->{LST}->[0] ) { |
744 |
$lst = $item->{related_numbers}->[$relcount]->{LST}->[0]; |
745 |
} |
746 |
if ( $item->{related_numbers}->[$relcount]->{LFS}->[0] ) { |
747 |
$lfs = $item->{related_numbers}->[$relcount]->{LFS}->[0]; |
748 |
} |
749 |
if ( $item->{related_numbers}->[$relcount]->{LCL}->[0] ) { |
750 |
$lcl = $item->{related_numbers}->[$relcount]->{LCL}->[0]; |
751 |
} |
752 |
if ( $item->{related_numbers}->[$relcount]->{id} ) { |
753 |
$id = $item->{related_numbers}->[$relcount]->{id}; |
754 |
} |
755 |
} |
756 |
$relcount++; |
757 |
} |
758 |
|
759 |
my $lclnote; |
760 |
if ( !$lst ) { |
761 |
$lst = uc( $item->item_format ); |
762 |
} |
763 |
if ( !$lcl ) { |
764 |
$lcl = $item->shelfmark; |
765 |
} |
766 |
else { |
767 |
( $lcl, $lclnote ) = DawsonsLCL($lcl); |
768 |
} |
769 |
if ($lfs) { |
770 |
$lcl .= " $lfs"; |
771 |
} |
772 |
|
773 |
my $budget_id = GetBudgetID($lfn); |
774 |
|
775 |
#Uncomment section below to define a default budget_id if there is no match |
776 |
#if (!defined $budget_id) |
777 |
#{ |
778 |
# $budget_id=0; |
779 |
#} |
780 |
|
781 |
# create biblio record |
782 |
my $bib_record = TransformKohaToMarc( |
783 |
{ |
784 |
'biblio.title' => $item->title, |
785 |
'biblio.author' => $author ? $author : q{}, |
786 |
'biblio.seriestitle' => q{}, |
787 |
'biblioitems.isbn' => $item->{item_number} |
788 |
? $item->{item_number} |
789 |
: q{}, |
790 |
'biblioitems.publishercode' => $item->publisher |
791 |
? $item->publisher |
792 |
: q{}, |
793 |
'biblioitems.publicationyear' => $item->date_of_publication |
794 |
? $item->date_of_publication |
795 |
: q{}, |
796 |
'biblio.copyrightdate' => $item->date_of_publication |
797 |
? $item->date_of_publication |
798 |
: q{}, |
799 |
'biblioitems.itemtype' => uc( $item->item_format ), |
800 |
'biblioitems.cn_source' => 'ddc', |
801 |
'items.cn_source' => 'ddc', |
802 |
'items.notforloan' => -1, |
803 |
|
804 |
#"items.ccode" => $lsq, |
805 |
'items.location' => $lsq, |
806 |
'items.homebranch' => $llo, |
807 |
'items.holdingbranch' => $llo, |
808 |
'items.booksellerid' => $bookseller_id, |
809 |
'items.price' => $item->{price}->{price}, |
810 |
'items.replacementprice' => $item->{price}->{price}, |
811 |
'items.itemcallnumber' => $lcl, |
812 |
'items.itype' => $lst, |
813 |
'items.cn_sort' => q{}, |
814 |
} |
815 |
); |
816 |
|
817 |
#check if item already exists in catalogue |
818 |
my $biblionumber; |
819 |
my $bibitemnumber; |
820 |
( $biblionumber, $bibitemnumber ) = |
821 |
CheckOrderItemExists( $item->{item_number} ); |
822 |
|
823 |
if ( !defined $biblionumber ) { |
824 |
|
825 |
# create the record in catalogue, with framework '' |
826 |
( $biblionumber, $bibitemnumber ) = AddBiblio( $bib_record, q{} ); |
827 |
} |
828 |
|
829 |
my $ordernote; |
830 |
if ($lclnote) { |
831 |
$ordernote = $lclnote; |
832 |
} |
833 |
if ($ftxlno) { |
834 |
$ordernote = $ftxlno; |
835 |
} |
836 |
if ($ftxlin) { |
837 |
$ordernote = $ftxlin; |
838 |
} |
839 |
|
840 |
my %orderinfo = ( |
841 |
basketno => $basketno, |
842 |
ordernumber => q{}, |
843 |
subscription => 'no', |
844 |
uncertainprice => 0, |
845 |
biblionumber => $biblionumber, |
846 |
title => $item->title, |
847 |
quantity => 1, |
848 |
biblioitemnumber => $bibitemnumber, |
849 |
rrp => $item->{price}->{price}, |
850 |
ecost => $ecost, |
851 |
sort1 => q{}, |
852 |
sort2 => q{}, |
853 |
booksellerinvoicenumber => $item->{item_reference}[0][1], |
854 |
listprice => $item->{price}->{price}, |
855 |
branchcode => $llo, |
856 |
budget_id => $budget_id, |
857 |
notes => $ordernote, |
858 |
); |
859 |
|
860 |
my $orderinfo = \%orderinfo; |
861 |
|
862 |
my ( $retbasketno, $ordernumber ) = NewOrder($orderinfo); |
863 |
|
864 |
# now, add items if applicable |
865 |
if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { |
866 |
my $itemnumber; |
867 |
( $biblionumber, $bibitemnumber, $itemnumber ) = |
868 |
AddItemFromMarc( $bib_record, $biblionumber ); |
869 |
NewOrderItem( $itemnumber, $ordernumber ); |
870 |
} |
871 |
}; |
872 |
|
873 |
for ( my $count = 0 ; $count < $msg_cnt ; $count++ ) { |
874 |
my $items = $messages->[$count]->items(); |
875 |
my $ref_num = $messages->[$count]->{ref_num}; |
876 |
|
877 |
foreach my $item ( @{$items} ) { |
878 |
for ( my $i = 0 ; $i < $item->{quantity} ; $i++ ) { |
879 |
&$ParseEDIQuoteItem( $item, $i, $booksellerid, $basketno ); |
880 |
} |
881 |
} |
882 |
} |
883 |
|
884 |
# update edifact_messages entry |
885 |
LogEDIFactQuote( $booksellerid, 'Received', $basketno, $messagekey ); |
886 |
return 1; |
887 |
|
888 |
} |
889 |
|
890 |
=head2 GetDiscountedPrice |
891 |
|
892 |
Returns the discounted price for an order based on the discount rate for a given vendor |
893 |
|
894 |
=cut |
895 |
|
896 |
sub GetDiscountedPrice { |
897 |
my ( $booksellerid, $price ) = @_; |
898 |
my $dbh = C4::Context->dbh; |
899 |
my $sth; |
900 |
my @discount; |
901 |
my $ecost; |
902 |
my $percentage; |
903 |
$sth = $dbh->prepare(q|select discount from aqbooksellers where id=?|); |
904 |
$sth->execute($booksellerid); |
905 |
|
906 |
while ( @discount = $sth->fetchrow_array() ) { |
907 |
$percentage = $discount[0]; |
908 |
} |
909 |
$ecost = ( $price - ( ( $percentage * $price ) / 100 ) ); |
910 |
return $ecost; |
911 |
} |
912 |
|
913 |
=head2 DawsonsLCL |
914 |
|
915 |
Checks for a call number encased by asterisks. If found, returns call number as $lcl and string with |
916 |
asterisks as $lclnote to go into FTX field enabling spine label creation by Dawsons bookseller |
917 |
|
918 |
=cut |
919 |
|
920 |
sub DawsonsLCL { |
921 |
my $lcl = shift; |
922 |
my $lclnote; |
923 |
my $f = index( $lcl, '*' ); |
924 |
my $l = rindex( $lcl, '*' ); |
925 |
if ( $f == 0 && $l == ( length($lcl) - 1 ) ) { |
926 |
$lclnote = $lcl; |
927 |
$lcl =~ s/\*//g; |
928 |
} |
929 |
return ( $lcl, $lclnote ); |
930 |
} |
931 |
|
932 |
=head2 GetBudgetID |
933 |
|
934 |
Returns the budget_id for a given budget_code |
935 |
|
936 |
=cut |
937 |
|
938 |
sub GetBudgetID { |
939 |
my $fundcode = shift; |
940 |
my $dbh = C4::Context->dbh; |
941 |
my @funds; |
942 |
my $ecost; |
943 |
my $budget_id; |
944 |
my $sth = |
945 |
$dbh->prepare('select budget_id from aqbudgets where budget_code=?'); |
946 |
$sth->execute($fundcode); |
947 |
|
948 |
while ( @funds = $sth->fetchrow_array() ) { |
949 |
$budget_id = $funds[0]; |
950 |
} |
951 |
return $budget_id; |
952 |
} |
953 |
|
954 |
=head2 CheckOrderItemExists |
955 |
|
956 |
Checks to see if a biblio record already exists in the catalogue when parsing a quotes message |
957 |
Converts 10-13 digit ISBNs and vice-versa if an initial match is not found |
958 |
|
959 |
=cut |
960 |
|
961 |
sub CheckOrderItemExists { |
962 |
my $isbn = shift; |
963 |
my $dbh = C4::Context->dbh; |
964 |
my @matches; |
965 |
my $biblionumber; |
966 |
my $bibitemnumber; |
967 |
my $sth = $dbh->prepare( |
968 |
'select biblionumber, biblioitemnumber from biblioitems where isbn=?'); |
969 |
$sth->execute($isbn); |
970 |
|
971 |
while ( @matches = $sth->fetchrow_array() ) { |
972 |
$biblionumber = $matches[0]; |
973 |
$bibitemnumber = $matches[1]; |
974 |
} |
975 |
if ($biblionumber) { |
976 |
return $biblionumber, $bibitemnumber; |
977 |
} |
978 |
else { |
979 |
$isbn = cleanisbn($isbn); |
980 |
if ( length($isbn) == 10 ) { |
981 |
$isbn = Business::ISBN->new($isbn); |
982 |
if ($isbn) { |
983 |
if ( $isbn->is_valid ) { |
984 |
$isbn = ( $isbn->as_isbn13 )->isbn; |
985 |
$sth->execute($isbn); |
986 |
while ( @matches = $sth->fetchrow_array() ) { |
987 |
$biblionumber = $matches[0]; |
988 |
$bibitemnumber = $matches[1]; |
989 |
} |
990 |
} |
991 |
} |
992 |
} |
993 |
elsif ( length($isbn) == 13 ) { |
994 |
$isbn = Business::ISBN->new($isbn); |
995 |
if ($isbn) { |
996 |
if ( $isbn->is_valid ) { |
997 |
$isbn = ( $isbn->as_isbn10 )->isbn; |
998 |
$sth->execute($isbn); |
999 |
while ( @matches = $sth->fetchrow_array() ) { |
1000 |
$biblionumber = $matches[0]; |
1001 |
$bibitemnumber = $matches[1]; |
1002 |
} |
1003 |
} |
1004 |
} |
1005 |
} |
1006 |
return $biblionumber, $bibitemnumber; |
1007 |
} |
1008 |
} |
1009 |
|
1010 |
sub string35escape { |
1011 |
my $string = shift; |
1012 |
my $colon_string; |
1013 |
my @sections; |
1014 |
if ( length($string) > 35 ) { |
1015 |
my ( $chunk, $stringlength ) = ( 35, length($string) ); |
1016 |
for ( my $counter = 0 ; $counter < $stringlength ; $counter += $chunk ) |
1017 |
{ |
1018 |
push @sections, substr( $string, $counter, $chunk ); |
1019 |
} |
1020 |
foreach my $section (@sections) { |
1021 |
$colon_string .= "$section:"; |
1022 |
} |
1023 |
chop $colon_string; |
1024 |
} |
1025 |
else { |
1026 |
$colon_string = $string; |
1027 |
} |
1028 |
return $colon_string; |
1029 |
} |
1030 |
|
1031 |
sub GetOrderItemInfo { |
1032 |
my $ordernumber = shift; |
1033 |
my $dbh = C4::Context->dbh; |
1034 |
my @rows; |
1035 |
my $homebranch; |
1036 |
my $callnumber; |
1037 |
my $itype; |
1038 |
my $ccode; |
1039 |
my $fund; |
1040 |
my $sth = $dbh->prepare( |
1041 |
q|select items.homebranch, items.itemcallnumber, items.itype, items.location from items |
1042 |
inner join aqorders_items on aqorders_items.itemnumber=items.itemnumber |
1043 |
where aqorders_items.ordernumber=?| |
1044 |
); |
1045 |
$sth->execute($ordernumber); |
1046 |
|
1047 |
while ( @rows = $sth->fetchrow_array() ) { |
1048 |
$homebranch = $rows[0]; |
1049 |
$callnumber = $rows[1]; |
1050 |
$itype = $rows[2]; |
1051 |
$ccode = $rows[3]; |
1052 |
} |
1053 |
$sth = $dbh->prepare( |
1054 |
q|select aqbudgets.budget_code from aqbudgets inner join aqorders on |
1055 |
aqorders.budget_id=aqbudgets.budget_id where aqorders.ordernumber=?| |
1056 |
); |
1057 |
$sth->execute($ordernumber); |
1058 |
while ( @rows = $sth->fetchrow_array() ) { |
1059 |
$fund = $rows[0]; |
1060 |
} |
1061 |
return $homebranch, $callnumber, $itype, $ccode, $fund; |
1062 |
} |
1063 |
|
1064 |
sub CheckVendorFTPAccountExists { |
1065 |
my $booksellerid = shift; |
1066 |
my $dbh = C4::Context->dbh; |
1067 |
my $sth = $dbh->prepare( |
1068 |
q|select count(id) from vendor_edi_accounts where provider=?|); |
1069 |
$sth->execute($booksellerid); |
1070 |
while ( my @rows = $sth->fetchrow_array() ) { |
1071 |
if ( $rows[0] > 0 ) { |
1072 |
return 1; |
1073 |
} |
1074 |
} |
1075 |
return; |
1076 |
} |
1077 |
|
1078 |
1; |
1079 |
|
1080 |
__END__ |
1081 |
|
1082 |
=head1 AUTHOR |
1083 |
|
1084 |
Mark Gavillet |
1085 |
|
1086 |
=cut |