|
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 |