Line 0
Link Here
|
|
|
1 |
package Rebus::EDI::System::Koha; |
2 |
|
3 |
# Copyright 2012 Mark Gavillet |
4 |
|
5 |
use strict; |
6 |
use warnings; |
7 |
|
8 |
=head1 NAME |
9 |
|
10 |
Rebus::EDI::System::Koha |
11 |
|
12 |
=head1 VERSION |
13 |
|
14 |
Version 0.01 |
15 |
|
16 |
=cut |
17 |
|
18 |
use C4::Context; |
19 |
|
20 |
our $VERSION = '0.01'; |
21 |
|
22 |
### Evergreen |
23 |
#our $edidir = "/tmp/"; |
24 |
|
25 |
### Koha |
26 |
our $edidir = "$ENV{'PERL5LIB'}/misc/edi_files/"; |
27 |
|
28 |
our $ftplogfile = "$edidir/edi_ftp.log"; |
29 |
our $quoteerrorlogfile = "$edidir/edi_quote_error.log"; |
30 |
our $edi_quote_user = 0; |
31 |
|
32 |
sub new { |
33 |
my $class = shift; |
34 |
my $self = {}; |
35 |
bless $self, $class; |
36 |
return $self; |
37 |
} |
38 |
|
39 |
sub retrieve_vendor_ftp_accounts { |
40 |
my $self = shift; |
41 |
my $dbh = C4::Context->dbh; |
42 |
my $sth = $dbh->prepare( |
43 |
'select vendor_edi_accounts.id as edi_account_id, |
44 |
aqbooksellers.id as account_id, aqbooksellers.name as vendor, |
45 |
vendor_edi_accounts.host as server, vendor_edi_accounts.username as ftpuser, |
46 |
vendor_edi_accounts.password as ftppass, vendor_edi_accounts.in_dir as ftpdir |
47 |
from vendor_edi_accounts inner join aqbooksellers on |
48 |
vendor_edi_accounts.provider = aqbooksellers.id' |
49 |
); |
50 |
$sth->execute(); |
51 |
my $set = $sth->fetchall_arrayref( {} ); |
52 |
my @accounts; |
53 |
my $new_account; |
54 |
|
55 |
foreach my $account (@$set) { |
56 |
$new_account = { |
57 |
account_id => $account->{account_id}, |
58 |
edi_account_id => $account->{edi_account_id}, |
59 |
vendor => $account->{vendor}, |
60 |
server => $account->{server}, |
61 |
ftpuser => $account->{ftpuser}, |
62 |
ftppass => $account->{ftppass}, |
63 |
ftpdir => $account->{ftpdir}, |
64 |
po_org_unit => 0, |
65 |
}; |
66 |
push( @accounts, $new_account ); |
67 |
} |
68 |
return @accounts; |
69 |
} |
70 |
|
71 |
sub download_quotes { |
72 |
my ( $self, $ftp_accounts ) = @_; |
73 |
my @local_files; |
74 |
foreach my $account (@$ftp_accounts) { |
75 |
|
76 |
#get vendor details |
77 |
print "server: " . $account->{server} . "\n"; |
78 |
print "account: " . $account->{vendor} . "\n"; |
79 |
|
80 |
#get files |
81 |
use Net::FTP; |
82 |
my $newerr; |
83 |
my @ERRORS; |
84 |
my @files; |
85 |
open my $ediftplog, '>>', $ftplogfile |
86 |
or die "Could not open $ftplogfile\n"; |
87 |
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time); |
88 |
printf $ediftplog "\n\n%4d-%02d-%02d %02d:%02d:%02d\n-----\n", |
89 |
$year + 1900, $mon + 1, $mday, $hour, $min, $sec; |
90 |
print $ediftplog "Connecting to " . $account->{server} . "... "; |
91 |
my $ftp = |
92 |
Net::FTP->new( $account->{server}, Timeout => 10, Passive => 1 ) |
93 |
or $newerr = 1; |
94 |
push @ERRORS, "Can't ftp to " . $account->{server} . ": $!\n" |
95 |
if $newerr; |
96 |
myerr(@ERRORS) if $newerr; |
97 |
|
98 |
if ( !$newerr ) { |
99 |
$newerr = 0; |
100 |
print $ediftplog "connected.\n"; |
101 |
|
102 |
$ftp->login( $account->{ftpuser}, $account->{ftppass} ) |
103 |
or $newerr = 1; |
104 |
print $ediftplog "Getting file list\n"; |
105 |
push @ERRORS, "Can't login to " . $account->{server} . ": $!\n" |
106 |
if $newerr; |
107 |
$ftp->quit if $newerr; |
108 |
myerr(@ERRORS) if $newerr; |
109 |
if ( !$newerr ) { |
110 |
print $ediftplog "Logged in\n"; |
111 |
$ftp->cwd( $account->{ftpdir} ) or $newerr = 1; |
112 |
push @ERRORS, |
113 |
"Can't cd in server " . $account->{server} . " $!\n" |
114 |
if $newerr; |
115 |
myerr(@ERRORS) if $newerr; |
116 |
$ftp->quit if $newerr; |
117 |
|
118 |
@files = $ftp->ls or $newerr = 1; |
119 |
push @ERRORS, |
120 |
"Can't get file list from server " |
121 |
. $account->{server} . " $!\n" |
122 |
if $newerr; |
123 |
myerr(@ERRORS) if $newerr; |
124 |
if ( !$newerr ) { |
125 |
print $ediftplog "Got file list\n"; |
126 |
foreach (@files) { |
127 |
my $filename = $_; |
128 |
if ( ( index lc($filename), '.ceq' ) > -1 ) { |
129 |
my $description = sprintf "%s/%s", |
130 |
$account->{server}, $filename; |
131 |
print $ediftplog "Found file: $description - "; |
132 |
|
133 |
# deduplicate vs. acct/filenames already in DB |
134 |
my $hits = |
135 |
find_duplicate_quotes( $account->{edi_account_id}, |
136 |
$account->{ftpdir}, $filename ); |
137 |
|
138 |
my $match = 0; |
139 |
if ( scalar(@$hits) ) { |
140 |
print $ediftplog |
141 |
"File already retrieved. Skipping.\n"; |
142 |
$match = 1; |
143 |
} |
144 |
if ( $match ne 1 ) { |
145 |
chdir "$edidir"; |
146 |
$ftp->get($filename) or $newerr = 1; |
147 |
push @ERRORS, |
148 |
"Can't transfer file ($filename) from " |
149 |
. $account->{server} . " $!\n" |
150 |
if $newerr; |
151 |
$ftp->quit if $newerr; |
152 |
myerr(@ERRORS) if $newerr; |
153 |
if ( !$newerr ) { |
154 |
print $ediftplog "File retrieved\n"; |
155 |
open my $fh, '<', "$edidir/$filename" |
156 |
or die "Couldn't open file: $!\n"; |
157 |
my $message_content = join( "", <$fh> ); |
158 |
close $fh; |
159 |
my $logged_quote = LogQuote( |
160 |
$message_content, |
161 |
$account->{ftpdir} . "/" . $filename, |
162 |
$account->{server}, |
163 |
$account->{edi_account_id} |
164 |
); |
165 |
my $quote_file = { |
166 |
filename => $filename, |
167 |
account_id => $account->{account_id}, |
168 |
po_org_unit => $account->{po_org_unit}, |
169 |
edi_quote_user => $edi_quote_user, |
170 |
logged_quote_id => $logged_quote, |
171 |
edi_account_id => |
172 |
$account->{edi_account_id}, |
173 |
}; |
174 |
push( @local_files, $quote_file ); |
175 |
} |
176 |
} |
177 |
} |
178 |
} |
179 |
} |
180 |
} |
181 |
|
182 |
$ftp->quit; |
183 |
} |
184 |
$newerr = 0; |
185 |
} |
186 |
return @local_files; |
187 |
} |
188 |
|
189 |
sub myerr { |
190 |
my @errors = shift; |
191 |
open my $ediftplog, '>>', $ftplogfile or die "Could not open $ftplogfile\n"; |
192 |
print $ediftplog "Error: ", @errors; |
193 |
close $ediftplog; |
194 |
} |
195 |
|
196 |
sub find_duplicate_quotes { |
197 |
my ( $edi_account_id, $ftpdir, $filename ) = @_; |
198 |
my $dbh = C4::Context->dbh; |
199 |
my $sth = $dbh->prepare( |
200 |
'select edifact_messages.key from edifact_messages |
201 |
inner join vendor_edi_accounts on vendor_edi_accounts.provider=edifact_messages.provider |
202 |
where vendor_edi_accounts.id=? and edifact_messages.remote_file=? and status<>?' |
203 |
); |
204 |
$sth->execute( $edi_account_id, $ftpdir . "/" . $filename, 'Processed' ); |
205 |
my $hits = $sth->fetchall_arrayref( {} ); |
206 |
return $hits; |
207 |
} |
208 |
|
209 |
# updates last activity in acq.edi_account and writes a new entry to acq.edi_message |
210 |
sub LogQuote { |
211 |
my ( $content, $remote, $server, $account_or_id ) = @_; |
212 |
$content or return; |
213 |
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time); |
214 |
my $last_activity = |
215 |
sprintf( "%4d-%02d-%02d", $year + 1900, $mon + 1, $mday ); |
216 |
my $account = record_activity( $account_or_id, $last_activity ); |
217 |
my $message_type = ( $content =~ /'UNH\+\w+\+(\S{6}):/ ) ? $1 : 'QUOTES'; |
218 |
my $dbh = C4::Context->dbh; |
219 |
my $sth = $dbh->prepare( |
220 |
'insert into edifact_messages (message_type, date_sent, provider, |
221 |
status, edi, remote_file) values (?,?,?,?,?,?)' |
222 |
); |
223 |
$sth->execute( $message_type, $last_activity, $account, 'Received', |
224 |
$content, $remote ); |
225 |
my $insert_id = |
226 |
$dbh->last_insert_id( undef, undef, qw(edifact_messages key), undef ); |
227 |
|
228 |
return $insert_id; |
229 |
} |
230 |
|
231 |
sub update_quote_status { |
232 |
my ( $quote_id, $edi_account_id, $basketno ) = @_; |
233 |
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time); |
234 |
my $last_activity = sprintf '%4d-%02d-%02d', $year + 1900, $mon + 1, $mday; |
235 |
my $account = record_activity( $edi_account_id, $last_activity ); |
236 |
my $dbh = C4::Context->dbh; |
237 |
my $sth = $dbh->prepare( |
238 |
'update edifact_messages set edifact_messages.status=?, |
239 |
basketno=? where edifact_messages.key=?' |
240 |
); |
241 |
$sth->execute( 'Processed', $basketno, $quote_id ); |
242 |
} |
243 |
|
244 |
sub record_activity { |
245 |
my ( $account_or_id, $last_activity ) = @_; |
246 |
$account_or_id or return; |
247 |
my $dbh = C4::Context->dbh; |
248 |
my $sth = $dbh->prepare( |
249 |
'update vendor_edi_accounts set last_activity=? where |
250 |
id=?' |
251 |
); |
252 |
$sth->execute( $last_activity, $account_or_id ); |
253 |
$sth = $dbh->prepare('select provider from vendor_edi_accounts where id=?'); |
254 |
$sth->execute($account_or_id); |
255 |
my @result; |
256 |
my $provider; |
257 |
|
258 |
while ( @result = $sth->fetchrow_array() ) { |
259 |
$provider = $result[0]; |
260 |
} |
261 |
return $provider; |
262 |
} |
263 |
|
264 |
sub process_quotes { |
265 |
my ( $self, $quotes ) = @_; |
266 |
foreach my $quote (@$quotes) { |
267 |
my $vendor_san = get_vendor_san( $quote->{account_id} ); |
268 |
my $module = get_vendor_module($vendor_san); |
269 |
$module or return; |
270 |
require "Rebus/EDI/Vendor/$module.pm"; |
271 |
$module = "Rebus::EDI::Vendor::$module"; |
272 |
import $module; |
273 |
my $vendor_module = $module->new(); |
274 |
my @parsed_quote = $vendor_module->parse_quote($quote); |
275 |
use C4::Acquisition; |
276 |
use C4::Biblio; |
277 |
use C4::Items; |
278 |
my $order_id = |
279 |
NewBasket( $quote->{account_id}, 0, $quote->{filename}, '', '', '' ); |
280 |
|
281 |
foreach my $item (@parsed_quote) { |
282 |
foreach my $copy ( @{ $item->{copies} } ) { |
283 |
my $quote_copy = { |
284 |
author => $item->{author}, |
285 |
price => $item->{price}, |
286 |
ecost => get_discounted_price( |
287 |
$quote->{account_id}, $item->{price} |
288 |
), |
289 |
llo => $copy->{llo}, |
290 |
lfn => $copy->{lfn}, |
291 |
lsq => $copy->{lsq}, |
292 |
lst => $copy->{lst}, |
293 |
lcl => $copy->{lcl}, |
294 |
budget_id => get_budget_id( $copy->{lfn} ), |
295 |
title => $item->{title}, |
296 |
isbn => $item->{isbn}, |
297 |
publisher => $item->{publisher}, |
298 |
year => $item->{year}, |
299 |
}; |
300 |
use Rebus::EDI::Custom::Default; |
301 |
my $local_transform = Rebus::EDI::Custom::Default->new(); |
302 |
my $koha_copy = |
303 |
$local_transform->transform_local_quote_copy($quote_copy); |
304 |
|
305 |
my $lsq_identifier = $local_transform->lsq_identifier(); |
306 |
|
307 |
# create biblio record |
308 |
my $record = TransformKohaToMarc( |
309 |
{ |
310 |
"biblio.title" => $koha_copy->{title}, |
311 |
"biblio.author" => $koha_copy->{author} |
312 |
? $koha_copy->{author} |
313 |
: "", |
314 |
"biblio.seriestitle" => "", |
315 |
"biblioitems.isbn" => $koha_copy->{isbn} |
316 |
? $koha_copy->{isbn} |
317 |
: "", |
318 |
"biblioitems.publishercode" => $koha_copy->{publisher} |
319 |
? $koha_copy->{publisher} |
320 |
: "", |
321 |
"biblioitems.publicationyear" => $koha_copy->{year} |
322 |
? $koha_copy->{year} |
323 |
: "", |
324 |
"biblio.copyrightdate" => $koha_copy->{year} |
325 |
? $koha_copy->{year} |
326 |
: "", |
327 |
"biblioitems.cn_source" => "ddc", |
328 |
"items.cn_source" => "ddc", |
329 |
"items.notforloan" => "-1", |
330 |
"items.$lsq_identifier" => $koha_copy->{lsq}, |
331 |
"items.homebranch" => $koha_copy->{llo}, |
332 |
"items.holdingbranch" => $koha_copy->{llo}, |
333 |
"items.booksellerid" => $quote->{account_id}, |
334 |
"items.price" => $koha_copy->{price}, |
335 |
"items.replacementprice" => $koha_copy->{price}, |
336 |
"items.itemcallnumber" => $koha_copy->{lcl}, |
337 |
"items.itype" => $koha_copy->{lst}, |
338 |
"items.cn_sort" => "", |
339 |
} |
340 |
); |
341 |
|
342 |
#check if item already exists in catalogue |
343 |
my ( $biblionumber, $bibitemnumber ) = |
344 |
check_order_item_exists( $item->{isbn} ); |
345 |
|
346 |
if ( !defined $biblionumber ) { |
347 |
|
348 |
# create the record in catalogue, with framework '' |
349 |
( $biblionumber, $bibitemnumber ) = |
350 |
AddBiblio( $record, '' ); |
351 |
} |
352 |
|
353 |
# create order line |
354 |
my %orderinfo = ( |
355 |
basketno => $order_id, |
356 |
ordernumber => "", |
357 |
subscription => "no", |
358 |
uncertainprice => 0, |
359 |
biblionumber => $biblionumber, |
360 |
title => $koha_copy->{title}, |
361 |
quantity => 1, |
362 |
biblioitemnumber => $bibitemnumber, |
363 |
rrp => $koha_copy->{price}, |
364 |
ecost => $koha_copy->{ecost}, |
365 |
sort1 => "", |
366 |
sort2 => "", |
367 |
booksellerinvoicenumber => $item->{item_reference}, |
368 |
listprice => $koha_copy->{price}, |
369 |
branchcode => $koha_copy->{llo}, |
370 |
budget_id => $koha_copy->{budget_id}, |
371 |
); |
372 |
|
373 |
my $orderinfo = \%orderinfo; |
374 |
|
375 |
my ( $retbasketno, $ordernumber ) = NewOrder($orderinfo); |
376 |
|
377 |
# now, add items if applicable |
378 |
if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { |
379 |
my $itemnumber; |
380 |
( $biblionumber, $bibitemnumber, $itemnumber ) = |
381 |
AddItemFromMarc( $record, $biblionumber ); |
382 |
NewOrderItem( $itemnumber, $ordernumber ); |
383 |
} |
384 |
} |
385 |
} |
386 |
update_quote_status( $quote->{logged_quote_id}, |
387 |
$quote->{edi_account_id}, $order_id ); |
388 |
### manipulate quote file on remote server |
389 |
my $vendor_ftp_account = |
390 |
get_vendor_ftp_account( $quote->{edi_account_id} ); |
391 |
$vendor_module->post_process_quote_file( $quote->{filename}, |
392 |
$vendor_ftp_account ); |
393 |
return 1; |
394 |
|
395 |
} |
396 |
} |
397 |
|
398 |
sub get_vendor_ftp_account { |
399 |
my $edi_account_id = shift; |
400 |
my $dbh = C4::Context->dbh; |
401 |
my $sth = $dbh->prepare( |
402 |
'select host,username,password,in_dir from vendor_edi_accounts |
403 |
where id=?' |
404 |
); |
405 |
$sth->execute($edi_account_id); |
406 |
my @result; |
407 |
my $account; |
408 |
while ( @result = $sth->fetchrow_array() ) { |
409 |
$account = { |
410 |
host => $result[0], |
411 |
username => $result[1], |
412 |
password => $result[2], |
413 |
in_dir => $result[3], |
414 |
}; |
415 |
} |
416 |
return $account; |
417 |
} |
418 |
|
419 |
sub get_discounted_price { |
420 |
my ( $booksellerid, $price ) = @_; |
421 |
my $dbh = C4::Context->dbh; |
422 |
my @discount; |
423 |
my $ecost; |
424 |
my $percentage; |
425 |
my $sth = $dbh->prepare('select discount from aqbooksellers where id=?'); |
426 |
$sth->execute($booksellerid); |
427 |
while ( @discount = $sth->fetchrow_array() ) { |
428 |
$percentage = $discount[0]; |
429 |
} |
430 |
$ecost = ( $price - ( ( $percentage * $price ) / 100 ) ); |
431 |
return $ecost; |
432 |
} |
433 |
|
434 |
sub get_budget_id { |
435 |
my $fundcode = shift; |
436 |
my $dbh = C4::Context->dbh; |
437 |
my @funds; |
438 |
my $ecost; |
439 |
my $budget_id; |
440 |
my $sth = |
441 |
$dbh->prepare('select budget_id from aqbudgets where budget_code=?'); |
442 |
$sth->execute($fundcode); |
443 |
while ( @funds = $sth->fetchrow_array() ) { |
444 |
$budget_id = $funds[0]; |
445 |
} |
446 |
return $budget_id; |
447 |
} |
448 |
|
449 |
sub get_vendor_san { |
450 |
my $vendor_id = shift; |
451 |
my $dbh = C4::Context->dbh; |
452 |
my $sth = |
453 |
$dbh->prepare('select san from vendor_edi_accounts where provider=?'); |
454 |
$sth->execute($vendor_id); |
455 |
my @result; |
456 |
my $san; |
457 |
while ( @result = $sth->fetchrow_array() ) { |
458 |
$san = $result[0]; |
459 |
} |
460 |
return $san; |
461 |
} |
462 |
|
463 |
sub get_vendor_module { |
464 |
my $san = shift; |
465 |
my $module; |
466 |
use Rebus::EDI; |
467 |
my @vendor_list = Rebus::EDI::list_vendors(); |
468 |
foreach my $vendor (@vendor_list) { |
469 |
if ( $san eq $vendor->{san} || $san eq $vendor->{ean} ) { |
470 |
$module = $vendor->{module}; |
471 |
last; |
472 |
} |
473 |
} |
474 |
return $module; |
475 |
} |
476 |
|
477 |
sub check_order_item_exists { |
478 |
my $isbn = shift; |
479 |
my $dbh = C4::Context->dbh; |
480 |
my $sth; |
481 |
my @matches; |
482 |
my $biblionumber; |
483 |
my $bibitemnumber; |
484 |
$sth = $dbh->prepare( |
485 |
'select biblionumber, biblioitemnumber from biblioitems where isbn=?'); |
486 |
$sth->execute($isbn); |
487 |
|
488 |
while ( @matches = $sth->fetchrow_array() ) { |
489 |
$biblionumber = $matches[0]; |
490 |
$bibitemnumber = $matches[1]; |
491 |
} |
492 |
if ($biblionumber) { |
493 |
return $biblionumber, $bibitemnumber; |
494 |
} |
495 |
else { |
496 |
use Rebus::EDI; |
497 |
use Business::ISBN; |
498 |
my $edi = Rebus::EDI->new(); |
499 |
$isbn = $edi->cleanisbn($isbn); |
500 |
if ( length($isbn) == 10 ) { |
501 |
$isbn = Business::ISBN->new($isbn); |
502 |
if ($isbn) { |
503 |
if ( $isbn->is_valid ) { |
504 |
$isbn = ( $isbn->as_isbn13 )->isbn; |
505 |
$sth->execute($isbn); |
506 |
while ( @matches = $sth->fetchrow_array() ) { |
507 |
$biblionumber = $matches[0]; |
508 |
$bibitemnumber = $matches[1]; |
509 |
} |
510 |
} |
511 |
} |
512 |
} |
513 |
elsif ( length($isbn) == 13 ) { |
514 |
$isbn = Business::ISBN->new($isbn); |
515 |
if ($isbn) { |
516 |
if ( $isbn->is_valid ) { |
517 |
$isbn = ( $isbn->as_isbn10 )->isbn; |
518 |
$sth->execute($isbn); |
519 |
while ( @matches = $sth->fetchrow_array() ) { |
520 |
$biblionumber = $matches[0]; |
521 |
$bibitemnumber = $matches[1]; |
522 |
} |
523 |
} |
524 |
} |
525 |
} |
526 |
return $biblionumber, $bibitemnumber; |
527 |
} |
528 |
} |
529 |
|
530 |
sub retrieve_orders { |
531 |
my ( $self, $order_id ) = @_; |
532 |
my $dbh = C4::Context->dbh; |
533 |
my @active_orders; |
534 |
|
535 |
## retrieve basic order details |
536 |
my $sth = $dbh->prepare( |
537 |
'select booksellerid as provider from aqbasket where basketno=?'); |
538 |
$sth->execute($order_id); |
539 |
my $orders = $sth->fetchall_arrayref( {} ); |
540 |
|
541 |
foreach my $order ( @{$orders} ) { |
542 |
push @active_orders, |
543 |
{ order_id => $order_id, provider_id => $order->{provider} }; |
544 |
} |
545 |
return \@active_orders; |
546 |
} |
547 |
|
548 |
sub retrieve_order_details { |
549 |
my ( $self, $orders, $ean ) = @_; |
550 |
my @fleshed_orders; |
551 |
foreach my $order ( @{$orders} ) { |
552 |
my $fleshed_order; |
553 |
$fleshed_order = { |
554 |
order_id => $order->{order_id}, |
555 |
provider_id => $order->{provider_id} |
556 |
}; |
557 |
|
558 |
## retrieve module for vendor |
559 |
my $dbh = C4::Context->dbh; |
560 |
my $sth = |
561 |
$dbh->prepare('select san from vendor_edi_accounts where provider=?'); |
562 |
$sth->execute( $order->{provider_id} ); |
563 |
my @result; |
564 |
my $san; |
565 |
while ( @result = $sth->fetchrow_array() ) { |
566 |
$san = $result[0]; |
567 |
} |
568 |
$fleshed_order->{'module'} = get_vendor_module($san); |
569 |
$fleshed_order->{'san_or_ean'} = $san; |
570 |
$fleshed_order->{'org_san'} = $ean; |
571 |
$fleshed_order->{'quote_or_order'} = |
572 |
quote_or_order( $order->{order_id} ); |
573 |
my @lineitems = get_order_lineitems( $order->{order_id} ); |
574 |
$fleshed_order->{'lineitems'} = \@lineitems; |
575 |
|
576 |
push @fleshed_orders, $fleshed_order; |
577 |
} |
578 |
return \@fleshed_orders; |
579 |
} |
580 |
|
581 |
sub create_order_file { |
582 |
my ( $self, $order_message, $order_id ) = @_; |
583 |
my $filename = "$edidir/ediorder_$order_id.CEP"; |
584 |
open my $ediorder, '>', $filename; |
585 |
print $ediorder $order_message; |
586 |
close $ediorder; |
587 |
my $vendor_ftp_account = get_vendor_ftp_account_by_order_id($order_id); |
588 |
my $sent_order = |
589 |
send_order_message( $filename, $vendor_ftp_account, $order_message, |
590 |
$order_id ); |
591 |
return $filename; |
592 |
} |
593 |
|
594 |
sub get_vendor_ftp_account_by_order_id { |
595 |
my $order_id = shift; |
596 |
my $vendor_ftp_account; |
597 |
my @result; |
598 |
my $dbh = C4::Context->dbh; |
599 |
my $sth = $dbh->prepare( |
600 |
'select vendor_edi_accounts.* from vendor_edi_accounts, aqbasket |
601 |
where vendor_edi_accounts.provider=aqbasket.booksellerid and aqbasket.basketno=?' |
602 |
); |
603 |
$sth->execute($order_id); |
604 |
while ( @result = $sth->fetchrow_array() ) { |
605 |
$vendor_ftp_account->{id} = $result[0]; |
606 |
$vendor_ftp_account->{label} = $result[1]; |
607 |
$vendor_ftp_account->{host} = $result[2]; |
608 |
$vendor_ftp_account->{username} = $result[3]; |
609 |
$vendor_ftp_account->{password} = $result[4]; |
610 |
$vendor_ftp_account->{path} = $result[7]; |
611 |
$vendor_ftp_account->{last_activity} = $result[5]; |
612 |
$vendor_ftp_account->{provider} = $result[6]; |
613 |
$vendor_ftp_account->{in_dir} = $result[7]; |
614 |
$vendor_ftp_account->{edi_account_id} = $result[0]; |
615 |
} |
616 |
return $vendor_ftp_account; |
617 |
} |
618 |
|
619 |
sub send_order_message { |
620 |
my ( $filename, $ftpaccount, $order_message, $order_id ) = @_; |
621 |
my @ERRORS; |
622 |
my $newerr; |
623 |
my $result; |
624 |
|
625 |
open my $ediftplog, '>>', $ftplogfile or die "Could not open $ftplogfile\n"; |
626 |
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time); |
627 |
printf $ediftplog "\n\n%4d-%02d-%02d %02d:%02d:%02d\n-----\n", $year + 1900, |
628 |
$mon + 1, $mday, $hour, $min, $sec; |
629 |
|
630 |
# check edi order file exists |
631 |
if ( -e $filename ) { |
632 |
use Net::FTP; |
633 |
|
634 |
print $ediftplog "Connecting to " . $ftpaccount->{host} . "... "; |
635 |
|
636 |
# connect to ftp account |
637 |
my $ftp = |
638 |
Net::FTP->new( $ftpaccount->{host}, Timeout => 10, Passive => 1 ) |
639 |
or $newerr = 1; |
640 |
push @ERRORS, "Can't ftp to " . $ftpaccount->{host} . ": $!\n" |
641 |
if $newerr; |
642 |
myerr(@ERRORS) if $newerr; |
643 |
if ( !$newerr ) { |
644 |
$newerr = 0; |
645 |
print $ediftplog "connected.\n"; |
646 |
|
647 |
# login |
648 |
$ftp->login( "$ftpaccount->{username}", "$ftpaccount->{password}" ) |
649 |
or $newerr = 1; |
650 |
$ftp->quit if $newerr; |
651 |
print $ediftplog "Logging in...\n"; |
652 |
push @ERRORS, "Can't login to " . $ftpaccount->{host} . ": $!\n" |
653 |
if $newerr; |
654 |
myerr(@ERRORS) if $newerr; |
655 |
if ( !$newerr ) { |
656 |
print $ediftplog "Logged in\n"; |
657 |
|
658 |
# cd to directory |
659 |
$ftp->cwd("$ftpaccount->{path}") or $newerr = 1; |
660 |
push @ERRORS, |
661 |
"Can't cd in server " . $ftpaccount->{host} . " $!\n" |
662 |
if $newerr; |
663 |
myerr(@ERRORS) if $newerr; |
664 |
$ftp->quit if $newerr; |
665 |
|
666 |
# put file |
667 |
if ( !$newerr ) { |
668 |
$newerr = 0; |
669 |
$ftp->put($filename) or $newerr = 1; |
670 |
push @ERRORS, |
671 |
"Can't write order file to server " |
672 |
. $ftpaccount->{host} . " $!\n" |
673 |
if $newerr; |
674 |
myerr(@ERRORS) if $newerr; |
675 |
$ftp->quit if $newerr; |
676 |
if ( !$newerr ) { |
677 |
print $ediftplog |
678 |
"File: $filename transferred successfully\n"; |
679 |
$ftp->quit; |
680 |
unlink($filename); |
681 |
record_activity( $ftpaccount->{id} ); |
682 |
log_order( |
683 |
$order_message, |
684 |
$ftpaccount->{path} . substr( $filename, 4 ), |
685 |
$ftpaccount->{edi_account_id}, |
686 |
$order_id |
687 |
); |
688 |
|
689 |
return $result; |
690 |
} |
691 |
} |
692 |
} |
693 |
} |
694 |
} |
695 |
else { |
696 |
print $ediftplog "Order file $filename does not exist\n"; |
697 |
} |
698 |
} |
699 |
|
700 |
sub log_order { |
701 |
my ( $content, $remote, $edi_account_id, $order_id ) = @_; |
702 |
my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time); |
703 |
my $date_sent = sprintf( "%4d-%02d-%02d", $year + 1900, $mon + 1, $mday ); |
704 |
|
705 |
my $dbh = C4::Context->dbh; |
706 |
my $sth = $dbh->prepare( |
707 |
'insert into edifact_messages (message_type,date_sent,provider,status,basketno, |
708 |
edi,remote_file) values (?,?,?,?,?,?,?)' |
709 |
); |
710 |
$sth->execute( 'ORDER', $date_sent, $edi_account_id, 'Sent', $order_id, |
711 |
$content, $remote ); |
712 |
} |
713 |
|
714 |
sub quote_or_order { |
715 |
my $order_id = shift; |
716 |
my @result; |
717 |
my $quote_or_order; |
718 |
my $dbh = C4::Context->dbh; |
719 |
my $sth = $dbh->prepare( |
720 |
'select edifact_messages.key from edifact_messages |
721 |
where basketno=? and message_type=?' |
722 |
); |
723 |
$sth->execute( $order_id, 'QUOTES' ); |
724 |
if ( $sth->rows == 0 ) { |
725 |
$quote_or_order = 'o'; |
726 |
} |
727 |
else { |
728 |
$quote_or_order = 'q'; |
729 |
} |
730 |
return $quote_or_order; |
731 |
} |
732 |
|
733 |
sub get_order_lineitems { |
734 |
my $order_id = shift; |
735 |
use C4::Acquisition; |
736 |
my @lineitems = GetOrders($order_id); |
737 |
my @fleshed_lineitems; |
738 |
foreach my $lineitem (@lineitems) { |
739 |
use Rebus::EDI; |
740 |
my $clean_isbn = Rebus::EDI::cleanisbn( $lineitem->{isbn} ); |
741 |
my $fleshed_lineitem; |
742 |
$fleshed_lineitem->{binding} = 'O'; |
743 |
$fleshed_lineitem->{currency} = 'GBP'; |
744 |
$fleshed_lineitem->{id} = $lineitem->{ordernumber}; |
745 |
$fleshed_lineitem->{qli} = $lineitem->{booksellerinvoicenumber}; |
746 |
$fleshed_lineitem->{rff} = $order_id . "/" . $fleshed_lineitem->{id}; |
747 |
$fleshed_lineitem->{isbn} = $clean_isbn; |
748 |
$fleshed_lineitem->{title} = $lineitem->{title}; |
749 |
$fleshed_lineitem->{author} = $lineitem->{author}; |
750 |
$fleshed_lineitem->{publisher} = $lineitem->{publishercode}; |
751 |
$fleshed_lineitem->{year} = $lineitem->{copyrightdate}; |
752 |
$fleshed_lineitem->{price} = sprintf "%.2f", $lineitem->{listprice}; |
753 |
$fleshed_lineitem->{quantity} = '1'; |
754 |
|
755 |
my @lineitem_copies; |
756 |
my $fleshed_lineitem_detail; |
757 |
my ( $branchcode, $callnumber, $itype, $location, $fund ) = |
758 |
get_lineitem_additional_info( $lineitem->{ordernumber} ); |
759 |
$fleshed_lineitem_detail->{llo} = $branchcode; |
760 |
$fleshed_lineitem_detail->{lfn} = $fund; |
761 |
$fleshed_lineitem_detail->{lsq} = $location; |
762 |
$fleshed_lineitem_detail->{lst} = $itype; |
763 |
$fleshed_lineitem_detail->{lcl} = $callnumber; |
764 |
$fleshed_lineitem_detail->{note} = $lineitem->{notes}; |
765 |
push( @lineitem_copies, $fleshed_lineitem_detail ); |
766 |
|
767 |
$fleshed_lineitem->{copies} = \@lineitem_copies; |
768 |
push( @fleshed_lineitems, $fleshed_lineitem ); |
769 |
} |
770 |
return @fleshed_lineitems; |
771 |
} |
772 |
|
773 |
sub get_lineitem_additional_info { |
774 |
my $ordernumber = shift; |
775 |
my @rows; |
776 |
my $homebranch; |
777 |
my $callnumber; |
778 |
my $itype; |
779 |
my $location; |
780 |
my $fund; |
781 |
use Rebus::EDI::Custom::Default; |
782 |
my $local_transform = Rebus::EDI::Custom::Default->new(); |
783 |
my $lsq_identifier = $local_transform->lsq_identifier(); |
784 |
my $dbh = C4::Context->dbh; |
785 |
my $sth = $dbh->prepare( |
786 |
"select items.homebranch, items.itemcallnumber, items.itype, |
787 |
items.$lsq_identifier from items inner join aqorders_items on |
788 |
aqorders_items.itemnumber=items.itemnumber where aqorders_items.ordernumber=?" |
789 |
); |
790 |
$sth->execute($ordernumber); |
791 |
|
792 |
while ( @rows = $sth->fetchrow_array() ) { |
793 |
$homebranch = $rows[0]; |
794 |
$callnumber = $rows[1]; |
795 |
$itype = $rows[2]; |
796 |
$location = $rows[3]; |
797 |
} |
798 |
$sth = $dbh->prepare( |
799 |
"select aqbudgets.budget_code from aqbudgets inner join aqorders on |
800 |
aqorders.budget_id=aqbudgets.budget_id where aqorders.ordernumber=?" |
801 |
); |
802 |
$sth->execute($ordernumber); |
803 |
while ( @rows = $sth->fetchrow_array() ) { |
804 |
$fund = $rows[0]; |
805 |
} |
806 |
return $homebranch, $callnumber, $itype, $location, $fund; |
807 |
} |
808 |
|
809 |
1; |