View | Details | Raw Unified | Return to bug 7736
Collapse All | Expand All

(-)a/C4/Acquisition.pm (-1 / +5 lines)
Lines 2477-2482 sub GetInvoices { Link Here
2477
        push @bind_strs, " borrowers.branchcode = ? ";
2477
        push @bind_strs, " borrowers.branchcode = ? ";
2478
        push @bind_args, $args{branchcode};
2478
        push @bind_args, $args{branchcode};
2479
    }
2479
    }
2480
    if($args{message_id}) {
2481
        push @bind_strs, " aqinvoices.message_id = ? ";
2482
        push @bind_args, $args{message_id};
2483
    }
2480
2484
2481
    $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2485
    $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2482
    $query .= " GROUP BY aqinvoices.invoiceid ";
2486
    $query .= " GROUP BY aqinvoices.invoiceid ";
Lines 2601-2607 sub AddInvoice { Link Here
2601
    return unless(%invoice and $invoice{invoicenumber});
2605
    return unless(%invoice and $invoice{invoicenumber});
2602
2606
2603
    my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2607
    my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2604
        closedate shipmentcost shipmentcost_budgetid);
2608
        closedate shipmentcost shipmentcost_budgetid message_id);
2605
2609
2606
    my @set_strs;
2610
    my @set_strs;
2607
    my @set_args;
2611
    my @set_args;
(-)a/C4/Installer/PerlDependencies.pm (+10 lines)
Lines 787-792 our $PERL_DEPS = { Link Here
787
        'required' => '0',
787
        'required' => '0',
788
        'min_ver'  => '0.03',
788
        'min_ver'  => '0.03',
789
    },
789
    },
790
    'Net::SFTP::Foreign' => {
791
        'usage'    => 'Edifact',
792
        'required' => '0',
793
        'min_ver'  => '1.73',
794
    },
795
    'Text::Unidecode' => {
796
        'usage'    => 'Edifact',
797
        'required' => '0',
798
        'min_ver'  => '0.04',
799
    },
790
};
800
};
791
801
792
1;
802
1;
(-)a/Koha/EDI.pm (+1150 lines)
Line 0 Link Here
1
package Koha::EDI;
2
3
# Copyright 2014,2015 PTFS-Europe Ltd
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use strict;
21
use warnings;
22
use base qw(Exporter);
23
use utf8;
24
use Carp;
25
use English qw{ -no_match_vars };
26
use Business::ISBN;
27
use DateTime;
28
use C4::Context;
29
use Koha::Database;
30
use C4::Acquisition qw( NewBasket CloseBasket ModOrder);
31
use C4::Suggestions qw( ModSuggestion );
32
use C4::Items qw(AddItem);
33
use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio );
34
use Koha::Edifact::Order;
35
use Koha::Edifact;
36
use Log::Log4perl;
37
use Text::Unidecode;
38
39
our $VERSION = 1.1;
40
our @EXPORT_OK =
41
  qw( process_quote process_invoice process_ordrsp create_edi_order get_edifact_ean );
42
43
sub create_edi_order {
44
    my $parameters = shift;
45
    my $basketno   = $parameters->{basketno};
46
    my $ean        = $parameters->{ean};
47
    my $branchcode = $parameters->{branchcode};
48
    my $noingest   = $parameters->{noingest};
49
    $ean ||= C4::Context->preference('EDIfactEAN');
50
    if ( !$basketno || !$ean ) {
51
        carp 'create_edi_order called with no basketno or ean';
52
        return;
53
    }
54
55
    my $schema = Koha::Database->new()->schema();
56
57
    my @orderlines = $schema->resultset('Aqorder')->search(
58
        {
59
            basketno    => $basketno,
60
            orderstatus => 'new',
61
        }
62
    )->all;
63
64
    if ( !@orderlines ) {
65
        carp "No orderlines for basket $basketno";
66
        return;
67
    }
68
69
    my $vendor = $schema->resultset('VendorEdiAccount')->search(
70
        {
71
            vendor_id => $orderlines[0]->basketno->booksellerid->id,
72
        }
73
    )->single;
74
75
    my $ean_search_keys = { ean => $ean, };
76
    if ($branchcode) {
77
        $ean_search_keys->{branchcode} = $branchcode;
78
    }
79
    my $ean_obj =
80
      $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
81
82
    my $dbh     = C4::Context->dbh;
83
    my $arr_ref = $dbh->selectcol_arrayref(
84
'select id from edifact_messages where basketno = ? and message_type = \'QUOTE\'',
85
        {}, $basketno
86
    );
87
    my $response = @{$arr_ref} ? 1 : 0;
88
89
    my $edifact = Koha::Edifact::Order->new(
90
        {
91
            orderlines  => \@orderlines,
92
            vendor      => $vendor,
93
            ean         => $ean_obj,
94
            is_response => $response,
95
        }
96
    );
97
    if ( !$edifact ) {
98
        return;
99
    }
100
101
    my $order_file = $edifact->encode();
102
103
    # ingest result
104
    if ($order_file) {
105
        my $m = unidecode($order_file);  # remove diacritics and non-latin chars
106
        if ($noingest) {                 # allows scripts to produce test files
107
            return $m;
108
        }
109
        my $order = {
110
            message_type  => 'ORDERS',
111
            raw_msg       => $m,
112
            vendor_id     => $vendor->vendor_id,
113
            status        => 'Pending',
114
            basketno      => $basketno,
115
            filename      => $edifact->filename(),
116
            transfer_date => $edifact->msg_date_string(),
117
            edi_acct      => $vendor->id,
118
119
        };
120
        $schema->resultset('EdifactMessage')->create($order);
121
        return 1;
122
    }
123
124
    return;
125
}
126
127
sub process_ordrsp {
128
    my $response_message = shift;
129
    $response_message->status('processing');
130
    $response_message->update;
131
    my $schema = Koha::Database->new()->schema();
132
    my $logger = Log::Log4perl->get_logger();
133
    my $vendor_acct;
134
    my $edi =
135
      Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
136
    my $messages = $edi->message_array();
137
138
    if ( @{$messages} ) {
139
        foreach my $msg ( @{$messages} ) {
140
            my $lines = $msg->lineitems();
141
            foreach my $line ( @{$lines} ) {
142
                my $ordernumber = $line->ordernumber();
143
144
       # action cancelled:change_requested:no_action:accepted:not_found:recorded
145
                my $action = $line->action_notification();
146
                if ( $action eq 'cancelled' ) {
147
                    my $reason = $line->coded_orderline_text();
148
                    ModOrder(
149
                        {
150
                            ordernumber             => $ordernumber,
151
                            cancellationreason      => $reason,
152
                            orderstatus             => 'cancelled',
153
                            datecancellationprinted => DateTime->now()->ymd(),
154
                        }
155
                    );
156
                }
157
                else {    # record order as due with possible further info
158
159
                    my $report     = $line->coded_orderline_text();
160
                    my $date_avail = $line->availability_date();
161
                    $report ||= q{};
162
                    if ($date_avail) {
163
                        $report .= " Available: $date_avail";
164
                    }
165
                    ModOrder(
166
                        {
167
                            ordernumber      => $ordernumber,
168
                            suppliers_report => $report,
169
                        }
170
                    );
171
                }
172
            }
173
        }
174
    }
175
176
    $response_message->status('received');
177
    $response_message->update;
178
    return;
179
}
180
181
sub process_invoice {
182
    my $invoice_message = shift;
183
    $invoice_message->status('processing');
184
    $invoice_message->update;
185
    my $schema = Koha::Database->new()->schema();
186
    my $logger = Log::Log4perl->get_logger();
187
    my $vendor_acct;
188
    my $edi =
189
      Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
190
    my $messages = $edi->message_array();
191
192
    if ( @{$messages} ) {
193
194
        # BGM contains an invoice number
195
        foreach my $msg ( @{$messages} ) {
196
            my $invoicenumber  = $msg->docmsg_number();
197
            my $shipmentcharge = $msg->shipment_charge();
198
            my $msg_date       = $msg->message_date;
199
            my $tax_date       = $msg->tax_point_date;
200
            if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
201
                $tax_date = $msg_date;
202
            }
203
204
            my $vendor_ean = $msg->supplier_ean;
205
            if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
206
                $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
207
                    {
208
                        san => $vendor_ean,
209
                    }
210
                )->single;
211
            }
212
            if ( !$vendor_acct ) {
213
                carp
214
"Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
215
                next;
216
            }
217
            $invoice_message->edi_acct( $vendor_acct->id );
218
            $logger->trace("Adding invoice:$invoicenumber");
219
            my $new_invoice = $schema->resultset('Aqinvoice')->create(
220
                {
221
                    invoicenumber         => $invoicenumber,
222
                    booksellerid          => $invoice_message->vendor_id,
223
                    shipmentdate          => $msg_date,
224
                    billingdate           => $tax_date,
225
                    shipmentcost          => $shipmentcharge,
226
                    shipmentcost_budgetid => $vendor_acct->shipment_budget,
227
                    message_id            => $invoice_message->id,
228
                }
229
            );
230
            my $invoiceid = $new_invoice->invoiceid;
231
            $logger->trace("Added as invoiceno :$invoiceid");
232
            my $lines = $msg->lineitems();
233
234
            foreach my $line ( @{$lines} ) {
235
                my $ordernumber = $line->ordernumber;
236
                $logger->trace( "Receipting order:$ordernumber Qty: ",
237
                    $line->quantity );
238
239
                my $order = $schema->resultset('Aqorder')->find($ordernumber);
240
241
      # ModReceiveOrder does not validate that $ordernumber exists validate here
242
                if ($order) {
243
244
                    # check suggestions
245
                    my $s = $schema->resultset('Suggestion')->search(
246
                        {
247
                            biblionumber => $order->biblionumber->biblionumber,
248
                        }
249
                    )->single;
250
                    if ($s) {
251
                        ModSuggestion(
252
                            {
253
                                suggestionid => $s->suggestionid,
254
                                STATUS       => 'AVAILABLE',
255
                            }
256
                        );
257
                    }
258
259
                    my $price = _get_invoiced_price($line);
260
261
                    if ( $order->quantity > $line->quantity ) {
262
                        my $ordered = $order->quantity;
263
264
                        # part receipt
265
                        $order->orderstatus('partial');
266
                        $order->quantity( $ordered - $line->quantity );
267
                        $order->update;
268
                        my $received_order = $order->copy(
269
                            {
270
                                ordernumber      => undef,
271
                                quantity         => $line->quantity,
272
                                quantityreceived => $line->quantity,
273
                                orderstatus      => 'complete',
274
                                unitprice        => $price,
275
                                invoiceid        => $invoiceid,
276
                                datereceived     => $msg_date,
277
                            }
278
                        );
279
                        transfer_items( $schema, $line, $order,
280
                            $received_order );
281
                        receipt_items( $schema, $line,
282
                            $received_order->ordernumber );
283
                    }
284
                    else {    # simple receipt all copies on order
285
                        $order->quantityreceived( $line->quantity );
286
                        $order->datereceived($msg_date);
287
                        $order->invoiceid($invoiceid);
288
                        $order->unitprice($price);
289
                        $order->orderstatus('complete');
290
                        $order->update;
291
                        receipt_items( $schema, $line, $ordernumber );
292
                    }
293
                }
294
                else {
295
                    $logger->error(
296
                        "No order found for $ordernumber Invoice:$invoicenumber"
297
                    );
298
                    next;
299
                }
300
301
            }
302
303
        }
304
    }
305
306
    $invoice_message->status('received');
307
    $invoice_message->update;    # status and basketno link
308
    return;
309
}
310
311
sub _get_invoiced_price {
312
    my $line  = shift;
313
    my $price = $line->price_net;
314
    if ( !defined $price ) {  # no net price so generate it from lineitem amount
315
        $price = $line->amt_lineitem;
316
        if ( $price and $line->quantity > 1 ) {
317
            $price /= $line->quantity;    # div line cost by qty
318
        }
319
    }
320
    return $price;
321
}
322
323
sub receipt_items {
324
    my ( $schema, $inv_line, $ordernumber ) = @_;
325
    my $logger   = Log::Log4perl->get_logger();
326
    my $quantity = $inv_line->quantity;
327
328
    # itemnumber is not a foreign key ??? makes this a bit cumbersome
329
    my @item_links = $schema->resultset('AqordersItem')->search(
330
        {
331
            ordernumber => $ordernumber,
332
        }
333
    );
334
    my %branch_map;
335
    foreach my $ilink (@item_links) {
336
        my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
337
        if ( !$item ) {
338
            my $i = $ilink->itemnumber;
339
            $logger->warn(
340
                "Cannot find aqorder item for $i :Order:$ordernumber");
341
            next;
342
        }
343
        my $b = $item->homebranch->branchcode;
344
        if ( !exists $branch_map{$b} ) {
345
            $branch_map{$b} = [];
346
        }
347
        push @{ $branch_map{$b} }, $item;
348
    }
349
    my $gir_occurence = 0;
350
    while ( $gir_occurence < $quantity ) {
351
        my $branch = $inv_line->girfield( 'branch', $gir_occurence );
352
        my $item = shift @{ $branch_map{$branch} };
353
        if ($item) {
354
            my $barcode = $inv_line->girfield( 'barcode', $gir_occurence );
355
            if ( $barcode && !$item->barcode ) {
356
                my $rs = $schema->resultset('Item')->search(
357
                    {
358
                        barcode => $barcode,
359
                    }
360
                );
361
                if ( $rs->count > 0 ) {
362
                    $logger->warn("Barcode $barcode is a duplicate");
363
                }
364
                else {
365
366
                    $logger->trace("Adding barcode $barcode");
367
                    $item->barcode($barcode);
368
                }
369
            }
370
371
            $item->update;
372
        }
373
        else {
374
            $logger->warn("Unmatched item at branch:$branch");
375
        }
376
        ++$gir_occurence;
377
    }
378
    return;
379
380
}
381
382
sub transfer_items {
383
    my ( $schema, $inv_line, $order_from, $order_to ) = @_;
384
385
    # Transfer x items from the orig order to a completed partial order
386
    my $quantity = $inv_line->quantity;
387
    my $gocc     = 0;
388
    my %mapped_by_branch;
389
    while ( $gocc < $quantity ) {
390
        my $branch = $inv_line->girfield( 'branch', $gocc );
391
        if ( !exists $mapped_by_branch{$branch} ) {
392
            $mapped_by_branch{$branch} = 1;
393
        }
394
        else {
395
            $mapped_by_branch{$branch}++;
396
        }
397
        ++$gocc;
398
    }
399
    my $logger = Log::Log4perl->get_logger();
400
    my $o1     = $order_from->ordernumber;
401
    my $o2     = $order_to->ordernumber;
402
    $logger->warn("transferring $quantity copies from order $o1 to order $o2");
403
404
    my @item_links = $schema->resultset('AqordersItem')->search(
405
        {
406
            ordernumber => $order_from->ordernumber,
407
        }
408
    );
409
    foreach my $ilink (@item_links) {
410
        my $ino      = $ilink->itemnumber;
411
        my $item     = $schema->resultset('Item')->find( $ilink->itemnumber );
412
        my $i_branch = $item->homebranch;
413
        if ( exists $mapped_by_branch{$i_branch}
414
            && $mapped_by_branch{$i_branch} > 0 )
415
        {
416
            $ilink->ordernumber( $order_to->ordernumber );
417
            $ilink->update;
418
            --$quantity;
419
            --$mapped_by_branch{$i_branch};
420
            $logger->warn("Transferred item $item");
421
        }
422
        else {
423
            $logger->warn("Skipped item $item");
424
        }
425
        if ( $quantity < 1 ) {
426
            last;
427
        }
428
    }
429
430
    return;
431
}
432
433
sub process_quote {
434
    my $quote = shift;
435
436
    $quote->status('processing');
437
    $quote->update;
438
439
    my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
440
441
    my $messages       = $edi->message_array();
442
    my $process_errors = 0;
443
    my $logger         = Log::Log4perl->get_logger();
444
    my $schema         = Koha::Database->new()->schema();
445
    my $message_count  = 0;
446
    my @added_baskets;    # if auto & multiple baskets need to order all
447
448
    if ( @{$messages} && $quote->vendor_id ) {
449
        foreach my $msg ( @{$messages} ) {
450
            ++$message_count;
451
            my $basketno =
452
              NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
453
                q{} . q{} );
454
            push @added_baskets, $basketno;
455
            if ( $message_count > 1 ) {
456
                my $m_filename = $quote->filename;
457
                $m_filename .= "_$message_count";
458
                $schema->resultset('EdifactMessage')->create(
459
                    {
460
                        message_type  => $quote->message_type,
461
                        transfer_date => $quote->transfer_date,
462
                        vendor_id     => $quote->vendor_id,
463
                        edi_acct      => $quote->edi_acct,
464
                        status        => 'recmsg',
465
                        basketno      => $basketno,
466
                        raw_msg       => q{},
467
                        filename      => $m_filename,
468
                    }
469
                );
470
            }
471
            else {
472
                $quote->basketno($basketno);
473
            }
474
            $logger->trace("Created basket :$basketno");
475
            my $items  = $msg->lineitems();
476
            my $refnum = $msg->message_refno;
477
478
            for my $item ( @{$items} ) {
479
                if ( !quote_item( $item, $quote, $basketno ) ) {
480
                    ++$process_errors;
481
                }
482
            }
483
        }
484
    }
485
    my $status = 'received';
486
    if ($process_errors) {
487
        $status = 'error';
488
    }
489
490
    $quote->status($status);
491
    $quote->update;    # status and basketno link
492
                       # Do we automatically generate orders for this vendor
493
    my $v = $schema->resultset('VendorEdiAccount')->search(
494
        {
495
            vendor_id => $quote->vendor_id,
496
        }
497
    )->single;
498
    if ( $v->auto_orders ) {
499
        for my $b (@added_baskets) {
500
            create_edi_order(
501
                {
502
503
                    basketno => $b,
504
                }
505
            );
506
            CloseBasket($b);
507
        }
508
    }
509
510
    return;
511
}
512
513
sub quote_item {
514
    my ( $item, $quote, $basketno ) = @_;
515
516
    my $schema = Koha::Database->new()->schema();
517
518
    # create biblio record
519
    my $logger = Log::Log4perl->get_logger();
520
    if ( !$basketno ) {
521
        $logger->error('Skipping order creation no basketno');
522
        return;
523
    }
524
    $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
525
    my $bib = _check_for_existing_bib( $item->item_number_id() );
526
    if ( !defined $bib ) {
527
        $bib = {};
528
        my $bib_record = _create_bib_from_quote( $item, $quote );
529
        ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
530
          AddBiblio( $bib_record, q{} );
531
        $logger->trace("New biblio added $bib->{biblionumber}");
532
    }
533
    else {
534
        $logger->trace("Match found: $bib->{biblionumber}");
535
    }
536
537
    # Create an orderline
538
    my $order_note = $item->{orderline_free_text};
539
    $order_note ||= q{};
540
    my $order_quantity = $item->quantity();
541
    my $gir_count      = $item->number_of_girs();
542
    $order_quantity ||= 1;    # quantity not necessarily present
543
    if ( $gir_count > 1 ) {
544
        if ( $gir_count != $order_quantity ) {
545
            $logger->error(
546
                "Order for $order_quantity items, $gir_count segments present");
547
        }
548
        $order_quantity = 1;    # attempts to create an orderline for each gir
549
    }
550
551
    # database definitions should set some of these defaults but dont
552
    my $order_hash = {
553
        biblionumber       => $bib->{biblionumber},
554
        entrydate          => DateTime->now( time_zone => 'local' )->ymd(),
555
        basketno           => $basketno,
556
        listprice          => $item->price,
557
        quantity           => $order_quantity,
558
        quantityreceived   => 0,
559
        order_vendornote   => q{},
560
        order_internalnote => $order_note,
561
        rrp                => $item->price,
562
        ecost => _discounted_price( $quote->vendor->discount, $item->price ),
563
        uncertainprice => 0,
564
        sort1          => q{},
565
        sort2          => q{},
566
    };
567
568
    # suppliers references
569
    if ( $item->reference() ) {
570
        $order_hash->{suppliers_reference_number}    = $item->reference;
571
        $order_hash->{suppliers_reference_qualifier} = 'QLI';
572
    }
573
    elsif ( $item->orderline_reference_number() ) {
574
        $order_hash->{suppliers_reference_number} =
575
          $item->orderline_reference_number;
576
        $order_hash->{suppliers_reference_qualifier} = 'SLI';
577
    }
578
    if ( $item->item_number_id ) {    # suppliers ean
579
        $order_hash->{line_item_id} = $item->item_number_id;
580
    }
581
582
    if ( $item->girfield('servicing_instruction') ) {
583
        my $occ = 0;
584
        my $txt = q{};
585
        my $si;
586
        while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
587
            if ($occ) {
588
                $txt .= q{: };
589
            }
590
            $txt .= $si;
591
            ++$occ;
592
        }
593
        $order_hash->{order_vendornote} = $txt;
594
    }
595
596
    if ( $item->internal_notes() ) {
597
        if ( $order_hash->{order_internalnote} ) {    # more than ''
598
            $order_hash->{order_internalnote} .= q{ };
599
        }
600
        $order_hash->{order_internalnote} .= $item->internal_notes;
601
    }
602
603
    my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
604
605
    my $skip = '0';
606
    if ( !$budget ) {
607
        if ( $item->quantity > 1 ) {
608
            carp 'Skipping line with no budget info';
609
            $logger->trace('girfield skipped for invalid budget');
610
            $skip++;
611
        }
612
        else {
613
            carp 'Skipping line with no budget info';
614
            $logger->trace('orderline skipped for invalid budget');
615
            return;
616
        }
617
    }
618
619
    my %ordernumber;
620
    my %budgets;
621
    my $item_hash;
622
623
    if ( !$skip ) {
624
        $order_hash->{budget_id} = $budget->budget_id;
625
        my $first_order = $schema->resultset('Aqorder')->create($order_hash);
626
        my $o           = $first_order->ordernumber();
627
        $logger->trace("Order created :$o");
628
629
        # should be done by database settings
630
        $first_order->parent_ordernumber( $first_order->ordernumber() );
631
        $first_order->update();
632
633
        # add to $budgets to prevent duplicate orderlines
634
        $budgets{ $budget->budget_id } = '1';
635
636
        # record ordernumber against budget
637
        $ordernumber{ $budget->budget_id } = $o;
638
639
        if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
640
            $item_hash = _create_item_from_quote( $item, $quote );
641
642
            my $created = 0;
643
            while ( $created < $order_quantity ) {
644
                my $itemnumber;
645
                ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber )
646
                  = AddItem( $item_hash, $bib->{biblionumber} );
647
                $logger->trace("Added item:$itemnumber");
648
                $schema->resultset('AqordersItem')->create(
649
                    {
650
                        ordernumber => $first_order->ordernumber,
651
                        itemnumber  => $itemnumber,
652
                    }
653
                );
654
                ++$created;
655
            }
656
        }
657
    }
658
659
    if ( $order_quantity == 1 && $item->quantity > 1 ) {
660
        my $occurence = 1;    # occ zero already added
661
        while ( $occurence < $item->quantity ) {
662
663
            # check budget code
664
            $budget = _get_budget( $schema,
665
                $item->girfield( 'fund_allocation', $occurence ) );
666
667
            if ( !$budget ) {
668
                my $bad_budget =
669
                  $item->girfield( 'fund_allocation', $occurence );
670
                carp 'Skipping line with no budget info';
671
                $logger->trace(
672
                    "girfield skipped for invalid budget:$bad_budget");
673
                ++$occurence;    ## lets look at the next one not this one again
674
                next;
675
            }
676
677
            # add orderline for NEW budget in $budgets
678
            if ( !exists $budgets{ $budget->budget_id } ) {
679
680
                # $order_hash->{quantity} = 1; by default above
681
                # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
682
683
                $order_hash->{budget_id} = $budget->budget_id;
684
685
                my $new_order =
686
                  $schema->resultset('Aqorder')->create($order_hash);
687
                my $o = $new_order->ordernumber();
688
                $logger->trace("Order created :$o");
689
690
                # should be done by database settings
691
                $new_order->parent_ordernumber( $new_order->ordernumber() );
692
                $new_order->update();
693
694
                # add to $budgets to prevent duplicate orderlines
695
                $budgets{ $budget->budget_id } = '1';
696
697
                # record ordernumber against budget
698
                $ordernumber{ $budget->budget_id } = $o;
699
700
                if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
701
                    if ( !defined $item_hash ) {
702
                        $item_hash = _create_item_from_quote( $item, $quote );
703
                    }
704
                    my $new_item = {
705
                        itype =>
706
                          $item->girfield( 'stock_category', $occurence ),
707
                        location =>
708
                          $item->girfield( 'collection_code', $occurence ),
709
                        itemcallnumber =>
710
                          $item->girfield( 'shelfmark', $occurence )
711
                          || $item->girfield( 'classification', $occurence )
712
                          || title_level_class($item),
713
                        holdingbranch =>
714
                          $item->girfield( 'branch', $occurence ),
715
                        homebranch => $item->girfield( 'branch', $occurence ),
716
                    };
717
                    if ( $new_item->{itype} ) {
718
                        $item_hash->{itype} = $new_item->{itype};
719
                    }
720
                    if ( $new_item->{location} ) {
721
                        $item_hash->{location} = $new_item->{location};
722
                    }
723
                    if ( $new_item->{itemcallnumber} ) {
724
                        $item_hash->{itemcallnumber} =
725
                          $new_item->{itemcallnumber};
726
                    }
727
                    if ( $new_item->{holdingbranch} ) {
728
                        $item_hash->{holdingbranch} =
729
                          $new_item->{holdingbranch};
730
                    }
731
                    if ( $new_item->{homebranch} ) {
732
                        $item_hash->{homebranch} = $new_item->{homebranch};
733
                    }
734
735
                    my $itemnumber;
736
                    ( undef, undef, $itemnumber ) =
737
                      AddItem( $item_hash, $bib->{biblionumber} );
738
                    $logger->trace("New item $itemnumber added");
739
                    $schema->resultset('AqordersItem')->create(
740
                        {
741
                            ordernumber => $new_order->ordernumber,
742
                            itemnumber  => $itemnumber,
743
                        }
744
                    );
745
                }
746
747
                ++$occurence;
748
            }
749
750
            # increment quantity in orderline for EXISTING budget in $budgets
751
            else {
752
                my $row = $schema->resultset('Aqorder')->find(
753
                    {
754
                        ordernumber => $ordernumber{ $budget->budget_id }
755
                    }
756
                );
757
                if ($row) {
758
                    my $qty = $row->quantity;
759
                    $qty++;
760
                    $row->update(
761
                        {
762
                            quantity => $qty,
763
                        }
764
                    );
765
                }
766
767
                if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
768
                    my $new_item = {
769
                        notforloan       => -1,
770
                        cn_sort          => q{},
771
                        cn_source        => 'ddc',
772
                        price            => $item->price,
773
                        replacementprice => $item->price,
774
                        itype =>
775
                          $item->girfield( 'stock_category', $occurence ),
776
                        location =>
777
                          $item->girfield( 'collection_code', $occurence ),
778
                        itemcallnumber =>
779
                          $item->girfield( 'shelfmark', $occurence )
780
                          || $item->girfield( 'classification', $occurence )
781
                          || $item_hash->{itemcallnumber},
782
                        holdingbranch =>
783
                          $item->girfield( 'branch', $occurence ),
784
                        homebranch => $item->girfield( 'branch', $occurence ),
785
                    };
786
                    my $itemnumber;
787
                    ( undef, undef, $itemnumber ) =
788
                      AddItem( $new_item, $bib->{biblionumber} );
789
                    $logger->trace("New item $itemnumber added");
790
                    $schema->resultset('AqordersItem')->create(
791
                        {
792
                            ordernumber => $ordernumber{ $budget->budget_id },
793
                            itemnumber  => $itemnumber,
794
                        }
795
                    );
796
                }
797
798
                ++$occurence;
799
            }
800
        }
801
    }
802
    return 1;
803
804
}
805
806
sub get_edifact_ean {
807
808
    my $dbh = C4::Context->dbh;
809
810
    my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
811
812
    return $eans->[0];
813
}
814
815
# We should not need to have a routine to do this here
816
sub _discounted_price {
817
    my ( $discount, $price ) = @_;
818
    return $price - ( ( $discount * $price ) / 100 );
819
}
820
821
sub _check_for_existing_bib {
822
    my $isbn = shift;
823
824
    my $search_isbn = $isbn;
825
    $search_isbn =~ s/^\s*/%/xms;
826
    $search_isbn =~ s/\s*$/%/xms;
827
    my $dbh = C4::Context->dbh;
828
    my $sth = $dbh->prepare(
829
'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
830
    );
831
    my $tuple_arr =
832
      $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
833
    if ( @{$tuple_arr} ) {
834
        return $tuple_arr->[0];
835
    }
836
    elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
837
        my $tarr = $dbh->selectall_arrayref(
838
'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
839
            { Slice => {} },
840
            $isbn
841
        );
842
        if ( @{$tarr} ) {
843
            return $tarr->[0];
844
        }
845
    }
846
    else {
847
        undef $search_isbn;
848
        $isbn =~ s/\-//xmsg;
849
        if ( $isbn =~ m/(\d{13})/xms ) {
850
            my $b_isbn = Business::ISBN->new($1);
851
            if ( $b_isbn && $b_isbn->is_valid ) {
852
                $search_isbn = $b_isbn->as_isbn10->as_string( [] );
853
            }
854
855
        }
856
        elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
857
            my $b_isbn = Business::ISBN->new($1);
858
            if ( $b_isbn && $b_isbn->is_valid ) {
859
                $search_isbn = $b_isbn->as_isbn13->as_string( [] );
860
            }
861
862
        }
863
        if ($search_isbn) {
864
            $search_isbn = "%$search_isbn%";
865
            $tuple_arr =
866
              $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
867
            if ( @{$tuple_arr} ) {
868
                return $tuple_arr->[0];
869
            }
870
        }
871
    }
872
    return;
873
}
874
875
# returns a budget obj or undef
876
# fact we need this shows what a mess Acq API is
877
sub _get_budget {
878
    my ( $schema, $budget_code ) = @_;
879
    my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
880
        {
881
            budget_period_active => 1,
882
        }
883
    );
884
885
    # db does not ensure budget code is unque
886
    return $schema->resultset('Aqbudget')->single(
887
        {
888
            budget_code => $budget_code,
889
            budget_period_id =>
890
              { -in => $period_rs->get_column('budget_period_id')->as_query },
891
        }
892
    );
893
}
894
895
# try to get title level classification from incoming quote
896
sub title_level_class {
897
    my ($item)         = @_;
898
    my $class          = q{};
899
    my $default_scheme = C4::Context->preference('DefaultClassificationSource');
900
    if ( $default_scheme eq 'ddc' ) {
901
        $class = $item->dewey_class();
902
    }
903
    elsif ( $default_scheme eq 'lcc' ) {
904
        $class = $item->lc_class();
905
    }
906
    if ( !$class ) {
907
        $class =
908
             $item->girfield('shelfmark')
909
          || $item->girfield('classification')
910
          || q{};
911
    }
912
    return $class;
913
}
914
915
sub _create_bib_from_quote {
916
917
    #TBD we should flag this for updating from an external source
918
    #As biblio (&biblioitems) has no candidates flag in order
919
    my ( $item, $quote ) = @_;
920
    my $itemid = $item->item_number_id;
921
    my $defalt_classification_source =
922
      C4::Context->preference('DefaultClassificationSource');
923
    my $bib_hash = {
924
        'biblioitems.cn_source' => $defalt_classification_source,
925
        'items.cn_source'       => $defalt_classification_source,
926
        'items.notforloan'      => -1,
927
        'items.cn_sort'         => q{},
928
    };
929
    $bib_hash->{'biblio.seriestitle'} = $item->series;
930
931
    $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
932
    $bib_hash->{'biblioitems.publicationyear'} =
933
      $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
934
935
    $bib_hash->{'biblio.title'}         = $item->title;
936
    $bib_hash->{'biblio.author'}        = $item->author;
937
    $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
938
    $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
939
940
    # If we have a 13 digit id we are assuming its an ean
941
    # (it may also be an isbn or issn)
942
    if ( $itemid =~ /^\d{13}$/ ) {
943
        $bib_hash->{'biblioitems.ean'} = $itemid;
944
        if ( $itemid =~ /^977/ ) {
945
            $bib_hash->{'biblioitems.issn'} = $itemid;
946
        }
947
    }
948
    for my $key ( keys %{$bib_hash} ) {
949
        if ( !defined $bib_hash->{$key} ) {
950
            delete $bib_hash->{$key};
951
        }
952
    }
953
    return TransformKohaToMarc($bib_hash);
954
955
}
956
957
sub _create_item_from_quote {
958
    my ( $item, $quote ) = @_;
959
    my $defalt_classification_source =
960
      C4::Context->preference('DefaultClassificationSource');
961
    my $item_hash = {
962
        cn_source  => $defalt_classification_source,
963
        notforloan => -1,
964
        cn_sort    => q{},
965
    };
966
    $item_hash->{booksellerid} = $quote->vendor_id;
967
    $item_hash->{price}        = $item_hash->{replacementprice} = $item->price;
968
    $item_hash->{itype}        = $item->girfield('stock_category');
969
    $item_hash->{location}     = $item->girfield('collection_code');
970
971
    my $note = {};
972
973
    $item_hash->{itemcallnumber} =
974
         $item->girfield('shelfmark')
975
      || $item->girfield('classification')
976
      || title_level_class($item);
977
978
    my $branch = $item->girfield('branch');
979
    $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
980
    return $item_hash;
981
}
982
983
1;
984
__END__
985
986
=head1 NAME
987
988
Koha::EDI
989
990
=head1 SYNOPSIS
991
992
   Module exporting subroutines used in EDI processing for Koha
993
994
=head1 DESCRIPTION
995
996
   Subroutines called by batch processing to handle Edifact
997
   messages of various types and related utilities
998
999
=head1 BUGS
1000
1001
   These routines should really be methods of some object.
1002
   get_edifact_ean is a stopgap which should be replaced
1003
1004
=head1 SUBROUTINES
1005
1006
=head2 process_quote
1007
1008
    process_quote(quote_message);
1009
1010
   passed a message object for a quote, parses it creating an order basket
1011
   and orderlines in the database
1012
   updates the message's status to received in the database and adds the
1013
   link to basket
1014
1015
=head2 process_invoice
1016
1017
    process_invoice(invoice_message)
1018
1019
    passed a message object for an invoice, add the contained invoices
1020
    and update the orderlines referred to in the invoice
1021
    As an Edifact invoice is in effect a despatch note this receipts the
1022
    appropriate quantities in the orders
1023
1024
    no meaningful return value
1025
1026
=head2 process_ordrsp
1027
1028
     process_ordrsp(ordrsp_message)
1029
1030
     passed a message object for a supplier response, process the contents
1031
     If an orderline is cancelled cancel the corresponding orderline in koha
1032
     otherwise record the supplier message against it
1033
1034
     no meaningful return value
1035
1036
=head2 create_edi_order
1037
1038
    create_edi_order( { parameter_hashref } )
1039
1040
    parameters must include basketno and ean
1041
1042
    branchcode can optionally be passed
1043
1044
    returns 1 on success undef otherwise
1045
1046
    if the parameter noingest is set the formatted order is returned
1047
    and not saved in the database. This functionality is intended for debugging only
1048
1049
=head2 receipt_items
1050
1051
    receipt_items( schema_obj, invoice_line, ordernumber)
1052
1053
    receipts the items recorded on this invoice line
1054
1055
    no meaningful return
1056
1057
=head2 transfer_items
1058
1059
    transfer_items(schema, invoice_line, originating_order, receiving_order)
1060
1061
    Transfer the items covered by this invoice line from their original
1062
    order to another order recording the partial fulfillment of the original
1063
    order
1064
1065
    no meaningful return
1066
1067
=head2 get_edifact_ean
1068
1069
    $ean = get_edifact_ean();
1070
1071
    routine to return the ean.
1072
1073
=head2 quote_item
1074
1075
     quote_item(lineitem, quote_message);
1076
1077
      Called by process_quote to handle an individual lineitem
1078
     Generate the biblios and items if required and orderline linking to them
1079
1080
     Returns 1 on success undef on error
1081
1082
     Most usual cause of error is a line with no or incorrect budget codes
1083
     which woild cause order creation to abort
1084
     If other correct lines exist these are processed and the erroneous line os logged
1085
1086
=head2 title_level_class
1087
1088
      classmark = title_level_class(edi_item)
1089
1090
      Trys to return a title level classmark from a quote message line
1091
      Will return a dewey or lcc classmark if one exists according to the
1092
      value in DefaultClassificationSource syspref
1093
1094
      If unable to returns the shelfmark or classification from the GIR segment
1095
1096
      If all else fails returns empty string
1097
1098
=head2 _create_bib_from_quote
1099
1100
       marc_record_obj = _create_bib_from_quote(lineitem, quote)
1101
1102
       Returns a MARC::Record object based on the  info in the quote's lineitem
1103
1104
=head2 _create_item_from_quote
1105
1106
       item_hashref = _create_item_from_quote( lineitem, quote)
1107
1108
       returns a hashref representing the item fields specified in the quote
1109
1110
=head2 _get_invoiced_price
1111
1112
      _get_invoiced_price(line_object)
1113
1114
      Returns the net price or an equivalent calculated from line cost / qty
1115
1116
=head2 _discounted_price
1117
1118
      ecost = _discounted_price(discount, item_price)
1119
1120
      utility subroutine to return a price calculated from the
1121
      vendors discount and quoted price
1122
1123
=head2 _check_for_existing_bib
1124
1125
     (biblionumber, biblioitemnumber) = _check_for_existing_bib(isbn_or_ean)
1126
1127
     passed an isbn or ean attempts to locate a match bib
1128
     On success returns biblionumber and biblioitemnumber
1129
     On failure returns undefined/an empty list
1130
1131
=head2 _get_budget
1132
1133
     b = _get_budget(schema_obj, budget_code)
1134
1135
     Returns the Aqbudget object for the active budget given the passed budget_code
1136
     or undefined if one does not exist
1137
1138
=head1 AUTHOR
1139
1140
   Colin Campbell <colin.campbell@ptfs-europe.com>
1141
1142
1143
=head1 COPYRIGHT
1144
1145
   Copyright 2014,2015 PTFS-Europe Ltd
1146
   This program is free software, You may redistribute it under
1147
   under the terms of the GNU General Public License
1148
1149
1150
=cut
(-)a/Koha/Edifact.pm (+337 lines)
Line 0 Link Here
1
package Koha::Edifact;
2
3
# Copyright 2014,2015 PTFS-Europe Ltd
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use strict;
21
use warnings;
22
use File::Slurp;
23
use Carp;
24
use Encode qw( from_to );
25
use Koha::Edifact::Segment;
26
use Koha::Edifact::Message;
27
28
my $separator = {
29
    component => q{\:},
30
    data      => q{\+},
31
    decimal   => q{.},
32
    release   => q{\?},
33
    reserved  => q{ },
34
    segment   => q{\'},
35
};
36
37
sub new {
38
    my ( $class, $param_hashref ) = @_;
39
    my $transmission;
40
    my $self = ();
41
42
    if ( $param_hashref->{filename} ) {
43
        if ( $param_hashref->{transmission} ) {
44
            carp
45
"Cannot instantiate $class : both filename and transmission passed";
46
            return;
47
        }
48
        $transmission = read_file( $param_hashref->{filename} );
49
    }
50
    else {
51
        $transmission = $param_hashref->{transmission};
52
    }
53
    $self->{transmission} = _init($transmission);
54
55
    bless $self, $class;
56
    return $self;
57
}
58
59
sub interchange_header {
60
    my ( $self, $field ) = @_;
61
62
    my %element = (
63
        sender                        => 1,
64
        recipient                     => 2,
65
        datetime                      => 3,
66
        interchange_control_reference => 4,
67
        application_reference         => 6,
68
    );
69
    if ( !exists $element{$field} ) {
70
        carp "No interchange header field $field available";
71
        return;
72
    }
73
    my $data = $self->{transmission}->[0]->elem( $element{$field} );
74
    return $data;
75
}
76
77
sub interchange_trailer {
78
    my ( $self, $field ) = @_;
79
    my $trailer = $self->{transmission}->[-1];
80
    if ( $field eq 'interchange_control_count' ) {
81
        return $trailer->elem(0);
82
    }
83
    elsif ( $field eq 'interchange_control_reference' ) {
84
        return $trailer->elem(1);
85
    }
86
    carp "Trailer field $field not recognized";
87
    return;
88
}
89
90
sub new_data_iterator {
91
    my $self   = shift;
92
    my $offset = 0;
93
    while ( $self->{transmission}->[$offset]->tag() ne 'UNH' ) {
94
        ++$offset;
95
        if ( $offset == @{ $self->{transmission} } ) {
96
            carp 'Cannot find message start';
97
            return;
98
        }
99
    }
100
    $self->{data_iterator} = $offset;
101
    return 1;
102
}
103
104
sub next_segment {
105
    my $self = shift;
106
    if ( defined $self->{data_iterator} ) {
107
        my $seg = $self->{transmission}->[ $self->{data_iterator} ];
108
        if ( $seg->tag eq 'UNH' ) {
109
110
            $self->{msg_type} = $seg->elem( 1, 0 );
111
        }
112
        elsif ( $seg->tag eq 'LIN' ) {
113
            $self->{msg_type} = 'detail';
114
        }
115
116
        if ( $seg->tag ne 'UNZ' ) {
117
            $self->{data_iterator}++;
118
        }
119
        else {
120
            $self->{data_iterator} = undef;
121
        }
122
        return $seg;
123
    }
124
    return;
125
}
126
127
# for debugging return whole transmission
128
sub get_transmission {
129
    my $self = shift;
130
131
    return $self->{transmission};
132
}
133
134
sub message_type {
135
    my $self = shift;
136
    return $self->{msg_type};
137
}
138
139
sub _init {
140
    my $msg = shift;
141
    if ( !$msg ) {
142
        return;
143
    }
144
    if ( $msg =~ s/^UNA(.{6})// ) {
145
        if ( service_string_advice($1) ) {
146
            return segmentize($msg);
147
148
        }
149
        return;
150
    }
151
    else {
152
        my $s = substr $msg, 10;
153
        croak "File does not start with a Service string advice :$s";
154
    }
155
}
156
157
# return an array of Message objects
158
sub message_array {
159
    my $self = shift;
160
161
    # return an array of array_refs 1 ref to a message
162
    my $msg_arr = [];
163
    my $msg     = [];
164
    my $in_msg  = 0;
165
    foreach my $seg ( @{ $self->{transmission} } ) {
166
        if ( $seg->tag eq 'UNH' ) {
167
            $in_msg = 1;
168
            push @{$msg}, $seg;
169
        }
170
        elsif ( $seg->tag eq 'UNT' ) {
171
            $in_msg = 0;
172
            if ( @{$msg} ) {
173
                push @{$msg_arr}, Koha::Edifact::Message->new($msg);
174
                $msg = [];
175
            }
176
        }
177
        elsif ($in_msg) {
178
            push @{$msg}, $seg;
179
        }
180
    }
181
    return $msg_arr;
182
}
183
184
#
185
# internal parsing routines used in _init
186
#
187
sub service_string_advice {
188
    my $ssa = shift;
189
190
    # At present this just validates that the ssa
191
    # is standard Edifact
192
    # TBD reset the seps if non standard
193
    if ( $ssa ne q{:+.? '} ) {
194
        carp " Non standard Service String Advice [$ssa]";
195
        return;
196
    }
197
198
    # else use default separators
199
    return 1;
200
}
201
202
sub segmentize {
203
    my $raw = shift;
204
205
    # In practice edifact uses latin-1 but check
206
    # Transport now converts to utf-8 on ingest
207
    # Do not convert here
208
    #my $char_set = 'iso-8859-1';
209
    #if ( $raw =~ m/^UNB[+]UNO(.)/ ) {
210
    #    $char_set = msgcharset($1);
211
    #}
212
    #from_to( $raw, $char_set, 'utf8' );
213
214
    my $re = qr{
215
(?>         # dont backtrack into this group
216
    [?].     # either the escape character
217
            # followed by any other character
218
     |      # or
219
     [^'?]   # a character that is neither escape
220
             # nor split
221
             )+
222
}x;
223
    my @segmented;
224
    while ( $raw =~ /($re)/g ) {
225
        push @segmented, Koha::Edifact::Segment->new( { seg_string => $1 } );
226
    }
227
    return \@segmented;
228
}
229
230
sub msgcharset {
231
    my $code = shift;
232
    if ( $code =~ m/^[^ABCDEF]$/ ) {
233
        $code = 'default';
234
    }
235
    my %encoding_map = (
236
        A       => 'ascii',
237
        B       => 'ascii',
238
        C       => 'iso-8859-1',
239
        D       => 'iso-8859-1',
240
        E       => 'iso-8859-1',
241
        F       => 'iso-8859-1',
242
        default => 'iso-8859-1',
243
    );
244
    return $encoding_map{$code};
245
}
246
247
1;
248
__END__
249
250
=head1 NAME
251
252
Edifact - Edifact message handler
253
254
=head1 DESCRIPTION
255
256
   Koha module for parsing Edifact messages
257
258
=head1 SUBROUTINES
259
260
=head2 new
261
262
     my $e = Koha::Edifact->new( { filename => 'myfilename' } );
263
     or
264
     my $e = Koha::Edifact->new( { transmission => $msg_variable } );
265
266
     instantiate the Edifact parser, requires either to be passed an in-memory
267
     edifact message as transmission or a filename which it will read on creation
268
269
=head2 interchange_header
270
271
     will return the data in the header field designated by the parameter
272
     specified. Valid parameters are: 'sender', 'recipient', 'datetime',
273
    'interchange_control_reference', and 'application_reference'
274
275
=head2 interchange_trailer
276
277
     called either with the string 'interchange_control_count' or
278
     'interchange_control_reference' will return the corresponding field from
279
     the interchange trailer
280
281
=head2 new_data_iterator
282
283
     Sets the object's data_iterator to point to the UNH segment
284
285
=head2 next_segment
286
287
     Returns the next segment pointed to by the data_iterator. Increments the
288
     data_iterator member or destroys it if segment UNZ has been reached
289
290
=head2 get_transmission
291
292
     This method is useful in debugg:ing. Call on an Edifact object
293
     it returns the object's transmission member
294
295
=head2 message_type
296
297
     return the object's message type
298
299
=head2 message_array
300
301
     return an array of Message objects contained in the Edifact transmission
302
303
=head1 Internal Methods
304
305
=head2 _init
306
307
  Called by the constructor to do the parsing of the transmission
308
309
=head2 service_string_advice
310
311
  Examines the Service String Advice returns 1 if the default separartors are in use
312
  undef otherwise
313
314
=head2 segmentize
315
316
   takes a raw Edifact message and returns a reference to an array of
317
   its segments
318
319
=head2 msgcharset
320
321
    Return the character set the message was encoded in. The default is iso-8859-1
322
323
    We preserve this info but will have converted to utf-8 on ingest
324
325
=head1 AUTHOR
326
327
   Colin Campbell <colin.campbell@ptfs-europe.com>
328
329
330
=head1 COPYRIGHT
331
332
   Copyright 2014,2015, PTFS-Europe Ltd
333
   This program is free software, You may redistribute it under
334
   under the terms of the GNU General Public License
335
336
337
=cut
(-)a/Koha/Edifact/Line.pm (+864 lines)
Line 0 Link Here
1
package Koha::Edifact::Line;
2
3
# Copyright 2014, 2015 PTFS-Europe Ltd
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use strict;
21
use warnings;
22
use utf8;
23
24
use MARC::Record;
25
use MARC::Field;
26
use Carp;
27
28
sub new {
29
    my ( $class, $data_array_ref ) = @_;
30
    my $self = _parse_lines($data_array_ref);
31
32
    bless $self, $class;
33
    return $self;
34
}
35
36
# helper routine used by constructor
37
# creates the hashref used as a data structure by the Line object
38
39
sub _parse_lines {
40
    my $aref = shift;
41
42
    my $lin = shift @{$aref};
43
44
    my $id     = $lin->elem( 2, 0 );    # may be undef in ordrsp
45
    my $action = $lin->elem( 1, 0 );
46
    my $d      = {
47
        line_item_number       => $lin->elem(0),
48
        action_notification    => $action,
49
        item_number_id         => $id,
50
        additional_product_ids => [],
51
    };
52
    my @item_description;
53
54
    foreach my $s ( @{$aref} ) {
55
        if ( $s->tag eq 'PIA' ) {
56
            push @{ $d->{additional_product_ids} },
57
              {
58
                function_code => $s->elem(0),
59
                item_number   => $s->elem( 1, 0 ),
60
                number_type   => $s->elem( 1, 1 ),
61
              };
62
        }
63
        elsif ( $s->tag eq 'IMD' ) {
64
            push @item_description, $s;
65
        }
66
        elsif ( $s->tag eq 'QTY' ) {
67
            $d->{quantity} = $s->elem( 0, 1 );
68
        }
69
        elsif ( $s->tag eq 'DTM' ) {
70
            if ( $s->elem( 0, 0 ) eq '44' ) {
71
                $d->{availability_date} = $s->elem( 0, 1 );
72
            }
73
        }
74
        elsif ( $s->tag eq 'GIR' ) {
75
76
            # we may get a Gir for each copy if QTY > 1
77
            if ( !$d->{GIR} ) {
78
                $d->{GIR} = [];
79
                push @{ $d->{GIR} }, extract_gir($s);
80
            }
81
            else {
82
                my $gir = extract_gir($s);
83
                if ( $gir->{copy} ) {    # may have to merge
84
                    foreach my $g ( @{ $d->{GIR} } ) {
85
                        if ( $gir->{copy} eq $g->{copy} ) {
86
                            foreach my $field ( keys %{$gir} ) {
87
                                if ( !exists $g->{$field} ) {
88
                                    $g->{$field} = $gir->{$field};
89
                                }
90
                            }
91
                            undef $gir;
92
                            last;
93
                        }
94
                    }
95
                    if ( defined $gir ) {
96
                        push @{ $d->{GIR} }, $gir;
97
                    }
98
                }
99
            }
100
        }
101
        elsif ( $s->tag eq 'FTX' ) {
102
103
            my $type  = $s->elem(0);
104
            my $ctype = 'coded_free_text';
105
            if ( $type eq 'LNO' ) {    # Ingrams Oasis Internal Notes field
106
                $type  = 'internal_notes';
107
                $ctype = 'coded_internal_note';
108
            }
109
            elsif ( $type eq 'LIN' ) {
110
                $type  = 'orderline_free_text';
111
                $ctype = 'coded_orderline_text';
112
            }
113
            elsif ( $type eq 'SUB' ) {
114
                $type = 'coded_substitute_text';
115
            }
116
            else {
117
                $type = 'free_text';
118
            }
119
120
            my $coded_text = $s->elem(2);
121
            if ( ref $coded_text eq 'ARRAY' && $coded_text->[0] ) {
122
                $d->{$ctype}->{table} = $coded_text->[1];
123
                $d->{$ctype}->{code}  = $coded_text->[0];
124
            }
125
126
            my $ftx = $s->elem(3);
127
            if ( ref $ftx eq 'ARRAY' ) {   # it comes in 70 character components
128
                $ftx = join q{ }, @{$ftx};
129
            }
130
            if ( exists $d->{$type} ) {    # we can only catenate repeats
131
                $d->{$type} .= q{ };
132
                $d->{$type} .= $ftx;
133
            }
134
            else {
135
                $d->{$type} = $ftx;
136
            }
137
        }
138
        elsif ( $s->tag eq 'MOA' ) {
139
140
            $d->{monetary_amount} = $s->elem( 0, 1 );
141
        }
142
        elsif ( $s->tag eq 'PRI' ) {
143
144
            $d->{price} = $s->elem( 0, 1 );
145
        }
146
        elsif ( $s->tag eq 'RFF' ) {
147
            my $qualifier = $s->elem( 0, 0 );
148
            if ( $qualifier eq 'QLI' ) {  # Suppliers unique quotation reference
149
                $d->{reference} = $s->elem( 0, 1 );
150
            }
151
            elsif ( $qualifier eq 'LI' ) {    # Buyer's unique orderline number
152
                $d->{ordernumber} = $s->elem( 0, 1 );
153
            }
154
            elsif ( $qualifier eq 'SLI' )
155
            {    # Suppliers unique order line reference number
156
                $d->{orderline_reference_number} = $s->elem( 0, 1 );
157
            }
158
        }
159
    }
160
    $d->{item_description} = _format_item_description(@item_description);
161
    $d->{segs}             = $aref;
162
163
    return $d;
164
}
165
166
sub _format_item_description {
167
    my @imd    = @_;
168
    my $bibrec = {};
169
170
 # IMD : +Type code 'L' + characteristic code 3 char + Description in comp 3 & 4
171
    foreach my $imd (@imd) {
172
        my $type_code = $imd->elem(0);
173
        my $ccode     = $imd->elem(1);
174
        my $desc      = $imd->elem( 2, 3 );
175
        if ( $imd->elem( 2, 4 ) ) {
176
            $desc .= $imd->elem( 2, 4 );
177
        }
178
        if ( $type_code ne 'L' ) {
179
            carp
180
              "Only handles text item descriptions at present: code=$type_code";
181
            next;
182
        }
183
        if ( exists $bibrec->{$ccode} ) {
184
            $bibrec->{$ccode} .= q{ };
185
            $bibrec->{$ccode} .= $desc;
186
        }
187
        else {
188
            $bibrec->{$ccode} = $desc;
189
        }
190
    }
191
    return $bibrec;
192
}
193
194
sub marc_record {
195
    my $self = shift;
196
    my $b    = $self->{item_description};
197
198
    my $bib = MARC::Record->new();
199
200
    my @spec;
201
    my @fields;
202
    if ( exists $b->{'010'} ) {
203
        @spec = qw( 100 a 011 c 012 b 013 d 014 e );
204
        push @fields, new_field( $b, [ 100, 1, q{ } ], @spec );
205
    }
206
    if ( exists $b->{'020'} ) {
207
        @spec = qw( 020 a 021 c 022 b 023 d 024 e );
208
        push @fields, new_field( $b, [ 700, 1, q{ } ], @spec );
209
    }
210
211
    # corp conf
212
    if ( exists $b->{'030'} ) {
213
        push @fields, $self->corpcon(1);
214
    }
215
    if ( exists $b->{'040'} ) {
216
        push @fields, $self->corpcon(7);
217
    }
218
    if ( exists $b->{'050'} ) {
219
        @spec = qw( '050' a '060' b '065' c );
220
        push @fields, new_field( $b, [ 245, 1, 0 ], @spec );
221
    }
222
    if ( exists $b->{100} ) {
223
        @spec = qw( 100 a 101 b);
224
        push @fields, new_field( $b, [ 250, q{ }, q{ } ], @spec );
225
    }
226
    @spec = qw( 110 a 120 b 170 c );
227
    my $f = new_field( $b, [ 260, q{ }, q{ } ], @spec );
228
    if ($f) {
229
        push @fields, $f;
230
    }
231
    @spec = qw( 180 a 181 b 182 c 183 e);
232
    $f = new_field( $b, [ 300, q{ }, q{ } ], @spec );
233
    if ($f) {
234
        push @fields, $f;
235
    }
236
    if ( exists $b->{190} ) {
237
        @spec = qw( 190 a);
238
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
239
    }
240
241
    if ( exists $b->{200} ) {
242
        @spec = qw( 200 a);
243
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
244
    }
245
    if ( exists $b->{210} ) {
246
        @spec = qw( 210 a);
247
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
248
    }
249
    if ( exists $b->{300} ) {
250
        @spec = qw( 300 a);
251
        push @fields, new_field( $b, [ 500, q{ }, q{ } ], @spec );
252
    }
253
    if ( exists $b->{310} ) {
254
        @spec = qw( 310 a);
255
        push @fields, new_field( $b, [ 520, q{ }, q{ } ], @spec );
256
    }
257
    if ( exists $b->{320} ) {
258
        @spec = qw( 320 a);
259
        push @fields, new_field( $b, [ 521, q{ }, q{ } ], @spec );
260
    }
261
    if ( exists $b->{260} ) {
262
        @spec = qw( 260 a);
263
        push @fields, new_field( $b, [ 600, q{ }, q{ } ], @spec );
264
    }
265
    if ( exists $b->{270} ) {
266
        @spec = qw( 270 a);
267
        push @fields, new_field( $b, [ 650, q{ }, q{ } ], @spec );
268
    }
269
    if ( exists $b->{280} ) {
270
        @spec = qw( 280 a);
271
        push @fields, new_field( $b, [ 655, q{ }, q{ } ], @spec );
272
    }
273
274
    # class
275
    if ( exists $b->{230} ) {
276
        @spec = qw( 230 a);
277
        push @fields, new_field( $b, [ '082', q{ }, q{ } ], @spec );
278
    }
279
    if ( exists $b->{240} ) {
280
        @spec = qw( 240 a);
281
        push @fields, new_field( $b, [ '084', q{ }, q{ } ], @spec );
282
    }
283
    $bib->insert_fields_ordered(@fields);
284
285
    return $bib;
286
}
287
288
sub corpcon {
289
    my ( $self, $level ) = @_;
290
    my $test_these = {
291
        1 => [ '033', '032', '034' ],
292
        7 => [ '043', '042', '044' ],
293
    };
294
    my $conf = 0;
295
    foreach my $t ( @{ $test_these->{$level} } ) {
296
        if ( exists $self->{item_description}->{$t} ) {
297
            $conf = 1;
298
        }
299
    }
300
    my $tag;
301
    my @spec;
302
    my ( $i1, $i2 ) = ( q{ }, q{ } );
303
    if ($conf) {
304
        $tag = ( $level * 100 ) + 11;
305
        if ( $level == 1 ) {
306
            @spec = qw( 030 a 031 e 032 n 033 c 034 d);
307
        }
308
        else {
309
            @spec = qw( 040 a 041 e 042 n 043 c 044 d);
310
        }
311
    }
312
    else {
313
        $tag = ( $level * 100 ) + 10;
314
        if ( $level == 1 ) {
315
            @spec = qw( 030 a 031 b);
316
        }
317
        else {
318
            @spec = qw( 040 a 041 b);
319
        }
320
    }
321
    return new_field( $self->{item_description}, [ $tag, $i1, $i2 ], @spec );
322
}
323
324
sub new_field {
325
    my ( $b, $tag_ind, @sfd_elem ) = @_;
326
    my @sfd;
327
    while (@sfd_elem) {
328
        my $e = shift @sfd_elem;
329
        my $c = shift @sfd_elem;
330
        if ( exists $b->{$e} ) {
331
            push @sfd, $c, $b->{$e};
332
        }
333
    }
334
    if (@sfd) {
335
        my $field = MARC::Field->new( @{$tag_ind}, @sfd );
336
        return $field;
337
    }
338
    return;
339
}
340
341
# Accessor methods to line data
342
343
sub item_number_id {
344
    my $self = shift;
345
    return $self->{item_number_id};
346
}
347
348
sub line_item_number {
349
    my $self = shift;
350
    return $self->{line_item_number};
351
}
352
353
sub additional_product_ids {
354
    my $self = shift;
355
    return $self->{additional_product_ids};
356
}
357
358
sub action_notification {
359
    my $self = shift;
360
    my $a    = $self->{action_notification};
361
    if ($a) {
362
        $a = _translate_action($a);    # return the associated text string
363
    }
364
    return $a;
365
}
366
367
sub item_description {
368
    my $self = shift;
369
    return $self->{item_description};
370
}
371
372
sub monetary_amount {
373
    my $self = shift;
374
    return $self->{monetary_amount};
375
}
376
377
sub quantity {
378
    my $self = shift;
379
    return $self->{quantity};
380
}
381
382
sub price {
383
    my $self = shift;
384
    return $self->{price};
385
}
386
387
sub reference {
388
    my $self = shift;
389
    return $self->{reference};
390
}
391
392
sub orderline_reference_number {
393
    my $self = shift;
394
    return $self->{orderline_reference_number};
395
}
396
397
sub ordernumber {
398
    my $self = shift;
399
    return $self->{ordernumber};
400
}
401
402
sub free_text {
403
    my $self = shift;
404
    return $self->{free_text};
405
}
406
407
sub coded_free_text {
408
    my $self = shift;
409
    return $self->{coded_free_text}->{code};
410
}
411
412
sub internal_notes {
413
    my $self = shift;
414
    return $self->{internal_notes};
415
}
416
417
sub coded_internal_note {
418
    my $self = shift;
419
    return $self->{coded_internal_note}->{code};
420
}
421
422
sub orderline_free_text {
423
    my $self = shift;
424
    return $self->{orderline_free_text};
425
}
426
427
sub coded_orderline_text {
428
    my $self  = shift;
429
    my $code  = $self->{coded_orderline_text}->{code};
430
    my $table = $self->{coded_orderline_text}->{table};
431
    my $txt;
432
    if ( $table eq '8B' || $table eq '7B' ) {
433
        $txt = translate_8B($code);
434
    }
435
    elsif ( $table eq '12B' ) {
436
        $txt = translate_12B($code);
437
    }
438
    if ( !$txt || $txt eq 'no match' ) {
439
        $txt = $code;
440
    }
441
    return $txt;
442
}
443
444
sub substitute_free_text {
445
    my $self = shift;
446
    return $self->{substitute_free_text};
447
}
448
449
sub coded_substitute_text {
450
    my $self = shift;
451
    return $self->{coded_substitute_text}->{code};
452
}
453
454
# This will take a standard code as returned
455
# by (orderline|substitue)-free_text (FTX seg LIN)
456
# and expand it useing EditEUR code list 8B
457
sub translate_8B {
458
    my ($code) = @_;
459
460
    # list 7B is a subset of this
461
    my %code_list_8B = (
462
        AB => 'Publication abandoned',
463
        AD => 'Apply direct',
464
        AU => 'Publisher address unknown',
465
        CS => 'Status uncertain',
466
        FQ => 'Only available abroad',
467
        HK => 'Paperback OP: Hardback available',
468
        IB => 'In stock',
469
        IP => 'In print and in stock at publisher',
470
        MD => 'Manufactured on demand',
471
        NK => 'Item not known',
472
        NN => 'We do not supply this item',
473
        NP => 'Not yet published',
474
        NQ => 'Not stocked',
475
        NS => 'Not sold separately',
476
        OB => 'Temporarily out of stock',
477
        OF => 'This format out of print: other format available',
478
        OP => 'Out of print',
479
        OR => 'Out pf print; New Edition coming',
480
        PK => 'Hardback out of print: paperback available',
481
        PN => 'Publisher no longer in business',
482
        RE => 'Awaiting reissue',
483
        RF => 'refer to other publisher or distributor',
484
        RM => 'Remaindered',
485
        RP => 'Reprinting',
486
        RR => 'Rights restricted: cannot supply in this market',
487
        SD => 'Sold',
488
        SN => 'Our supplier cannot trace',
489
        SO => 'Pack or set not available: single items only',
490
        ST => 'Stocktaking: temporarily unavailable',
491
        TO => 'Only to order',
492
        TU => 'Temporarily unavailable',
493
        UB => 'Item unobtainable from our suppliers',
494
        UC => 'Unavailable@ reprint under consideration',
495
    );
496
497
    if ( exists $code_list_8B{$code} ) {
498
        return $code_list_8B{$code};
499
    }
500
    else {
501
        return 'no match';
502
    }
503
}
504
505
sub translate_12B {
506
    my ($code) = @_;
507
508
    my %code_list_12B = (
509
        100 => 'Order line accepted',
510
        101 => 'Price query: orderline will be held awaiting customer response',
511
        102 =>
512
          'Discount query: order line will be held awaiting customer response',
513
        103 => 'Minimum order value not reached: order line will be held',
514
        104 =>
515
'Firm order required: order line will be held awaiting customer response',
516
        110 => 'Order line accepted, substitute product will be supplied',
517
        200 => 'Order line not accepted',
518
        201 => 'Price query: order line not accepted',
519
        202 => 'Discount query: order line not accepted',
520
        203 => 'Minimum order value not reached: order line not accepted',
521
        205 => 'Order line not accepted: quoted promotion is invalid',
522
        206 => 'Order line not accepted: quoted promotion has ended',
523
        207 =>
524
          'Order line not accepted: customer ineligible for quoted promotion',
525
        210 => 'Order line not accepted: substitute product is offered',
526
        220 => 'Oustanding order line cancelled: reason unspecified',
527
        221 => 'Oustanding order line cancelled: past order expiry date',
528
        222 => 'Oustanding order line cancelled by customer request',
529
        223 => 'Oustanding order line cancelled: unable to supply',
530
        300 => 'Order line passed to new supplier',
531
        301 => 'Order line passed to secondhand department',
532
        400 => 'Backordered - awaiting supply',
533
        401 => 'On order from our supplier',
534
        402 => 'On order from abroad',
535
        403 => 'Backordered, waiting to reach minimum order value',
536
        404 => 'Despatched from our supplier, awaiting delivery',
537
        405 => 'Our supplier sent wrong item(s), re-ordered',
538
        406 => 'Our supplier sent short, re-ordered',
539
        407 => 'Our supplier sent damaged item(s), re-ordered',
540
        408 => 'Our supplier sent imperfect item(s), re-ordered',
541
        409 => 'Our supplier cannot trace order, re-ordered',
542
        410 => 'Ordered item(s) being processed by bookseller',
543
        411 =>
544
'Ordered item(s) being processed by bookseller, awaiting customer action',
545
        412 => 'Order line held awaiting customer instruction',
546
        500 => 'Order line on hold - contact customer service',
547
        800 => 'Order line already despatched',
548
        900 => 'Cannot trace order line',
549
        901 => 'Order line held: note title change',
550
        902 => 'Order line held: note availability date delay',
551
        903 => 'Order line held: note price change',
552
        999 => 'Temporary hold: order action not yet determined',
553
    );
554
555
    if ( exists $code_list_12B{$code} ) {
556
        return $code_list_12B{$code};
557
    }
558
    else {
559
        return 'no match';
560
    }
561
}
562
563
# item_desription_fields accessors
564
565
sub title {
566
    my $self       = shift;
567
    my $titlefield = q{050};
568
    if ( exists $self->{item_description}->{$titlefield} ) {
569
        return $self->{item_description}->{$titlefield};
570
    }
571
    return;
572
}
573
574
sub author {
575
    my $self  = shift;
576
    my $field = q{010};
577
    if ( exists $self->{item_description}->{$field} ) {
578
        my $a              = $self->{item_description}->{$field};
579
        my $forename_field = q{011};
580
        if ( exists $self->{item_description}->{$forename_field} ) {
581
            $a .= ', ';
582
            $a .= $self->{item_description}->{$forename_field};
583
        }
584
        return $a;
585
    }
586
    return;
587
}
588
589
sub series {
590
    my $self  = shift;
591
    my $field = q{190};
592
    if ( exists $self->{item_description}->{$field} ) {
593
        return $self->{item_description}->{$field};
594
    }
595
    return;
596
}
597
598
sub publisher {
599
    my $self  = shift;
600
    my $field = q{120};
601
    if ( exists $self->{item_description}->{$field} ) {
602
        return $self->{item_description}->{$field};
603
    }
604
    return;
605
}
606
607
sub publication_date {
608
    my $self  = shift;
609
    my $field = q{170};
610
    if ( exists $self->{item_description}->{$field} ) {
611
        return $self->{item_description}->{$field};
612
    }
613
    return;
614
}
615
616
sub dewey_class {
617
    my $self  = shift;
618
    my $field = q{230};
619
    if ( exists $self->{item_description}->{$field} ) {
620
        return $self->{item_description}->{$field};
621
    }
622
    return;
623
}
624
625
sub lc_class {
626
    my $self  = shift;
627
    my $field = q{240};
628
    if ( exists $self->{item_description}->{$field} ) {
629
        return $self->{item_description}->{$field};
630
    }
631
    return;
632
}
633
634
sub girfield {
635
    my ( $self, $field, $occ ) = @_;
636
    if ( $self->number_of_girs ) {
637
638
        # defaults to occurence 0 returns undef if occ requested > occs
639
        if ( defined $occ && $occ >= @{ $self->{GIR} } ) {
640
            return;
641
        }
642
        $occ ||= 0;
643
        return $self->{GIR}->[$occ]->{$field};
644
    }
645
    else {
646
        return;
647
    }
648
}
649
650
sub number_of_girs {
651
    my $self = shift;
652
    if ( $self->{GIR} ) {
653
654
        my $qty = @{ $self->{GIR} };
655
656
        return $qty;
657
    }
658
    else {
659
        return 0;
660
    }
661
}
662
663
sub extract_gir {
664
    my $s    = shift;
665
    my %qmap = (
666
        LAC => 'barcode',
667
        LAF => 'first_accession_number',
668
        LAL => 'last_accession_number',
669
        LCL => 'classification',
670
        LCO => 'item_unique_id',
671
        LCV => 'copy_value',
672
        LFH => 'feature_heading',
673
        LFN => 'fund_allocation',
674
        LFS => 'filing_suffix',
675
        LLN => 'loan_category',
676
        LLO => 'branch',
677
        LLS => 'label_sublocation',
678
        LQT => 'part_order_quantity',
679
        LRS => 'record_sublocation',
680
        LSM => 'shelfmark',
681
        LSQ => 'collection_code',
682
        LST => 'stock_category',
683
        LSZ => 'size_code',
684
        LVC => 'coded_servicing_instruction',
685
        LVT => 'servicing_instruction',
686
    );
687
688
    my $set_qualifier = $s->elem( 0, 0 );    # copy number
689
    my $gir_element = { copy => $set_qualifier, };
690
    my $element = 1;
691
    while ( my $e = $s->elem($element) ) {
692
        ++$element;
693
        if ( exists $qmap{ $e->[1] } ) {
694
            my $qualifier = $qmap{ $e->[1] };
695
            $gir_element->{$qualifier} = $e->[0];
696
        }
697
        else {
698
699
            carp "Unrecognized GIR code : $e->[1] for $e->[0]";
700
        }
701
    }
702
    return $gir_element;
703
}
704
705
# mainly for invoice processing amt_ will derive from MOA price_ from PRI and tax_ from TAX/MOA pairsn
706
sub moa_amt {
707
    my ( $self, $qualifier ) = @_;
708
    foreach my $s ( @{ $self->{segs} } ) {
709
        if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) {
710
            return $s->elem( 0, 1 );
711
        }
712
    }
713
    return;
714
}
715
716
sub amt_discount {
717
    my $self = shift;
718
    return $self->moa_amt('52');
719
}
720
721
sub amt_prepayment {
722
    my $self = shift;
723
    return $self->moa_amt('113');
724
}
725
726
# total including allowances & tax
727
sub amt_total {
728
    my $self = shift;
729
    return $self->moa_amt('128');
730
}
731
732
# Used to give price in currency other than that given in price
733
sub amt_unitprice {
734
    my $self = shift;
735
    return $self->moa_amt('146');
736
}
737
738
# item amount after allowances excluding tax
739
sub amt_lineitem {
740
    my $self = shift;
741
    return $self->moa_amt('203');
742
}
743
744
sub pri_price {
745
    my ( $self, $price_qualifier ) = @_;
746
    foreach my $s ( @{ $self->{segs} } ) {
747
        if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) {
748
            return {
749
                price          => $s->elem( 0, 1 ),
750
                type           => $s->elem( 0, 2 ),
751
                type_qualifier => $s->elem( 0, 3 ),
752
            };
753
        }
754
    }
755
    return;
756
}
757
758
# unit price that will be chaged excl tax
759
sub price_net {
760
    my $self = shift;
761
    my $p    = $self->pri_price('AAA');
762
    if ( defined $p ) {
763
        return $p->{price};
764
    }
765
    return;
766
}
767
768
# unit price excluding all allowances, charges and taxes
769
sub price_gross {
770
    my $self = shift;
771
    my $p    = $self->pri_price('AAB');
772
    if ( defined $p ) {
773
        return $p->{price};
774
    }
775
    return;
776
}
777
778
# information price incl tax excluding allowances, charges
779
sub price_info {
780
    my $self = shift;
781
    my $p    = $self->pri_price('AAE');
782
    if ( defined $p ) {
783
        return $p->{price};
784
    }
785
    return;
786
}
787
788
# information price incl tax,allowances, charges
789
sub price_info_inclusive {
790
    my $self = shift;
791
    my $p    = $self->pri_price('AAE');
792
    if ( defined $p ) {
793
        return $p->{price};
794
    }
795
    return;
796
}
797
798
sub tax {
799
    my $self = shift;
800
    return $self->moa_amt('124');
801
}
802
803
sub availability_date {
804
    my $self = shift;
805
    if ( exists $self->{availability_date} ) {
806
        return $self->{availability_date};
807
    }
808
    return;
809
}
810
811
# return text string representing action code
812
sub _translate_action {
813
    my $code   = shift;
814
    my %action = (
815
        2  => 'cancelled',
816
        3  => 'change_requested',
817
        4  => 'no_action',
818
        5  => 'accepted',
819
        10 => 'not_found',
820
        24 => 'recorded',           # Order accepted but a change notified
821
    );
822
    if ( $code && exists $action{$code} ) {
823
        return $action{$code};
824
    }
825
    return $code;
826
827
}
828
1;
829
__END__
830
831
=head1 NAME
832
833
Koha::Edifact::Line
834
835
=head1 SYNOPSIS
836
837
  Class to abstractly handle a Line in an Edifact Transmission
838
839
=head1 DESCRIPTION
840
841
  Allows access to Edifact line elements by name
842
843
=head1 BUGS
844
845
  None documented at present
846
847
=head1 Methods
848
849
=head2 new
850
851
   Called with an array ref of segments constituting the line
852
853
=head1 AUTHOR
854
855
   Colin Campbell <colin.campbell@ptfs-europe.com>
856
857
=head1 COPYRIGHT
858
859
   Copyright 2014,2015  PTFS-Europe Ltd
860
   This program is free software, You may redistribute it under
861
   under the terms of the GNU General Public License
862
863
864
=cut
(-)a/Koha/Edifact/Message.pm (+249 lines)
Line 0 Link Here
1
package Koha::Edifact::Message;
2
3
# Copyright 2014,2015 PTFS-Europe Ltd
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use strict;
21
use warnings;
22
use utf8;
23
24
use Koha::Edifact::Line;
25
26
sub new {
27
    my ( $class, $data_array_ref ) = @_;
28
    my $header       = shift @{$data_array_ref};
29
    my $bgm          = shift @{$data_array_ref};
30
    my $msg_function = $bgm->elem(2);
31
    my $dtm          = [];
32
    while ( $data_array_ref->[0]->tag eq 'DTM' ) {
33
        push @{$dtm}, shift @{$data_array_ref};
34
    }
35
36
    my $self = {
37
        function                 => $msg_function,
38
        header                   => $header,
39
        bgm                      => $bgm,
40
        message_reference_number => $header->elem(0),
41
        dtm                      => $dtm,
42
        datasegs                 => $data_array_ref,
43
    };
44
45
    bless $self, $class;
46
    return $self;
47
}
48
49
sub message_refno {
50
    my $self = shift;
51
    return $self->{message_reference_number};
52
}
53
54
sub function {
55
    my $self         = shift;
56
    my $msg_function = $self->{bgm}->elem(2);
57
    if ( $msg_function == 9 ) {
58
        return 'original';
59
    }
60
    elsif ( $msg_function == 7 ) {
61
        return 'retransmission';
62
    }
63
    return;
64
}
65
66
sub message_reference_number {
67
    my $self = shift;
68
    return $self->{header}->elem(0);
69
}
70
71
sub message_type {
72
    my $self = shift;
73
    return $self->{header}->elem( 1, 0 );
74
}
75
76
sub message_code {
77
    my $self = shift;
78
    return $self->{bgm}->elem( 0, 0 );
79
}
80
81
sub docmsg_number {
82
    my $self = shift;
83
    return $self->{bgm}->elem(1);
84
}
85
86
sub message_date {
87
    my $self = shift;
88
89
    # usually the first if not only dtm
90
    foreach my $d ( @{ $self->{dtm} } ) {
91
        if ( $d->elem( 0, 0 ) eq '137' ) {
92
            return $d->elem( 0, 1 );
93
        }
94
    }
95
    return;    # this should not happen
96
}
97
98
sub tax_point_date {
99
    my $self = shift;
100
    if ( $self->message_type eq 'INVOIC' ) {
101
        foreach my $d ( @{ $self->{dtm} } ) {
102
            if ( $d->elem( 0, 0 ) eq '131' ) {
103
                return $d->elem( 0, 1 );
104
            }
105
        }
106
    }
107
    return;
108
}
109
110
sub expiry_date {
111
    my $self = shift;
112
    if ( $self->message_type eq 'QUOTES' ) {
113
        foreach my $d ( @{ $self->{dtm} } ) {
114
            if ( $d->elem( 0, 0 ) eq '36' ) {
115
                return $d->elem( 0, 1 );
116
            }
117
        }
118
    }
119
    return;
120
}
121
122
sub shipment_charge {
123
    my $self = shift;
124
125
    # A large number of different charges can be expressed at invoice and
126
    # item level but the only one koha takes cognizance of is shipment
127
    # should we wrap all invoice level charges into it??
128
    if ( $self->message_type eq 'INVOIC' ) {
129
        my $delivery = 0;
130
        my $amt      = 0;
131
        foreach my $s ( @{ $self->{datasegs} } ) {
132
            if ( $s->tag eq 'LIN' ) {
133
                last;
134
            }
135
            if ( $s->tag eq 'ALC' ) {
136
                if ( $s->elem(0) eq 'C' ) {    # Its a charge
137
                    if ( $s->elem( 4, 0 ) eq 'DL' ) {    # delivery charge
138
                        $delivery = 1;
139
                    }
140
                }
141
                next;
142
            }
143
            if ( $s->tag eq 'MOA' ) {
144
                $amt += $s->elem( 0, 1 );
145
            }
146
        }
147
        return $amt;
148
    }
149
    return;
150
}
151
152
# return NAD fields
153
154
sub buyer_ean {
155
    my $self = shift;
156
    foreach my $s ( @{ $self->{datasegs} } ) {
157
        if ( $s->tag eq 'LIN' ) {
158
            last;
159
        }
160
        if ( $s->tag eq 'NAD' ) {
161
            my $qualifier = $s->elem(0);
162
            if ( $qualifier eq 'BY' ) {
163
                return $s->elem( 1, 0 );
164
            }
165
        }
166
    }
167
    return;
168
}
169
170
sub supplier_ean {
171
    my $self = shift;
172
    foreach my $s ( @{ $self->{datasegs} } ) {
173
        if ( $s->tag eq 'LIN' ) {
174
            last;
175
        }
176
        if ( $s->tag eq 'NAD' ) {
177
            my $qualifier = $s->elem(0);
178
            if ( $qualifier eq 'SU' ) {
179
                return $s->elem( 1, 0 );
180
            }
181
        }
182
    }
183
    return;
184
185
}
186
187
sub lineitems {
188
    my $self = shift;
189
    if ( $self->{quotation_lines} ) {
190
        return $self->{quotation_lines};
191
    }
192
    else {
193
        my $items    = [];
194
        my $item_arr = [];
195
        foreach my $seg ( @{ $self->{datasegs} } ) {
196
            my $tag = $seg->tag;
197
            if ( $tag eq 'LIN' ) {
198
                if ( @{$item_arr} ) {
199
                    push @{$items}, Koha::Edifact::Line->new($item_arr);
200
                }
201
                $item_arr = [$seg];
202
                next;
203
            }
204
            elsif ( $tag =~ m/^(UNS|CNT|UNT)$/sxm ) {
205
                if ( @{$item_arr} ) {
206
                    push @{$items}, Koha::Edifact::Line->new($item_arr);
207
                }
208
                last;
209
            }
210
            else {
211
                if ( @{$item_arr} ) {
212
                    push @{$item_arr}, $seg;
213
                }
214
            }
215
        }
216
        $self->{quotation_lines} = $items;
217
        return $items;
218
    }
219
}
220
221
1;
222
__END__
223
224
=head1 NAME
225
226
Koha::Edifact::Message
227
228
=head1 DESCRIPTION
229
230
Class modelling an Edifact Message for parsing
231
232
=head1 METHODS
233
234
=head2 new
235
236
   Passed an array of segments extracts message level info
237
   and parses lineitems as Line objects
238
239
=head1 AUTHOR
240
241
   Colin Campbell <colin.campbell@ptfs-europe.com>
242
243
=head1 COPYRIGHT
244
245
   Copyright 2014,2015 PTFS-Europe Ltd
246
   This program is free software, You may redistribute it under
247
   under the terms of the GNU General Public License
248
249
=cut
(-)a/Koha/Edifact/Order.pm (+831 lines)
Line 0 Link Here
1
package Koha::Edifact::Order;
2
3
use strict;
4
use warnings;
5
use utf8;
6
7
# Copyright 2014,2015 PTFS-Europe Ltd
8
#
9
# This file is part of Koha.
10
#
11
# Koha is free software; you can redistribute it and/or modify it
12
# under the terms of the GNU General Public License as published by
13
# the Free Software Foundation; either version 3 of the License, or
14
# (at your option) any later version.
15
#
16
# Koha is distributed in the hope that it will be useful, but
17
# WITHOUT ANY WARRANTY; without even the implied warranty of
18
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19
# GNU General Public License for more details.
20
#
21
# You should have received a copy of the GNU General Public License
22
# along with Koha; if not, see <http://www.gnu.org/licenses>.
23
24
use Carp;
25
use DateTime;
26
use Readonly;
27
use Business::ISBN;
28
use Koha::Database;
29
use C4::Budgets qw( GetBudget );
30
31
Readonly::Scalar my $seg_terminator      => q{'};
32
Readonly::Scalar my $separator           => q{+};
33
Readonly::Scalar my $component_separator => q{:};
34
Readonly::Scalar my $release_character   => q{?};
35
36
Readonly::Scalar my $NINES_12  => 999_999_999_999;
37
Readonly::Scalar my $NINES_14  => 99_999_999_999_999;
38
Readonly::Scalar my $CHUNKSIZE => 35;
39
40
sub new {
41
    my ( $class, $parameter_hashref ) = @_;
42
43
    my $self = {};
44
    if ( ref $parameter_hashref ) {
45
        $self->{orderlines}  = $parameter_hashref->{orderlines};
46
        $self->{recipient}   = $parameter_hashref->{vendor};
47
        $self->{sender}      = $parameter_hashref->{ean};
48
        $self->{is_response} = $parameter_hashref->{is_response};
49
50
        # convenient alias
51
        $self->{basket} = $self->{orderlines}->[0]->basketno;
52
        $self->{message_date} = DateTime->now( time_zone => 'local' );
53
    }
54
55
    # validate that its worth proceeding
56
    if ( !$self->{orderlines} ) {
57
        carp 'No orderlines passed to create order';
58
        return;
59
    }
60
    if ( !$self->{recipient} ) {
61
        carp
62
"No vendor passed to order creation: basket = $self->{basket}->basketno()";
63
        return;
64
    }
65
    if ( !$self->{sender} ) {
66
        carp
67
"No sender ean passed to order creation: basket = $self->{basket}->basketno()";
68
        return;
69
    }
70
71
    # do this once per object not once per orderline
72
    my $database = Koha::Database->new();
73
    $self->{schema} = $database->schema;
74
75
    bless $self, $class;
76
    return $self;
77
}
78
79
sub filename {
80
    my $self = shift;
81
    if ( !$self->{orderlines} ) {
82
        return;
83
    }
84
    my $filename = 'ordr' . $self->{basket}->basketno;
85
    $filename .= '.CEP';
86
    return $filename;
87
}
88
89
sub encode {
90
    my ($self) = @_;
91
92
    $self->{interchange_control_reference} = int rand($NINES_14);
93
    $self->{message_count}                 = 0;
94
95
    #    $self->{segs}; # Message segments
96
97
    $self->{transmission} = q{};
98
99
    $self->{transmission} .= $self->initial_service_segments();
100
101
    $self->{transmission} .= $self->user_data_message_segments();
102
103
    $self->{transmission} .= $self->trailing_service_segments();
104
    return $self->{transmission};
105
}
106
107
sub msg_date_string {
108
    my $self = shift;
109
    return $self->{message_date}->ymd();
110
}
111
112
sub initial_service_segments {
113
    my $self = shift;
114
115
    #UNA service string advice - specifies standard separators
116
    my $segs = _const('service_string_advice');
117
118
    #UNB interchange header
119
    $segs .= $self->interchange_header();
120
121
    #UNG functional group header NOT USED
122
    return $segs;
123
}
124
125
sub interchange_header {
126
    my $self = shift;
127
128
    # syntax identifier
129
    my $hdr =
130
      'UNB+UNOC:3';    # controling agency character set syntax version number
131
                       # Interchange Sender
132
    $hdr .= _interchange_sr_identifier( $self->{sender}->ean,
133
        $self->{sender}->id_code_qualifier );    # interchange sender
134
    $hdr .= _interchange_sr_identifier( $self->{recipient}->san,
135
        $self->{recipient}->id_code_qualifier );    # interchange Recipient
136
137
    $hdr .= $separator;
138
139
    # DateTime of preparation
140
    $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm');
141
    $hdr .= $separator;
142
    $hdr .= $self->interchange_control_reference();
143
    $hdr .= $separator;
144
145
    # Recipents reference password not usually used in edifact
146
    $hdr .= q{+ORDERS};                             # application reference
147
148
#Edifact does not usually include the following
149
#    $hdr .= $separator; # Processing priority  not usually used in edifact
150
#    $hdr .= $separator; # Acknowledgewment request : not usually used in edifact
151
#    $hdr .= q{+EANCOM} # Communications agreement id
152
#    $hdr .= q{+1} # Test indicator
153
#
154
    $hdr .= $seg_terminator;
155
    return $hdr;
156
}
157
158
sub user_data_message_segments {
159
    my $self = shift;
160
161
    #UNH message_header  :: seg count begins here
162
    $self->message_header();
163
164
    $self->order_msg_header();
165
166
    my $line_number = 0;
167
    foreach my $ol ( @{ $self->{orderlines} } ) {
168
        ++$line_number;
169
        $self->order_line( $line_number, $ol );
170
    }
171
172
    $self->message_trailer();
173
174
    my $data_segment_string = join q{}, @{ $self->{segs} };
175
    return $data_segment_string;
176
}
177
178
sub message_trailer {
179
    my $self = shift;
180
181
    # terminate the message
182
    $self->add_seg("UNS+S$seg_terminator");
183
184
    # CNT Control_Total
185
    # Could be (code  1) total value of QTY segments
186
    # or ( code = 2 ) number of lineitems
187
    my $num_orderlines = @{ $self->{orderlines} };
188
    $self->add_seg("CNT+2:$num_orderlines$seg_terminator");
189
190
    # UNT Message Trailer
191
    my $segments_in_message =
192
      1 + @{ $self->{segs} };    # count incl UNH & UNT (!!this one)
193
    my $reference = $self->message_reference('current');
194
    $self->add_seg("UNT+$segments_in_message+$reference$seg_terminator");
195
    return;
196
}
197
198
sub trailing_service_segments {
199
    my $self    = shift;
200
    my $trailer = q{};
201
202
    #UNE functional group trailer NOT USED
203
    #UNZ interchange trailer
204
    $trailer .= $self->interchange_trailer();
205
206
    return $trailer;
207
}
208
209
sub interchange_control_reference {
210
    my $self = shift;
211
    if ( $self->{interchange_control_reference} ) {
212
        return sprintf '%014d', $self->{interchange_control_reference};
213
    }
214
    else {
215
        carp 'calling for ref of unencoded order';
216
        return 'NONE ASSIGNED';
217
    }
218
}
219
220
sub message_reference {
221
    my ( $self, $function ) = @_;
222
    if ( $function eq 'new' || !$self->{message_reference_no} ) {
223
224
        # unique 14 char mesage ref
225
        $self->{message_reference_no} = sprintf 'ME%012d', int rand($NINES_12);
226
    }
227
    return $self->{message_reference_no};
228
}
229
230
sub message_header {
231
    my $self = shift;
232
233
    $self->{segs} = [];          # initialize the message
234
    $self->{message_count}++;    # In practice alwaya 1
235
236
    my $hdr = q{UNH+} . $self->message_reference('new');
237
    $hdr .= _const('message_identifier');
238
    $self->add_seg($hdr);
239
    return;
240
}
241
242
sub interchange_trailer {
243
    my $self = shift;
244
245
    my $t = "UNZ+$self->{message_count}+";
246
    $t .= $self->interchange_control_reference;
247
    $t .= $seg_terminator;
248
    return $t;
249
}
250
251
sub order_msg_header {
252
    my $self = shift;
253
    my @header;
254
255
    # UNH  see message_header
256
    # BGM
257
    push @header,
258
      beginning_of_message(
259
        $self->{basket}->basketno,
260
        $self->{recipient}->san,
261
        $self->{is_response}
262
      );
263
264
    # DTM
265
    push @header, message_date_segment( $self->{message_date} );
266
267
    # NAD-RFF buyer supplier ids
268
    push @header,
269
      name_and_address(
270
        'BUYER',
271
        $self->{sender}->ean,
272
        $self->{sender}->id_code_qualifier
273
      );
274
    push @header,
275
      name_and_address(
276
        'SUPPLIER',
277
        $self->{recipient}->san,
278
        $self->{recipient}->id_code_qualifier
279
      );
280
281
    # repeat for for other relevant parties
282
283
    # CUX currency
284
    # ISO 4217 code to show default currency prices are quoted in
285
    # e.g. CUX+2:GBP:9'
286
    # TBD currency handling
287
288
    $self->add_seg(@header);
289
    return;
290
}
291
292
sub beginning_of_message {
293
    my $basketno            = shift;
294
    my $supplier_san        = shift;
295
    my $response            = shift;
296
    my $document_message_no = sprintf '%011d', $basketno;
297
298
  # Peters & Bolinda use the BIC recommendation to use 22V a code not in Edifact
299
  # If the order is in response to a quote
300
    my %bic_sans = (
301
        '5013546025065' => 'Peters',
302
        '9377779308820' => 'Bolinda',
303
    );
304
305
    #    my $message_function = 9;    # original 7 = retransmission
306
    # message_code values
307
    #      220 prder
308
    #      224 rush order
309
    #      228 sample order :: order for approval / inspection copies
310
    #      22C continuation  order for volumes in a set etc.
311
    #    my $message_code = '220';
312
    if ( exists $bic_sans{$supplier_san} && $response ) {
313
        return "BGM+22V+$document_message_no+9$seg_terminator";
314
    }
315
316
    return "BGM+220+$document_message_no+9$seg_terminator";
317
}
318
319
sub name_and_address {
320
    my ( $party, $id_code, $id_agency ) = @_;
321
    my %qualifier_code = (
322
        BUYER    => 'BY',
323
        DELIVERY => 'DP',    # delivery location if != buyer
324
        INVOICEE => 'IV',    # if different from buyer
325
        SUPPLIER => 'SU',
326
    );
327
    if ( !exists $qualifier_code{$party} ) {
328
        carp "No qualifier code for $party";
329
        return;
330
    }
331
    if ( $id_agency eq '14' ) {
332
        $id_agency = '9';    # ean coded differently in this seg
333
    }
334
335
    return "NAD+$qualifier_code{$party}+${id_code}::$id_agency$seg_terminator";
336
}
337
338
sub order_line {
339
    my ( $self, $linenumber, $orderline ) = @_;
340
341
    my $schema = $self->{schema};
342
    if ( !$orderline->biblionumber )
343
    {                        # cannot generate an orderline without a bib record
344
        return;
345
    }
346
    my $biblionumber = $orderline->biblionumber->biblionumber;
347
    my @biblioitems  = $schema->resultset('Biblioitem')
348
      ->search( { biblionumber => $biblionumber, } );
349
    my $biblioitem = $biblioitems[0];    # makes the assumption there is 1 only
350
                                         # or else all have same details
351
352
    my $id_string = $orderline->line_item_id;
353
354
    # LIN line-number in msg :: if we had a 13 digit ean we could add
355
    $self->add_seg( lin_segment( $linenumber, $id_string ) );
356
357
    # PIA isbn or other id
358
    my @identifiers;
359
    foreach my $id ( $biblioitem->ean, $biblioitem->issn, $biblioitem->isbn ) {
360
        if ( $id && $id ne $id_string ) {
361
            push @identifiers, $id;
362
        }
363
    }
364
    $self->add_seg( additional_product_id( join( ' ', @identifiers ) ) );
365
366
    #  biblio description
367
    $self->add_seg( item_description( $orderline->biblionumber, $biblioitem ) );
368
369
    # QTY order quantity
370
    my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator;
371
    $self->add_seg($qty);
372
373
    # DTM Optional date constraints on delivery
374
    #     we dont currently support this in koha
375
    # GIR copy-related data
376
    my @items;
377
    if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
378
        my @linked_itemnumbers = $orderline->aqorders_items;
379
380
        foreach my $item (@linked_itemnumbers) {
381
            my $i_obj = $schema->resultset('Item')->find( $item->itemnumber );
382
            if ( defined $i_obj ) {
383
                push @items, $i_obj;
384
            }
385
        }
386
    }
387
    else {
388
        my $item_hash = {
389
            itemtype  => $biblioitem->itemtype,
390
            shelfmark => $biblioitem->cn_class,
391
        };
392
        my $branch = $orderline->basketno->deliveryplace;
393
        if ($branch) {
394
            $item_hash->{branch} = $branch;
395
        }
396
        for ( 1 .. $orderline->quantity ) {
397
            push @items, $item_hash;
398
        }
399
    }
400
    my $budget = GetBudget( $orderline->budget_id );
401
    my $ol_fields = { budget_code => $budget->{budget_code}, };
402
    if ( $orderline->order_vendornote ) {
403
        $ol_fields->{servicing_instruction} = $orderline->order_vendornote;
404
    }
405
    $self->add_seg( gir_segments( $ol_fields, @items ) );
406
407
    # TBD what if #items exceeds quantity
408
409
    # FTX free text for current orderline TBD
410
    #    dont really have a special instructions field to encode here
411
    # Encode notes here
412
    # PRI-CUX-DTM unit price on which order is placed : optional
413
    # Coutts read this as 0.00 if not present
414
    if ( $orderline->listprice ) {
415
        my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice;
416
        $price .= $seg_terminator;
417
        $self->add_seg($price);
418
    }
419
420
    # RFF unique orderline reference no
421
    my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator;
422
    $self->add_seg($rff);
423
424
    # RFF : suppliers unique quotation reference number
425
    if ( $orderline->suppliers_reference_number ) {
426
        $rff = join q{}, 'RFF+', $orderline->suppliers_reference_qualifier,
427
          ':', $orderline->suppliers_reference_number, $seg_terminator;
428
        $self->add_seg($rff);
429
    }
430
431
    # LOC-QTY multiple delivery locations
432
    #TBD to specify extra delivery locs
433
    # NAD order line name and address
434
    #TBD Optionally indicate a name & address or order originator
435
    # TDT method of delivey ol-specific
436
    # TBD requests a special delivery option
437
438
    return;
439
}
440
441
sub item_description {
442
    my ( $bib, $biblioitem ) = @_;
443
    my $bib_desc = {
444
        author    => $bib->author,
445
        title     => $bib->title,
446
        publisher => $biblioitem->publishercode,
447
        year      => $biblioitem->publicationyear,
448
    };
449
450
    my @itm = ();
451
452
    # 009 Author
453
    # 050 Title   :: title
454
    # 080 Vol/Part no
455
    # 100 Edition statement
456
    # 109 Publisher  :: publisher
457
    # 110 place of pub
458
    # 170 Date of publication :: year
459
    # 220 Binding  :: binding
460
    my %code = (
461
        author    => '009',
462
        title     => '050',
463
        publisher => '109',
464
        year      => '170',
465
        binding   => '220',
466
    );
467
    for my $field (qw(author title publisher year binding )) {
468
        if ( $bib_desc->{$field} ) {
469
            my $data = encode_text( $bib_desc->{$field} );
470
            push @itm, imd_segment( $code{$field}, $data );
471
        }
472
    }
473
474
    return @itm;
475
}
476
477
sub imd_segment {
478
    my ( $code, $data ) = @_;
479
480
    my $seg_prefix = "IMD+L+$code+:::";
481
482
    # chunk_line
483
    my @chunks;
484
    while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) {
485
        if ( length $x == $CHUNKSIZE ) {
486
            if ( $x =~ s/([?]{1,2})$// ) {
487
                $data = "$1$data";    # dont breakup ?' ?? etc
488
            }
489
        }
490
        push @chunks, $x;
491
    }
492
    my @segs;
493
    my $odd = 1;
494
    foreach my $c (@chunks) {
495
        if ($odd) {
496
            push @segs, "$seg_prefix$c";
497
        }
498
        else {
499
            $segs[-1] .= ":$c$seg_terminator";
500
        }
501
        $odd = !$odd;
502
    }
503
    if ( @segs && $segs[-1] !~ m/$seg_terminator$/o ) {
504
        $segs[-1] .= $seg_terminator;
505
    }
506
    return @segs;
507
}
508
509
sub gir_segments {
510
    my ( $orderfields, @onorderitems ) = @_;
511
512
    my $budget_code = $orderfields->{budget_code};
513
    my @segments;
514
    my $sequence_no = 1;
515
    foreach my $item (@onorderitems) {
516
        my $seg = sprintf 'GIR+%03d', $sequence_no;
517
        $seg .= add_gir_identity_number( 'LFN', $budget_code );
518
        if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
519
            $seg .=
520
              add_gir_identity_number( 'LLO', $item->homebranch->branchcode );
521
            $seg .= add_gir_identity_number( 'LST', $item->itype );
522
            $seg .= add_gir_identity_number( 'LSQ', $item->location );
523
            $seg .= add_gir_identity_number( 'LSM', $item->itemcallnumber );
524
525
            # itemcallnumber -> shelfmark
526
        }
527
        else {
528
            if ( $item->{branch} ) {
529
                $seg .= add_gir_identity_number( 'LLO', $item->{branch} );
530
            }
531
            $seg .= add_gir_identity_number( 'LST', $item->{itemtype} );
532
            $seg .= add_gir_identity_number( 'LSM', $item->{shelfmark} );
533
        }
534
        if ( $orderfields->{servicing_instruction} ) {
535
            $seg .= add_gir_identity_number( 'LVT',
536
                $orderfields->{servicing_instruction} );
537
        }
538
        $sequence_no++;
539
        push @segments, $seg;
540
    }
541
    return @segments;
542
}
543
544
sub add_gir_identity_number {
545
    my ( $number_qualifier, $number ) = @_;
546
    if ($number) {
547
        return "+${number}:${number_qualifier}";
548
    }
549
    return q{};
550
}
551
552
sub add_seg {
553
    my ( $self, @s ) = @_;
554
    foreach my $segment (@s) {
555
        if ( $segment !~ m/$seg_terminator$/o ) {
556
            $segment .= $seg_terminator;
557
        }
558
    }
559
    push @{ $self->{segs} }, @s;
560
    return;
561
}
562
563
sub lin_segment {
564
    my ( $line_number, $item_number_id ) = @_;
565
566
    if ($item_number_id) {
567
        $item_number_id = "++${item_number_id}:EN";
568
    }
569
    else {
570
        $item_number_id = q||;
571
    }
572
573
    return "LIN+$line_number$item_number_id$seg_terminator";
574
}
575
576
sub additional_product_id {
577
    my $isbn_field = shift;
578
    my ( $product_id, $product_code );
579
    if ( $isbn_field =~ m/(\d{13})/ ) {
580
        $product_id   = $1;
581
        $product_code = 'EN';
582
    }
583
    elsif ( $isbn_field =~ m/(\d{9})[Xx\d]/ ) {
584
        $product_id   = $1;
585
        $product_code = 'IB';
586
    }
587
588
    # TBD we could have a manufacturers no issn etc
589
    if ( !$product_id ) {
590
        return;
591
    }
592
593
    # function id set to 5 states this is the main product id
594
    return "PIA+5+$product_id:$product_code$seg_terminator";
595
}
596
597
sub message_date_segment {
598
    my $dt = shift;
599
600
    # qualifier:message_date:format_code
601
602
    my $message_date = $dt->ymd(q{});    # no sep in edifact format
603
604
    return "DTM+137:$message_date:102$seg_terminator";
605
}
606
607
sub _const {
608
    my $key = shift;
609
    Readonly my %S => {
610
        service_string_advice => q{UNA:+.? '},
611
        message_identifier    => q{+ORDERS:D:96A:UN:EAN008'},
612
    };
613
    return ( $S{$key} ) ? $S{$key} : q{};
614
}
615
616
sub _interchange_sr_identifier {
617
    my ( $identification, $qualifier ) = @_;
618
619
    if ( !$identification ) {
620
        $identification = 'RANDOM';
621
        $qualifier      = '92';
622
        carp 'undefined identifier';
623
    }
624
625
    # 14   EAN International
626
    # 31B   US SAN (preferred)
627
    # also 91 assigned by supplier
628
    # also 92 assigned by buyer
629
    if ( $qualifier !~ m/^(?:14|31B|91|92)/xms ) {
630
        $qualifier = '92';
631
    }
632
633
    return "+$identification:$qualifier";
634
}
635
636
sub encode_text {
637
    my $string = shift;
638
    if ($string) {
639
        $string =~ s/[?]/??/g;
640
        $string =~ s/'/?'/g;
641
        $string =~ s/:/?:/g;
642
        $string =~ s/[+]/?+/g;
643
    }
644
    return $string;
645
}
646
647
1;
648
__END__
649
650
=head1 NAME
651
652
Koha::Edifact::Order
653
654
=head1 SYNOPSIS
655
656
Format an Edifact Order message from a Koha basket
657
658
=head1 DESCRIPTION
659
660
Generates an Edifact format Order message for a Koha basket.
661
Normally the only methods used directly by the caller would be
662
new to set up the message, encode to return the formatted message
663
and filename to obtain a name under which to store the message
664
665
=head1 BUGS
666
667
Should integrate into Koha::Edifact namespace
668
Can caller interface be made cleaner?
669
Make handling of GIR segments more customizable
670
671
=head1 METHODS
672
673
=head2 new
674
675
  my $edi_order = Edifact::Order->new(
676
  orderlines => \@orderlines,
677
  vendor     => $vendor_edi_account,
678
  ean        => $library_ean
679
  );
680
681
  instantiate the Edifact::Order object, all parameters are Schema::Resultset objects
682
  Called in Koha::Edifact create_edi_order
683
684
=head2 filename
685
686
   my $filename = $edi_order->filename()
687
688
   returns a filename for the edi order. The filename embeds a reference to the
689
   basket the message was created to encode
690
691
=head2 encode
692
693
   my $edifact_message = $edi_order->encode();
694
695
   Encodes the basket as a valid edifact message ready for transmission
696
697
=head2 initial_service_segments
698
699
    Creates the service segments which begin the message
700
701
=head2 interchange_header
702
703
    Return an interchange header encoding sender and recipient
704
    ids message date and standards
705
706
=head2 user_data_message_segments
707
708
    Include message data within the encoded message
709
710
=head2 message_trailer
711
712
    Terminate message data including control data on number
713
    of messages and segments included
714
715
=head2 trailing_service_segments
716
717
   Include the service segments occuring at the end of the message
718
=head2 interchange_control_reference
719
720
   Returns the unique interchange control reference as a 14 digit number
721
722
=head2 message_reference
723
724
    On generates and subsequently returns the unique message
725
    reference number as a 12 digit number preceded by ME, to generate a new number
726
    pass the string 'new'.
727
    In practice we encode 1 message per transmission so there is only one message
728
    referenced. were we to encode multiple messages a new reference would be
729
    neaded for each
730
731
=head2 message_header
732
733
    Commences a new message
734
735
=head2 interchange_trailer
736
737
    returns the UNZ segment which ends the tranmission encoding the
738
    message count and control reference for the interchange
739
740
=head2 order_msg_header
741
742
    Formats the message header segments
743
744
=head2 beginning_of_message
745
746
    Returns the BGM segment which includes the Koha basket number
747
748
=head2 name_and_address
749
750
    Parameters: Function ( BUYER, DELIVERY, INVOICE, SUPPLIER)
751
                Id
752
                Agency
753
754
    Returns a NAD segment containg the id and agency for for the Function
755
    value. Handles the fact that NAD segments encode the value for 'EAN' differently
756
    to elsewhere.
757
758
=head2 order_line
759
760
    Creates the message segments wncoding an order line
761
762
=head2 item_description
763
764
    Encodes the biblio item fields Author, title, publisher, date of publication
765
    binding
766
767
=head2 imd_segment
768
769
    Formats an IMD segment, handles the chunking of data into the 35 character
770
    lengths required and the creation of repeat segments
771
772
=head2 gir_segments
773
774
    Add item level information
775
776
=head2 add_gir_identity_number
777
778
    Handle the formatting of a GIR element
779
    return empty string if no data
780
781
=head2 add_seg
782
783
    Adds a parssed array of segments to the objects segment list
784
    ensures all segments are properly terminated by '
785
786
=head2 lin_segment
787
788
    Adds a LIN segment consisting of the line number and the ean number
789
    if the passed isbn is valid
790
791
=head2 additional_product_id
792
793
    Add a PIA segment for an additional product id
794
795
=head2 message_date_segment
796
797
    Passed a DateTime object returns a correctly formatted DTM segment
798
799
=head2 _const
800
801
    Stores and returns constant strings for service_string_advice
802
    and message_identifier
803
    TBD replace with class variables
804
805
=head2 _interchange_sr_identifier
806
807
    Format sender and receipient identifiers for use in the interchange header
808
809
=head2 encode_text
810
811
    Encode textual data into the standard character set ( iso 8859-1 )
812
    and quote any Edifact metacharacters
813
814
=head2 msg_date_string
815
816
    Convenient routine which returns message date as a Y-m-d string
817
    useful if the caller wants to log date of creation
818
819
=head1 AUTHOR
820
821
   Colin Campbell <colin.campbell@ptfs-europe.com>
822
823
824
=head1 COPYRIGHT
825
826
   Copyright 2014,2015,2016 PTFS-Europe Ltd
827
   This program is free software, You may redistribute it under
828
   under the terms of the GNU General Public License
829
830
831
=cut
(-)a/Koha/Edifact/Segment.pm (+204 lines)
Line 0 Link Here
1
package Koha::Edifact::Segment;
2
3
# Copyright 2014,2016 PTFS-Europe Ltd
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use strict;
21
use warnings;
22
use utf8;
23
24
sub new {
25
    my ( $class, $parm_ref ) = @_;
26
    my $self = {};
27
    if ( $parm_ref->{seg_string} ) {
28
        $self = _parse_seg( $parm_ref->{seg_string} );
29
    }
30
31
    bless $self, $class;
32
    return $self;
33
}
34
35
sub tag {
36
    my $self = shift;
37
    return $self->{tag};
38
}
39
40
# return specified element may be data or an array ref if components
41
sub elem {
42
    my ( $self, $element_number, $component_number ) = @_;
43
    if ( $element_number < @{ $self->{elem_arr} } ) {
44
45
        my $e = $self->{elem_arr}->[$element_number];
46
        if ( defined $component_number ) {
47
            if ( ref $e eq 'ARRAY' ) {
48
                if ( $component_number < @{$e} ) {
49
                    return $e->[$component_number];
50
                }
51
            }
52
            elsif ( $component_number == 0 ) {
53
54
                # a string could be an element with a single component
55
                return $e;
56
            }
57
            return;
58
        }
59
        else {
60
            return $e;
61
        }
62
    }
63
    return;    #element undefined ( out of range
64
}
65
66
sub element {
67
    my ( $self, @params ) = @_;
68
69
    return $self->elem(@params);
70
}
71
72
sub as_string {
73
    my $self = shift;
74
75
    my $string = $self->{tag};
76
    foreach my $e ( @{ $self->{elem_arr} } ) {
77
        $string .= q|+|;
78
        if ( ref $e eq 'ARRAY' ) {
79
            $string .= join q{:}, @{$e};
80
        }
81
        else {
82
            $string .= $e;
83
        }
84
    }
85
86
    return $string;
87
}
88
89
# parse a string into fields
90
sub _parse_seg {
91
    my $s = shift;
92
    my $e = {
93
        tag      => substr( $s,                0, 3 ),
94
        elem_arr => _get_elements( substr( $s, 3 ) ),
95
    };
96
    return $e;
97
}
98
99
##
100
# String parsing
101
#
102
103
sub _get_elements {
104
    my $seg = shift;
105
106
    $seg =~ s/^[+]//;    # dont start with a dummy element`
107
    my @elem_array = map { _components($_) } split /(?<![?])[+]/, $seg;
108
109
    return \@elem_array;
110
}
111
112
sub _components {
113
    my $element = shift;
114
    my @c = split /(?<![?])[:]/, $element;
115
    if ( @c == 1 ) {     # single element return a string
116
        return de_escape( $c[0] );
117
    }
118
    @c = map { de_escape($_) } @c;
119
    return \@c;
120
}
121
122
sub de_escape {
123
    my $string = shift;
124
125
    # remove escaped characters from the component string
126
    $string =~ s/[?]([:?+'])/$1/g;
127
    return $string;
128
}
129
1;
130
__END__
131
132
=head1 NAME
133
134
Koha::Edifact::Segment - Class foe Edifact Segments
135
136
=head1 DESCRIPTION
137
138
 Used by Koha::Edifact to represent segments in a parsed Edifact message
139
140
141
=head1 METHODS
142
143
=head2 new
144
145
     my $s = Koha::Edifact::Segment->new( { seg_string => $raw });
146
147
     passed a string representation of the segment,  parses it
148
     and retums a Segment object
149
150
=head2 tag
151
152
     returns the three character segment tag
153
154
=head2 elem
155
156
      $data = $s->elem($element_number, $component_number)
157
      return the contents of a specified element and if specified
158
      component of that element
159
160
=head2 element
161
162
      syntactic sugar this wraps the rlem method in a fuller name
163
164
=head2 as_string
165
166
      returns a string representation of the segment
167
168
=head2 _parse_seg
169
170
   passed a string representation of a segment returns a hash ref with
171
   separate tag and data elements
172
173
=head2 _get_elements
174
175
   passed the data portion of a segment, splits it into elements, passing each to
176
   components to further parse them. Returns a reference to an array of
177
   elements
178
179
=head2 _components
180
181
   Passed a string element splits it into components  and returns a reference
182
   to an array of components, if only one component is present that is returned
183
   directly.
184
   quote characters are removed from the components
185
186
=head2 de_escape
187
188
   Removes Edifact escapes from the passed string and returns the modified
189
   string
190
191
192
=head1 AUTHOR
193
194
   Colin Campbell <colin.campbell@ptfs-europe.com>
195
196
197
=head1 COPYRIGHT
198
199
   Copyright 2014,2016, PTFS-Europe Ltd
200
   This program is free software, You may redistribute it under
201
   under the terms of the GNU General Public License
202
203
204
=cut
(-)a/Koha/Edifact/Transport.pm (+479 lines)
Line 0 Link Here
1
package Koha::Edifact::Transport;
2
3
# Copyright 2014,2015 PTFS-Europe Ltd
4
#
5
# This file is part of Koha.
6
#
7
# Koha is free software; you can redistribute it and/or modify it
8
# under the terms of the GNU General Public License as published by
9
# the Free Software Foundation; either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# Koha is distributed in the hope that it will be useful, but
13
# WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with Koha; if not, see <http://www.gnu.org/licenses>.
19
20
use strict;
21
use warnings;
22
use utf8;
23
use DateTime;
24
use Carp;
25
use English qw{ -no_match_vars };
26
use Net::FTP;
27
use Net::SFTP::Foreign;
28
use File::Slurp;
29
use File::Copy;
30
use File::Basename qw( fileparse );
31
use File::Spec;
32
use Koha::Database;
33
use Encode qw( from_to );
34
35
sub new {
36
    my ( $class, $account_id ) = @_;
37
    my $database = Koha::Database->new();
38
    my $schema   = $database->schema();
39
    my $acct     = $schema->resultset('VendorEdiAccount')->find($account_id);
40
    my $self     = {
41
        account     => $acct,
42
        schema      => $schema,
43
        working_dir => File::Spec->tmpdir(),    #temporary work directory
44
        transfer_date => DateTime->now( time_zone => 'local' ),
45
    };
46
47
    bless $self, $class;
48
    return $self;
49
}
50
51
sub working_directory {
52
    my ( $self, $new_value ) = @_;
53
    if ($new_value) {
54
        $self->{working_directory} = $new_value;
55
    }
56
    return $self->{working_directory};
57
}
58
59
sub download_messages {
60
    my ( $self, $message_type ) = @_;
61
    $self->{message_type} = $message_type;
62
63
    my @retrieved_files;
64
65
    if ( $self->{account}->transport eq 'SFTP' ) {
66
        @retrieved_files = $self->sftp_download();
67
    }
68
    elsif ( $self->{account}->transport eq 'FILE' ) {
69
        @retrieved_files = $self->file_download();
70
    }
71
    else {    # assume FTP
72
        @retrieved_files = $self->ftp_download();
73
    }
74
    return @retrieved_files;
75
}
76
77
sub upload_messages {
78
    my ( $self, @messages ) = @_;
79
    if (@messages) {
80
        if ( $self->{account}->transport eq 'SFTP' ) {
81
            $self->sftp_upload(@messages);
82
        }
83
        elsif ( $self->{account}->transport eq 'FILE' ) {
84
            $self->file_upload(@messages);
85
        }
86
        else {    # assume FTP
87
            $self->ftp_upload(@messages);
88
        }
89
    }
90
    return;
91
}
92
93
sub file_download {
94
    my $self = shift;
95
    my @downloaded_files;
96
97
    my $file_ext = _get_file_ext( $self->{message_type} );
98
99
    my $dir = $self->{account}->download_directory;   # makes code more readable
100
         # C = ready to retrieve E = Edifact
101
    my $msg_hash = $self->message_hash();
102
    if ( opendir my $dh, $dir ) {
103
        my @file_list = readdir $dh;
104
        closedir $dh;
105
        foreach my $filename (@file_list) {
106
107
            if ( $filename =~ m/[.]$file_ext$/ ) {
108
                if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
109
                }
110
                else {
111
                    carp "copy of $filename failed";
112
                    next;
113
                }
114
                push @downloaded_files, $filename;
115
                my $processed_name = $filename;
116
                substr $processed_name, -3, 1, 'E';
117
                move( "$dir/$filename", "$dir/$processed_name" );
118
            }
119
        }
120
        $self->ingest( $msg_hash, @downloaded_files );
121
    }
122
    else {
123
        carp "Cannot open $dir";
124
        return;
125
    }
126
    return @downloaded_files;
127
}
128
129
sub sftp_download {
130
    my $self = shift;
131
132
    my $file_ext = _get_file_ext( $self->{message_type} );
133
134
    # C = ready to retrieve E = Edifact
135
    my $msg_hash = $self->message_hash();
136
    my @downloaded_files;
137
    my $sftp = Net::SFTP::Foreign->new(
138
        host     => $self->{account}->host,
139
        user     => $self->{account}->username,
140
        password => $self->{account}->password,
141
        timeout  => 10,
142
    );
143
    if ( $sftp->error ) {
144
        return $self->_abort_download( undef,
145
            'Unable to connect to remote host: ' . $sftp->error );
146
    }
147
    $sftp->setcwd( $self->{account}->download_directory )
148
      or return $self->_abort_download( $sftp,
149
        "Cannot change remote dir : $sftp->error" );
150
    my $file_list = $sftp->ls()
151
      or return $self->_abort_download( $sftp,
152
        "cannot get file list from server: $sftp->error" );
153
    foreach my $file ( @{$file_list} ) {
154
        my $filename = $file->{filename};
155
156
        if ( $filename =~ m/[.]$file_ext$/ ) {
157
            $sftp->get( $filename, "$self->{working_dir}/$filename" );
158
            if ( $sftp->error ) {
159
                $self->_abort_download( $sftp,
160
                    "Error retrieving $filename: $sftp->error" );
161
                last;
162
            }
163
            push @downloaded_files, $filename;
164
            my $processed_name = $filename;
165
            substr $processed_name, -3, 1, 'E';
166
167
            #$sftp->atomic_rename( $filename, $processed_name );
168
            my $ret = $sftp->rename( $filename, $processed_name );
169
            if ( !$ret ) {
170
                $self->_abort_download( $sftp,
171
                    "Error renaming $filename: $sftp->error" );
172
                last;
173
            }
174
175
        }
176
    }
177
    $sftp->disconnect;
178
    $self->ingest( $msg_hash, @downloaded_files );
179
180
    return @downloaded_files;
181
}
182
183
sub ingest {
184
    my ( $self, $msg_hash, @downloaded_files ) = @_;
185
    foreach my $f (@downloaded_files) {
186
        $msg_hash->{filename} = $f;
187
        my $file_content =
188
          read_file( "$self->{working_dir}/$f", binmode => ':raw' );
189
        if ( !defined $file_content ) {
190
            carp "Unable to read download file $f";
191
            next;
192
        }
193
        from_to( $file_content, 'iso-8859-1', 'utf8' );
194
        $msg_hash->{raw_msg} = $file_content;
195
        $self->{schema}->resultset('EdifactMessage')->create($msg_hash);
196
    }
197
    return;
198
}
199
200
sub ftp_download {
201
    my $self = shift;
202
203
    my $file_ext = _get_file_ext( $self->{message_type} );
204
205
    # C = ready to retrieve E = Edifact
206
207
    my $msg_hash = $self->message_hash();
208
    my @downloaded_files;
209
    my $ftp = Net::FTP->new(
210
        $self->{account}->host,
211
        Timeout => 10,
212
        Passive => 1
213
      )
214
      or return $self->_abort_download( undef,
215
        "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
216
    $ftp->login( $self->{account}->username, $self->{account}->password )
217
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
218
    $ftp->cwd( $self->{account}->download_directory )
219
      or return $self->_abort_download( $ftp,
220
        "Cannot change remote dir : $ftp->message()" );
221
    my $file_list = $ftp->ls()
222
      or
223
      return $self->_abort_download( $ftp, 'cannot get file list from server' );
224
225
    foreach my $filename ( @{$file_list} ) {
226
227
        if ( $filename =~ m/[.]$file_ext$/ ) {
228
229
            if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
230
                $self->_abort_download( $ftp,
231
                    "Error retrieving $filename: $ftp->message" );
232
                last;
233
            }
234
235
            push @downloaded_files, $filename;
236
            my $processed_name = $filename;
237
            substr $processed_name, -3, 1, 'E';
238
            $ftp->rename( $filename, $processed_name );
239
        }
240
    }
241
    $ftp->quit;
242
243
    $self->ingest( $msg_hash, @downloaded_files );
244
245
    return @downloaded_files;
246
}
247
248
sub ftp_upload {
249
    my ( $self, @messages ) = @_;
250
    my $ftp = Net::FTP->new(
251
        $self->{account}->host,
252
        Timeout => 10,
253
        Passive => 1
254
      )
255
      or return $self->_abort_download( undef,
256
        "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
257
    $ftp->login( $self->{account}->username, $self->{account}->password )
258
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
259
    $ftp->cwd( $self->{account}->upload_directory )
260
      or return $self->_abort_download( $ftp,
261
        "Cannot change remote dir : $ftp->message()" );
262
    foreach my $m (@messages) {
263
        my $content = $m->raw_msg;
264
        if ($content) {
265
            open my $fh, '<', \$content;
266
            if ( $ftp->put( $fh, $m->filename ) ) {
267
                close $fh;
268
                $m->transfer_date( $self->{transfer_date} );
269
                $m->status('sent');
270
                $m->update;
271
            }
272
            else {
273
                # error in transfer
274
275
            }
276
        }
277
    }
278
279
    $ftp->quit;
280
    return;
281
}
282
283
sub sftp_upload {
284
    my ( $self, @messages ) = @_;
285
    my $sftp = Net::SFTP::Foreign->new(
286
        host     => $self->{account}->host,
287
        user     => $self->{account}->username,
288
        password => $self->{account}->password,
289
        timeout  => 10,
290
    );
291
    $sftp->die_on_error("Cannot ssh to $self->{account}->host");
292
    $sftp->setcwd( $self->{account}->upload_directory )
293
      or return $self->_abort_download( $sftp,
294
        "Cannot change remote dir : $sftp->error" );
295
    foreach my $m (@messages) {
296
        my $content = $m->raw_msg;
297
        if ($content) {
298
            open my $fh, '<', \$content;
299
            if ( $sftp->put( $fh, $m->filename ) ) {
300
                close $fh;
301
                $m->transfer_date( $self->{transfer_date} );
302
                $m->status('sent');
303
                $m->update;
304
            }
305
            else {
306
                # error in transfer
307
308
            }
309
        }
310
    }
311
312
    # sftp will be closed on object destructor
313
    return;
314
}
315
316
sub file_upload {
317
    my ( $self, @messages ) = @_;
318
    my $dir = $self->{account}->upload_directory;
319
    if ( -d $dir ) {
320
        foreach my $m (@messages) {
321
            my $content = $m->raw_msg;
322
            if ($content) {
323
                my $filename     = $m->filename;
324
                my $new_filename = "$dir/$filename";
325
                if ( open my $fh, '>', $new_filename ) {
326
                    print {$fh} $content;
327
                    close $fh;
328
                    $m->transfer_date( $self->{transfer_date} );
329
                    $m->status('sent');
330
                    $m->update;
331
                }
332
                else {
333
                    carp "Could not transfer $m->filename : $ERRNO";
334
                    next;
335
                }
336
            }
337
        }
338
    }
339
    else {
340
        carp "Upload directory $dir does not exist";
341
    }
342
    return;
343
}
344
345
sub _abort_download {
346
    my ( $self, $handle, $log_message ) = @_;
347
348
    my $a = $self->{account}->description;
349
350
    if ($handle) {
351
        $handle->abort();
352
    }
353
    $log_message .= ": $a";
354
    carp $log_message;
355
356
    #returns undef i.e. an empty array
357
    return;
358
}
359
360
sub _get_file_ext {
361
    my $type = shift;
362
363
    # Extension format
364
    # 1st char Status C = Ready For pickup A = Completed E = Extracted
365
    # 2nd Char Standard E = Edifact
366
    # 3rd Char Type of message
367
    my %file_types = (
368
        QUOTE   => 'CEQ',
369
        INVOICE => 'CEI',
370
        ORDRSP  => 'CEA',
371
        ALL     => 'CE.',
372
    );
373
    if ( exists $file_types{$type} ) {
374
        return $file_types{$type};
375
    }
376
    return 'XXXX';    # non matching type
377
}
378
379
sub message_hash {
380
    my $self = shift;
381
    my $msg  = {
382
        message_type  => $self->{message_type},
383
        vendor_id     => $self->{account}->vendor_id,
384
        edi_acct      => $self->{account}->id,
385
        status        => 'new',
386
        deleted       => 0,
387
        transfer_date => $self->{transfer_date}->ymd(),
388
    };
389
390
    return $msg;
391
}
392
393
1;
394
__END__
395
396
=head1 NAME
397
398
Koha::Edifact::Transport
399
400
=head1 SYNOPSIS
401
402
my $download = Koha::Edifact::Transport->new( $vendor_edi_account_id );
403
$downlowd->download_messages('QUOTE');
404
405
406
=head1 DESCRIPTION
407
408
Module that handles Edifact download and upload transport
409
currently can use sftp or ftp
410
Or FILE to access a local directory (useful for testing)
411
412
413
=head1 METHODS
414
415
=head2 new
416
417
    Creates an object of Edifact::Transport requires to be passed the id
418
    identifying the relevant edi vendor account
419
420
=head2 working_directory
421
422
    getter and setter for the working_directory attribute
423
424
=head2 download_messages
425
426
    called with the message type to download will perform the download
427
    using the appropriate transport method
428
429
=head2 upload_messages
430
431
   passed an array of messages will upload them to the supplier site
432
433
=head2 sftp_download
434
435
   called by download_messages to perform the download using SFTP
436
437
=head2 ingest
438
439
   loads downloaded files into the database
440
441
=head2 ftp_download
442
443
   called by download_messages to perform the download using FTP
444
445
=head2 ftp_upload
446
447
  called by upload_messages to perform the upload using ftp
448
449
=head2 sftp_upload
450
451
  called by upload_messages to perform the upload using sftp
452
453
=head2 _abort_download
454
455
   internal routine to halt operation on error and supply a stacktrace
456
457
=head2 _get_file_ext
458
459
   internal method returning standard suffix for file names
460
   according to message type
461
462
=head2 set_transport_direct
463
464
  sets the direct ingest flag so that the object reads files from
465
  the local file system useful in debugging
466
467
=head1 AUTHOR
468
469
   Colin Campbell <colin.campbell@ptfs-europe.com>
470
471
472
=head1 COPYRIGHT
473
474
   Copyright 2014,2015 PTFS-Europe Ltd
475
   This program is free software, You may redistribute it under
476
   under the terms of the GNU General Public License
477
478
479
=cut
(-)a/Koha/Schema/Result/Aqbasket.pm (-2 / +17 lines)
Lines 263-268 __PACKAGE__->belongs_to( Link Here
263
  },
263
  },
264
);
264
);
265
265
266
=head2 edifact_messages
267
268
Type: has_many
269
270
Related object: L<Koha::Schema::Result::EdifactMessage>
271
272
=cut
273
274
__PACKAGE__->has_many(
275
  "edifact_messages",
276
  "Koha::Schema::Result::EdifactMessage",
277
  { "foreign.basketno" => "self.basketno" },
278
  { cascade_copy => 0, cascade_delete => 0 },
279
);
280
266
=head2 borrowernumbers
281
=head2 borrowernumbers
267
282
268
Type: many_to_many
283
Type: many_to_many
Lines 274-281 Composing rels: L</aqbasketusers> -> borrowernumber Link Here
274
__PACKAGE__->many_to_many("borrowernumbers", "aqbasketusers", "borrowernumber");
289
__PACKAGE__->many_to_many("borrowernumbers", "aqbasketusers", "borrowernumber");
275
290
276
291
277
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55
292
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
278
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:pT+YFf9nfD/dmBuE4RNCFw
293
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:tsMzwP7eofOR27sfZSTqFQ
279
294
280
295
281
# You can replace this text with custom content, and it will be preserved on regeneration
296
# You can replace this text with custom content, and it will be preserved on regeneration
(-)a/Koha/Schema/Result/Aqbookseller.pm (-2 / +32 lines)
Lines 311-316 __PACKAGE__->has_many( Link Here
311
  { cascade_copy => 0, cascade_delete => 0 },
311
  { cascade_copy => 0, cascade_delete => 0 },
312
);
312
);
313
313
314
=head2 edifact_messages
315
316
Type: has_many
317
318
Related object: L<Koha::Schema::Result::EdifactMessage>
319
320
=cut
321
322
__PACKAGE__->has_many(
323
  "edifact_messages",
324
  "Koha::Schema::Result::EdifactMessage",
325
  { "foreign.vendor_id" => "self.id" },
326
  { cascade_copy => 0, cascade_delete => 0 },
327
);
328
314
=head2 invoiceprice
329
=head2 invoiceprice
315
330
316
Type: belongs_to
331
Type: belongs_to
Lines 351-359 __PACKAGE__->belongs_to( Link Here
351
  },
366
  },
352
);
367
);
353
368
369
=head2 vendor_edi_accounts
370
371
Type: has_many
372
373
Related object: L<Koha::Schema::Result::VendorEdiAccount>
374
375
=cut
376
377
__PACKAGE__->has_many(
378
  "vendor_edi_accounts",
379
  "Koha::Schema::Result::VendorEdiAccount",
380
  { "foreign.vendor_id" => "self.id" },
381
  { cascade_copy => 0, cascade_delete => 0 },
382
);
383
354
384
355
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-08-26 11:53:50
385
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
356
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:kz1tuPJihENyV6OyCwyX/A
386
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:bm3bQTUitVpvT+euN9brOg
357
387
358
388
359
# You can replace this text with custom content, and it will be preserved on regeneration
389
# You can replace this text with custom content, and it will be preserved on regeneration
(-)a/Koha/Schema/Result/Aqbudget.pm (-2 / +17 lines)
Lines 257-262 __PACKAGE__->has_many( Link Here
257
  { cascade_copy => 0, cascade_delete => 0 },
257
  { cascade_copy => 0, cascade_delete => 0 },
258
);
258
);
259
259
260
=head2 vendor_edi_accounts
261
262
Type: has_many
263
264
Related object: L<Koha::Schema::Result::VendorEdiAccount>
265
266
=cut
267
268
__PACKAGE__->has_many(
269
  "vendor_edi_accounts",
270
  "Koha::Schema::Result::VendorEdiAccount",
271
  { "foreign.shipment_budget" => "self.budget_id" },
272
  { cascade_copy => 0, cascade_delete => 0 },
273
);
274
260
=head2 borrowernumbers
275
=head2 borrowernumbers
261
276
262
Type: many_to_many
277
Type: many_to_many
Lines 268-275 Composing rels: L</aqbudgetborrowers> -> borrowernumber Link Here
268
__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");
283
__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");
269
284
270
285
271
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-02-09 15:51:54
286
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2015-03-04 10:26:49
272
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:SZKnWPCMNFUm/TzeBxeDZA
287
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:E4J/D0+2j0/8JZd0YRnoeA
273
288
274
289
275
# You can replace this text with custom content, and it will be preserved on regeneration
290
# You can replace this text with custom content, and it will be preserved on regeneration
(-)a/Koha/Schema/Result/Aqinvoice.pm (-2 / +30 lines)
Lines 70-75 __PACKAGE__->table("aqinvoices"); Link Here
70
  is_foreign_key: 1
70
  is_foreign_key: 1
71
  is_nullable: 1
71
  is_nullable: 1
72
72
73
=head2 message_id
74
75
  data_type: 'integer'
76
  is_foreign_key: 1
77
  is_nullable: 1
78
73
=cut
79
=cut
74
80
75
__PACKAGE__->add_columns(
81
__PACKAGE__->add_columns(
Lines 89-94 __PACKAGE__->add_columns( Link Here
89
  { data_type => "decimal", is_nullable => 1, size => [28, 6] },
95
  { data_type => "decimal", is_nullable => 1, size => [28, 6] },
90
  "shipmentcost_budgetid",
96
  "shipmentcost_budgetid",
91
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
97
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
98
  "message_id",
99
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
92
);
100
);
93
101
94
=head1 PRIMARY KEY
102
=head1 PRIMARY KEY
Lines 135-140 __PACKAGE__->belongs_to( Link Here
135
  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
143
  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
136
);
144
);
137
145
146
=head2 message
147
148
Type: belongs_to
149
150
Related object: L<Koha::Schema::Result::EdifactMessage>
151
152
=cut
153
154
__PACKAGE__->belongs_to(
155
  "message",
156
  "Koha::Schema::Result::EdifactMessage",
157
  { id => "message_id" },
158
  {
159
    is_deferrable => 1,
160
    join_type     => "LEFT",
161
    on_delete     => "SET NULL",
162
    on_update     => "RESTRICT",
163
  },
164
);
165
138
=head2 shipmentcost_budgetid
166
=head2 shipmentcost_budgetid
139
167
140
Type: belongs_to
168
Type: belongs_to
Lines 156-163 __PACKAGE__->belongs_to( Link Here
156
);
184
);
157
185
158
186
159
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55
187
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-18 16:21:46
160
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:3se4f767VfvBKaZ8tlXwHQ
188
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FPZXlNt8dkjhgt2Rtc+krQ
161
189
162
190
163
# You can replace this text with custom content, and it will be preserved on regeneration
191
# You can replace this text with custom content, and it will be preserved on regeneration
(-)a/Koha/Schema/Result/Aqorder.pm (-3 / +34 lines)
Lines 227-232 __PACKAGE__->table("aqorders"); Link Here
227
  is_nullable: 1
227
  is_nullable: 1
228
  size: 16
228
  size: 16
229
229
230
=head2 line_item_id
231
232
  data_type: 'varchar'
233
  is_nullable: 1
234
  size: 35
235
236
=head2 suppliers_reference_number
237
238
  data_type: 'varchar'
239
  is_nullable: 1
240
  size: 35
241
242
=head2 suppliers_reference_qualifier
243
244
  data_type: 'varchar'
245
  is_nullable: 1
246
  size: 3
247
248
=head2 suppliers_report
249
250
  data_type: 'text'
251
  is_nullable: 1
252
230
=cut
253
=cut
231
254
232
__PACKAGE__->add_columns(
255
__PACKAGE__->add_columns(
Lines 310-315 __PACKAGE__->add_columns( Link Here
310
    is_nullable => 1,
333
    is_nullable => 1,
311
    size => 16,
334
    size => 16,
312
  },
335
  },
336
  "line_item_id",
337
  { data_type => "varchar", is_nullable => 1, size => 35 },
338
  "suppliers_reference_number",
339
  { data_type => "varchar", is_nullable => 1, size => 35 },
340
  "suppliers_reference_qualifier",
341
  { data_type => "varchar", is_nullable => 1, size => 3 },
342
  "suppliers_report",
343
  { data_type => "text", is_nullable => 1 },
313
);
344
);
314
345
315
=head1 PRIMARY KEY
346
=head1 PRIMARY KEY
Lines 492-500 Composing rels: L</aqorder_users> -> borrowernumber Link Here
492
__PACKAGE__->many_to_many("borrowernumbers", "aqorder_users", "borrowernumber");
523
__PACKAGE__->many_to_many("borrowernumbers", "aqorder_users", "borrowernumber");
493
524
494
525
495
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-05-14 11:27:15
526
# Created by DBIx::Class::Schema::Loader v0.07043 @ 2016-01-19 11:57:26
496
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:BCa/SxerJ+zEh8Pg9Jdkaw
527
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:iw+b4tqItFOXERzWvhYxlQ
497
528
498
529
499
# You can replace this text with custom content, and it will be preserved on regeneration
530
# You can replace this text with custom code or comments, and it will be preserved on regeneration
500
1;
531
1;
(-)a/Koha/Schema/Result/Branch.pm (-3 / +18 lines)
Lines 397-402 __PACKAGE__->might_have( Link Here
397
  { cascade_copy => 0, cascade_delete => 0 },
397
  { cascade_copy => 0, cascade_delete => 0 },
398
);
398
);
399
399
400
=head2 edifact_eans
401
402
Type: has_many
403
404
Related object: L<Koha::Schema::Result::EdifactEan>
405
406
=cut
407
408
__PACKAGE__->has_many(
409
  "edifact_eans",
410
  "Koha::Schema::Result::EdifactEan",
411
  { "foreign.branchcode" => "self.branchcode" },
412
  { cascade_copy => 0, cascade_delete => 0 },
413
);
414
400
=head2 hold_fill_targets
415
=head2 hold_fill_targets
401
416
402
Type: has_many
417
Type: has_many
Lines 513-521 Composing rels: L</branchrelations> -> categorycode Link Here
513
__PACKAGE__->many_to_many("categorycodes", "branchrelations", "categorycode");
528
__PACKAGE__->many_to_many("categorycodes", "branchrelations", "categorycode");
514
529
515
530
516
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-11-06 15:26:36
531
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-11-26 11:08:29
517
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:CGNPB/MkGLOihDThj43/4A
532
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FjNI9OEpa5OKfwwCkggu0w
518
533
519
534
520
# You can replace this text with custom content, and it will be preserved on regeneration
535
# You can replace this text with custom code or comments, and it will be preserved on regeneration
521
1;
536
1;
(-)a/Koha/Schema/Result/EdifactEan.pm (+117 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::EdifactEan;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::EdifactEan
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<edifact_ean>
19
20
=cut
21
22
__PACKAGE__->table("edifact_ean");
23
24
=head1 ACCESSORS
25
26
=head2 ee_id
27
28
  data_type: 'integer'
29
  extra: {unsigned => 1}
30
  is_auto_increment: 1
31
  is_nullable: 0
32
33
=head2 branchcode
34
35
  data_type: 'varchar'
36
  is_foreign_key: 1
37
  is_nullable: 0
38
  size: 10
39
40
=head2 ean
41
42
  data_type: 'varchar'
43
  is_nullable: 0
44
  size: 15
45
46
=head2 id_code_qualifier
47
48
  data_type: 'varchar'
49
  default_value: 14
50
  is_nullable: 0
51
  size: 3
52
53
=cut
54
55
__PACKAGE__->add_columns(
56
  "ee_id",
57
  {
58
    data_type => "integer",
59
    extra => { unsigned => 1 },
60
    is_auto_increment => 1,
61
    is_nullable => 0,
62
  },
63
  "branchcode",
64
  { data_type => "varchar", is_foreign_key => 1, is_nullable => 0, size => 10 },
65
  "ean",
66
  { data_type => "varchar", is_nullable => 0, size => 15 },
67
  "id_code_qualifier",
68
  { data_type => "varchar", default_value => 14, is_nullable => 0, size => 3 },
69
);
70
71
=head1 PRIMARY KEY
72
73
=over 4
74
75
=item * L</ee_id>
76
77
=back
78
79
=cut
80
81
__PACKAGE__->set_primary_key("ee_id");
82
83
=head1 RELATIONS
84
85
=head2 branchcode
86
87
Type: belongs_to
88
89
Related object: L<Koha::Schema::Result::Branch>
90
91
=cut
92
93
__PACKAGE__->belongs_to(
94
  "branchcode",
95
  "Koha::Schema::Result::Branch",
96
  { branchcode => "branchcode" },
97
  { is_deferrable => 1, on_delete => "RESTRICT", on_update => "RESTRICT" },
98
);
99
100
101
# Created by DBIx::Class::Schema::Loader v0.07042 @ 2015-06-12 10:22:04
102
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:WWcMBSXeuzgCPqM0KMxfBg
103
104
105
# You can replace this text with custom code or comments, and it will be preserved on regeneration
106
__PACKAGE__->belongs_to('branch',
107
    "Koha::Schema::Result::Branch",
108
    { 'branchcode' => 'branchcode' },
109
    {
110
        is_deferrable => 1,
111
        join_type => 'LEFT',
112
        on_delete => 'CASCADE',
113
        on_update => 'CASCADE',
114
    },
115
);
116
117
1;
(-)a/Koha/Schema/Result/EdifactMessage.pm (+202 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::EdifactMessage;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::EdifactMessage
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<edifact_messages>
19
20
=cut
21
22
__PACKAGE__->table("edifact_messages");
23
24
=head1 ACCESSORS
25
26
=head2 id
27
28
  data_type: 'integer'
29
  is_auto_increment: 1
30
  is_nullable: 0
31
32
=head2 message_type
33
34
  data_type: 'varchar'
35
  is_nullable: 0
36
  size: 10
37
38
=head2 transfer_date
39
40
  data_type: 'date'
41
  datetime_undef_if_invalid: 1
42
  is_nullable: 1
43
44
=head2 vendor_id
45
46
  data_type: 'integer'
47
  is_foreign_key: 1
48
  is_nullable: 1
49
50
=head2 edi_acct
51
52
  data_type: 'integer'
53
  is_foreign_key: 1
54
  is_nullable: 1
55
56
=head2 status
57
58
  data_type: 'text'
59
  is_nullable: 1
60
61
=head2 basketno
62
63
  data_type: 'integer'
64
  is_foreign_key: 1
65
  is_nullable: 1
66
67
=head2 raw_msg
68
69
  data_type: 'mediumtext'
70
  is_nullable: 1
71
72
=head2 filename
73
74
  data_type: 'text'
75
  is_nullable: 1
76
77
=head2 deleted
78
79
  data_type: 'tinyint'
80
  default_value: 0
81
  is_nullable: 0
82
83
=cut
84
85
__PACKAGE__->add_columns(
86
  "id",
87
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
88
  "message_type",
89
  { data_type => "varchar", is_nullable => 0, size => 10 },
90
  "transfer_date",
91
  { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 },
92
  "vendor_id",
93
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
94
  "edi_acct",
95
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
96
  "status",
97
  { data_type => "text", is_nullable => 1 },
98
  "basketno",
99
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
100
  "raw_msg",
101
  { data_type => "mediumtext", is_nullable => 1 },
102
  "filename",
103
  { data_type => "text", is_nullable => 1 },
104
  "deleted",
105
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
106
);
107
108
=head1 PRIMARY KEY
109
110
=over 4
111
112
=item * L</id>
113
114
=back
115
116
=cut
117
118
__PACKAGE__->set_primary_key("id");
119
120
=head1 RELATIONS
121
122
=head2 aqinvoices
123
124
Type: has_many
125
126
Related object: L<Koha::Schema::Result::Aqinvoice>
127
128
=cut
129
130
__PACKAGE__->has_many(
131
  "aqinvoices",
132
  "Koha::Schema::Result::Aqinvoice",
133
  { "foreign.message_id" => "self.id" },
134
  { cascade_copy => 0, cascade_delete => 0 },
135
);
136
137
=head2 basketno
138
139
Type: belongs_to
140
141
Related object: L<Koha::Schema::Result::Aqbasket>
142
143
=cut
144
145
__PACKAGE__->belongs_to(
146
  "basketno",
147
  "Koha::Schema::Result::Aqbasket",
148
  { basketno => "basketno" },
149
  {
150
    is_deferrable => 1,
151
    join_type     => "LEFT",
152
    on_delete     => "RESTRICT",
153
    on_update     => "RESTRICT",
154
  },
155
);
156
157
=head2 edi_acct
158
159
Type: belongs_to
160
161
Related object: L<Koha::Schema::Result::VendorEdiAccount>
162
163
=cut
164
165
__PACKAGE__->belongs_to(
166
  "edi_acct",
167
  "Koha::Schema::Result::VendorEdiAccount",
168
  { id => "edi_acct" },
169
  {
170
    is_deferrable => 1,
171
    join_type     => "LEFT",
172
    on_delete     => "RESTRICT",
173
    on_update     => "RESTRICT",
174
  },
175
);
176
177
=head2 vendor
178
179
Type: belongs_to
180
181
Related object: L<Koha::Schema::Result::Aqbookseller>
182
183
=cut
184
185
__PACKAGE__->belongs_to(
186
  "vendor",
187
  "Koha::Schema::Result::Aqbookseller",
188
  { id => "vendor_id" },
189
  {
190
    is_deferrable => 1,
191
    join_type     => "LEFT",
192
    on_delete     => "RESTRICT",
193
    on_update     => "RESTRICT",
194
  },
195
);
196
197
198
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2015-02-25 10:41:36
199
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:l4h8AsG2RJupxXQcEw8yzQ
200
201
202
1;
(-)a/Koha/Schema/Result/MsgInvoice.pm (+115 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::MsgInvoice;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::MsgInvoice
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<msg_invoice>
19
20
=cut
21
22
__PACKAGE__->table("msg_invoice");
23
24
=head1 ACCESSORS
25
26
=head2 mi_id
27
28
  data_type: 'integer'
29
  is_auto_increment: 1
30
  is_nullable: 0
31
32
=head2 msg_id
33
34
  data_type: 'integer'
35
  is_foreign_key: 1
36
  is_nullable: 1
37
38
=head2 invoiceid
39
40
  data_type: 'integer'
41
  is_foreign_key: 1
42
  is_nullable: 1
43
44
=cut
45
46
__PACKAGE__->add_columns(
47
  "mi_id",
48
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
49
  "msg_id",
50
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
51
  "invoiceid",
52
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
53
);
54
55
=head1 PRIMARY KEY
56
57
=over 4
58
59
=item * L</mi_id>
60
61
=back
62
63
=cut
64
65
__PACKAGE__->set_primary_key("mi_id");
66
67
=head1 RELATIONS
68
69
=head2 invoiceid
70
71
Type: belongs_to
72
73
Related object: L<Koha::Schema::Result::Aqinvoice>
74
75
=cut
76
77
__PACKAGE__->belongs_to(
78
  "invoiceid",
79
  "Koha::Schema::Result::Aqinvoice",
80
  { invoiceid => "invoiceid" },
81
  {
82
    is_deferrable => 1,
83
    join_type     => "LEFT",
84
    on_delete     => "RESTRICT",
85
    on_update     => "RESTRICT",
86
  },
87
);
88
89
=head2 msg
90
91
Type: belongs_to
92
93
Related object: L<Koha::Schema::Result::EdifactMessage>
94
95
=cut
96
97
__PACKAGE__->belongs_to(
98
  "msg",
99
  "Koha::Schema::Result::EdifactMessage",
100
  { id => "msg_id" },
101
  {
102
    is_deferrable => 1,
103
    join_type     => "LEFT",
104
    on_delete     => "RESTRICT",
105
    on_update     => "RESTRICT",
106
  },
107
);
108
109
110
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
111
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:F1jqlEH57dpxn2Pvm/vPGA
112
113
114
# You can replace this text with custom code or comments, and it will be preserved on regeneration
115
1;
(-)a/Koha/Schema/Result/VendorEdiAccount.pm (+249 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::VendorEdiAccount;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::VendorEdiAccount
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<vendor_edi_accounts>
19
20
=cut
21
22
__PACKAGE__->table("vendor_edi_accounts");
23
24
=head1 ACCESSORS
25
26
=head2 id
27
28
  data_type: 'integer'
29
  is_auto_increment: 1
30
  is_nullable: 0
31
32
=head2 description
33
34
  data_type: 'text'
35
  is_nullable: 0
36
37
=head2 host
38
39
  data_type: 'varchar'
40
  is_nullable: 1
41
  size: 40
42
43
=head2 username
44
45
  data_type: 'varchar'
46
  is_nullable: 1
47
  size: 40
48
49
=head2 password
50
51
  data_type: 'varchar'
52
  is_nullable: 1
53
  size: 40
54
55
=head2 last_activity
56
57
  data_type: 'date'
58
  datetime_undef_if_invalid: 1
59
  is_nullable: 1
60
61
=head2 vendor_id
62
63
  data_type: 'integer'
64
  is_foreign_key: 1
65
  is_nullable: 1
66
67
=head2 download_directory
68
69
  data_type: 'text'
70
  is_nullable: 1
71
72
=head2 upload_directory
73
74
  data_type: 'text'
75
  is_nullable: 1
76
77
=head2 san
78
79
  data_type: 'varchar'
80
  is_nullable: 1
81
  size: 20
82
83
=head2 id_code_qualifier
84
85
  data_type: 'varchar'
86
  default_value: 14
87
  is_nullable: 1
88
  size: 3
89
90
=head2 transport
91
92
  data_type: 'varchar'
93
  default_value: 'FTP'
94
  is_nullable: 1
95
  size: 6
96
97
=head2 quotes_enabled
98
99
  data_type: 'tinyint'
100
  default_value: 0
101
  is_nullable: 0
102
103
=head2 invoices_enabled
104
105
  data_type: 'tinyint'
106
  default_value: 0
107
  is_nullable: 0
108
109
=head2 orders_enabled
110
111
  data_type: 'tinyint'
112
  default_value: 0
113
  is_nullable: 0
114
115
=head2 responses_enabled
116
117
  data_type: 'tinyint'
118
  default_value: 0
119
  is_nullable: 0
120
121
=head2 auto_orders
122
123
  data_type: 'tinyint'
124
  default_value: 0
125
  is_nullable: 0
126
127
=head2 shipment_budget
128
129
  data_type: 'integer'
130
  is_foreign_key: 1
131
  is_nullable: 1
132
133
=cut
134
135
__PACKAGE__->add_columns(
136
  "id",
137
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
138
  "description",
139
  { data_type => "text", is_nullable => 0 },
140
  "host",
141
  { data_type => "varchar", is_nullable => 1, size => 40 },
142
  "username",
143
  { data_type => "varchar", is_nullable => 1, size => 40 },
144
  "password",
145
  { data_type => "varchar", is_nullable => 1, size => 40 },
146
  "last_activity",
147
  { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 },
148
  "vendor_id",
149
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
150
  "download_directory",
151
  { data_type => "text", is_nullable => 1 },
152
  "upload_directory",
153
  { data_type => "text", is_nullable => 1 },
154
  "san",
155
  { data_type => "varchar", is_nullable => 1, size => 20 },
156
  "id_code_qualifier",
157
  { data_type => "varchar", default_value => 14, is_nullable => 1, size => 3 },
158
  "transport",
159
  { data_type => "varchar", default_value => "FTP", is_nullable => 1, size => 6 },
160
  "quotes_enabled",
161
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
162
  "invoices_enabled",
163
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
164
  "orders_enabled",
165
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
166
  "responses_enabled",
167
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
168
  "auto_orders",
169
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
170
  "shipment_budget",
171
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
172
);
173
174
=head1 PRIMARY KEY
175
176
=over 4
177
178
=item * L</id>
179
180
=back
181
182
=cut
183
184
__PACKAGE__->set_primary_key("id");
185
186
=head1 RELATIONS
187
188
=head2 edifact_messages
189
190
Type: has_many
191
192
Related object: L<Koha::Schema::Result::EdifactMessage>
193
194
=cut
195
196
__PACKAGE__->has_many(
197
  "edifact_messages",
198
  "Koha::Schema::Result::EdifactMessage",
199
  { "foreign.edi_acct" => "self.id" },
200
  { cascade_copy => 0, cascade_delete => 0 },
201
);
202
203
=head2 shipment_budget
204
205
Type: belongs_to
206
207
Related object: L<Koha::Schema::Result::Aqbudget>
208
209
=cut
210
211
__PACKAGE__->belongs_to(
212
  "shipment_budget",
213
  "Koha::Schema::Result::Aqbudget",
214
  { budget_id => "shipment_budget" },
215
  {
216
    is_deferrable => 1,
217
    join_type     => "LEFT",
218
    on_delete     => "RESTRICT",
219
    on_update     => "RESTRICT",
220
  },
221
);
222
223
=head2 vendor
224
225
Type: belongs_to
226
227
Related object: L<Koha::Schema::Result::Aqbookseller>
228
229
=cut
230
231
__PACKAGE__->belongs_to(
232
  "vendor",
233
  "Koha::Schema::Result::Aqbookseller",
234
  { id => "vendor_id" },
235
  {
236
    is_deferrable => 1,
237
    join_type     => "LEFT",
238
    on_delete     => "RESTRICT",
239
    on_update     => "RESTRICT",
240
  },
241
);
242
243
244
# Created by DBIx::Class::Schema::Loader v0.07042 @ 2015-08-19 11:41:15
245
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:0CgJuFAItI71dfSG88NWhg
246
247
248
# You can replace this text with custom code or comments, and it will be preserved on regeneration
249
1;
(-)a/acqui/basket.pl (+77 lines)
Lines 36-41 use C4::Members qw/GetMember/; #needed for permissions checking for changing ba Link Here
36
use C4::Items;
36
use C4::Items;
37
use C4::Suggestions;
37
use C4::Suggestions;
38
use Date::Calc qw/Add_Delta_Days/;
38
use Date::Calc qw/Add_Delta_Days/;
39
use Koha::Database;
40
use Koha::EDI qw( create_edi_order get_edifact_ean );
39
41
40
=head1 NAME
42
=head1 NAME
41
43
Lines 67-72 the supplier this script have to display the basket. Link Here
67
69
68
my $query        = new CGI;
70
my $query        = new CGI;
69
our $basketno     = $query->param('basketno');
71
our $basketno     = $query->param('basketno');
72
my $ean          = $query->param('ean');
70
my $booksellerid = $query->param('booksellerid');
73
my $booksellerid = $query->param('booksellerid');
71
my $duplinbatch =  $query->param('duplinbatch');
74
my $duplinbatch =  $query->param('duplinbatch');
72
75
Lines 84-89 my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( Link Here
84
my $basket = GetBasket($basketno);
87
my $basket = GetBasket($basketno);
85
$booksellerid = $basket->{booksellerid} unless $booksellerid;
88
$booksellerid = $basket->{booksellerid} unless $booksellerid;
86
my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
89
my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
90
my $schema = Koha::Database->new()->schema();
91
my $rs = $schema->resultset('VendorEdiAccount')->search(
92
    { vendor_id => $booksellerid, } );
93
$template->param( ediaccount => ($rs->count > 0));
87
94
88
unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
95
unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
89
    $template->param(
96
    $template->param(
Lines 196-201 if ( $op eq 'delete_confirm' ) { Link Here
196
} elsif ($op eq 'reopen') {
203
} elsif ($op eq 'reopen') {
197
    ReopenBasket($query->param('basketno'));
204
    ReopenBasket($query->param('basketno'));
198
    print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
205
    print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
206
}
207
elsif ( $op eq 'ediorder' ) {
208
    edi_close_and_order()
199
} elsif ( $op eq 'mod_users' ) {
209
} elsif ( $op eq 'mod_users' ) {
200
    my $basketusers_ids = $query->param('users_ids');
210
    my $basketusers_ids = $query->param('users_ids');
201
    my @basketusers = split( /:/, $basketusers_ids );
211
    my @basketusers = split( /:/, $basketusers_ids );
Lines 470-472 sub get_order_infos { Link Here
470
}
480
}
471
481
472
output_html_with_http_headers $query, $cookie, $template->output;
482
output_html_with_http_headers $query, $cookie, $template->output;
483
484
485
sub edi_close_and_order {
486
    my $confirm = $query->param('confirm') || $confirm_pref eq '2';
487
    if ($confirm) {
488
            my $edi_params = {
489
                basketno => $basketno,
490
                ean    => $ean,
491
            };
492
            if ( $basket->{branch} ) {
493
                $edi_params->{branchcode} = $basket->{branch};
494
            }
495
            if ( create_edi_order($edi_params) ) {
496
                #$template->param( edifile => 1 );
497
            }
498
        CloseBasket($basketno);
499
500
        # if requested, create basket group, close it and attach the basket
501
        if ( $query->param('createbasketgroup') ) {
502
            my $branchcode;
503
            if (    C4::Context->userenv
504
                and C4::Context->userenv->{'branch'}
505
                and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET" )
506
            {
507
                $branchcode = C4::Context->userenv->{'branch'};
508
            }
509
            my $basketgroupid = NewBasketgroup(
510
                {
511
                    name          => $basket->{basketname},
512
                    booksellerid  => $booksellerid,
513
                    deliveryplace => $branchcode,
514
                    billingplace  => $branchcode,
515
                    closed        => 1,
516
                }
517
            );
518
            ModBasket(
519
                {
520
                    basketno      => $basketno,
521
                    basketgroupid => $basketgroupid
522
                }
523
            );
524
            print $query->redirect(
525
"/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1"
526
            );
527
        }
528
        else {
529
            print $query->redirect(
530
                "/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid"
531
            );
532
        }
533
        exit;
534
    }
535
    else {
536
        $template->param(
537
            edi_confirm     => 1,
538
            booksellerid    => $booksellerid,
539
            basketno        => $basket->{basketno},
540
            basketname      => $basket->{basketname},
541
            basketgroupname => $basket->{basketname},
542
        );
543
        if ($ean) {
544
            $template->param( ean => $ean );
545
        }
546
547
    }
548
    return;
549
}
(-)a/acqui/basketgroup.pl (+17 lines)
Lines 55-60 use C4::Budgets qw/ConvertCurrency/; Link Here
55
use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/;
55
use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/;
56
use C4::Branch qw/GetBranches/;
56
use C4::Branch qw/GetBranches/;
57
use C4::Members qw/GetMember/;
57
use C4::Members qw/GetMember/;
58
use Koha::EDI qw/create_edi_order get_edifact_ean/;
58
59
59
use Koha::Acquisition::Bookseller;
60
use Koha::Acquisition::Bookseller;
60
61
Lines 207-218 sub printbasketgrouppdf{ Link Here
207
208
208
}
209
}
209
210
211
sub generate_edifact_orders {
212
    my $basketgroupid = shift;
213
    my $baskets       = GetBasketsByBasketgroup($basketgroupid);
214
    my $ean           = get_edifact_ean();
215
216
    for my $basket ( @{$baskets} ) {
217
        create_edi_order( { ean => $ean, basketno => $basket->{basketno}, } );
218
    }
219
    return;
220
}
221
210
my $op = $input->param('op') || 'display';
222
my $op = $input->param('op') || 'display';
211
# possible values of $op :
223
# possible values of $op :
212
# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup
224
# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup
213
# - mod_basket : modify an individual basket of the basketgroup
225
# - mod_basket : modify an individual basket of the basketgroup
214
# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list
226
# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list
215
# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list
227
# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list
228
# - ediprint : generate edi order messages for the baskets in the group
216
# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list
229
# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list
217
# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list
230
# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list
218
# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list
231
# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list
Lines 371-376 if ( $op eq "add" ) { Link Here
371
    $redirectpath .=  "&amp;listclosed=1" if $closedbg ;
384
    $redirectpath .=  "&amp;listclosed=1" if $closedbg ;
372
    print $input->redirect($redirectpath );
385
    print $input->redirect($redirectpath );
373
    
386
    
387
} elsif ( $op eq 'ediprint') {
388
    my $basketgroupid = $input->param('basketgroupid');
389
    generate_edifact_orders( $basketgroupid );
390
    exit;
374
}else{
391
}else{
375
# no param : display the list of all basketgroups for a given vendor
392
# no param : display the list of all basketgroups for a given vendor
376
    my $basketgroups = &GetBasketgroups($booksellerid);
393
    my $basketgroups = &GetBasketgroups($booksellerid);
(-)a/acqui/edi_ean.pl (+64 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2012 Mark Gavillet & PTFS Europe Ltd
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 3 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
# This is an awkward construct and should probably be totally replaced
21
# but as all sites so far are single ordering ean its not clear what we should
22
# replace it with
23
#
24
use strict;
25
use warnings;
26
27
use C4::Auth;
28
use C4::Koha;
29
use C4::Output;
30
use Koha::Database;
31
use CGI;
32
my $schema = Koha::Database->new()->schema();
33
34
my @eans = $schema->resultset('EdifactEan')->search(
35
    {},
36
    {
37
        join => 'branch',
38
    }
39
);
40
my $query    = CGI->new();
41
my $basketno = $query->param('basketno');
42
43
if ( @eans == 1 ) {
44
    my $ean = $eans[0]->ean;
45
    print $query->redirect(
46
        "/cgi-bin/koha/acqui/basket.pl?basketno=$basketno&op=ediorder&ean=$ean"
47
    );
48
}
49
else {
50
    my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
51
        {
52
            template_name   => 'acqui/edi_ean.tt',
53
            query           => $query,
54
            type            => 'intranet',
55
            authnotrequired => 0,
56
            flagsrequired   => { acquisition => 'order_manage' },
57
            debug           => 1,
58
        }
59
    );
60
    $template->param( eans     => \@eans );
61
    $template->param( basketno => $basketno );
62
63
    output_html_with_http_headers( $query, $cookie, $template->output );
64
}
(-)a/acqui/edifactmsgs.pl (+62 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2014 PTFS Europe Ltd.
4
# This file is part of Koha.
5
#
6
# Koha is free software; you can redistribute it and/or modify it under the
7
# terms of the GNU General Public License as published by the Free Software
8
# Foundation; either version 3 of the License, or (at your option) any later
9
# version.
10
#
11
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
12
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License along
16
# with Koha; if not, write to the Free Software Foundation, Inc.,
17
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
19
use strict;
20
use warnings;
21
22
use CGI;
23
use Koha::Database;
24
use C4::Koha;
25
use C4::Auth;
26
use C4::Output;
27
28
my $q = CGI->new;
29
my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
30
    {
31
        template_name   => 'acqui/edifactmsgs.tt',
32
        query           => $q,
33
        type            => 'intranet',
34
        authnotrequired => 0,
35
        flagsrequired   => { acquisition => 'manage_edi' },
36
        debug           => 1,
37
    }
38
);
39
40
my $schema = Koha::Database->new()->schema();
41
my $cmd    = $q->param('op');
42
if ( $cmd && $cmd == 'delete' ) {
43
    my $id  = $q->param->('message_id');
44
    my $msg = $schema->resultset('EdifactMessage')->find($id);
45
    $msg->deleted(1);
46
    $msg->update;
47
}
48
49
my @msgs = $schema->resultset('EdifactMessage')->search(
50
    {
51
        deleted => 0,
52
    },
53
    {
54
        join     => 'vendor',
55
        order_by => { -desc => 'transfer_date' },
56
    }
57
58
)->all;
59
60
$template->param( messages => \@msgs );
61
62
output_html_with_http_headers( $q, $cookie, $template->output );
(-)a/acqui/edimsg.pl (+72 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2014 PTFS Europe Ltd.
4
# This file is part of Koha.
5
#
6
# Koha is free software; you can redistribute it and/or modify it under the
7
# terms of the GNU General Public License as published by the Free Software
8
# Foundation; either version 3 of the License, or (at your option) any later
9
# version.
10
#
11
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
12
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14
#
15
# You should have received a copy of the GNU General Public License along
16
# with Koha; if not, write to the Free Software Foundation, Inc.,
17
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18
19
use strict;
20
use warnings;
21
22
use CGI;
23
use Koha::Database;
24
use C4::Koha;
25
use C4::Auth;
26
use C4::Output;
27
28
my $q = CGI->new;
29
my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
30
    {
31
        template_name   => 'acqui/edimsg.tt',
32
        query           => $q,
33
        type            => 'intranet',
34
        authnotrequired => 0,
35
        flagsrequired   => { acquisition => 'manage_edi' },
36
        debug           => 1,
37
    }
38
);
39
my $msg_id = $q->param('id');
40
my $schema = Koha::Database->new()->schema();
41
42
my $msg = $schema->resultset('EdifactMessage')->find($msg_id);
43
if ($msg) {
44
    my $transmission = $msg->raw_msg;
45
46
    my @segments = segmentize($transmission);
47
    $template->param( segments => \@segments );
48
}
49
else {
50
    $template->param( no_message => 1 );
51
}
52
53
output_html_with_http_headers( $q, $cookie, $template->output );
54
55
sub segmentize {
56
    my $raw = shift;
57
58
    my $re = qr{
59
(?>    # dont backtrack into this group
60
    [?].      # either the escape character
61
            # followed by any other character
62
     |      # or
63
     [^'?]   # a character that is neither escape
64
             # nor split
65
             )+
66
}x;
67
    my @segmented;
68
    while ( $raw =~ /($re)/g ) {
69
        push @segmented, "$1'";
70
    }
71
    return @segmented;
72
}
(-)a/acqui/invoices.pl (-1 / +3 lines)
Lines 62-67 my $author = $input->param('author'); Link Here
62
my $publisher        = $input->param('publisher');
62
my $publisher        = $input->param('publisher');
63
my $publicationyear  = $input->param('publicationyear');
63
my $publicationyear  = $input->param('publicationyear');
64
my $branch           = $input->param('branch');
64
my $branch           = $input->param('branch');
65
my $message_id       = $input->param('message_id');
65
my $op               = $input->param('op');
66
my $op               = $input->param('op');
66
67
67
$shipmentdatefrom and $shipmentdatefrom = eval { dt_from_string( $shipmentdatefrom ) };
68
$shipmentdatefrom and $shipmentdatefrom = eval { dt_from_string( $shipmentdatefrom ) };
Lines 83-89 if ( $op and $op eq 'do_search' ) { Link Here
83
        author           => $author,
84
        author           => $author,
84
        publisher        => $publisher,
85
        publisher        => $publisher,
85
        publicationyear  => $publicationyear,
86
        publicationyear  => $publicationyear,
86
        branchcode       => $branch
87
        branchcode       => $branch,
88
        message_id       => $message_id,
87
    );
89
    );
88
}
90
}
89
91
(-)a/admin/edi_accounts.pl (+155 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2011,2014 Mark Gavillet & PTFS Europe Ltd
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 3 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 CGI;
23
use C4::Auth;
24
use C4::Output;
25
use Koha::Database;
26
27
my $input = CGI->new();
28
29
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
30
    {
31
        template_name   => 'admin/edi_accounts.tt',
32
        query           => $input,
33
        type            => 'intranet',
34
        authnotrequired => 0,
35
        flagsrequired   => { acquisition => 'edi_manage' },
36
    }
37
);
38
39
my $op = $input->param('op');
40
$op ||= 'display';
41
my $schema = Koha::Database->new()->schema();
42
43
if ( $op eq 'acct_form' ) {
44
    show_account();
45
    $template->param( acct_form => 1 );
46
    my @vendors = $schema->resultset('Aqbookseller')->search(
47
        undef,
48
        {
49
            columns => [ 'name', 'id' ],
50
            order_by => { -asc => 'name' }
51
        }
52
    );
53
    $template->param( vendors => \@vendors );
54
    $template->param(
55
        code_qualifiers => [
56
            {
57
                code        => '14',
58
                description => 'EAN International',
59
            },
60
            {
61
                code        => '31B',
62
                description => 'US SAN Agency',
63
            },
64
            {
65
                code        => '91',
66
                description => 'Assigned by supplier',
67
            },
68
            {
69
                code        => '92',
70
                description => 'Assigned by buyer',
71
            },
72
        ]
73
    );
74
75
}
76
elsif ( $op eq 'delete_confirm' ) {
77
    show_account();
78
    $template->param( delete_confirm => 1 );
79
}
80
else {
81
    if ( $op eq 'save' ) {
82
83
        # validate & display
84
        my $id     = $input->param('id');
85
        my $fields = {
86
            description        => $input->param('description'),
87
            host               => $input->param('host'),
88
            username           => $input->param('username'),
89
            password           => $input->param('password'),
90
            vendor_id          => $input->param('vendor_id'),
91
            upload_directory   => $input->param('upload_directory'),
92
            download_directory => $input->param('download_directory'),
93
            san                => $input->param('san'),
94
            transport          => $input->param('transport'),
95
            quotes_enabled     => defined $input->param('quotes_enabled'),
96
            invoices_enabled   => defined $input->param('invoices_enabled'),
97
            orders_enabled     => defined $input->param('orders_enabled'),
98
            responses_enabled  => defined $input->param('responses_enabled'),
99
            auto_orders        => defined $input->param('auto_orders'),
100
            id_code_qualifier  => $input->param('id_code_qualifier'),
101
        };
102
103
        if ($id) {
104
            $schema->resultset('VendorEdiAccount')->search(
105
                {
106
                    id => $id,
107
                }
108
            )->update_all($fields);
109
        }
110
        else {    # new record
111
            $schema->resultset('VendorEdiAccount')->create($fields);
112
        }
113
    }
114
    elsif ( $op eq 'delete_confirmed' ) {
115
116
        $schema->resultset('VendorEdiAccount')
117
          ->search( { id => $input->param('id'), } )->delete_all;
118
    }
119
120
    # we do a default dispaly after deletes and saves
121
    # as well as when thats all you want
122
    $template->param( display => 1 );
123
    my @ediaccounts = $schema->resultset('VendorEdiAccount')->search(
124
        {},
125
        {
126
            join => 'vendor',
127
        }
128
    );
129
    $template->param( ediaccounts => \@ediaccounts );
130
}
131
132
output_html_with_http_headers( $input, $cookie, $template->output );
133
134
sub get_account {
135
    my $id = shift;
136
137
    my $account = $schema->resultset('VendorEdiAccount')->find($id);
138
    if ($account) {
139
        return $account;
140
    }
141
142
    # passing undef will default to add
143
    return;
144
}
145
146
sub show_account {
147
    my $acct_id = $input->param('id');
148
    if ($acct_id) {
149
        my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id);
150
        if ($acct) {
151
            $template->param( account => $acct );
152
        }
153
    }
154
    return;
155
}
(-)a/admin/edi_ean_accounts.pl (+158 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
3
# Copyright 2012, 2014 Mark Gavillet & PTFS Europe Ltd
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 3 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 CGI;
23
use C4::Auth;
24
use C4::Output;
25
use Koha::Database;
26
27
my $input = CGI->new();
28
29
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
30
    {
31
        template_name   => 'admin/edi_ean_accounts.tt',
32
        query           => $input,
33
        type            => 'intranet',
34
        authnotrequired => 0,
35
        flagsrequired   => { acquisition => 'edi_manage' },
36
    }
37
);
38
39
my $schema = Koha::Database->new()->schema();
40
my $op     = $input->param('op');
41
$op ||= 'display';
42
43
if ( $op eq 'ean_form' ) {
44
    show_ean();
45
    $template->param( ean_form => 1 );
46
    my @branches = $schema->resultset('Branch')->search(
47
        undef,
48
        {
49
            columns  => [ 'branchcode', 'branchname' ],
50
            order_by => 'branchname',
51
        }
52
    );
53
    $template->param( branches => \@branches );
54
    $template->param(
55
        code_qualifiers => [
56
            {
57
                code        => '14',
58
                description => 'EAN International',
59
            },
60
            {
61
                code        => '31B',
62
                description => 'US SAN Agency',
63
            },
64
            {
65
                code        => '91',
66
                description => 'Assigned by supplier',
67
            },
68
            {
69
                code        => '92',
70
                description => 'Assigned by buyer',
71
            },
72
        ]
73
    );
74
75
}
76
elsif ( $op eq 'delete_confirm' ) {
77
    show_ean();
78
    $template->param( delete_confirm => 1 );
79
}
80
else {
81
    if ( $op eq 'save' ) {
82
        my $change = $input->param('oldean');
83
        if ($change) {
84
            editsubmit();
85
        }
86
        else {
87
            addsubmit();
88
        }
89
    }
90
    elsif ( $op eq 'delete_confirmed' ) {
91
        delsubmit();
92
    }
93
    my @eans = $schema->resultset('EdifactEan')->search(
94
        {},
95
        {
96
            join => 'branch',
97
        }
98
    );
99
    $template->param( display => 1 );
100
    $template->param( eans    => \@eans );
101
}
102
103
output_html_with_http_headers( $input, $cookie, $template->output );
104
105
sub delsubmit {
106
    my $ean = $schema->resultset('EdifactEan')->find(
107
        {
108
            branchcode => $input->param('branchcode'),
109
            ean        => $input->param('ean')
110
        }
111
    );
112
    $ean->delete;
113
    return;
114
}
115
116
sub addsubmit {
117
118
    my $new_ean = $schema->resultset('EdifactEan')->new(
119
        {
120
            branchcode        => $input->param('branchcode'),
121
            ean               => $input->param('ean'),
122
            id_code_qualifier => $input->param('id_code_qualifier'),
123
        }
124
    );
125
    $new_ean->insert();
126
    return;
127
}
128
129
sub editsubmit {
130
    $schema->resultset('EdifactEan')->search(
131
        {
132
            branchcode => $input->param('oldbranchcode'),
133
            ean        => $input->param('oldean'),
134
        }
135
      )->update_all(
136
        {
137
            branchcode        => $input->param('branchcode'),
138
            ean               => $input->param('ean'),
139
            id_code_qualifier => $input->param('id_code_qualifier'),
140
        }
141
      );
142
    return;
143
}
144
145
sub show_ean {
146
    my $branchcode = $input->param('branchcode');
147
    my $ean        = $input->param('ean');
148
    if ( $branchcode && $ean ) {
149
        my $e = $schema->resultset('EdifactEan')->find(
150
            {
151
                ean        => $ean,
152
                branchcode => $branchcode,
153
            }
154
        );
155
        $template->param( ean => $e );
156
    }
157
    return;
158
}
(-)a/installer/data/mysql/atomicupdate/edifact.sql (+79 lines)
Line 0 Link Here
1
-- Holds details for vendors supplying goods by EDI
2
CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
3
  id int(11) NOT NULL auto_increment,
4
  description text NOT NULL,
5
  host varchar(40),
6
  username varchar(40),
7
  password varchar(40),
8
  last_activity date,
9
  vendor_id int(11) references aqbooksellers( id ),
10
  download_directory text,
11
  upload_directory text,
12
  san varchar(20),
13
  id_code_qualifier varchar(3) default '14',
14
  transport varchar(6) default 'FTP',
15
  quotes_enabled tinyint(1) not null default 0,
16
  invoices_enabled tinyint(1) not null default 0,
17
  orders_enabled tinyint(1) not null default 0,
18
  responses_enabled tinyint(1) not null default 0,
19
  auto_orders tinyint(1) not null default 0,
20
  shipment_budget integer(11) references aqbudgets( budget_id ),
21
  PRIMARY KEY  (id),
22
  KEY vendorid (vendor_id),
23
  KEY shipmentbudget (shipment_budget),
24
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
25
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
26
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
27
28
-- Hold the actual edifact messages with links to associated baskets
29
CREATE TABLE IF NOT EXISTS edifact_messages (
30
  id int(11) NOT NULL auto_increment,
31
  message_type varchar(10) NOT NULL,
32
  transfer_date date,
33
  vendor_id int(11) references aqbooksellers( id ),
34
  edi_acct  integer references vendor_edi_accounts( id ),
35
  status text,
36
  basketno int(11) REFERENCES aqbasket( basketno),
37
  raw_msg mediumtext,
38
  filename text,
39
  deleted boolean not null default 0,
40
  PRIMARY KEY  (id),
41
  KEY vendorid ( vendor_id),
42
  KEY ediacct (edi_acct),
43
  KEY basketno ( basketno),
44
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
45
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
46
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
47
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
48
49
-- invoices link back to the edifact message it was generated from
50
ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id );
51
52
-- clean up link on deletes
53
ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL;
54
55
-- Hold the supplier ids from quotes for ordering
56
-- although this is an EAN-13 article number the standard says 35 characters ???
57
ALTER TABLE aqorders ADD COLUMN line_item_id varchar(35);
58
59
-- The suppliers unique reference usually a quotation line number ('QLI')
60
-- Otherwise Suppliers unique orderline reference ('SLI')
61
ALTER TABLE aqorders ADD COLUMN suppliers_reference_number varchar(35);
62
ALTER TABLE aqorders ADD COLUMN suppliers_reference_qualifier varchar(3);
63
ALTER TABLE aqorders ADD COLUMN suppliers_report text;
64
65
-- hold the EAN/SAN used in ordering
66
CREATE TABLE IF NOT EXISTS edifact_ean (
67
  ee_id integer(11) unsigned not null auto_increment primary key,
68
  branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode),
69
  ean varchar(15) NOT NULL,
70
  id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14',
71
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
72
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
73
74
-- Syspref budget to hold shipping costs
75
INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages',  'free');
76
77
-- Add a permission for managing EDI
78
INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions');
79
(-)a/installer/data/mysql/kohastructure.sql (+76 lines)
Lines 3076-3081 CREATE TABLE `aqorders` ( -- information related to the basket line items Link Here
3076
  `subscriptionid` int(11) default NULL, -- links this order line to a subscription (subscription.subscriptionid)
3076
  `subscriptionid` int(11) default NULL, -- links this order line to a subscription (subscription.subscriptionid)
3077
  parent_ordernumber int(11) default NULL, -- ordernumber of parent order line, or same as ordernumber if no parent
3077
  parent_ordernumber int(11) default NULL, -- ordernumber of parent order line, or same as ordernumber if no parent
3078
  `orderstatus` varchar(16) default 'new', -- the current status for this line item. Can be 'new', 'ordered', 'partial', 'complete' or 'cancelled'
3078
  `orderstatus` varchar(16) default 'new', -- the current status for this line item. Can be 'new', 'ordered', 'partial', 'complete' or 'cancelled'
3079
  line_item_id varchar(35) default NULL, -- Supplier's article id for Edifact orderline
3080
  suppliers_reference_number varchar(35) default NULL, -- Suppliers unique edifact quote ref
3081
  suppliers_reference_qualifier varchar(3) default NULL, -- Type of number above usually 'QLI'
3082
  `suppliers_report` text COLLATE utf8_unicode_ci, -- reports received from suppliers
3079
  PRIMARY KEY  (`ordernumber`),
3083
  PRIMARY KEY  (`ordernumber`),
3080
  KEY `basketno` (`basketno`),
3084
  KEY `basketno` (`basketno`),
3081
  KEY `biblionumber` (`biblionumber`),
3085
  KEY `biblionumber` (`biblionumber`),
Lines 3133-3138 CREATE TABLE aqorders_transfers ( Link Here
3133
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3137
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3134
3138
3135
--
3139
--
3140
-- Table structure for table vendor_edi_accounts
3141
--
3142
3143
DROP TABLE IF EXISTS vendor_edi_accounts;
3144
CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
3145
  id int(11) NOT NULL auto_increment,
3146
  description text NOT NULL,
3147
  host varchar(40),
3148
  username varchar(40),
3149
  password varchar(40),
3150
  last_activity date,
3151
  vendor_id int(11) references aqbooksellers( id ),
3152
  download_directory text,
3153
  upload_directory text,
3154
  san varchar(20),
3155
  id_code_qualifier varchar(3) default '14',
3156
  transport varchar(6) default 'FTP',
3157
  quotes_enabled tinyint(1) not null default 0,
3158
  invoices_enabled tinyint(1) not null default 0,
3159
  orders_enabled tinyint(1) not null default 0,
3160
  responses_enabled tinyint(1) NOT NULL DEFAULT '0',
3161
  auto_orders tinyint(1) NOT NULL DEFAULT '0',
3162
  shipment_budget integer(11) references aqbudgets( budget_id ),
3163
  PRIMARY KEY  (id),
3164
  KEY vendorid (vendor_id),
3165
  KEY shipmentbudget (shipment_budget),
3166
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
3167
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
3168
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3169
3170
--
3171
-- Table structure for table edifact_messages
3172
--
3173
3174
DROP TABLE IF EXISTS edifact_messages;
3175
CREATE TABLE IF NOT EXISTS edifact_messages (
3176
  id int(11) NOT NULL auto_increment,
3177
  message_type varchar(10) NOT NULL,
3178
  transfer_date date,
3179
  vendor_id int(11) references aqbooksellers( id ),
3180
  edi_acct  integer references vendor_edi_accounts( id ),
3181
  status text,
3182
  basketno int(11) references aqbasket( basketno),
3183
  raw_msg mediumtext,
3184
  filename text,
3185
  deleted boolean not null default 0,
3186
  PRIMARY KEY  (id),
3187
  KEY vendorid ( vendor_id),
3188
  KEY ediacct (edi_acct),
3189
  KEY basketno ( basketno),
3190
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
3191
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
3192
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
3193
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3194
3195
--
3136
-- Table structure for table aqinvoices
3196
-- Table structure for table aqinvoices
3137
--
3197
--
3138
3198
Lines 3146-3153 CREATE TABLE aqinvoices ( Link Here
3146
  closedate date default NULL,  -- invoice close date, NULL means the invoice is open
3206
  closedate date default NULL,  -- invoice close date, NULL means the invoice is open
3147
  shipmentcost decimal(28,6) default NULL,  -- shipment cost
3207
  shipmentcost decimal(28,6) default NULL,  -- shipment cost
3148
  shipmentcost_budgetid int(11) default NULL,   -- foreign key to aqbudgets, link the shipment cost to a budget
3208
  shipmentcost_budgetid int(11) default NULL,   -- foreign key to aqbudgets, link the shipment cost to a budget
3209
  message_id int(11) default NULL, -- foreign key to edifact invoice message
3149
  PRIMARY KEY (invoiceid),
3210
  PRIMARY KEY (invoiceid),
3150
  CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
3211
  CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
3212
  CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL,
3151
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE
3213
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE
3152
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3214
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3153
3215
Lines 3609-3614 CREATE TABLE audio_alerts ( Link Here
3609
  KEY precedence (precedence)
3671
  KEY precedence (precedence)
3610
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3672
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3611
3673
3674
--
3675
-- Table structure for table 'edifact_ean'
3676
--
3677
3678
DROP TABLE IF EXISTS edifact_ean;
3679
CREATE TABLE IF NOT EXISTS edifact_ean (
3680
  ee_id int(11) NOT NULL AUTO_INCREMENT,
3681
  branchcode varchar(10) not null references branches (branchcode),
3682
  ean varchar(15) NOT NULL,
3683
  id_code_qualifier varchar(3) NOT NULL default '14',
3684
  PRIMARY KEY (ee_id),
3685
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
3686
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3687
3612
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
3688
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
3613
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
3689
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
3614
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
3690
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
Lines 129-134 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here
129
('DumpTemplateVarsIntranet',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.',  'YesNo'),
129
('DumpTemplateVarsIntranet',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.',  'YesNo'),
130
('DumpTemplateVarsOpac',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.',  'YesNo'),
130
('DumpTemplateVarsOpac',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.',  'YesNo'),
131
('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),
131
('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),
132
('EDIInvoicesShippingBudget',NULL,NULL,'The budget code used to allocate shipping charges to when processing EDI Invoice messages','free'),
132
('emailLibrarianWhenHoldIsPlaced','0',NULL,'If ON, emails the librarian whenever a hold is placed','YesNo'),
133
('emailLibrarianWhenHoldIsPlaced','0',NULL,'If ON, emails the librarian whenever a hold is placed','YesNo'),
133
('EnableAdvancedCatalogingEditor','0','','Enable the Rancor advanced cataloging editor','YesNo'),
134
('EnableAdvancedCatalogingEditor','0','','Enable the Rancor advanced cataloging editor','YesNo'),
134
('EnableBorrowerFiles','0',NULL,'If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'),
135
('EnableBorrowerFiles','0',NULL,'If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'),
(-)a/installer/data/mysql/userpermissions.sql (+1 lines)
Lines 28-33 INSERT INTO permissions (module_bit, code, description) VALUES Link Here
28
   (11, 'order_receive', 'Manage orders & basket'),
28
   (11, 'order_receive', 'Manage orders & basket'),
29
   (11, 'budget_add_del', 'Add and delete budgets (but can''t modify budgets)'),
29
   (11, 'budget_add_del', 'Add and delete budgets (but can''t modify budgets)'),
30
   (11, 'budget_manage_all', 'Manage all budgets'),
30
   (11, 'budget_manage_all', 'Manage all budgets'),
31
   (11, 'edi_manage', 'Manage EDIFACT transmissions'),
31
   (13, 'edit_news', 'Write news for the OPAC and staff interfaces'),
32
   (13, 'edit_news', 'Write news for the OPAC and staff interfaces'),
32
   (13, 'label_creator', 'Create printable labels and barcodes from catalog and patron data'),
33
   (13, 'label_creator', 'Create printable labels and barcodes from catalog and patron data'),
33
   (13, 'edit_calendar', 'Define days when the library is closed'),
34
   (13, 'edit_calendar', 'Define days when the library is closed'),
(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc (+3 lines)
Lines 9-12 Link Here
9
    [% IF ( CAN_user_parameters ) %]
9
    [% IF ( CAN_user_parameters ) %]
10
     <li><a href="/cgi-bin/koha/admin/currency.pl">Currencies</a></li>
10
     <li><a href="/cgi-bin/koha/admin/currency.pl">Currencies</a></li>
11
    [% END %]
11
    [% END %]
12
    [% IF CAN_user_acquisition_edi_manage %]
13
     <li><a href="/cgi-bin/koha/acqui/edifactmsgs.pl">Edifact Messages</a></li>
14
    [% END %]
12
</ul>
15
</ul>
(-)a/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc (+2 lines)
Lines 54-59 Link Here
54
    <li><a href="/cgi-bin/koha/admin/currency.pl">Currencies and exchange rates</a></li>
54
    <li><a href="/cgi-bin/koha/admin/currency.pl">Currencies and exchange rates</a></li>
55
    <li><a href="/cgi-bin/koha/admin/aqbudgetperiods.pl">Budgets</a></li>
55
    <li><a href="/cgi-bin/koha/admin/aqbudgetperiods.pl">Budgets</a></li>
56
    <li><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></li>
56
    <li><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></li>
57
    <li><a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI accounts</a></li>
58
    <li><a href="/cgi-bin/koha/admin/edi_ean_accounts.pl">EDI eans</a></li>
57
</ul>
59
</ul>
58
60
59
[% IF CAN_user_plugins %]
61
[% IF CAN_user_plugins %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt (-1 / +37 lines)
Lines 51-56 Link Here
51
                window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes');
51
                window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes');
52
            }
52
            }
53
53
54
            function confirm_ediorder() {
55
                var is_confirmed = confirm(_("Are you sure you want to close this basket and generate an Edifact order?"));
56
                if (is_confirmed) {
57
                    window.location = "[% script_name %]?op=edi_confirm&basketno=[% basketno %]";
58
                }
59
            }
60
54
//]]>
61
//]]>
55
</script>
62
</script>
56
[% ELSE %]
63
[% ELSE %]
Lines 157-163 Link Here
157
        </div>
164
        </div>
158
    [% ELSE %]
165
    [% ELSE %]
159
    <div class="yui-b">
166
    <div class="yui-b">
160
        [% UNLESS ( confirm_close ) %]
167
        [% IF !confirm_close && !edi_confirm %]
161
        [% UNLESS ( selectbasketg ) %]
168
        [% UNLESS ( selectbasketg ) %]
162
            [% UNLESS ( closedate ) %]
169
            [% UNLESS ( closedate ) %]
163
                <div id="toolbar" class="btn-toolbar">
170
                <div id="toolbar" class="btn-toolbar">
Lines 176-181 Link Here
176
                        </div>
183
                        </div>
177
                    [% END %]
184
                    [% END %]
178
                        <div class="btn-group"><a href="[% script_name %]?op=export&amp;basketno=[% basketno %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="fa fa-download"></i> Export this basket as CSV</a></div>
185
                        <div class="btn-group"><a href="[% script_name %]?op=export&amp;basketno=[% basketno %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="fa fa-download"></i> Export this basket as CSV</a></div>
186
                        [% IF ediaccount %]
187
                        <div class="btn-group"><a href="/cgi-bin/koha/acqui/edi_ean.pl?op=ediorder&amp;basketno=[% basketno %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="ediorderbutton"><i class="icon-download"></i>Create edifact order</a></div>
188
                        [% END %]
179
                </div>
189
                </div>
180
<!-- Modal for confirm deletion box-->
190
<!-- Modal for confirm deletion box-->
181
                <div class="modal hide" id="deleteBasketModal" tabindex="-1" role="dialog" aria-labelledby="delbasketModalLabel" aria-hidden="true">
191
                <div class="modal hide" id="deleteBasketModal" tabindex="-1" role="dialog" aria-labelledby="delbasketModalLabel" aria-hidden="true">
Lines 392-397 Link Here
392
                        <th>GST %</th>
402
                        <th>GST %</th>
393
                        <th>GST</th>
403
                        <th>GST</th>
394
                        <th>Fund</th>
404
                        <th>Fund</th>
405
                        <th>Supplier report</th>
395
                        [% IF ( active ) %]
406
                        [% IF ( active ) %]
396
                            [% UNLESS ( closedate ) %]
407
                            [% UNLESS ( closedate ) %]
397
                                <th>Modify</th>
408
                                <th>Modify</th>
Lines 415-420 Link Here
415
                        <th>&nbsp;</th>
426
                        <th>&nbsp;</th>
416
                        <th>[% foot_loo.gstvalue | $Price %]</th>
427
                        <th>[% foot_loo.gstvalue | $Price %]</th>
417
                        <th>&nbsp;</th>
428
                        <th>&nbsp;</th>
429
                        <th>&nbsp;</th>
418
                        [% IF ( active ) %]
430
                        [% IF ( active ) %]
419
                            [% UNLESS ( closedate ) %]
431
                            [% UNLESS ( closedate ) %]
420
                                <th>&nbsp;</th>
432
                                <th>&nbsp;</th>
Lines 436-441 Link Here
436
                    <th>&nbsp;</th>
448
                    <th>&nbsp;</th>
437
                    <th>[% total_gstvalue | $Price %]</th>
449
                    <th>[% total_gstvalue | $Price %]</th>
438
                    <th>&nbsp;</th>
450
                    <th>&nbsp;</th>
451
                    <th>&nbsp;</th>
439
                    [% IF ( active ) %]
452
                    [% IF ( active ) %]
440
                        [% UNLESS ( closedate ) %]
453
                        [% UNLESS ( closedate ) %]
441
                            <th>&nbsp;</th>
454
                            <th>&nbsp;</th>
Lines 505-510 Link Here
505
                        <td class="number">[% books_loo.gstrate * 100 | $Price %]</td>
518
                        <td class="number">[% books_loo.gstrate * 100 | $Price %]</td>
506
                        <td class="number [% IF books_loo.gstvalue.search(zero_regex) %]error[% END %]">[% books_loo.gstvalue | $Price %]</td>
519
                        <td class="number [% IF books_loo.gstvalue.search(zero_regex) %]error[% END %]">[% books_loo.gstvalue | $Price %]</td>
507
                        <td>[% books_loo.budget_name %]</td>
520
                        <td>[% books_loo.budget_name %]</td>
521
                        <td>[% books_loo.suppliers_report %]</td>
508
                        [% IF ( active ) %]
522
                        [% IF ( active ) %]
509
                            [% UNLESS ( closedate ) %]
523
                            [% UNLESS ( closedate ) %]
510
                            <td>
524
                            <td>
Lines 663-668 Link Here
663
        </form>
677
        </form>
664
        </div>
678
        </div>
665
    [% END %]
679
    [% END %]
680
[% IF edi_confirm %]
681
        <div id="closebasket_needsconfirmation" class="dialog alert">
682
683
        <form action="/cgi-bin/koha/acqui/basket.pl" class="confirm">
684
            <h1>Are you sure you want to generate an edifact order and close basket [% basketname|html %]?</h1>
685
            [% IF CAN_user_acquisition_group_manage %]
686
            <p>
687
            <label for="createbasketgroup">Attach this basket to a new basket group with the same name</label>
688
            <input type="checkbox" id="createbasketgroup" name="createbasketgroup"/>
689
            </p>
690
            [% END %]
691
            <input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
692
            <input type="hidden" value="ediorder" name="op" />
693
            <input type="hidden" name="ean" value="[% ean %]" />
694
            <input type="hidden" name="booksellerid" value="[% booksellerid %]" />
695
            <input type="hidden" name="confirm" value="1" />
696
            <input type="hidden" name="basketgroupname" value="[% basketgroupname %]" />
697
            <input type="submit" class="approve" value="Yes, close (Y)" accesskey="y" />
698
            <input type="submit" class="deny" value="No, don't close (N)" accesskey="n" onclick="javascript:window.location='/cgi-bin/koha/acqui/basket.pl?basketno=[% basketno %]';return false;" />
699
        </form>
700
        </div>
701
    [% END %]
666
</div>
702
</div>
667
[% END %][%# IF (cannot_manage_basket) %]
703
[% END %][%# IF (cannot_manage_basket) %]
668
</div>
704
</div>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt (+2 lines)
Lines 144-149 function submitForm(form) { Link Here
144
                            <div class="btn-group"><a href="[% script_name %]?op=reopen&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]&amp;mode=singlebg" class="btn btn-small" id="reopenbutton"><i class="fa fa-download"></i> Reopen this basket group</a></div>
144
                            <div class="btn-group"><a href="[% script_name %]?op=reopen&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]&amp;mode=singlebg" class="btn btn-small" id="reopenbutton"><i class="fa fa-download"></i> Reopen this basket group</a></div>
145
                            <div class="btn-group"><a href="[% script_name %]?op=export&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="fa fa-download"></i> Export this basket group as CSV</a></div>
145
                            <div class="btn-group"><a href="[% script_name %]?op=export&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="fa fa-download"></i> Export this basket group as CSV</a></div>
146
                            <div class="btn-group"><a href="[% script_name %]?op=print&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="fa fa-download"></i> Print this basket group in PDF</a></div>
146
                            <div class="btn-group"><a href="[% script_name %]?op=print&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="fa fa-download"></i> Print this basket group in PDF</a></div>
147
                            <div class="btn-group"><a href="[% script_name %]?op=ediprint&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="icon-download"></i>Generate edifact order</a></div>
147
                        </div>
148
                        </div>
148
                    [% ELSE %]
149
                    [% ELSE %]
149
                        <div class="btn-group"><a href="[% script_name %]?op=delete&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="delbutton"><i class="fa fa-remove"></i> Delete basket group</a></div>
150
                        <div class="btn-group"><a href="[% script_name %]?op=delete&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="delbutton"><i class="fa fa-remove"></i> Delete basket group</a></div>
Lines 380-385 function submitForm(form) { Link Here
380
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="reopen" /><input type="hidden" name="booksellerid" value="[% basketgroup.booksellerid %]" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Reopen" /></form>
381
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="reopen" /><input type="hidden" name="booksellerid" value="[% basketgroup.booksellerid %]" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Reopen" /></form>
381
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="print" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Print" /></form>
382
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="print" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Print" /></form>
382
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="export" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Export as CSV" /></form>
383
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="export" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Export as CSV" /></form>
384
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="ediprint" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Generate edifact order" /></form>
383
                                                </td>
385
                                                </td>
384
                                            </tr>
386
                                            </tr>
385
                                        [% END %]
387
                                        [% END %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt (+38 lines)
Line 0 Link Here
1
[% INCLUDE 'doc-head-open.inc' %]
2
<title>Koha &rsaquo; Acquisitions &rsaquo; Basket ([% basketno %])</title>
3
[% INCLUDE 'doc-head-close.inc' %]
4
5
</head>
6
<body>
7
[% INCLUDE 'header.inc' %]
8
[% INCLUDE 'acquisitions-search.inc' %]
9
10
<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a> &rsaquo; Basket ([% basketno %])</div>
11
12
<div id="doc3" class="yui-t2">
13
14
<div id="bd">
15
    <div id="yui-main">
16
    <div class="yui-b">
17
18
    <h2>Identify the branch account submitting the EDI order</h2>
19
    <br />
20
    <form action="/cgi-bin/koha/acqui/basket.pl" method="get">
21
         <p>Select ordering branch account: </p>
22
         <select id="ean" name="ean">
23
             [% FOREACH eanacct IN eans %]
24
             <option value="[% eanacct.ean %]">[% eanacct.branch.branchname %] ([% eanacct.ean %])</option>
25
             [% END %]
26
        </select>
27
        <br />
28
        <input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
29
        <input type="hidden" value="ediorder" name="op" />
30
        <input type="submit" value="Send EDI order" />
31
    </form>
32
</div>
33
</div>
34
<div class="yui-b">
35
[% INCLUDE 'acquisitions-menu.inc' %]
36
</div>
37
</div>
38
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt (+90 lines)
Line 0 Link Here
1
[% INCLUDE 'doc-head-open.inc' %]
2
<title>Koha &rsaquo; Acquisitions</title>
3
<link rel="stylesheet" type="text/css" href="[% themelang %]/css/datatables.css" />
4
[% INCLUDE 'doc-head-close.inc' %]
5
[% INCLUDE 'datatables.inc' %]
6
<script type="text/javascript">
7
$(document).ready(function() {
8
    $('#edi_msgs').dataTable($.extend(true, {}, dataTablesDefaults, {
9
        'aaSorting': [[1, "desc" ]],
10
        'sPaginationType': "four_button"
11
        }));
12
});
13
</script>
14
15
</head>
16
<body id="acq_edifactmsgs" class="acq">
17
[% INCLUDE 'header.inc' %]
18
[% INCLUDE 'acquisitions-search.inc' %]
19
<div id="breadcrumbs">
20
<a href="/cgi-bin/koha/mainpage.pl">Home</a>
21
&rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a>
22
&rsaquo; <a href="/cgi-bin/koha/acqui/edifactmsgs.pl">Edifact Messages</a>
23
</div>
24
25
<div id="doc3" class="yui-t2">
26
27
<div id="bd">
28
    <div id="yui-main">
29
    <div class="yui-b">
30
31
32
<h1>Edifact Messages</h1>
33
<div id="acqui_edifactmsgs">
34
35
36
<table id="edi_msgs">
37
<thead>
38
<th>Type</th>
39
<th>Transferred</th>
40
<th>Status</th>
41
<th>Vendor</th>
42
<th>Details</th>
43
<th>Filename</th>
44
<th> </th>
45
<th>Action</th>
46
</thead>
47
<tbody>
48
[% FOREACH msg IN messages %]
49
<tr>
50
<td>[% msg.message_type %]</td>
51
<td>[% msg.transfer_date %]</td>
52
<td>[% msg.status %]</td>
53
<td>
54
<a href="/cgi-bin/koha/acqui/supplier.pl?booksellerid=[% msg.vendor_id %]"</a>
55
[% msg.vendor.name %]
56
</td>
57
<td>
58
[% IF msg.message_type == 'QUOTE' || msg.message_type == 'ORDERS' %]
59
    [% IF msg.basketno %]
60
    <a href="/cgi-bin/koha/acqui/basket.pl?basketno=[% msg.basketno.basketno %]">
61
    Basket: [% msg.basketno.basketno %]
62
    </a>
63
    [% END %]
64
[% ELSE %]
65
<!-- Assuming invoices -->
66
     <a href="/cgi-bin/koha/acqui/invoices.pl?message_id=[% msg.id %]">
67
      Invoices
68
     </a>
69
[% END %]
70
</td>
71
</td>
72
<td>[% msg.filename %]</td>
73
<td><a class="popup" target="_blank" title="View Message" href="/cgi-bin/koha/acqui/edimsg.pl?id=[% msg.id %]"</a>View Message</td>
74
<td>
75
<a href="/cgi-bin/koha/acqui/edifactmsgs.pl?op=delete&amp;message_id=[% msg.id %]">Delete</a>
76
</td>
77
</tr>
78
[% END %]
79
80
</tbody>
81
</table>
82
83
</div>
84
</div>
85
</div>
86
<div class="yui-b">
87
[% INCLUDE 'acquisitions-menu.inc' %]
88
</div>
89
</div>
90
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edimsg.tt (+35 lines)
Line 0 Link Here
1
[% INCLUDE 'doc-head-open.inc' %]
2
<title>Koha &rsaquo; Acquisitions &rsaquo; Edifact Message Display</title>
3
[% INCLUDE 'doc-head-close.inc' %]
4
</head>
5
<body id="acq_edifactmsgs" class="acq">
6
[% INCLUDE 'header.inc' %]
7
[% INCLUDE 'acquisitions-search.inc' %]
8
<div id="breadcrumbs">
9
<a href="/cgi-bin/koha/mainpage.pl">Home</a>
10
&rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a>
11
&rsaquo; <a href="/cgi-bin/koha/acqui/edifactmsgs.pl">Edifact Messages</a>
12
</div>
13
14
<div id="doc3" class="yui-t2">
15
16
[% IF no_message %]
17
  <div class"dialog message">The requested message cannot be displayed</div>
18
[% ELSE %]
19
  <div id="bd">
20
  <div id="yui-main">
21
  <div class="yui-b">
22
   <ul>
23
   [% FOREACH seg IN segments %]
24
   <li>[% seg | html %]</li>
25
   [% END %]
26
   </ul>
27
[% END %]
28
29
</div>
30
</div>
31
<div class="yui-b">
32
[% INCLUDE 'acquisitions-menu.inc' %]
33
</div>
34
</div>
35
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt (+5 lines)
Lines 96-101 Link Here
96
96
97
                        <dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>
97
                        <dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>
98
                        <dd>Define funds within your budgets</dd>
98
                        <dd>Define funds within your budgets</dd>
99
100
                        <dt><a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI Accounts</a></dt>
101
                        <dd>Manage vendor EDI accounts for import/export</dd>
102
                        <dt><a href="/cgi-bin/koha/admin/edi_ean_accounts.pl">EDI EANs</a></dt>
103
                        <dd>Manage Branch EDI EANs</dd>
99
                </dl>
104
                </dl>
100
105
101
                <h3>Additional parameters</h3>
106
                <h3>Additional parameters</h3>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt (+299 lines)
Line 0 Link Here
1
[% INCLUDE 'doc-head-open.inc' %]
2
<title>Koha &rsaquo; Administration &rsaquo; EDI accounts
3
[% IF acct_form %]
4
  [% IF account %]
5
     &rsquo; Modify account
6
  [% ELSE %]
7
     &rsquo; Add new account
8
  [% END %]
9
[% END %]
10
[% IF delete_confirm %]
11
     &rsquo; Confirm deletion of account
12
[% END %]
13
</title>
14
[% INCLUDE 'doc-head-close.inc' %]
15
</head>
16
<body id="admin_edi_acct" class="admin">
17
[% INCLUDE 'header.inc' %]
18
[% INCLUDE 'cat-search.inc' %]
19
20
<div id="breadcrumbs">
21
<a href="/cgi-bin/koha/mainpage.pl">Home</a>
22
 &rsaquo; <a href="/cgi-bin/koha/admin/admin-home.pl">Administration</a>
23
 &rsaquo; <a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI accounts</a>
24
[% IF acct_form %]
25
  [% IF account %]
26
     &rsaquo; Modify account
27
  [% ELSE %]
28
     &rsaquo; Add new account
29
  [% END %]
30
[% ELSIF delete_confirm %]
31
     &rsaquo; Confirm deletion of account
32
[% ELSE %]
33
     &rsaquo; Accounts
34
[% END %]
35
</div>
36
37
<div id="doc3" class="yui-t2">
38
39
<div id="bd">
40
<div id="yui-main">
41
<div class="yui-b">
42
[% IF display %]
43
    <div id="toolbar" class="btn-toolbar">
44
    <a class="btn btn-small" id="newediacct" href="/cgi-bin/koha/admin/edi_accounts.pl?op=acct_form">
45
         <i class="icon-plus"></i>
46
         New account
47
    </a>
48
    </div>
49
[% END %]
50
51
[% IF acct_form %]
52
<form action="/cgi-bin/koha/admin/edi_accounts.pl" name="Actform" method="post">
53
  <input type="hidden" name="op" value="save" />
54
  [% IF account %]
55
  <input type="hidden" name="id" value="[% account.id %]" />
56
  [% END %]
57
  <fieldset class="rows">
58
  <legend>
59
  [% IF account %]
60
     Modify account
61
  [% ELSE %]
62
    New account
63
  [% END %]
64
  </legend>
65
66
  <ol>
67
  <li>
68
     <label for="vendor_id">Vendor: </label>
69
     <select name="vendor_id" id="vendor_id">
70
     [% FOREACH vendor IN vendors %]
71
       [% IF account.vendor_id == vendor.id %]
72
          <option value="[% vendor.id %]" selected="selected">[% vendor.name %]</option>
73
       [% ELSE %]
74
          <option value="[% vendor.id %]">[% vendor.name %]</option>
75
       [% END %]
76
     [% END %]
77
     </select>
78
  </li>
79
  <li>
80
     <label for="description">Description: </label>
81
     <input type="text" name="description" id="description" size="20" maxlength="90" value="[% account.description %]" />
82
  </li>
83
  <li>
84
     [% transport_types = [
85
                 'FTP', 'SFTP', 'FILE'
86
            ]
87
     %]
88
     <label for="transport">Transport: </label>
89
     <select name="transport" title="valid types of transport are FTP and SFTP"
90
      id="transport">
91
      [% FOREACH transport_type IN transport_types %]
92
           [% IF transport_type == account.transport %]
93
              <option value="[% transport_type %]" selected="selected">[% transport_type %]</option>
94
           [% ELSE %]
95
              <option value="[% transport_type %]">[% transport_type %]</option>
96
           [% END %]
97
       [% END %]
98
     </select>
99
  </li>
100
  <li>
101
     <label for="host">Remote host: </label>
102
     <input type="text" name="host" id="host" size="20" maxlength="90" value="[% account.host %]" />
103
  </li>
104
  <li>
105
     <label for="username">Username: </label>
106