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