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