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

(-)a/C4/Acquisition.pm (-1 / +5 lines)
Lines 2499-2504 sub GetInvoices { Link Here
2499
        push @bind_strs, " borrowers.branchcode = ? ";
2499
        push @bind_strs, " borrowers.branchcode = ? ";
2500
        push @bind_args, $args{branchcode};
2500
        push @bind_args, $args{branchcode};
2501
    }
2501
    }
2502
    if($args{message_id}) {
2503
        push @bind_strs, " aqinvoices.message_id = ? ";
2504
        push @bind_args, $args{message_id};
2505
    }
2502
2506
2503
    $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2507
    $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2504
    $query .= " GROUP BY aqinvoices.invoiceid ";
2508
    $query .= " GROUP BY aqinvoices.invoiceid ";
Lines 2623-2629 sub AddInvoice { Link Here
2623
    return unless(%invoice and $invoice{invoicenumber});
2627
    return unless(%invoice and $invoice{invoicenumber});
2624
2628
2625
    my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2629
    my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2626
        closedate shipmentcost shipmentcost_budgetid);
2630
        closedate shipmentcost shipmentcost_budgetid message_id);
2627
2631
2628
    my @set_strs;
2632
    my @set_strs;
2629
    my @set_args;
2633
    my @set_args;
(-)a/C4/Installer/PerlDependencies.pm (+10 lines)
Lines 762-767 our $PERL_DEPS = { Link Here
762
        'required' => '0',
762
        'required' => '0',
763
        'min_ver'  => '0.614',
763
        'min_ver'  => '0.614',
764
    },
764
    },
765
    'Net::SFTP::Foreign' => {
766
        'usage'    => 'Edifact',
767
        'required' => '0',
768
        'min_ver'  => '1.73',
769
    },
770
    'Text::Unidecode' => {
771
        'usage'    => 'Edifact',
772
        'required' => '0',
773
        'min_ver'  => '0.04',
774
    },
765
};
775
};
766
776
767
1;
777
1;
(-)a/Koha/EDI.pm (+1027 lines)
Line 0 Link Here
1
package Koha::EDI;
2
3
# Copyright 2014 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 );
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 $edifact = Koha::Edifact::Order->new(
83
        { orderlines => \@orderlines, vendor => $vendor, ean => $ean_obj } );
84
    if ( !$edifact ) {
85
        return;
86
    }
87
88
    my $order_file = $edifact->encode();
89
90
    # ingest result
91
    if ($order_file) {
92
        my $m = unidecode($order_file);  # remove diacritics and non-latin chars
93
        if ($noingest) {                 # allows scripts to produce test files
94
            return $m;
95
        }
96
        my $order = {
97
            message_type  => 'ORDERS',
98
            raw_msg       => $m,
99
            vendor_id     => $vendor->vendor_id,
100
            status        => 'Pending',
101
            basketno      => $basketno,
102
            filename      => $edifact->filename(),
103
            transfer_date => $edifact->msg_date_string(),
104
            edi_acct      => $vendor->id,
105
106
        };
107
        $schema->resultset('EdifactMessage')->create($order);
108
        return 1;
109
    }
110
111
    return;
112
}
113
114
sub process_ordrsp {
115
    my $response_message = shift;
116
    $response_message->status('processing');
117
    $response_message->update;
118
    my $schema = Koha::Database->new()->schema();
119
    my $logger = Log::Log4perl->get_logger();
120
    my $vendor_acct;
121
    my $edi =
122
      Koha::Edifact->new( { transmission => $response_message->raw_msg, } );
123
    my $messages = $edi->message_array();
124
125
    if ( @{$messages} ) {
126
        foreach my $msg ( @{$messages} ) {
127
128
            # currently a no-op
129
        }
130
    }
131
132
    $response_message->status('received');
133
    $response_message->update;
134
    return;
135
}
136
137
sub process_invoice {
138
    my $invoice_message = shift;
139
    $invoice_message->status('processing');
140
    $invoice_message->update;
141
    my $schema = Koha::Database->new()->schema();
142
    my $logger = Log::Log4perl->get_logger();
143
    my $vendor_acct;
144
    my $edi =
145
      Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
146
    my $messages = $edi->message_array();
147
148
    if ( @{$messages} ) {
149
150
        # BGM contains an invoice number
151
        foreach my $msg ( @{$messages} ) {
152
            my $invoicenumber  = $msg->docmsg_number();
153
            my $shipmentcharge = $msg->shipment_charge();
154
            my $msg_date       = $msg->message_date;
155
            my $tax_date       = $msg->tax_point_date;
156
            if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
157
                $tax_date = $msg_date;
158
            }
159
160
            my $vendor_ean = $msg->supplier_ean;
161
            if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
162
                $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
163
                    {
164
                        san => $vendor_ean,
165
                    }
166
                )->single;
167
            }
168
            if ( !$vendor_acct ) {
169
                carp
170
"Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
171
                next;
172
            }
173
            $invoice_message->edi_acct( $vendor_acct->id );
174
            $logger->trace("Adding invoice:$invoicenumber");
175
            my $new_invoice = $schema->resultset('Aqinvoice')->create(
176
                {
177
                    invoicenumber         => $invoicenumber,
178
                    booksellerid          => $invoice_message->vendor_id,
179
                    shipmentdate          => $msg_date,
180
                    billingdate           => $tax_date,
181
                    shipmentcost          => $shipmentcharge,
182
                    shipmentcost_budgetid => $vendor_acct->shipment_budget,
183
                    message_id            => $invoice_message->id,
184
                }
185
            );
186
            my $invoiceid = $new_invoice->invoiceid;
187
            $logger->trace("Added as invoiceno :$invoiceid");
188
            my $lines = $msg->lineitems();
189
190
            foreach my $line ( @{$lines} ) {
191
                my $ordernumber = $line->ordernumber;
192
                $logger->trace( "Receipting order:$ordernumber Qty: ",
193
                    $line->quantity );
194
195
                my $order = $schema->resultset('Aqorder')->find($ordernumber);
196
197
      # ModReceiveOrder does not validate that $ordernumber exists validate here
198
                if ($order) {
199
200
                    # check suggestions
201
                    my $s = $schema->resultset('Suggestion')->search(
202
                        {
203
                            biblionumber => $order->biblionumber->biblionumber,
204
                        }
205
                    )->single;
206
                    if ($s) {
207
                        ModSuggestion(
208
                            {
209
                                suggestionid => $s->suggestionid,
210
                                STATUS       => 'AVAILABLE',
211
                            }
212
                        );
213
                    }
214
215
                    my $price = _get_invoiced_price($line);
216
217
                    if ( $order->quantity > $line->quantity ) {
218
                        my $ordered = $order->quantity;
219
220
                        # part receipt
221
                        $order->orderstatus('partial');
222
                        $order->quantity( $ordered - $line->quantity );
223
                        $order->update;
224
                        my $received_order = $order->copy(
225
                            {
226
                                ordernumber      => undef,
227
                                quantity         => $line->quantity,
228
                                quantityreceived => $line->quantity,
229
                                orderstatus      => 'complete',
230
                                unitprice        => $price,
231
                                invoiceid        => $invoiceid,
232
                                datereceived     => $msg_date,
233
                            }
234
                        );
235
                        transfer_items( $schema, $line, $order,
236
                            $received_order );
237
                        receipt_items( $schema, $line,
238
                            $received_order->ordernumber );
239
                    }
240
                    else {    # simple receipt all copies on order
241
                        $order->quantityreceived( $line->quantity );
242
                        $order->datereceived($msg_date);
243
                        $order->invoiceid($invoiceid);
244
                        $order->unitprice($price);
245
                        $order->orderstatus('complete');
246
                        $order->update;
247
                        receipt_items( $schema, $line, $ordernumber );
248
                    }
249
                }
250
                else {
251
                    $logger->error(
252
                        "No order found for $ordernumber Invoice:$invoicenumber"
253
                    );
254
                    next;
255
                }
256
257
            }
258
259
        }
260
    }
261
262
    $invoice_message->status('received');
263
    $invoice_message->update;    # status and basketno link
264
    return;
265
}
266
267
sub _get_invoiced_price {
268
    my $line  = shift;
269
    my $price = $line->price_net;
270
    if ( !defined $price ) {  # no net price so generate it from lineitem amount
271
        $price = $line->amt_lineitem;
272
        if ( $price and $line->quantity > 1 ) {
273
            $price /= $line->quantity;    # div line cost by qty
274
        }
275
    }
276
    return $price;
277
}
278
279
sub receipt_items {
280
    my ( $schema, $inv_line, $ordernumber ) = @_;
281
    my $logger   = Log::Log4perl->get_logger();
282
    my $quantity = $inv_line->quantity;
283
284
    # itemnumber is not a foreign key ??? makes this a bit cumbersome
285
    my @item_links = $schema->resultset('AqordersItem')->search(
286
        {
287
            ordernumber => $ordernumber,
288
        }
289
    );
290
    my %branch_map;
291
    foreach my $ilink (@item_links) {
292
        my $item = $schema->resultset('Item')->find( $ilink->itemnumber );
293
        if ( !$item ) {
294
            my $i = $ilink->itemnumber;
295
            $logger->warn(
296
                "Cannot find aqorder item for $i :Order:$ordernumber");
297
            next;
298
        }
299
        my $b = $item->homebranch->branchcode;
300
        if ( !exists $branch_map{$b} ) {
301
            $branch_map{$b} = [];
302
        }
303
        push @{ $branch_map{$b} }, $item;
304
    }
305
    my $gir_occurence = 0;
306
    while ( $gir_occurence < $quantity ) {
307
        my $branch = $inv_line->girfield( 'branch', $gir_occurence );
308
        my $item = shift @{ $branch_map{$branch} };
309
        if ($item) {
310
            my $barcode = $inv_line->girfield( 'barcode', $gir_occurence );
311
            if ( $barcode && !$item->barcode ) {
312
                my $rs = $schema->resultset('Item')->search(
313
                    {
314
                        barcode => $barcode,
315
                    }
316
                );
317
                if ( $rs->count > 0 ) {
318
                    $logger->warn("Barcode $barcode is a duplicate");
319
                }
320
                else {
321
322
                    $logger->trace("Adding barcode $barcode");
323
                    $item->barcode($barcode);
324
                }
325
            }
326
327
            # clear not for loan flag
328
            # if ( $item->notforloan == -1 ) {
329
            #     $item->notforloan(0);
330
            # }
331
            $item->update;
332
        }
333
        else {
334
            $logger->warn("Unmatched item at branch:$branch");
335
        }
336
        ++$gir_occurence;
337
    }
338
    return;
339
340
}
341
342
sub transfer_items {
343
    my ( $schema, $inv_line, $order_from, $order_to ) = @_;
344
345
    # Transfer x items from the orig order to a completed partial order
346
    my $quantity = $inv_line->quantity;
347
    my $gocc     = 0;
348
    my %mapped_by_branch;
349
    while ( $gocc < $quantity ) {
350
        my $branch = $inv_line->girfield( 'branch', $gocc );
351
        if ( !exists $mapped_by_branch{$branch} ) {
352
            $mapped_by_branch{$branch} = 1;
353
        }
354
        else {
355
            $mapped_by_branch{$branch}++;
356
        }
357
        ++$gocc;
358
    }
359
    my $logger = Log::Log4perl->get_logger();
360
    my $o1     = $order_from->ordernumber;
361
    my $o2     = $order_to->ordernumber;
362
    $logger->warn("transferring $quantity copies from order $o1 to order $o2");
363
364
    my @item_links = $schema->resultset('AqordersItem')->search(
365
        {
366
            ordernumber => $order_from->ordernumber,
367
        }
368
    );
369
    foreach my $ilink (@item_links) {
370
        my $ino      = $ilink->itemnumber;
371
        my $item     = $schema->resultset('Item')->find( $ilink->itemnumber );
372
        my $i_branch = $item->homebranch;
373
        if ( exists $mapped_by_branch{$i_branch}
374
            && $mapped_by_branch{$i_branch} > 0 )
375
        {
376
            $ilink->ordernumber( $order_to->ordernumber );
377
            $ilink->update;
378
            --$quantity;
379
            --$mapped_by_branch{$i_branch};
380
            $logger->warn("Transferred item $item");
381
        }
382
        else {
383
            $logger->warn("Skipped item $item");
384
        }
385
        if ( $quantity < 1 ) {
386
            last;
387
        }
388
    }
389
390
    return;
391
}
392
393
# called on messages with status 'new'
394
sub process_quote {
395
    my $quote = shift;
396
397
    $quote->status('processing');
398
    $quote->update;
399
400
    my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
401
402
    my $messages       = $edi->message_array();
403
    my $process_errors = 0;
404
    my $logger         = Log::Log4perl->get_logger();
405
    my $schema         = Koha::Database->new()->schema();
406
    my $message_count  = 0;
407
    my @added_baskets;    # if auto & multiple baskets need to order all
408
409
    if ( @{$messages} && $quote->vendor_id ) {
410
        foreach my $msg ( @{$messages} ) {
411
            ++$message_count;
412
            my $basketno =
413
              NewBasket( $quote->vendor_id, 0, $quote->filename, q{},
414
                q{} . q{} );
415
            push @added_baskets, $basketno;
416
            if ( $message_count > 1 ) {
417
                my $m_filename = $quote->filename;
418
                $m_filename .= "_$message_count";
419
                $schema->resultset('EdifactMessage')->create(
420
                    {
421
                        message_type  => $quote->message_type,
422
                        transfer_date => $quote->transfer_date,
423
                        vendor_id     => $quote->vendor_id,
424
                        edi_acct      => $quote->edi_acct,
425
                        status        => 'recmsg',
426
                        basketno      => $basketno,
427
                        raw_msg       => q{},
428
                        filename      => $m_filename,
429
                    }
430
                );
431
            }
432
            else {
433
                $quote->basketno($basketno);
434
            }
435
            $logger->trace("Created basket :$basketno");
436
            my $items  = $msg->lineitems();
437
            my $refnum = $msg->message_refno;
438
439
            for my $item ( @{$items} ) {
440
                if ( !quote_item( $item, $quote, $basketno ) ) {
441
                    ++$process_errors;
442
                }
443
            }
444
        }
445
    }
446
    my $status = 'received';
447
    if ($process_errors) {
448
        $status = 'error';
449
    }
450
451
    $quote->status($status);
452
    $quote->update;    # status and basketno link
453
                       # Do we automatically generate orders for this vendor
454
    my $v = $schema->resultset('VendorEdiAccount')->search(
455
        {
456
            vendor_id => $quote->vendor_id,
457
        }
458
    )->single;
459
    if ( $v->auto_orders ) {
460
        for my $b (@added_baskets) {
461
            create_edi_order(
462
                {
463
464
                    basketno => $b,
465
                }
466
            );
467
            CloseBasket($b);
468
        }
469
    }
470
471
    return;
472
}
473
474
sub quote_item {
475
    my ( $item, $quote, $basketno ) = @_;
476
477
    my $schema = Koha::Database->new()->schema();
478
479
    # create biblio record
480
    my $logger = Log::Log4perl->get_logger();
481
    if ( !$basketno ) {
482
        $logger->error('Skipping order creation no basketno');
483
        return;
484
    }
485
    $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
486
    my $bib = _check_for_existing_bib( $item->item_number_id() );
487
    if ( !defined $bib ) {
488
        $bib = {};
489
        my $bib_record = _create_bib_from_quote( $item, $quote );
490
        ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
491
          AddBiblio( $bib_record, q{} );
492
        $logger->trace("New biblio added $bib->{biblionumber}");
493
    }
494
    else {
495
        $logger->trace("Match found: $bib->{biblionumber}");
496
    }
497
498
    # Create an orderline
499
    my $order_note = $item->{orderline_free_text};
500
    $order_note ||= q{};
501
    my $order_quantity = $item->quantity();
502
    my $gir_count      = $item->number_of_girs();
503
    $order_quantity ||= 1;    # quantity not necessarily present
504
    if ( $gir_count > 1 ) {
505
        if ( $gir_count != $order_quantity ) {
506
            $logger->error(
507
                "Order for $order_quantity items, $gir_count segments present");
508
        }
509
        $order_quantity = 1;    # attempts to create an orderline for each gir
510
    }
511
512
    # database definitions should set some of these defaults but dont
513
    my $order_hash = {
514
        biblionumber       => $bib->{biblionumber},
515
        entrydate          => DateTime->now( time_zone => 'local' )->ymd(),
516
        basketno           => $basketno,
517
        listprice          => $item->price,
518
        quantity           => $order_quantity,
519
        quantityreceived   => 0,
520
        order_internalnote => $order_note,
521
        rrp                => $item->price,
522
        ecost => _discounted_price( $quote->vendor->discount, $item->price ),
523
        uncertainprice => 0,
524
        sort1          => q{},
525
        sort2          => q{},
526
527
        #        supplierreference => $item->reference,
528
    };
529
530
    # suppliers references
531
    if ( $item->reference() ) {
532
        $order_hash->{suppliers_reference_number}    = $item->reference;
533
        $order_hash->{suppliers_reference_qualifier} = 'QLI';
534
    }
535
    elsif ( $item->orderline_reference_number() ) {
536
        $order_hash->{suppliers_reference_number} =
537
          $item->orderline_reference_number;
538
        $order_hash->{suppliers_reference_qualifier} = 'SLI';
539
    }
540
    if ( $item->item_number_id ) {    # suppliers ean
541
        $order_hash->{line_item_id} = $item->item_number_id;
542
    }
543
544
    if ( $item->girfield('servicing_instruction') ) {
545
        my $occ = 0;
546
        my $txt = q{};
547
        my $si;
548
        while ( $si = $item->girfield( 'servicing_instruction', $occ ) ) {
549
            if ($occ) {
550
                $txt .= q{: };
551
            }
552
            $txt .= $si;
553
            ++$occ;
554
        }
555
        $order_hash->{order_vendornote} = $txt;
556
    }
557
558
    if ( $item->internal_notes() ) {
559
        if ( $order_hash->{order_internalnote} ) {    # more than ''
560
            $order_hash->{order_internalnote} .= q{ };
561
        }
562
        $order_hash->{order_internalnote} .= $item->internal_notes;
563
    }
564
565
    my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
566
567
    my $skip = '0';
568
    if ( !$budget ) {
569
        if ( $item->quantity > 1 ) {
570
            carp 'Skipping line with no budget info';
571
            $logger->trace('girfield skipped for invalid budget');
572
            $skip++;
573
        }
574
        else {
575
            carp 'Skipping line with no budget info';
576
            $logger->trace('orderline skipped for invalid budget');
577
            return;
578
        }
579
    }
580
581
    my %ordernumber;
582
    my %budgets;
583
    my $item_hash;
584
585
    if ( !$skip ) {
586
        $order_hash->{budget_id} = $budget->budget_id;
587
        my $first_order = $schema->resultset('Aqorder')->create($order_hash);
588
        my $o           = $first_order->ordernumber();
589
        $logger->trace("Order created :$o");
590
591
        # should be done by database settings
592
        $first_order->parent_ordernumber( $first_order->ordernumber() );
593
        $first_order->update();
594
595
        # add to $budgets to prevent duplicate orderlines
596
        $budgets{ $budget->budget_id } = '1';
597
598
        # record ordernumber against budget
599
        $ordernumber{ $budget->budget_id } = $o;
600
601
        if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
602
            $item_hash = _create_item_from_quote( $item, $quote );
603
604
            my $created = 0;
605
            while ( $created < $order_quantity ) {
606
                my $itemnumber;
607
                ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber )
608
                  = AddItem( $item_hash, $bib->{biblionumber} );
609
                $logger->trace("Added item:$itemnumber");
610
                $schema->resultset('AqordersItem')->create(
611
                    {
612
                        ordernumber => $first_order->ordernumber,
613
                        itemnumber  => $itemnumber,
614
                    }
615
                );
616
                ++$created;
617
            }
618
        }
619
    }
620
621
    if ( $order_quantity == 1 && $item->quantity > 1 ) {
622
        my $occurence = 1;    # occ zero already added
623
        while ( $occurence < $item->quantity ) {
624
625
            # check budget code
626
            $budget = _get_budget( $schema,
627
                $item->girfield( 'fund_allocation', $occurence ) );
628
629
            if ( !$budget ) {
630
                my $bad_budget =
631
                  $item->girfield( 'fund_allocation', $occurence );
632
                carp 'Skipping line with no budget info';
633
                $logger->trace(
634
                    "girfield skipped for invalid budget:$bad_budget");
635
                ++$occurence;    ## lets look at the next one not this one again
636
                next;
637
            }
638
639
            # add orderline for NEW budget in $budgets
640
            if ( !exists $budgets{ $budget->budget_id } ) {
641
642
                # $order_hash->{quantity} = 1; by default above
643
                # we should handle both 1:1 GIR & 1:n GIR (with LQT values) here
644
645
                $order_hash->{budget_id} = $budget->budget_id;
646
647
                my $new_order =
648
                  $schema->resultset('Aqorder')->create($order_hash);
649
                my $o = $new_order->ordernumber();
650
                $logger->trace("Order created :$o");
651
652
                # should be done by database settings
653
                $new_order->parent_ordernumber( $new_order->ordernumber() );
654
                $new_order->update();
655
656
                # add to $budgets to prevent duplicate orderlines
657
                $budgets{ $budget->budget_id } = '1';
658
659
                # record ordernumber against budget
660
                $ordernumber{ $budget->budget_id } = $o;
661
662
                if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
663
                    if ( !defined $item_hash ) {
664
                        $item_hash = _create_item_from_quote( $item, $quote );
665
                    }
666
                    my $new_item = {
667
                        itype =>
668
                          $item->girfield( 'stock_category', $occurence ),
669
                        location =>
670
                          $item->girfield( 'collection_code', $occurence ),
671
                        itemcallnumber =>
672
                          $item->girfield( 'shelfmark', $occurence )
673
                          || $item->girfield( 'classification', $occurence )
674
                          || title_level_class($item),
675
                        holdingbranch =>
676
                          $item->girfield( 'branch', $occurence ),
677
                        homebranch => $item->girfield( 'branch', $occurence ),
678
                    };
679
                    if ( $new_item->{itype} ) {
680
                        $item_hash->{itype} = $new_item->{itype};
681
                    }
682
                    if ( $new_item->{location} ) {
683
                        $item_hash->{location} = $new_item->{location};
684
                    }
685
                    if ( $new_item->{itemcallnumber} ) {
686
                        $item_hash->{itemcallnumber} =
687
                          $new_item->{itemcallnumber};
688
                    }
689
                    if ( $new_item->{holdingbranch} ) {
690
                        $item_hash->{holdingbranch} =
691
                          $new_item->{holdingbranch};
692
                    }
693
                    if ( $new_item->{homebranch} ) {
694
                        $item_hash->{homebranch} = $new_item->{homebranch};
695
                    }
696
697
                    my $itemnumber;
698
                    ( undef, undef, $itemnumber ) =
699
                      AddItem( $item_hash, $bib->{biblionumber} );
700
                    $logger->trace("New item $itemnumber added");
701
                    $schema->resultset('AqordersItem')->create(
702
                        {
703
                            ordernumber => $new_order->ordernumber,
704
                            itemnumber  => $itemnumber,
705
                        }
706
                    );
707
                }
708
709
                ++$occurence;
710
            }
711
712
            # increment quantity in orderline for EXISTING budget in $budgets
713
            else {
714
                my $row = $schema->resultset('Aqorder')->find(
715
                    {
716
                        ordernumber => $ordernumber{ $budget->budget_id }
717
                    }
718
                );
719
                if ($row) {
720
                    my $qty = $row->quantity;
721
                    $qty++;
722
                    $row->update(
723
                        {
724
                            quantity => $qty,
725
                        }
726
                    );
727
                }
728
729
                if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
730
                    my $new_item = {
731
                        notforloan       => -1,
732
                        cn_sort          => q{},
733
                        cn_source        => 'ddc',
734
                        price            => $item->price,
735
                        replacementprice => $item->price,
736
                        itype =>
737
                          $item->girfield( 'stock_category', $occurence ),
738
                        location =>
739
                          $item->girfield( 'collection_code', $occurence ),
740
                        itemcallnumber =>
741
                          $item->girfield( 'shelfmark', $occurence )
742
                          || $item->girfield( 'classification', $occurence )
743
                          || $item_hash->{itemcallnumber},
744
                        holdingbranch =>
745
                          $item->girfield( 'branch', $occurence ),
746
                        homebranch => $item->girfield( 'branch', $occurence ),
747
                    };
748
                    my $itemnumber;
749
                    ( undef, undef, $itemnumber ) =
750
                      AddItem( $new_item, $bib->{biblionumber} );
751
                    $logger->trace("New item $itemnumber added");
752
                    $schema->resultset('AqordersItem')->create(
753
                        {
754
                            ordernumber => $ordernumber{ $budget->budget_id },
755
                            itemnumber  => $itemnumber,
756
                        }
757
                    );
758
                }
759
760
                ++$occurence;
761
            }
762
        }
763
    }
764
    return 1;
765
766
}
767
768
sub get_edifact_ean {
769
770
    my $dbh = C4::Context->dbh;
771
772
    my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
773
774
    return $eans->[0];
775
}
776
777
# We should not need to have a routine to do this here
778
sub _discounted_price {
779
    my ( $discount, $price ) = @_;
780
    return $price - ( ( $discount * $price ) / 100 );
781
}
782
783
sub _check_for_existing_bib {
784
    my $isbn = shift;
785
786
    my $search_isbn = $isbn;
787
    $search_isbn =~ s/^\s*/%/xms;
788
    $search_isbn =~ s/\s*$/%/xms;
789
    my $dbh = C4::Context->dbh;
790
    my $sth = $dbh->prepare(
791
'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
792
    );
793
    my $tuple_arr =
794
      $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
795
    if ( @{$tuple_arr} ) {
796
        return $tuple_arr->[0];
797
    }
798
    elsif ( length($isbn) == 13 && $isbn !~ /^97[89]/ ) {
799
        my $tarr = $dbh->selectall_arrayref(
800
'select biblionumber, biblioitemnumber from biblioitems where ean = ?',
801
            { Slice => {} },
802
            $isbn
803
        );
804
        if ( @{$tarr} ) {
805
            return $tarr->[0];
806
        }
807
    }
808
    else {
809
        undef $search_isbn;
810
        $isbn =~ s/\-//xmsg;
811
        if ( $isbn =~ m/(\d{13})/xms ) {
812
            my $b_isbn = Business::ISBN->new($1);
813
            if ( $b_isbn && $b_isbn->is_valid ) {
814
                $search_isbn = $b_isbn->as_isbn10->as_string( [] );
815
            }
816
817
        }
818
        elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
819
            my $b_isbn = Business::ISBN->new($1);
820
            if ( $b_isbn && $b_isbn->is_valid ) {
821
                $search_isbn = $b_isbn->as_isbn13->as_string( [] );
822
            }
823
824
        }
825
        if ($search_isbn) {
826
            $search_isbn = "%$search_isbn%";
827
            $tuple_arr =
828
              $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
829
            if ( @{$tuple_arr} ) {
830
                return $tuple_arr->[0];
831
            }
832
        }
833
    }
834
    return;
835
}
836
837
# returns a budget obj or undef
838
# fact we need this shows what a mess Acq API is
839
sub _get_budget {
840
    my ( $schema, $budget_code ) = @_;
841
    my $period_rs = $schema->resultset('Aqbudgetperiod')->search(
842
        {
843
            budget_period_active => 1,
844
        }
845
    );
846
847
    # db does not ensure budget code is unque
848
    return $schema->resultset('Aqbudget')->single(
849
        {
850
            budget_code => $budget_code,
851
            budget_period_id =>
852
              { -in => $period_rs->get_column('budget_period_id')->as_query },
853
        }
854
    );
855
}
856
857
# try to get title level classification from incoming quote
858
sub title_level_class {
859
    my ($item)         = @_;
860
    my $class          = q{};
861
    my $default_scheme = C4::Context->preference('DefaultClassificationSource');
862
    if ( $default_scheme eq 'ddc' ) {
863
        $class = $item->dewey_class();
864
    }
865
    elsif ( $default_scheme eq 'lcc' ) {
866
        $class = $item->lc_class();
867
    }
868
    if ( !$class ) {
869
        $class =
870
             $item->girfield('shelfmark')
871
          || $item->girfield('classification')
872
          || q{};
873
    }
874
    return $class;
875
}
876
877
sub _create_bib_from_quote {
878
879
    #TBD we should flag this for updating from an external source
880
    #As biblio (&biblioitems) has no candidates flag in order
881
    my ( $item, $quote ) = @_;
882
    my $itemid = $item->item_number_id;
883
    my $defalt_classification_source =
884
      C4::Context->preference('DefaultClassificationSource');
885
    my $bib_hash = {
886
        'biblioitems.cn_source' => $defalt_classification_source,
887
        'items.cn_source'       => $defalt_classification_source,
888
        'items.notforloan'      => -1,
889
        'items.cn_sort'         => q{},
890
    };
891
    $bib_hash->{'biblio.seriestitle'} = $item->series;
892
893
    $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
894
    $bib_hash->{'biblioitems.publicationyear'} =
895
      $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
896
897
    $bib_hash->{'biblio.title'}         = $item->title;
898
    $bib_hash->{'biblio.author'}        = $item->author;
899
    $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
900
    $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
901
902
    # If we have a 13 digit id we are assuming its an ean
903
    # (it may also be an isbn or issn)
904
    if ( $itemid =~ /^\d{13}$/ ) {
905
        $bib_hash->{'biblioitems.ean'} = $itemid;
906
        if ( $itemid =~ /^977/ ) {
907
            $bib_hash->{'biblioitems.issn'} = $itemid;
908
        }
909
    }
910
    for my $key ( keys %{$bib_hash} ) {
911
        if ( !defined $bib_hash->{$key} ) {
912
            delete $bib_hash->{$key};
913
        }
914
    }
915
    return TransformKohaToMarc($bib_hash);
916
917
}
918
919
sub _create_item_from_quote {
920
    my ( $item, $quote ) = @_;
921
    my $defalt_classification_source =
922
      C4::Context->preference('DefaultClassificationSource');
923
    my $item_hash = {
924
        cn_source  => $defalt_classification_source,
925
        notforloan => -1,
926
        cn_sort    => q{},
927
    };
928
    $item_hash->{booksellerid} = $quote->vendor_id;
929
    $item_hash->{price}        = $item_hash->{replacementprice} = $item->price;
930
    $item_hash->{itype}        = $item->girfield('stock_category');
931
    $item_hash->{location}     = $item->girfield('collection_code');
932
933
    my $note = {};
934
935
    $item_hash->{itemcallnumber} =
936
         $item->girfield('shelfmark')
937
      || $item->girfield('classification')
938
      || title_level_class($item);
939
940
    my $branch = $item->girfield('branch');
941
    $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
942
    return $item_hash;
943
}
944
945
1;
946
__END__
947
948
=head1 NAME
949
950
Koha::EDI
951
952
=head1 SYNOPSIS
953
954
   Module exporting subroutines used in EDI processing for Koha
955
956
=head1 DESCRIPTION
957
958
   Subroutines called by batch processing to handle Edifact
959
   messages of various types and related utilities
960
961
=head1 BUGS
962
963
   These routines should really be methods of some object.
964
   get_edifact_ean is a stopgap which should be replaced
965
966
=head1 SUBROUTINES
967
968
=head2 process_quote
969
970
    process_quote(quote_message);
971
972
   passed a message object for a quote, parses it creating an order basket
973
   and orderlines in the database
974
   updates the message's status to received in the database and adds the
975
   link to basket
976
977
=head2 process_invoice
978
979
    process_invoice(invoice_message)
980
981
    passed a message object for an invoice, add the contained invoices
982
    and update the orderlines referred to in the invoice
983
    As an Edifact invoice is in effect a despatch note this receipts the
984
    appropriate quantities in the orders
985
986
987
=head2 create_edi_order
988
989
    create_edi_order( { parameter_hashref } )
990
991
    parameters must include basketno and ean
992
993
    branchcode can optionally be passed
994
995
    returns 1 on success undef otherwise
996
997
    if the parameter noingest is set the formatted order is returned
998
    and not saved in the database. This functionality is intended for debugging only
999
e
1000
    my $database       = Koha::Database->new();
1001
1002
=head2 get_edifact_ean
1003
1004
    $ean = get_edifact_ean();
1005
1006
    routine to return the ean.
1007
1008
=head2 quote_item
1009
1010
     quote_item(lineitem, quote_message);
1011
1012
      Called by process_quote to handle an individual lineitem
1013
     Generate the biblios and items if required and orderline linking to them
1014
1015
=head1 AUTHOR
1016
1017
   Colin Campbell <colin.campbell@ptfs-europe.com>
1018
1019
1020
=head1 COPYRIGHT
1021
1022
   Copyright 2014, PTFS-Europe Ltd
1023
   This program is free software, You may redistribute it under
1024
   under the terms of the GNU General Public License
1025
1026
1027
=cut
(-)a/Koha/Edifact.pm (+331 lines)
Line 0 Link Here
1
package Koha::Edifact;
2
3
# Copyright 2014 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 data which will be used to
158
# create Message objects
159
sub message_array {
160
    my $self = shift;
161
162
    # return an array of array_refs 1 ref to a message
163
    my $msg_arr = [];
164
    my $msg     = [];
165
    my $in_msg  = 0;
166
    foreach my $seg ( @{ $self->{transmission} } ) {
167
        if ( $seg->tag eq 'UNH' ) {
168
            $in_msg = 1;
169
            push @{$msg}, $seg;
170
        }
171
        elsif ( $seg->tag eq 'UNT' ) {
172
            $in_msg = 0;
173
            if ( @{$msg} ) {
174
                push @{$msg_arr}, Koha::Edifact::Message->new($msg);
175
                $msg = [];
176
            }
177
        }
178
        elsif ($in_msg) {
179
            push @{$msg}, $seg;
180
        }
181
    }
182
    return $msg_arr;
183
}
184
185
#
186
# internal parsing routines used in _init
187
#
188
sub service_string_advice {
189
    my $ssa = shift;
190
191
    # At present this just validates that the ssa
192
    # is standard Edifact
193
    # TBD reset the seps if non standard
194
    if ( $ssa ne q{:+.? '} ) {
195
        carp " Non standard Service String Advice [$ssa]";
196
        return;
197
    }
198
199
    # else use default separators
200
    return 1;
201
}
202
203
sub segmentize {
204
    my $raw = shift;
205
206
    # In practice edifact uses latin-1 but check
207
    # Transport now converts to utf-8 on ingest
208
    # Do not convert here
209
    #my $char_set = 'iso-8859-1';
210
    #if ( $raw =~ m/^UNB[+]UNO(.)/ ) {
211
    #    $char_set = msgcharset($1);
212
    #}
213
    #from_to( $raw, $char_set, 'utf8' );
214
215
    my $re = qr{
216
(?>         # dont backtrack into this group
217
    [?].     # either the escape character
218
            # followed by any other character
219
     |      # or
220
     [^'?]   # a character that is neither escape
221
             # nor split
222
             )+
223
}x;
224
    my @segmented;
225
    while ( $raw =~ /($re)/g ) {
226
        push @segmented, Koha::Edifact::Segment->new( { seg_string => $1 } );
227
    }
228
    return \@segmented;
229
}
230
231
sub msgcharset {
232
    my $code = shift;
233
    if ( $code =~ m/^[^ABCDEF]$/ ) {
234
        $code = 'default';
235
    }
236
    my %encoding_map = (
237
        A       => 'ascii',
238
        B       => 'ascii',
239
        C       => 'iso-8859-1',
240
        D       => 'iso-8859-1',
241
        E       => 'iso-8859-1',
242
        F       => 'iso-8859-1',
243
        default => 'iso-8859-1',
244
    );
245
    return $encoding_map{$code};
246
}
247
248
1;
249
__END__
250
251
=head1 NAME
252
253
Edifact - Edifact message handler
254
255
=head1 DESCRIPTION
256
257
   Koha module for parsing Edifact messages
258
259
=head1 SUBROUTINES
260
261
=head2 new
262
263
     my $e = Koha::Edifact->new( { filename => 'myfilename' } );
264
     or
265
     my $e = Koha::Edifact->new( { transmission => $msg_variable } );
266
267
     instantiate the Edifact parser, requires either to be passed an in-memory
268
     edifact message as transmission or a filename which it will read on creation
269
270
=head2 interchange_header
271
272
     will return the data in the header field designated by the parameter
273
     specified. Valid parameters are: 'sender', 'recipient', 'datetime',
274
    'interchange_control_reference', and 'application_reference'
275
276
=head2 interchange_trailer
277
278
     called either with the string 'interchange_control_count' or
279
     'interchange_control_reference' will return the corresponding field from
280
     the interchange trailer
281
282
=head2 new_data_iterator
283
284
     Sets the object's data_iterator to point to the UNH segment
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 it returns
293
     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 service_string_advice
306
307
  Examines the Service String Advice returns 1 if the default separartors are in use
308
  undef otherwise
309
310
=head2 segmentize
311
312
   takes a raw Edifact message and returns a reference to an array of
313
   its segments
314
315
=head2 msgcharset
316
317
    Return the character set the message was encoded in. The default is iso-8859-1
318
319
=head1 AUTHOR
320
321
   Colin Campbell <colin.campbell@ptfs-europe.com>
322
323
324
=head1 COPYRIGHT
325
326
   Copyright 2014, PTFS-Europe Ltd
327
   This program is free software, You may redistribute it under
328
   under the terms of the GNU General Public License
329
330
331
=cut
(-)a/Koha/Edifact/Line.pm (+756 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
            $d->{avaiability_date} = $s->elem( 0, 1 );
71
        }
72
        elsif ( $s->tag eq 'GIR' ) {
73
74
            # we may get a Gir for each copy if QTY > 1
75
            if ( !$d->{GIR} ) {
76
                $d->{GIR} = [];
77
            }
78
            push @{ $d->{GIR} }, extract_gir($s);
79
80
        }
81
        elsif ( $s->tag eq 'FTX' ) {
82
83
            my $type  = $s->elem(0);
84
            my $ctype = 'coded_free_text';
85
            if ( $type eq 'LNO' ) {    # Ingrams Oasis Internal Notes field
86
                $type  = 'internal_notes';
87
                $ctype = 'coded_internal_note';
88
            }
89
            elsif ( $type eq 'LIN' ) {
90
                $type  = 'orderline_free_text';
91
                $ctype = 'coded_orderline_text';
92
            }
93
            elsif ( $type eq 'SUB' ) {
94
                $type = 'coded_substitute_text';
95
            }
96
            else {
97
                $type = 'free_text';
98
            }
99
100
            my $coded_text = $s->elem(2);
101
            if ( ref $coded_text eq 'ARRAY' && $coded_text->[0] ) {
102
                $d->{$ctype}->{table} = $coded_text->[1];
103
                $d->{$ctype}->{code}  = $coded_text->[0];
104
            }
105
106
            my $ftx = $s->elem(3);
107
            if ( ref $ftx eq 'ARRAY' ) {   # it comes in 70 character components
108
                $ftx = join q{ }, @{$ftx};
109
            }
110
            if ( exists $d->{$type} ) {    # we can only catenate repeats
111
                $d->{$type} .= q{ };
112
                $d->{$type} .= $ftx;
113
            }
114
            else {
115
                $d->{$type} = $ftx;
116
            }
117
        }
118
        elsif ( $s->tag eq 'MOA' ) {
119
120
            $d->{monetary_amount} = $s->elem( 0, 1 );
121
        }
122
        elsif ( $s->tag eq 'PRI' ) {
123
124
            $d->{price} = $s->elem( 0, 1 );
125
        }
126
        elsif ( $s->tag eq 'RFF' ) {
127
            my $qualifier = $s->elem( 0, 0 );
128
            if ( $qualifier eq 'QLI' ) {  # Suppliers unique quotation reference
129
                $d->{reference} = $s->elem( 0, 1 );
130
            }
131
            elsif ( $qualifier eq 'LI' ) {    # Buyer's unique orderline number
132
                $d->{ordernumber} = $s->elem( 0, 1 );
133
            }
134
            elsif ( $qualifier eq 'SLI' )
135
            {    # Suppliers unique order line reference number
136
                $d->{orderline_reference_number} = $s->elem( 0, 1 );
137
            }
138
        }
139
    }
140
    $d->{item_description} = _format_item_description(@item_description);
141
    $d->{segs}             = $aref;
142
143
    return $d;
144
}
145
146
sub _format_item_description {
147
    my @imd    = @_;
148
    my $bibrec = {};
149
150
 # IMD : +Type code 'L' + characteristic code 3 char + Description in comp 3 & 4
151
    foreach my $imd (@imd) {
152
        my $type_code = $imd->elem(0);
153
        my $ccode     = $imd->elem(1);
154
        my $desc      = $imd->elem( 2, 3 );
155
        if ( $imd->elem( 2, 4 ) ) {
156
            $desc .= $imd->elem( 2, 4 );
157
        }
158
        if ( $type_code ne 'L' ) {
159
            carp
160
              "Only handles text item descriptions at present: code=$type_code";
161
            next;
162
        }
163
        if ( exists $bibrec->{$ccode} ) {
164
            $bibrec->{$ccode} .= q{ };
165
            $bibrec->{$ccode} .= $desc;
166
        }
167
        else {
168
            $bibrec->{$ccode} = $desc;
169
        }
170
    }
171
    return $bibrec;
172
}
173
174
sub marc_record {
175
    my $self = shift;
176
    my $b    = $self->{item_description};
177
178
    my $bib = MARC::Record->new();
179
180
    my @spec;
181
    my @fields;
182
    if ( exists $b->{'010'} ) {
183
        @spec = qw( 100 a 011 c 012 b 013 d 014 e );
184
        push @fields, new_field( $b, [ 100, 1, q{ } ], @spec );
185
    }
186
    if ( exists $b->{'020'} ) {
187
        @spec = qw( 020 a 021 c 022 b 023 d 024 e );
188
        push @fields, new_field( $b, [ 700, 1, q{ } ], @spec );
189
    }
190
191
    # corp conf
192
    if ( exists $b->{'030'} ) {
193
        push @fields, $self->corpcon(1);
194
    }
195
    if ( exists $b->{'040'} ) {
196
        push @fields, $self->corpcon(7);
197
    }
198
    if ( exists $b->{'050'} ) {
199
        @spec = qw( '050' a '060' b '065' c );
200
        push @fields, new_field( $b, [ 245, 1, 0 ], @spec );
201
    }
202
    if ( exists $b->{100} ) {
203
        @spec = qw( 100 a 101 b);
204
        push @fields, new_field( $b, [ 250, q{ }, q{ } ], @spec );
205
    }
206
    @spec = qw( 110 a 120 b 170 c );
207
    my $f = new_field( $b, [ 260, q{ }, q{ } ], @spec );
208
    if ($f) {
209
        push @fields, $f;
210
    }
211
    @spec = qw( 180 a 181 b 182 c 183 e);
212
    $f = new_field( $b, [ 300, q{ }, q{ } ], @spec );
213
    if ($f) {
214
        push @fields, $f;
215
    }
216
    if ( exists $b->{190} ) {
217
        @spec = qw( 190 a);
218
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
219
    }
220
221
    if ( exists $b->{200} ) {
222
        @spec = qw( 200 a);
223
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
224
    }
225
    if ( exists $b->{210} ) {
226
        @spec = qw( 210 a);
227
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
228
    }
229
    if ( exists $b->{300} ) {
230
        @spec = qw( 300 a);
231
        push @fields, new_field( $b, [ 500, q{ }, q{ } ], @spec );
232
    }
233
    if ( exists $b->{310} ) {
234
        @spec = qw( 310 a);
235
        push @fields, new_field( $b, [ 520, q{ }, q{ } ], @spec );
236
    }
237
    if ( exists $b->{320} ) {
238
        @spec = qw( 320 a);
239
        push @fields, new_field( $b, [ 521, q{ }, q{ } ], @spec );
240
    }
241
    if ( exists $b->{260} ) {
242
        @spec = qw( 260 a);
243
        push @fields, new_field( $b, [ 600, q{ }, q{ } ], @spec );
244
    }
245
    if ( exists $b->{270} ) {
246
        @spec = qw( 270 a);
247
        push @fields, new_field( $b, [ 650, q{ }, q{ } ], @spec );
248
    }
249
    if ( exists $b->{280} ) {
250
        @spec = qw( 280 a);
251
        push @fields, new_field( $b, [ 655, q{ }, q{ } ], @spec );
252
    }
253
254
    # class
255
    if ( exists $b->{230} ) {
256
        @spec = qw( 230 a);
257
        push @fields, new_field( $b, [ '082', q{ }, q{ } ], @spec );
258
    }
259
    if ( exists $b->{240} ) {
260
        @spec = qw( 240 a);
261
        push @fields, new_field( $b, [ '084', q{ }, q{ } ], @spec );
262
    }
263
    $bib->insert_fields_ordered(@fields);
264
265
    return $bib;
266
}
267
268
sub corpcon {
269
    my ( $self, $level ) = @_;
270
    my $test_these = {
271
        1 => [ '033', '032', '034' ],
272
        7 => [ '043', '042', '044' ],
273
    };
274
    my $conf = 0;
275
    foreach my $t ( @{ $test_these->{$level} } ) {
276
        if ( exists $self->{item_description}->{$t} ) {
277
            $conf = 1;
278
        }
279
    }
280
    my $tag;
281
    my @spec;
282
    my ( $i1, $i2 ) = ( q{ }, q{ } );
283
    if ($conf) {
284
        $tag = ( $level * 100 ) + 11;
285
        if ( $level == 1 ) {
286
            @spec = qw( 030 a 031 e 032 n 033 c 034 d);
287
        }
288
        else {
289
            @spec = qw( 040 a 041 e 042 n 043 c 044 d);
290
        }
291
    }
292
    else {
293
        $tag = ( $level * 100 ) + 10;
294
        if ( $level == 1 ) {
295
            @spec = qw( 030 a 031 b);
296
        }
297
        else {
298
            @spec = qw( 040 a 041 b);
299
        }
300
    }
301
    return new_field( $self->{item_description}, [ $tag, $i1, $i2 ], @spec );
302
}
303
304
sub new_field {
305
    my ( $b, $tag_ind, @sfd_elem ) = @_;
306
    my @sfd;
307
    while (@sfd_elem) {
308
        my $e = shift @sfd_elem;
309
        my $c = shift @sfd_elem;
310
        if ( exists $b->{$e} ) {
311
            push @sfd, $c, $b->{$e};
312
        }
313
    }
314
    if (@sfd) {
315
        my $field = MARC::Field->new( @{$tag_ind}, @sfd );
316
        return $field;
317
    }
318
    return;
319
}
320
321
# Accessor methods to line data
322
323
sub item_number_id {
324
    my $self = shift;
325
    return $self->{item_number_id};
326
}
327
328
sub line_item_number {
329
    my $self = shift;
330
    return $self->{line_item_number};
331
}
332
333
sub additional_product_ids {
334
    my $self = shift;
335
    return $self->{additional_product_ids};
336
}
337
338
sub action_notification {
339
    my $self = shift;
340
    my $a    = $self->{action_notification};
341
    if ($a) {
342
        $a = _translate_action($a);    # return the associated text string
343
    }
344
    return $a;
345
}
346
347
sub item_description {
348
    my $self = shift;
349
    return $self->{item_description};
350
}
351
352
sub monetary_amount {
353
    my $self = shift;
354
    return $self->{monetary_amount};
355
}
356
357
sub quantity {
358
    my $self = shift;
359
    return $self->{quantity};
360
}
361
362
sub price {
363
    my $self = shift;
364
    return $self->{price};
365
}
366
367
sub reference {
368
    my $self = shift;
369
    return $self->{reference};
370
}
371
372
sub orderline_reference_number {
373
    my $self = shift;
374
    return $self->{orderline_reference_number};
375
}
376
377
sub ordernumber {
378
    my $self = shift;
379
    return $self->{ordernumber};
380
}
381
382
sub free_text {
383
    my $self = shift;
384
    return $self->{free_text};
385
}
386
387
sub coded_free_text {
388
    my $self = shift;
389
    return $self->{coded_free_text}->{code};
390
}
391
392
sub internal_notes {
393
    my $self = shift;
394
    return $self->{internal_notes};
395
}
396
397
sub coded_internal_note {
398
    my $self = shift;
399
    return $self->{coded_internal_note}->{code};
400
}
401
402
sub orderline_free_text {
403
    my $self = shift;
404
    return $self->{orderline_free_text};
405
}
406
407
sub coded_orderline_text {
408
    my $self = shift;
409
    return $self->{coded_orderline_text}->{code};
410
}
411
412
sub substitute_free_text {
413
    my $self = shift;
414
    return $self->{substitute_free_text};
415
}
416
417
sub coded_substitute_text {
418
    my $self = shift;
419
    return $self->{coded_substitute_text}->{code};
420
}
421
422
# This will take a standard code as returned
423
# by (orderline|substitue)-free_text (FTX seg LIN)
424
# and expand it useing EditEUR code list 8B
425
sub translate_response_code {
426
    my ( $self, $code ) = @_;
427
428
    my %code_list_8B = (
429
        AB => 'Publication abandoned',
430
        AD => 'Apply direct',
431
        AU => 'Publisher address unknown',
432
        CS => 'Status uncertain',
433
        FQ => 'Only available abroad',
434
        HK => 'Paperback OP: Hardback available',
435
        IB => 'In stock',
436
        IP => 'In print and in stock at publisher',
437
        MD => 'Manufactured on demand',
438
        NK => 'Item not known',
439
        NN => 'We do not supply this item',
440
        NP => 'Not yet published',
441
        NQ => 'Not stocked',
442
        NS => 'Not sold separately',
443
        OB => 'Temporarily out of stock',
444
        OF => 'This format out of print: other format available',
445
        OP => 'Out of print',
446
        OR => 'Out pf print; New Edition coming',
447
        PK => 'Hardback out of print: paperback available',
448
        PN => 'Publisher no longer in business',
449
        RE => 'Awaiting reissue',
450
        RF => 'refer to other publisher or distributor',
451
        RM => 'Remaindered',
452
        RP => 'Reprinting',
453
        RR => 'Rights restricted: cannot supply in this market',
454
        SD => 'Sold',
455
        SN => 'Our supplier cannot trace',
456
        SO => 'Pack or set not available: single items only',
457
        ST => 'Stocktaking: temporarily unavailable',
458
        TO => 'Only to order',
459
        TU => 'Temporarily unavailable',
460
        UB => 'Item unobtainable from our suppliers',
461
        UC => 'Unavailable@ reprint under consideration',
462
    );
463
464
    if ( exists $code_list_8B{$code} ) {
465
        return $code_list_8B{$code};
466
    }
467
    else {
468
        return "no match";
469
    }
470
}
471
472
# item_desription_fields accessors
473
474
sub title {
475
    my $self       = shift;
476
    my $titlefield = q{050};
477
    if ( exists $self->{item_description}->{$titlefield} ) {
478
        return $self->{item_description}->{$titlefield};
479
    }
480
    return;
481
}
482
483
sub author {
484
    my $self  = shift;
485
    my $field = q{010};
486
    if ( exists $self->{item_description}->{$field} ) {
487
        my $a              = $self->{item_description}->{$field};
488
        my $forename_field = q{011};
489
        if ( exists $self->{item_description}->{$forename_field} ) {
490
            $a .= ', ';
491
            $a .= $self->{item_description}->{$forename_field};
492
        }
493
        return $a;
494
    }
495
    return;
496
}
497
498
sub series {
499
    my $self  = shift;
500
    my $field = q{190};
501
    if ( exists $self->{item_description}->{$field} ) {
502
        return $self->{item_description}->{$field};
503
    }
504
    return;
505
}
506
507
sub publisher {
508
    my $self  = shift;
509
    my $field = q{120};
510
    if ( exists $self->{item_description}->{$field} ) {
511
        return $self->{item_description}->{$field};
512
    }
513
    return;
514
}
515
516
sub publication_date {
517
    my $self  = shift;
518
    my $field = q{170};
519
    if ( exists $self->{item_description}->{$field} ) {
520
        return $self->{item_description}->{$field};
521
    }
522
    return;
523
}
524
525
sub dewey_class {
526
    my $self  = shift;
527
    my $field = q{230};
528
    if ( exists $self->{item_description}->{$field} ) {
529
        return $self->{item_description}->{$field};
530
    }
531
    return;
532
}
533
534
sub lc_class {
535
    my $self  = shift;
536
    my $field = q{240};
537
    if ( exists $self->{item_description}->{$field} ) {
538
        return $self->{item_description}->{$field};
539
    }
540
    return;
541
}
542
543
sub girfield {
544
    my ( $self, $field, $occ ) = @_;
545
546
    # defaults to occurence 0 returns undef if occ requested > occs
547
    if ( defined $occ && $occ > @{ $self->{GIR} } ) {
548
        return;
549
    }
550
    $occ ||= 0;
551
    return $self->{GIR}->[$occ]->{$field};
552
}
553
554
sub number_of_girs {
555
    my $self = shift;
556
557
    my $qty = @{ $self->{GIR} };
558
559
    return $qty;
560
}
561
562
sub extract_gir {
563
    my $s    = shift;
564
    my %qmap = (
565
        LAC => 'barcode',
566
        LAF => 'first_accession_number',
567
        LAL => 'last_accession_number',
568
        LCL => 'classification',
569
        LCO => 'item_unique_id',
570
        LCV => 'copy_value',
571
        LFH => 'feature_heading',
572
        LFN => 'fund_allocation',
573
        LFS => 'filing_suffix',
574
        LLN => 'loan_category',
575
        LLO => 'branch',
576
        LLS => 'label_sublocation',
577
        LQT => 'part_order_quantity',
578
        LRS => 'record_sublocation',
579
        LSM => 'shelfmark',
580
        LSQ => 'collection_code',
581
        LST => 'stock_category',
582
        LSZ => 'size_code',
583
        LVC => 'coded_servicing_instruction',
584
        LVT => 'servicing_instruction',
585
    );
586
587
    my $set_qualifier = $s->elem( 0, 0 );    # copy number
588
    my $gir_element = { copy => $set_qualifier, };
589
    my $element = 1;
590
    while ( my $e = $s->elem($element) ) {
591
        ++$element;
592
        if ( exists $qmap{ $e->[1] } ) {
593
            my $qualifier = $qmap{ $e->[1] };
594
            $gir_element->{$qualifier} = $e->[0];
595
        }
596
        else {
597
598
            carp "Unrecognized GIR code : $e->[1] for $e->[0]";
599
        }
600
    }
601
    return $gir_element;
602
}
603
604
# mainly for invoice processing amt_ will derive from MOA price_ from PRI and tax_ from TAX/MOA pairsn
605
sub moa_amt {
606
    my ( $self, $qualifier ) = @_;
607
    foreach my $s ( @{ $self->{segs} } ) {
608
        if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) {
609
            return $s->elem( 0, 1 );
610
        }
611
    }
612
    return;
613
}
614
615
sub amt_discount {
616
    my $self = shift;
617
    return $self->moa_amt('52');
618
}
619
620
sub amt_prepayment {
621
    my $self = shift;
622
    return $self->moa_amt('113');
623
}
624
625
# total including allowances & tax
626
sub amt_total {
627
    my $self = shift;
628
    return $self->moa_amt('128');
629
}
630
631
# Used to give price in currency other than that given in price
632
sub amt_unitprice {
633
    my $self = shift;
634
    return $self->moa_amt('146');
635
}
636
637
# item amount after allowances excluding tax
638
sub amt_lineitem {
639
    my $self = shift;
640
    return $self->moa_amt('203');
641
}
642
643
sub pri_price {
644
    my ( $self, $price_qualifier ) = @_;
645
    foreach my $s ( @{ $self->{segs} } ) {
646
        if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) {
647
            return {
648
                price          => $s->elem( 0, 1 ),
649
                type           => $s->elem( 0, 2 ),
650
                type_qualifier => $s->elem( 0, 3 ),
651
            };
652
        }
653
    }
654
    return;
655
}
656
657
# unit price that will be chaged excl tax
658
sub price_net {
659
    my $self = shift;
660
    my $p    = $self->pri_price('AAA');
661
    if ( defined $p ) {
662
        return $p->{price};
663
    }
664
    return;
665
}
666
667
# unit price excluding all allowances, charges and taxes
668
sub price_gross {
669
    my $self = shift;
670
    my $p    = $self->pri_price('AAB');
671
    if ( defined $p ) {
672
        return $p->{price};
673
    }
674
    return;
675
}
676
677
# information price incl tax excluding allowances, charges
678
sub price_info {
679
    my $self = shift;
680
    my $p    = $self->pri_price('AAE');
681
    if ( defined $p ) {
682
        return $p->{price};
683
    }
684
    return;
685
}
686
687
# information price incl tax,allowances, charges
688
sub price_info_inclusive {
689
    my $self = shift;
690
    my $p    = $self->pri_price('AAE');
691
    if ( defined $p ) {
692
        return $p->{price};
693
    }
694
    return;
695
}
696
697
sub tax {
698
    my $self = shift;
699
    return $self->moa_amt('124');
700
}
701
702
# return text string representing action code
703
sub _translate_action {
704
    my $code   = shift;
705
    my %action = (
706
        2  => 'cancelled',
707
        3  => 'change_requested',
708
        4  => 'no_action',
709
        5  => 'accepted',
710
        10 => 'not_found',
711
        24 => 'recorded',           # Order accepted but a change notified
712
    );
713
    if ( exists $action{$code} ) {
714
        return $action{$code};
715
    }
716
    return $code;
717
718
}
719
1;
720
__END__
721
722
=head1 NAME
723
724
Koha::Edifact::Line
725
726
=head1 SYNOPSIS
727
728
  Class to abstractly handle a Line in an Edifact Transmission
729
730
=head1 DESCRIPTION
731
732
  Allows access to Edifact line elements by name
733
734
=head1 BUGS
735
736
  None documented at present
737
738
=head1 Methods
739
740
=head2 new
741
742
   Called with an array ref of segments constituting the line
743
744
=head1 AUTHOR
745
746
   Colin Campbell <colin.campbell@ptfs-europe.com>
747
748
749
=head1 COPYRIGHT
750
751
   Copyright 2014, PTFS-Europe Ltd
752
   This program is free software, You may redistribute it under
753
   under the terms of the GNU General Public License
754
755
756
=cut
(-)a/Koha/Edifact/Message.pm (+249 lines)
Line 0 Link Here
1
package Koha::Edifact::Message;
2
3
# Copyright 2014 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, 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 (+837 lines)
Line 0 Link Here
1
package Koha::Edifact::Order;
2
3
use strict;
4
use warnings;
5
use utf8;
6
7
# Copyright 2014 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
my $use_marc_based_description =
41
  0;    # A global configflag : not currently implemented
42
43
sub new {
44
    my ( $class, $parameter_hashref ) = @_;
45
46
    my $self = {};
47
    if ( ref $parameter_hashref ) {
48
        $self->{orderlines} = $parameter_hashref->{orderlines};
49
        $self->{recipient}  = $parameter_hashref->{vendor};
50
        $self->{sender}     = $parameter_hashref->{ean};
51
52
        # convenient alias
53
        $self->{basket} = $self->{orderlines}->[0]->basketno;
54
        $self->{message_date} = DateTime->now( time_zone => 'local' );
55
    }
56
57
    # validate that its worth proceeding
58
    if ( !$self->{orderlines} ) {
59
        carp 'No orderlines passed to create order';
60
        return;
61
    }
62
    if ( !$self->{recipient} ) {
63
        carp
64
"No vendor passed to order creation: basket = $self->{basket}->basketno()";
65
        return;
66
    }
67
    if ( !$self->{sender} ) {
68
        carp
69
"No sender ean passed to order creation: basket = $self->{basket}->basketno()";
70
        return;
71
    }
72
73
    # do this once per object not once per orderline
74
    my $database = Koha::Database->new();
75
    $self->{schema} = $database->schema;
76
77
    bless $self, $class;
78
    return $self;
79
}
80
81
sub filename {
82
    my $self = shift;
83
    if ( !$self->{orderlines} ) {
84
        return;
85
    }
86
    my $filename = 'ordr' . $self->{basket}->basketno;
87
    $filename .= '.CEP';
88
    return $filename;
89
}
90
91
sub encode {
92
    my ($self) = @_;
93
94
    $self->{interchange_control_reference} = int rand($NINES_14);
95
    $self->{message_count}                 = 0;
96
97
    #    $self->{segs}; # Message segments
98
99
    $self->{transmission} = q{};
100
101
    $self->{transmission} .= $self->initial_service_segments();
102
103
    $self->{transmission} .= $self->user_data_message_segments();
104
105
    $self->{transmission} .= $self->trailing_service_segments();
106
    return $self->{transmission};
107
}
108
109
sub msg_date_string {
110
    my $self = shift;
111
    return $self->{message_date}->ymd();
112
}
113
114
sub initial_service_segments {
115
    my $self = shift;
116
117
    #UNA service string advice - specifies standard separators
118
    my $segs = _const('service_string_advice');
119
120
    #UNB interchange header
121
    $segs .= $self->interchange_header();
122
123
    #UNG functional group header NOT USED
124
    return $segs;
125
}
126
127
sub interchange_header {
128
    my $self = shift;
129
130
    # syntax identifier
131
    my $hdr =
132
      'UNB+UNOC:3';    # controling agency character set syntax version number
133
                       # Interchange Sender
134
    $hdr .= _interchange_sr_identifier( $self->{sender}->ean,
135
        $self->{sender}->id_code_qualifier );    # interchange sender
136
    $hdr .= _interchange_sr_identifier( $self->{recipient}->san,
137
        $self->{recipient}->id_code_qualifier );    # interchange Recipient
138
139
    $hdr .= $separator;
140
141
    # DateTime of preparation
142
    $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm');
143
    $hdr .= $separator;
144
    $hdr .= $self->interchange_control_reference();
145
    $hdr .= $separator;
146
147
    # Recipents reference password not usually used in edifact
148
    $hdr .= q{+ORDERS};                             # application reference
149
150
#Edifact does not usually include the following
151
#    $hdr .= $separator; # Processing priority  not usually used in edifact
152
#    $hdr .= $separator; # Acknowledgewment request : not usually used in edifact
153
#    $hdr .= q{+EANCOM} # Communications agreement id
154
#    $hdr .= q{+1} # Test indicator
155
#
156
    $hdr .= $seg_terminator;
157
    return $hdr;
158
}
159
160
sub user_data_message_segments {
161
    my $self = shift;
162
163
    #UNH message_header  :: seg count begins here
164
    $self->message_header();
165
166
    $self->order_msg_header();
167
168
    my $line_number = 0;
169
    foreach my $ol ( @{ $self->{orderlines} } ) {
170
        ++$line_number;
171
        $self->order_line( $line_number, $ol );
172
    }
173
174
    $self->message_trailer();
175
176
    my $data_segment_string = join q{}, @{ $self->{segs} };
177
    return $data_segment_string;
178
}
179
180
sub message_trailer {
181
    my $self = shift;
182
183
    # terminate the message
184
    $self->add_seg("UNS+S$seg_terminator");
185
186
    # CNT Control_Total
187
    # Could be (code  1) total value of QTY segments
188
    # or ( code = 2 ) number of lineitems
189
    my $num_orderlines = @{ $self->{orderlines} };
190
    $self->add_seg("CNT+2:$num_orderlines$seg_terminator");
191
192
    # UNT Message Trailer
193
    my $segments_in_message =
194
      1 + @{ $self->{segs} };    # count incl UNH & UNT (!!this one)
195
    my $reference = $self->message_reference('current');
196
    $self->add_seg("UNT+$segments_in_message+$reference$seg_terminator");
197
    return;
198
}
199
200
sub trailing_service_segments {
201
    my $self    = shift;
202
    my $trailer = q{};
203
204
    #UNE functional group trailer NOT USED
205
    #UNZ interchange trailer
206
    $trailer .= $self->interchange_trailer();
207
208
    return $trailer;
209
}
210
211
sub interchange_control_reference {
212
    my $self = shift;
213
    if ( $self->{interchange_control_reference} ) {
214
        return sprintf '%014d', $self->{interchange_control_reference};
215
    }
216
    else {
217
        carp 'calling for ref of unencoded order';
218
        return 'NONE ASSIGNED';
219
    }
220
}
221
222
sub message_reference {
223
    my ( $self, $function ) = @_;
224
    if ( $function eq 'new' || !$self->{message_reference_no} ) {
225
226
        # unique 14 char mesage ref
227
        $self->{message_reference_no} = sprintf 'ME%012d', int rand($NINES_12);
228
    }
229
    return $self->{message_reference_no};
230
}
231
232
sub message_header {
233
    my $self = shift;
234
235
    $self->{segs} = [];          # initialize the message
236
    $self->{message_count}++;    # In practice alwaya 1
237
238
    my $hdr = q{UNH+} . $self->message_reference('new');
239
    $hdr .= _const('message_identifier');
240
    $self->add_seg($hdr);
241
    return;
242
}
243
244
sub interchange_trailer {
245
    my $self = shift;
246
247
    my $t = "UNZ+$self->{message_count}+";
248
    $t .= $self->interchange_control_reference;
249
    $t .= $seg_terminator;
250
    return $t;
251
}
252
253
sub order_msg_header {
254
    my $self = shift;
255
    my @header;
256
257
    # UNH  see message_header
258
    # BGM
259
    push @header, beginning_of_message( $self->{basket}->basketno );
260
261
    # DTM
262
    push @header, message_date_segment( $self->{message_date} );
263
264
    # NAD-RFF buyer supplier ids
265
    push @header,
266
      name_and_address(
267
        'BUYER',
268
        $self->{sender}->ean,
269
        $self->{sender}->id_code_qualifier
270
      );
271
    push @header,
272
      name_and_address(
273
        'SUPPLIER',
274
        $self->{recipient}->san,
275
        $self->{recipient}->id_code_qualifier
276
      );
277
278
    # repeat for for other relevant parties
279
280
    # CUX currency
281
    # ISO 4217 code to show default currency prices are quoted in
282
    # e.g. CUX+2:GBP:9'
283
    # TBD currency handling
284
285
    $self->add_seg(@header);
286
    return;
287
}
288
289
sub beginning_of_message {
290
    my $basketno = shift;
291
    my $document_message_no = sprintf '%011d', $basketno;
292
293
    #    my $message_function = 9;    # original 7 = retransmission
294
    # message_code values
295
    #      220 prder
296
    #      224 rush order
297
    #      228 sample order :: order for approval / inspection copies
298
    #      22C continuation  order for volumes in a set etc.
299
    #    my $message_code = '220';
300
301
    return "BGM+220+$document_message_no+9$seg_terminator";
302
}
303
304
sub name_and_address {
305
    my ( $party, $id_code, $id_agency ) = @_;
306
    my %qualifier_code = (
307
        BUYER    => 'BY',
308
        DELIVERY => 'DP',    # delivery location if != buyer
309
        INVOICEE => 'IV',    # if different from buyer
310
        SUPPLIER => 'SU',
311
    );
312
    if ( !exists $qualifier_code{$party} ) {
313
        carp "No qualifier code for $party";
314
        return;
315
    }
316
    if ( $id_agency eq '14' ) {
317
        $id_agency = '9';    # ean coded differently in this seg
318
    }
319
320
    return "NAD+$qualifier_code{$party}+${id_code}::$id_agency$seg_terminator";
321
}
322
323
sub order_line {
324
    my ( $self, $linenumber, $orderline ) = @_;
325
326
    my $schema = $self->{schema};
327
    if ( !$orderline->biblionumber )
328
    {                        # cannot generate an orderline without a bib record
329
        return;
330
    }
331
    my $biblionumber = $orderline->biblionumber->biblionumber;
332
    my @biblioitems  = $schema->resultset('Biblioitem')
333
      ->search( { biblionumber => $biblionumber, } );
334
    my $biblioitem = $biblioitems[0];    # makes the assumption there is 1 only
335
                                         # or else all have same details
336
337
    my $id_string = $orderline->line_item_id;
338
339
    # LIN line-number in msg :: if we had a 13 digit ean we could add
340
    $self->add_seg( lin_segment( $linenumber, $id_string ) );
341
342
    # PIA isbn or other id
343
    my @identifiers;
344
    foreach my $id ( $biblioitem->ean, $biblioitem->issn, $biblioitem->isbn ) {
345
        if ( $id && $id ne $id_string ) {
346
            push @identifiers, $id;
347
        }
348
    }
349
    $self->add_seg( additional_product_id( join( ' ', @identifiers ) ) );
350
351
    # IMD biblio description
352
    if ($use_marc_based_description) {
353
354
        # get marc from biblioitem->marc
355
356
        # $ol .= marc_item_description($orderline->{bib_description});
357
    }
358
    else {    # use brief description
359
        $self->add_seg(
360
            item_description( $orderline->biblionumber, $biblioitem ) );
361
    }
362
363
    # QTY order quantity
364
    my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator;
365
    $self->add_seg($qty);
366
367
    # DTM Optional date constraints on delivery
368
    #     we dont currently support this in koha
369
    # GIR copy-related data
370
    my @items;
371
    if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
372
        my @linked_itemnumbers = $orderline->aqorders_items;
373
374
        foreach my $item (@linked_itemnumbers) {
375
            my $i_obj = $schema->resultset('Item')->find( $item->itemnumber );
376
            if ( defined $i_obj ) {
377
                push @items, $i_obj;
378
            }
379
        }
380
    }
381
    else {
382
        my $item_hash = {
383
            itemtype  => $biblioitem->itemtype,
384
            shelfmark => $biblioitem->cn_class,
385
        };
386
        my $branch = $orderline->basketno->deliveryplace;
387
        if ($branch) {
388
            $item_hash->{branch} = $branch;
389
        }
390
        for ( 1 .. $orderline->quantity ) {
391
            push @items, $item_hash;
392
        }
393
    }
394
    my $budget = GetBudget( $orderline->budget_id );
395
    my $ol_fields = { budget_code => $budget->{budget_code}, };
396
    if ( $orderline->order_vendornote ) {
397
        $ol_fields->{servicing_instruction} = $orderline->order_vendornote;
398
    }
399
    $self->add_seg( gir_segments( $ol_fields, @items ) );
400
401
    # TBD what if #items exceeds quantity
402
403
    # FTX free text for current orderline TBD
404
    #    dont really have a special instructions field to encode here
405
    # Encode notes here
406
    # PRI-CUX-DTM unit price on which order is placed : optional
407
    # Coutts read this as 0.00 if not present
408
    if ( $orderline->listprice ) {
409
        my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice;
410
        $price .= $seg_terminator;
411
        $self->add_seg($price);
412
    }
413
414
    # RFF unique orderline reference no
415
    my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator;
416
    $self->add_seg($rff);
417
418
    # RFF : suppliers unique quotation reference number
419
    if ( $orderline->suppliers_reference_number ) {
420
        $rff = join q{}, 'RFF+', $orderline->suppliers_reference_qualifier,
421
          ':', $orderline->suppliers_reference_number, $seg_terminator;
422
        $self->add_seg($rff);
423
    }
424
425
    # LOC-QTY multiple delivery locations
426
    #TBD to specify extra delivery locs
427
    # NAD order line name and address
428
    #TBD Optionally indicate a name & address or order originator
429
    # TDT method of delivey ol-specific
430
    # TBD requests a special delivery option
431
432
    return;
433
}
434
435
# ??? Use the IMD MARC
436
sub marc_based_description {
437
438
    # this includes a much larger number of fields
439
    return;
440
}
441
442
sub item_description {
443
    my ( $bib, $biblioitem ) = @_;
444
    my $bib_desc = {
445
        author    => $bib->author,
446
        title     => $bib->title,
447
        publisher => $biblioitem->publishercode,
448
        year      => $biblioitem->publicationyear,
449
    };
450
451
    my @itm = ();
452
453
    # 009 Author
454
    # 050 Title   :: title
455
    # 080 Vol/Part no
456
    # 100 Edition statement
457
    # 109 Publisher  :: publisher
458
    # 110 place of pub
459
    # 170 Date of publication :: year
460
    # 220 Binding  :: binding
461
    my %code = (
462
        author    => '009',
463
        title     => '050',
464
        publisher => '109',
465
        year      => '170',
466
        binding   => '220',
467
    );
468
    for my $field (qw(author title publisher year binding )) {
469
        if ( $bib_desc->{$field} ) {
470
            my $data = encode_text( $bib_desc->{$field} );
471
            push @itm, imd_segment( $code{$field}, $data );
472
        }
473
    }
474
475
    return @itm;
476
}
477
478
sub imd_segment {
479
    my ( $code, $data ) = @_;
480
481
    my $seg_prefix = "IMD+L+$code+:::";
482
483
    # chunk_line
484
    my @chunks;
485
    while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) {
486
        if ( length $x == $CHUNKSIZE ) {
487
            if ( $x =~ s/([?]{1,2})$// ) {
488
                $data = "$1$data";    # dont breakup ?' ?? etc
489
            }
490
        }
491
        push @chunks, $x;
492
    }
493
    my @segs;
494
    my $odd = 1;
495
    foreach my $c (@chunks) {
496
        if ($odd) {
497
            push @segs, "$seg_prefix$c";
498
        }
499
        else {
500
            $segs[-1] .= ":$c$seg_terminator";
501
        }
502
        $odd = !$odd;
503
    }
504
    if ( @segs && $segs[-1] !~ m/$seg_terminator$/o ) {
505
        $segs[-1] .= $seg_terminator;
506
    }
507
    return @segs;
508
}
509
510
sub gir_segments {
511
    my ( $orderfields, @onorderitems ) = @_;
512
513
    my $budget_code = $orderfields->{budget_code};
514
    my @segments;
515
    my $sequence_no = 1;
516
    foreach my $item (@onorderitems) {
517
        my $seg = sprintf 'GIR+%03d', $sequence_no;
518
        $seg .= add_gir_identity_number( 'LFN', $budget_code );
519
        if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
520
            $seg .=
521
              add_gir_identity_number( 'LLO', $item->homebranch->branchcode );
522
            $seg .= add_gir_identity_number( 'LST', $item->itype );
523
            $seg .= add_gir_identity_number( 'LSQ', $item->location );
524
            $seg .= add_gir_identity_number( 'LSM', $item->itemcallnumber );
525
526
            # itemcallnumber -> shelfmark
527
        }
528
        else {
529
            if ( $item->{branch} ) {
530
                $seg .= add_gir_identity_number( 'LLO', $item->{branch} );
531
            }
532
            $seg .= add_gir_identity_number( 'LST', $item->{itemtype} );
533
            $seg .= add_gir_identity_number( 'LSM', $item->{shelfmark} );
534
        }
535
        if ( $orderfields->{servicing_instruction} ) {
536
            $seg .= add_gir_identity_number( 'LVT',
537
                $orderfields->{servicing_instruction} );
538
        }
539
        $sequence_no++;
540
        push @segments, $seg;
541
    }
542
    return @segments;
543
}
544
545
sub add_gir_identity_number {
546
    my ( $number_qualifier, $number ) = @_;
547
    if ($number) {
548
        return "+${number}:${number_qualifier}";
549
    }
550
    return q{};
551
}
552
553
sub add_seg {
554
    my ( $self, @s ) = @_;
555
    foreach my $segment (@s) {
556
        if ( $segment !~ m/$seg_terminator$/o ) {
557
            $segment .= $seg_terminator;
558
        }
559
    }
560
    push @{ $self->{segs} }, @s;
561
    return;
562
}
563
564
sub lin_segment {
565
    my ( $line_number, $item_number_id ) = @_;
566
567
    if ($item_number_id) {
568
        $item_number_id = "++${item_number_id}:EN";
569
    }
570
    else {
571
        $item_number_id = q||;
572
    }
573
574
    return "LIN+$line_number$item_number_id$seg_terminator";
575
}
576
577
sub additional_product_id {
578
    my $isbn_field = shift;
579
    my ( $product_id, $product_code );
580
    if ( $isbn_field =~ m/(\d{13})/ ) {
581
        $product_id   = $1;
582
        $product_code = 'EN';
583
    }
584
    elsif ( $isbn_field =~ m/(\d{9})[Xx\d]/ ) {
585
        $product_id   = $1;
586
        $product_code = 'IB';
587
    }
588
589
    # TBD we could have a manufacturers no issn etc
590
    if ( !$product_id ) {
591
        return;
592
    }
593
594
    # function id set to 5 states this is the main product id
595
    return "PIA+5+$product_id:$product_code$seg_terminator";
596
}
597
598
sub message_date_segment {
599
    my $dt = shift;
600
601
    # qualifier:message_date:format_code
602
603
    my $message_date = $dt->ymd(q{});    # no sep in edifact format
604
605
    return "DTM+137:$message_date:102$seg_terminator";
606
}
607
608
sub _const {
609
    my $key = shift;
610
    Readonly my %S => {
611
        service_string_advice => q{UNA:+.? '},
612
        message_identifier    => q{+ORDERS:D:96A:UN:EAN008'},
613
    };
614
    return ( $S{$key} ) ? $S{$key} : q{};
615
}
616
617
sub _interchange_sr_identifier {
618
    my ( $identification, $qualifier ) = @_;
619
620
    if ( !$identification ) {
621
        $identification = 'RANDOM';
622
        $qualifier      = '92';
623
        carp 'undefined identifier';
624
    }
625
626
    # 14   EAN International
627
    # 31B   US SAN (preferred)
628
    # also 91 assigned by supplier
629
    # also 92 assigned by buyer
630
    if ( $qualifier !~ m/^(?:14|31B|91|92)/xms ) {
631
        $qualifier = '92';
632
    }
633
634
    return "+$identification:$qualifier";
635
}
636
637
sub encode_text {
638
    my $string = shift;
639
    if ($string) {
640
        $string =~ s/[?]/??/g;
641
        $string =~ s/'/?'/g;
642
        $string =~ s/:/?:/g;
643
        $string =~ s/[+]/?+/g;
644
    }
645
    return $string;
646
}
647
648
1;
649
__END__
650
651
=head1 NAME
652
653
Koha::Edifact::Order
654
655
=head1 SYNOPSIS
656
657
Format an Edifact Order message from a Koha basket
658
659
=head1 DESCRIPTION
660
661
Generates an Edifact format Order message for a Koha basket.
662
Normally the only methods used directly by the caller would be
663
new to set up the message, encode to return the formatted message
664
and filename to obtain a name under which to store the message
665
666
=head1 BUGS
667
668
Should integrate into Koha::Edifact namespace
669
Can caller interface be made cleaner?
670
Make handling of GIR segments more customizable
671
672
=head1 METHODS
673
674
=head2 new
675
676
  my $edi_order = Edifact::Order->new(
677
  orderlines => \@orderlines,
678
  vendor     => $vendor_edi_account,
679
  ean        => $library_ean
680
  );
681
682
  instantiate the Edifact::Order object, all parameters are Schema::Resultset objects
683
  Called in Koha::Edifact create_edi_order
684
685
=head2 filename
686
687
   my $filename = $edi_order->filename()
688
689
   returns a filename for the edi order. The filename embeds a reference to the
690
   basket the message was created to encode
691
692
=head2 encode
693
694
   my $edifact_message = $edi_order->encode();
695
696
   Encodes the basket as a valid edifact message ready for transmission
697
698
=head2 initial_service_segments
699
700
    Creates the service segments which begin the message
701
702
=head2 interchange_header
703
704
    Return an interchange header encoding sender and recipient
705
    ids message date and standards
706
707
=head2 user_data_message_segments
708
709
    Include message data within the encoded message
710
711
=head2 message_trailer
712
713
    Terminate message data including control data on number
714
    of messages and segments included
715
716
=head2 trailing_service_segments
717
718
   Include the service segments occuring at the end of the message
719
=head2 interchange_control_reference
720
721
   Returns the unique interchange control reference as a 14 digit number
722
723
=head2 message_reference
724
725
    On generates and subsequently returns the unique message
726
    reference number as a 12 digit number preceded by ME, to generate a new number
727
    pass the string 'new'.
728
    In practice we encode 1 message per transmission so there is only one message
729
    referenced. were we to encode multiple messages a new reference would be
730
    neaded for each
731
732
=head2 message_header
733
734
    Commences a new message
735
736
=head2 interchange_trailer
737
738
    returns the UNZ segment which ends the tranmission encoding the
739
    message count and control reference for the interchange
740
741
=head2 order_msg_header
742
743
    Formats the message header segments
744
745
=head2 beginning_of_message
746
747
    Returns the BGM segment which includes the Koha basket number
748
749
=head2 name_and_address
750
751
    Parameters: Function ( BUYER, DELIVERY, INVOICE, SUPPLIER)
752
                Id
753
                Agency
754
755
    Returns a NAD segment containg the id and agency for for the Function
756
    value. Handles the fact that NAD segments encode the value for 'EAN' differently
757
    to elsewhere.
758
759
=head2 order_line
760
761
    Creates the message segments wncoding an order line
762
763
=head2 marc_based_description
764
765
    Not yet implemented - To encode the the bibliographic info
766
    as MARC based IMD fields has the potential of encoding a wider range of info
767
768
=head2 item_description
769
770
    Encodes the biblio item fields Author, title, publisher, date of publication
771
    binding
772
773
=head2 imd_segment
774
775
    Formats an IMD segment, handles the chunking of data into the 35 character
776
    lengths required and the creation of repeat segments
777
778
=head2 gir_segments
779
780
    Add item level information
781
782
=head2 add_gir_identity_number
783
784
    Handle the formatting of a GIR element
785
    return empty string if no data
786
787
=head2 add_seg
788
789
    Adds a parssed array of segments to the objects segment list
790
    ensures all segments are properly terminated by '
791
792
=head2 lin_segment
793
794
    Adds a LIN segment consisting of the line number and the ean number
795
    if the passed isbn is valid
796
797
=head2 additional_product_id
798
799
    Add a PIA segment for an additional product id
800
801
=head2 message_date_segment
802
803
    Passed a DateTime object returns a correctly formatted DTM segment
804
805
=head2 _const
806
807
    Stores and returns constant strings for service_string_advice
808
    and message_identifier
809
    TBD replace with class variables
810
811
=head2 _interchange_sr_identifier
812
813
    Format sender and receipient identifiers for use in the interchange header
814
815
=head2 encode_text
816
817
    Encode textual data into the standard character set ( iso 8859-1 )
818
    and quote any Edifact metacharacters
819
820
=head2 msg_date_string
821
822
    Convenient routine which returns message date as a Y-m-d string
823
    useful if the caller wants to log date of creation
824
825
=head1 AUTHOR
826
827
   Colin Campbell <colin.campbell@ptfs-europe.com>
828
829
830
=head1 COPYRIGHT
831
832
   Copyright 2014, PTFS-Europe Ltd
833
   This program is free software, You may redistribute it under
834
   under the terms of the GNU General Public License
835
836
837
=cut
(-)a/Koha/Edifact/Segment.pm (+204 lines)
Line 0 Link Here
1
package Koha::Edifact::Segment;
2
3
# Copyright 2014 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, 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 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
$downlod->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, 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/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 (-1 / +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-212 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
Lines 370-376 if ( $op eq "add" ) { Link Here
370
    my $redirectpath = ((defined $input->param('mode')) && ($input->param('mode') eq 'singlebg')) ?'/cgi-bin/koha/acqui/basketgroup.pl?op=add&amp;basketgroupid='.$basketgroupid.'&amp;booksellerid='.$booksellerid : '/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=' . $booksellerid;
382
    my $redirectpath = ((defined $input->param('mode')) && ($input->param('mode') eq 'singlebg')) ?'/cgi-bin/koha/acqui/basketgroup.pl?op=add&amp;basketgroupid='.$basketgroupid.'&amp;booksellerid='.$booksellerid : '/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=' . $booksellerid;
371
    $redirectpath .=  "&amp;listclosed=1" if $closedbg ;
383
    $redirectpath .=  "&amp;listclosed=1" if $closedbg ;
372
    print $input->redirect($redirectpath );
384
    print $input->redirect($redirectpath );
373
    
385
386
} elsif ( $op eq 'ediprint') {
387
    my $basketgroupid = $input->param('basketgroupid');
388
    generate_edifact_orders( $basketgroupid );
389
    exit;
374
}else{
390
}else{
375
# no param : display the list of all basketgroups for a given vendor
391
# no param : display the list of all basketgroups for a given vendor
376
    my $basketgroups = &GetBasketgroups($booksellerid);
392
    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 61-66 my $author = $input->param('author'); Link Here
61
my $publisher        = $input->param('publisher');
61
my $publisher        = $input->param('publisher');
62
my $publicationyear  = $input->param('publicationyear');
62
my $publicationyear  = $input->param('publicationyear');
63
my $branch           = $input->param('branch');
63
my $branch           = $input->param('branch');
64
my $message_id       = $input->param('message_id');
64
my $op               = $input->param('op');
65
my $op               = $input->param('op');
65
66
66
my $invoices = [];
67
my $invoices = [];
Lines 81-87 if ( $op and $op eq 'do_search' ) { Link Here
81
        author           => $author,
82
        author           => $author,
82
        publisher        => $publisher,
83
        publisher        => $publisher,
83
        publicationyear  => $publicationyear,
84
        publicationyear  => $publicationyear,
84
        branchcode       => $branch
85
        branchcode       => $branch,
86
        message_id       => $message_id,
85
    );
87
    );
86
}
88
}
87
89
(-)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 (+85 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
  shipment_budget integer(11) references aqbudgets( budget_id ),
19
  PRIMARY KEY  (id),
20
  KEY vendorid (vendor_id),
21
  KEY shipmentbudget (shipment_budget),
22
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
23
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
24
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
25
26
-- Hold the actual edifact messages with links to associated baskets
27
CREATE TABLE IF NOT EXISTS edifact_messages (
28
  id int(11) NOT NULL auto_increment,
29
  message_type varchar(10) NOT NULL,
30
  transfer_date date,
31
  vendor_id int(11) references aqbooksellers( id ),
32
  edi_acct  integer references vendor_edi_accounts( id ),
33
  status text,
34
  basketno int(11) REFERENCES aqbasket( basketno),
35
  raw_msg mediumtext,
36
  filename text,
37
  deleted boolean not null default 0,
38
  PRIMARY KEY  (id),
39
  KEY vendorid ( vendor_id),
40
  KEY ediacct (edi_acct),
41
  KEY basketno ( basketno),
42
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
43
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
44
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
45
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
46
47
-- invoices link back to the edifact message it was generated from
48
ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id );
49
50
-- clean up link on deletes
51
ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL;
52
53
-- Hold the supplier ids from quotes for ordering
54
-- although this is an EAN-13 article number the standard says 35 characters ???
55
ALTER TABLE aqorders ADD COLUMN line_item_id varchar(35);
56
57
-- The suppliers unique reference usually a quotation line number ('QLI')
58
-- Otherwise Suppliers unique orderline reference ('SLI')
59
ALTER TABLE aqorders ADD COLUMN suppliers_reference_number varchar(35);
60
ALTER TABLE aqorders ADD COLUMN suppliers_reference_qualifier varchar(3);
61
62
-- hold the EAN/SAN used in ordering
63
CREATE TABLE IF NOT EXISTS edifact_ean (
64
  branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode),
65
  ean varchar(15) NOT NULL,
66
  id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14',
67
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
68
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
69
70
-- Syspref budget to hold shipping costs
71
INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages',  'free');
72
73
-- Add a permission for managing EDI
74
INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions');
75
76
-- Add primary key for edifact ean
77
alter table edifact_ean add column ee_id integer(11) unsigned not null auto_increment primary key first;
78
79
alter table vendor_edi_accounts
80
add column responses_enabled tinyint(1) not null default 0
81
after  orders_enabled;
82
83
alter table vendor_edi_accounts
84
add column auto_orders tinyint(1) not null default 0
85
after  responses_enabled;
(-)a/installer/data/mysql/kohastructure.sql (+71 lines)
Lines 3058-3063 CREATE TABLE `aqorders` ( -- information related to the basket line items Link Here
3058
  `subscriptionid` int(11) default NULL, -- links this order line to a subscription (subscription.subscriptionid)
3058
  `subscriptionid` int(11) default NULL, -- links this order line to a subscription (subscription.subscriptionid)
3059
  parent_ordernumber int(11) default NULL, -- ordernumber of parent order line, or same as ordernumber if no parent
3059
  parent_ordernumber int(11) default NULL, -- ordernumber of parent order line, or same as ordernumber if no parent
3060
  `orderstatus` varchar(16) default 'new', -- the current status for this line item. Can be 'new', 'ordered', 'partial', 'complete' or 'cancelled'
3060
  `orderstatus` varchar(16) default 'new', -- the current status for this line item. Can be 'new', 'ordered', 'partial', 'complete' or 'cancelled'
3061
  line_item_id varchar(35) default NULL, -- Supplier's article id for Edifact orderline
3062
  suppliers_reference_number varchar(35) default NULL, -- Suppliers unique edifact quote ref
3063
  suppliers_reference_qualifier varchar(3) default NULL, -- Type of number above usually 'QLI'
3061
  PRIMARY KEY  (`ordernumber`),
3064
  PRIMARY KEY  (`ordernumber`),
3062
  KEY `basketno` (`basketno`),
3065
  KEY `basketno` (`basketno`),
3063
  KEY `biblionumber` (`biblionumber`),
3066
  KEY `biblionumber` (`biblionumber`),
Lines 3115-3120 CREATE TABLE aqorders_transfers ( Link Here
3115
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3118
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3116
3119
3117
--
3120
--
3121
-- Table structure for table vendor_edi_accounts
3122
--
3123
3124
DROP TABLE IF EXISTS vendor_edi_accounts;
3125
CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
3126
  id int(11) NOT NULL auto_increment,
3127
  description text NOT NULL,
3128
  host varchar(40),
3129
  username varchar(40),
3130
  password varchar(40),
3131
  last_activity date,
3132
  vendor_id int(11) references aqbooksellers( id ),
3133
  download_directory text,
3134
  upload_directory text,
3135
  san varchar(20),
3136
  id_code_qualifier varchar(3) default '14',
3137
  transport varchar(6) default 'FTP',
3138
  quotes_enabled tinyint(1) not null default 0,
3139
  invoices_enabled tinyint(1) not null default 0,
3140
  orders_enabled tinyint(1) not null default 0,
3141
  shipment_budget integer(11) references aqbudgets( budget_id ),
3142
  PRIMARY KEY  (id),
3143
  KEY vendorid (vendor_id),
3144
  KEY shipmentbudget (shipment_budget),
3145
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
3146
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
3147
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3148
3149
--
3150
-- Table structure for table edifact_messages
3151
--
3152
3153
DROP TABLE IF EXISTS edifact_messages;
3154
CREATE TABLE IF NOT EXISTS edifact_messages (
3155
  id int(11) NOT NULL auto_increment,
3156
  message_type varchar(10) NOT NULL,
3157
  transfer_date date,
3158
  vendor_id int(11) references aqbooksellers( id ),
3159
  edi_acct  integer references vendor_edi_accounts( id ),
3160
  status text,
3161
  basketno int(11) references aqbasket( basketno),
3162
  raw_msg mediumtext,
3163
  filename text,
3164
  deleted boolean not null default 0,
3165
  PRIMARY KEY  (id),
3166
  KEY vendorid ( vendor_id),
3167
  KEY ediacct (edi_acct),
3168
  KEY basketno ( basketno),
3169
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
3170
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
3171
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
3172
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3173
3174
--
3118
-- Table structure for table aqinvoices
3175
-- Table structure for table aqinvoices
3119
--
3176
--
3120
3177
Lines 3128-3135 CREATE TABLE aqinvoices ( Link Here
3128
  closedate date default NULL,  -- invoice close date, NULL means the invoice is open
3185
  closedate date default NULL,  -- invoice close date, NULL means the invoice is open
3129
  shipmentcost decimal(28,6) default NULL,  -- shipment cost
3186
  shipmentcost decimal(28,6) default NULL,  -- shipment cost
3130
  shipmentcost_budgetid int(11) default NULL,   -- foreign key to aqbudgets, link the shipment cost to a budget
3187
  shipmentcost_budgetid int(11) default NULL,   -- foreign key to aqbudgets, link the shipment cost to a budget
3188
  message_id int(11) default NULL, -- foreign key to edifact invoice message
3131
  PRIMARY KEY (invoiceid),
3189
  PRIMARY KEY (invoiceid),
3132
  CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
3190
  CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
3191
  CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL,
3133
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE
3192
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE
3134
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3193
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3135
3194
Lines 3532-3537 CREATE TABLE discharges ( Link Here
3532
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3591
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3533
3592
3534
--
3593
--
3594
-- Table structure for table 'edifact_ean'
3595
--
3596
3597
DROP TABLE IF EXISTS edifact_ean;
3598
CREATE TABLE IF NOT EXISTS edifact_ean (
3599
  branchcode varchar(10) not null references branches (branchcode),
3600
  ean varchar(15) NOT NULL,
3601
  id_code_qualifier varchar(3) NOT NULL default '14',
3602
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
3603
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3604
3605
--
3535
-- Table structure for table additional_fields
3606
-- Table structure for table additional_fields
3536
-- This table add the ability to add new fields for a record
3607
-- This table add the ability to add new fields for a record
3537
--
3608
--
(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
Lines 122-127 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here
122
('DumpTemplateVarsIntranet',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.',  'YesNo'),
122
('DumpTemplateVarsIntranet',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the staff intranet.',  'YesNo'),
123
('DumpTemplateVarsOpac',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.',  'YesNo'),
123
('DumpTemplateVarsOpac',  '0', NULL ,  'If enabled, dump all Template Toolkit variable to a comment in the html source for the opac.',  'YesNo'),
124
('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),
124
('EasyAnalyticalRecords','0','','If on, display in the catalogue screens tools to easily setup analytical record relationships','YesNo'),
125
('EDIInvoicesShippingBudget',NULL,NULL,'The budget code used to allocate shipping charges to when processing EDI Invoice messages','free'),
125
('emailLibrarianWhenHoldIsPlaced','0',NULL,'If ON, emails the librarian whenever a hold is placed','YesNo'),
126
('emailLibrarianWhenHoldIsPlaced','0',NULL,'If ON, emails the librarian whenever a hold is placed','YesNo'),
126
('EnableBorrowerFiles','0',NULL,'If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'),
127
('EnableBorrowerFiles','0',NULL,'If enabled, allows librarians to upload and attach arbitrary files to a borrower record.','YesNo'),
127
('EnableOpacSearchHistory','1','YesNo','Enable or disable opac search history',''),
128
('EnableOpacSearchHistory','1','YesNo','Enable or disable opac search history',''),
(-)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
59
58
</ul>
60
</ul>
59
61
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt (-1 / +33 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="icon-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="icon-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 663-668 Link Here
663
        </form>
673
        </form>
664
        </div>
674
        </div>
665
    [% END %]
675
    [% END %]
676
[% IF edi_confirm %]
677
        <div id="closebasket_needsconfirmation" class="dialog alert">
678
679
        <form action="/cgi-bin/koha/acqui/basket.pl" class="confirm">
680
            <h1>Are you sure you want to generate an edifact order and close basket [% basketname|html %]?</h1>
681
            [% IF CAN_user_acquisition_group_manage %]
682
            <p>
683
            <label for="createbasketgroup">Attach this basket to a new basket group with the same name</label>
684
            <input type="checkbox" id="createbasketgroup" name="createbasketgroup"/>
685
            </p>
686
            [% END %]
687
            <input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
688
            <input type="hidden" value="ediorder" name="op" />
689
            <input type="hidden" name="ean" value="[% ean %]" />
690
            <input type="hidden" name="booksellerid" value="[% booksellerid %]" />
691
            <input type="hidden" name="confirm" value="1" />
692
            <input type="hidden" name="basketgroupname" value="[% basketgroupname %]" />
693
            <input type="submit" class="approve" value="Yes, close (Y)" accesskey="y" />
694
            <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;" />
695
        </form>
696
        </div>
697
    [% END %]
666
</div>
698
</div>
667
[% END %][%# IF (cannot_manage_basket) %]
699
[% END %][%# IF (cannot_manage_basket) %]
668
</div>
700
</div>
(-)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 (+4 lines)
Lines 98-103 Link Here
98
        
98
        
99
        <dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>
99
        <dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>
100
        <dd>Define funds within your budgets</dd>
100
        <dd>Define funds within your budgets</dd>
101
        <dt><a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI Accounts</a></dt>
102
        <dd>Manage vendor EDI accounts for import/export</dd>
103
        <dt><a href="/cgi-bin/koha/admin/edi_ean_accounts.pl">EDI EANs</a></dt>
104
        <dd>Manage Branch EDI EANs</dd>
101
105
102
</dl>
106
</dl>
103
107
(-)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
     <input type="text" name="username" id="username" size="20" maxlength="90" value="[% account.username %]" />
107
  </li>
108
  <li>
109
     <label for="password">Password: </label>
110
     <input type="text" name="password" id="password" size="20" maxlength="90" value="[% account.password %]" />
111
  </li>
112
  <li>
113
     <label for="download_directory">Download directory: </label>
114
     <input type="text" name="download_directory" id="download_directory" size="20" maxlength="90"
115
      title="The download directory specifies the directory on the ftpsite from which we download quotes and invoices"
116
      value="[% account.download_directory %]" />
117
  </li>
118
  <li>
119
     <label for="upload_directory">Upload directory: </label>
120
     <input type="text" name="upload_directory" id="upload_directory" size="20" maxlength="90"
121
      title="The upload directory specifies the directory on the ftp site to which we upload orders"
122
      value="[% account.upload_directory %]" />
123
  </li>
124
  <li>
125
     <label for="id_code_qualifier">Qualifier:</label>
126
     <select name="id_code_qualifier" id="id_code_qualifier">
127
     [% FOREACH qualifier IN code_qualifiers %]
128
        [% IF qualifier.code == account.id_code_qualifier %]
129
           <option value="[% qualifier.code %]" selected="selected">
130
               [% qualifier.description %]
131
           </option>
132
        [% ELSE %]
133
           <option value="[% qualifier.code %]">
134
              [% qualifier.description %]
135
           </option>
136
        [% END %]
137
     [% END %]
138
   </select>
139
  </li>
140
  <li>
141
     <label for="san">SAN: </label>
142
     <input type="text" name="san" id="san" size="20" maxlength="90" value="[% account.san %]" />
143
  </li>
144
  <li>
145
     <label for="quotes_enabled">Quotes enabled: </label>
146
      [% IF account.quotes_enabled %]
147
     <input type="checkbox" name="quotes_enabled" id="quotes_enabled" value="[% account.quotes_enabled %]" checked />
148
      [% ELSE %]
149
     <input type="checkbox" name="quotes_enabled" id="quotes_enabled" value="[% account.quotes_enabled %]" />
150
      [% END %]
151
  </li>
152
  <li>
153
     <label for="orders_enabled">Orders enabled: </label>
154
[% IF account.orders_enabled %]
155
     <input type="checkbox" name="orders_enabled" id="orders_enabled" value="[% account.orders_enabled %]" checked />
156
[% ELSE %]
157
     <input type="checkbox" name="orders_enabled" id="orders_enabled" value="[% account.orders_enabled %]" />
158
[% END %]
159
  </li>
160
  <li>
161
     <label for="invoices_enabled">Invoices enabled: </label>
162
[% IF account.invoices_enabled %]
163
     <input type="checkbox" name="invoices_enabled" id="invoices_enabled" value="[% account.invoices_enabled %]" checked />
164
[% ELSE %]
165
     <input type="checkbox" name="invoices_enabled" id="invoices_enabled" value="[% account.invoices_enabled %]" />
166
[% END %]
167
  </li>
168
  <li>
169
     <label for="responses_enabled">Responses enabled: </label>
170
[% IF account.responses_enabled %]
171
     <input type="checkbox" name="responses_enabled" id="responses_enabled" value="[% account.responses_enabled %]" checked />
172
[% ELSE %]
173
     <input type="checkbox" name="responses_enabled" id="responses_enabled" value="[% account.responses_enabled %]" />
174
[% END %]
175
  </li>
176
  <li>
177
     <label for="auto_orders">Automatic ordring (Quotes generate orders without staff intervention): </label>
178
[% IF account.auto_orders %]
179
     <input type="checkbox" name="auto_orders" id="auto_orders" value="[% account.auto_orders %]" checked />
180
[% ELSE %]
181
     <input type="checkbox" name="auto_orders" id="auto_orders" value="[% account.auto_orders %]" />
182
[% END %]
183
  </li>
184
  </ol>
185
  </fieldset>
186
187
  <fieldset class="action">
188
    <input type="submit" value="Submit" />
189
    <a href="/cgi-bin/koha/admin/edi_accounts.pl" class="cancel">Cancel</a>
190
  </fieldset>
191
</form>
192
193
[% END %]
194
[% IF delete_confirm %]
195
<div class="dialog alert">
196
<h3>Delete this account?</h3>
197
<table>
198
    <tr>
199
    <th>Vendor</th>
200
    <td>[% account.vendor %]</td>
201
    </tr>
202
    <tr>
203
    <th>Description</th>
204
    <td>[% account.description %]</td>
205
    </tr>
206
    <tr>
207
    <th>SAN</th>
208
    <td>[% account.san %]</td>
209
    </tr>
210
</table>
211
<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="post">
212
    <table>
213
    </table>
214
    <input type="hidden" name="op" value="delete_confirmed" />
215
    <input type="hidden" name="id" value="[% account.id %]" />
216
    <input type="submit" class="approve" value="Yes, Delete" />
217
</form>
218
<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="get">
219
    <input type="submit" class="deny" value="No, do not Delete" />
220
</form>
221
[% END %]
222
[% IF display %]
223
<h2>Vendor EDI accounts</h2>
224
225
    <table>
226
    <tr>
227
       <th>ID</th>
228
       <th>Vendor</th>
229
       <th>Description</th>
230
       <th>Transport</th>
231
       <th>Remote host</th>
232
       <th>Username</th>
233
       <th>Password</th>
234
       <th>Download Directory</th>
235
       <th>Upload Directory</th>
236
       <th>id_code_type</th>
237
       <th>id_code</th>
238
       <th>Quotes</th>
239
       <th>Orders</th>
240
       <th>Invoices</th>
241
       <th>Responses</th>
242
       <th>Auto ordering</th>
243
       <th>Actions</th>
244
    </tr>
245
    [% FOREACH account IN ediaccounts %]
246
    [% IF loop.even %]<tr>
247
    [% ELSE %]<tr class="highlight">
248
    [% END %]
249
      <td>[% account.id %]</td>
250
      <td><a href="/cgi-bin/koha/acqui/supplier.pl?supplierid=[% account.vendor_id %]">[% account.vendor.name %]</a></td>
251
      <td>[% account.description %]</td>
252
      <td>[% account.transport %]</td>
253
      <td>[% account.host %]</td>
254
      <td>[% account.username %]</td>
255
      <td>[% IF account.password %]xxxxx[% END %]</td>
256
      <td>[% account.download_directory %]</td>
257
      <td>[% account.upload_directory %]</td>
258
      <td>[% account.id_code_qualifier %]</td>
259
      <td>[% account.san %]</td>
260
      [% IF account.quotes_enabled %]
261
         <td>Y</td>
262
      [% ELSE %]
263
         <td>N</td>
264
      [% END %]
265
      [% IF account.orders_enabled %]
266
         <td>Y</td>
267
      [% ELSE %]
268
         <td>N</td>
269
      [% END %]
270
      [% IF account.invoices_enabled %]
271
         <td>Y</td>
272
      [% ELSE %]
273
         <td>N</td>
274
      [% END %]
275
      [% IF account.responses_enabled %]
276
         <td>Y</td>
277
      [% ELSE %]
278
         <td>N</td>
279
      [% END %]
280
      [% IF account.auto_orders %]
281
         <td>Y</td>
282
      [% ELSE %]
283
         <td>N</td>
284
      [% END %]
285
      <td align="center">
286
          <a href="/cgi-bin/koha/admin/edi_accounts.pl?op=acct_form&id=[% account.id %]">Edit</a> | <a href="/cgi-bin/koha/admin/edi_accounts.pl?op=delete_confirm&id=[% account.id %]">Delete</a>
287
      </td>
288
    </tr>
289
    [% END %]
290
    </table>
291
[% END %]
292
293
</div>
294
</div>
295
<div class="yui-b">
296
    [% INCLUDE 'admin-menu.inc' %]
297
</div>
298
</div>
299
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_ean_accounts.tt (+153 lines)
Line 0 Link Here
1
[% INCLUDE 'doc-head-open.inc' %]
2
<title>Koha &rsaquo; Administration &rsaquo; EDI EANs</title>
3
[% IF ean_form %]
4
  [% IF ean %]
5
     &rsquo; Modify branch EAN
6
  [% ELSE %]
7
     &rsquo; Add new branch EAN
8
  [% END %]
9
[% END %]
10
[% IF delete_confirm %]
11
     &rsquo; Confirm deletion of EAN
12
[% END %]
13
</title>
14
[% INCLUDE 'doc-head-close.inc' %]
15
</head>
16
<body id="admin_edi_ean" 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_ean_accounts.pl">EDI EANs</a>
24
[% IF ean_form %]
25
  [% IF ean %]
26
     &rsaquo; Modify branch EAN
27
  [% ELSE %]
28
     &rsaquo; Add new branch EAN
29
  [% END %]
30
[% ELSIF delete_confirm %]
31
     &rsaquo; Confirm deletion of Ean
32
[% ELSE %]
33
     &rsaquo; Branch EANs
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="newediean" href="/cgi-bin/koha/admin/edi_ean_accounts.pl?op=ean_form">
45
         <i class="icon-plus"></i>
46
         New EAN
47
    </a>
48
    </div>
49
[% END %]
50
51
[% IF ean_form %]
52
<form action="/cgi-bin/koha/admin/edi_ean_accounts.pl" name="Eanform" method="post">
53
  <input type="hidden" name="op" value="save" />
54
  [% IF ean %]
55
  <input type="hidden" name="oldbranchcode" value="[% branchcode %]" />
56
  <input type="hidden" name="oldean" value="[% ean %]" />
57
  [% END %]
58
  <fieldset class="rows">
59
  <legend>
60
  [% IF ean %]
61
     Modify EAN
62
  [% ELSE %]
63
    New EAN
64
  [% END %]
65
  </legend>
66
67
  <ol>
68
  <li>
69
     <label for="branchcode">Branchcode: </label>
70
     <select name="branchcode" id="branchcode">
71
        [% FOREACH branch IN branches %]
72
            [% IF branch.branchcode == ean.branch.branchcode %]
73
               <option value="[% branch.branchcode %]" selected="selected">[% branch.branchname %]</option>
74
            [% ELSE %]
75
               <option value="[% branch.branchcode %]">[% branch.branchname %]</option>
76
            [% END %]
77
        [% END %]
78
      </select>
79
  </li>
80
  <li>
81
     <label for="ean">EAN: </label>
82
     <input type="text" name="ean" id="ean`" size="20" maxlength="90" value="[% ean.ean %]" />
83
  </li>
84
  <li>
85
     <label for="id_code_qualifier">
86
     <select name="id_code_qualifier" id="id_code_qualifier">
87
     [% FOREACH qualifier IN code_qualifiers %]
88
        [% IF qualifier.code == ean.id_code_qualifier %]
89
           <option value="[% qualifier.code %]" selected="selected">
90
               [% qualifier.description %]
91
           </option>
92
        [% ELSE %]
93
           <option value="[% qualifier.code %]">
94
              [% qualifier.description %]
95
           </option>
96
        [% END %]
97
     [% END %]
98
  </li>
99
100
  </ol>
101
  </fieldset>
102
103
  <fieldset class="action">
104
    <input type="submit" value="Submit"/>
105
    <a href="/cgi-bin/koha/admin/edi_ean_accounts.pl" class="cancel">Cancel</a>
106
  </fieldset>
107
</form>
108
109
[% END %]
110
[% IF delete_confirm %]
111
<div class="dialog alert">
112
<h3>Delete EAN [% ean.ean %] for branch [% ean.branch.branchname %]?</h3>
113
<form action="/cgi-bin/koha/admin/edi_ean_accounts.pl" method="post">
114
    <input type="hidden" name="op" value="delete_confirmed" />
115
    <input type="hidden" name="branchcode" value="[% ean.branch.branchcode %]" />
116
    <input type="hidden" name="ean" value="[% ean.ean %]" />
117
    <input type="submit" class="approve" value="Yes, Delete" />
118
</form>
119
<form action="/cgi-bin/koha/admin/edi_ean_accounts.pl" method="get">
120
    <input type="submit" class="deny" value="No, do not Delete" />
121
</form>
122
</div>
123
[% END %]
124
[% IF display %]
125
<h2>Branch EANs</h2>
126
   <table>
127
   <tr>
128
      <th>Branch</th>
129
      <th>EAN</th>
130
      <th>Code Type</th>
131
      <th>Actions</th>
132
   </tr>
133
   [% FOREACH ean IN eans %]
134
   [% IF loop.even %]<tr>
135
   [% ELSE %]<tr class="highlight">
136
   [% END %]
137
      <td>[% ean.branch.branchname %]</td>
138
      <td>[% ean.ean %]</td>
139
      <td>[% ean.id_code_qualifier %]</td>
140
      <td align="center">
141
           <a href="/cgi-bin/koha/admin/edi_ean_accounts.pl?op=ean_form&branchcode=[% ean.branch.branchcode %]&ean=[% ean.ean %]">Edit</a> | <a href="/cgi-bin/koha/admin/edi_ean_accounts.pl?op=delete_confirm&branchcode=[% ean.branch.branchcode %]&ean=[% ean.ean %]">Delete</a></td>
142
   </tr>
143
   [% END %]
144
    </table>
145
[% END %]
146
147
</div>
148
</div>
149
<div class="yui-b">
150
    [% INCLUDE 'admin-menu.inc' %]
151
</div>
152
</div>
153
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt (+5 lines)
Lines 111-116 Link Here
111
    <dd>Use tool plugins</dd>
111
    <dd>Use tool plugins</dd>
112
    [% END %]
112
    [% END %]
113
113
114
    [% IF CAN_user_acquisition_edi_manage %]
115
    <dt><a href="/cgi-bin/koha/tools/edi.pl">EDIfact messages</a></dt>
116
    <dd>Manage EDIfact transmissions</dd>
117
    [% END %]
118
114
</dl>
119
</dl>
115
</div>
120
</div>
116
<div class="yui-u">
121
<div class="yui-u">
(-)a/misc/cronjobs/edi_cron.pl (+161 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
#
3
# Copyright 2013,2014 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 warnings;
21
use strict;
22
use utf8;
23
24
# Handles all the edi processing for a site
25
# loops through the vendor_edifact records and uploads and downloads
26
# edifact files id the appropriate type is enabled
27
# downloaded quotes and invoices are processed here
28
# can be run as frequently as required
29
30
use C4::Context;
31
use Log::Log4perl qw(:easy);
32
use Koha::Database;
33
use Koha::EDI qw( process_quote process_invoice process_ordrsp);
34
use Koha::Edifact::Transport;
35
use Fcntl qw( :DEFAULT :flock :seek );
36
37
my $logdir = C4::Context->logdir;
38
39
# logging set to trace as this may be what you
40
# want on implementation
41
Log::Log4perl->easy_init(
42
    {
43
        level => $TRACE,
44
        file  => ">>$logdir/editrace.log",
45
    }
46
);
47
48
# we dont have a lock dir in context so use the logdir
49
my $pidfile = "$logdir/edicron.pid";
50
51
my $pid_handle = check_pidfile();
52
53
my $schema = Koha::Database->new()->schema();
54
55
my @edi_accts = $schema->resultset('VendorEdiAccount')->all();
56
57
my $logger = Log::Log4perl->get_logger();
58
59
for my $acct (@edi_accts) {
60
    if ( $acct->quotes_enabled ) {
61
        my $downloader = Koha::Edifact::Transport->new( $acct->id );
62
        $downloader->download_messages('QUOTE');
63
64
    }
65
66
    if ( $acct->invoices_enabled ) {
67
        my $downloader = Koha::Edifact::Transport->new( $acct->id );
68
        $downloader->download_messages('INVOICE');
69
70
    }
71
    if ( $acct->orders_enabled ) {
72
73
        # select pending messages
74
        my @pending_orders = $schema->resultset('EdifactMessage')->search(
75
            {
76
                message_type => 'ORDERS',
77
                vendor_id    => $acct->vendor_id,
78
                status       => 'Pending',
79
            }
80
        );
81
        my $uploader = Koha::Edifact::Transport->new( $acct->id );
82
        $uploader->upload_messages(@pending_orders);
83
    }
84
    if ( $acct->responses_enabled ) {
85
        my $downloader = Koha::Edifact::Transport->new( $acct->id );
86
        $downloader->download_messages('ORDRSP');
87
    }
88
}
89
90
# process any downloaded quotes
91
92
my @downloaded_quotes = $schema->resultset('EdifactMessage')->search(
93
    {
94
        message_type => 'QUOTE',
95
        status       => 'new',
96
    }
97
)->all;
98
99
foreach my $quote_file (@downloaded_quotes) {
100
    my $filename = $quote_file->filename;
101
    $logger->trace("Processing quote $filename");
102
    process_quote($quote_file);
103
}
104
105
# process any downloaded invoices
106
107
my @downloaded_invoices = $schema->resultset('EdifactMessage')->search(
108
    {
109
        message_type => 'INVOICE',
110
        status       => 'new',
111
    }
112
)->all;
113
114
foreach my $invoice (@downloaded_invoices) {
115
    my $filename = $invoice->filename();
116
    $logger->trace("Processing invoice $filename");
117
    process_invoice($invoice);
118
}
119
120
my @downloaded_responses = $schema->resultset('EdifactMessage')->search(
121
    {
122
        message_type => 'ORDRSP',
123
        status       => 'new',
124
    }
125
)->all;
126
127
foreach my $response (@downloaded_responses) {
128
    my $filename = $response->filename();
129
    $logger->trace("Processing order response $filename");
130
    process_ordrsp($response);
131
}
132
133
if ( close $pid_handle ) {
134
    unlink $pidfile;
135
    exit 0;
136
}
137
else {
138
    $logger->error("Error on pidfile close: $!");
139
    exit 1;
140
}
141
142
sub check_pidfile {
143
144
    # sysopen my $fh, $pidfile, O_EXCL | O_RDWR or log_exit "$0 already running"
145
    sysopen my $fh, $pidfile, O_RDWR | O_CREAT
146
      or log_exit("$0: open $pidfile: $!");
147
    flock $fh => LOCK_EX or log_exit("$0: flock $pidfile: $!");
148
149
    sysseek $fh, 0, SEEK_SET or log_exit("$0: sysseek $pidfile: $!");
150
    truncate $fh, 0 or log_exit("$0: truncate $pidfile: $!");
151
    print $fh "$$\n" or log_exit("$0: print $pidfile: $!");
152
153
    return $fh;
154
}
155
156
sub log_exit {
157
    my $error = shift;
158
    $logger->error($error);
159
160
    exit 1;
161
}
(-)a/t/BLSINV337023.CEI (+1 lines)
Line 0 Link Here
1
UNA:+.? 'UNB+UNOC:3+5013546025078+5013546121974+140729:1153+337023++INVOIC'UNH+01975489+INVOIC:D:96A:UN:EAN008'BGM+380+01975489+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975489'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780007464593:EN'IMD+L+009+:::Beukes, Lauren'IMD+L+050+:::Broken monsters'QTY+47:1'GIR+001+34148009564714:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2724/71178'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:1'MOA+129:7.4'MOA+9:7.4'TAX+7+VAT+++:::0+Z'MOA+125:7.4'MOA+124:0'UNT+33+01975489'UNH+01975490+INVOIC:D:96A:UN:EAN008'BGM+380+01975490+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975490'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780755380664:EN'IMD+L+009+:::McDermott, Andy'IMD+L+050+:::The Valhalla prophecy'QTY+47:1'GIR+001+34148009564730:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2818/74528'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+2++9780755380664:EN'IMD+L+009+:::McDermott, Andy'IMD+L+050+:::The Valhalla prophecy'QTY+47:1'GIR+001+34148009564748:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2818/74529'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+3++9780857204028:EN'IMD+L+009+:::Fleming, Leah'IMD+L+050+:::The postcard'QTY+47:1'GIR+001+34148009564722:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74544'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+4++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564755:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74589'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+5++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564763:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74590'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+6++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564771:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74591'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+7++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564789:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74592'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+8++9781471112652:EN'IMD+L+009+:::Madeley, Richard'IMD+L+050+:::The way you look tonight'QTY+47:1'GIR+001+34148009564797:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2818/74593'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:8'MOA+129:35.260'MOA+9:35.260'TAX+7+VAT+++:::0+Z'MOA+125:35.260'MOA+124:0'UNT+145+01975490'UNH+01975491+INVOIC:D:96A:UN:EAN008'BGM+380+01975491+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975491'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9781471132193:EN'IMD+L+009+:::Carter, Chris'IMD+L+050+:::An evil mind'QTY+47:1'GIR+001+34148009564821:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2831/74996'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+2++9781472208682:EN'IMD+L+009+:::Brown, Benita'IMD+L+050+:::Counting the days'QTY+47:1'GIR+001+34148009564805:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:11.39'MOA+52:8.6'PRI+AAA:11.39'PRI+AAB:19.99'RFF+LI:2831/75006'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:8.6'TAX+7+VAT+++:::0+Z'LIN+3++9781472208682:EN'IMD+L+009+:::Brown, Benita'IMD+L+050+:::Counting the days'QTY+47:1'GIR+001+34148009564813:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:11.39'MOA+52:8.6'PRI+AAA:11.39'PRI+AAB:19.99'RFF+LI:2831/75007'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:8.6'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:3'MOA+129:30.180'MOA+9:30.180'TAX+7+VAT+++:::0+Z'MOA+125:30.180'MOA+124:0'UNT+65+01975491'UNH+01975492+INVOIC:D:96A:UN:EAN008'BGM+380+01975492+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975492'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780241957479:EN'IMD+L+009+:::Brook, Rhidian'IMD+L+050+:::The aftermath'QTY+47:1'GIR+001+34148009564839:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2894/77394'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:1'MOA+129:4.550'MOA+9:4.550'TAX+7+VAT+++:::0+Z'MOA+125:4.550'MOA+124:0'UNT+33+01975492'UNH+01975493+INVOIC:D:96A:UN:EAN008'BGM+380+01975493+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975493'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9780007513765:EN'IMD+L+009+:::Daywalt, Drew'IMD+L+050+:::The day the crayons quit'QTY+47:1'GIR+001+34148009564946:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79232'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+2++9780007513765:EN'IMD+L+009+:::Daywalt, Drew'IMD+L+050+:::The day the crayons quit'QTY+47:1'GIR+001+34148009564953:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79233'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+3++9780007513765:EN'IMD+L+009+:::Daywalt, Drew'IMD+L+050+:::The day the crayons quit'QTY+47:1'GIR+001+34148009564961:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79234'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+4++9780340981283:EN'IMD+L+009+:::Kelly, Mij'IMD+L+050+:::Friendly Day'QTY+47:1'GIR+001+34148009564979:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79276'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+5++9780340981283:EN'IMD+L+009+:::Kelly, Mij'IMD+L+050+:::Friendly Day'QTY+47:1'GIR+001+34148009564987:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79277'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+6++9780340981283:EN'IMD+L+009+:::Kelly, Mij'IMD+L+050+:::Friendly Day'QTY+47:1'GIR+001+34148009564995:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79278'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+7++9780349002071:EN'IMD+L+009+:::Cast, P. C.'IMD+L+050+:::Kalona s fall'QTY+47:1'GIR+001+34148009564920:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/78995'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+8++9780349002071:EN'IMD+L+009+:::Cast, P. C.'IMD+L+050+:::Kalona s fall'QTY+47:1'GIR+001+34148009564938:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/78996'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+9++9781405267212:EN'IMD+L+009+:::McKay, Hilary'IMD+L+050+:::Tilly and the dragon'QTY+47:1'GIR+001+34148009565026:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79301'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+10++9781405267212:EN'IMD+L+009+:::McKay, Hilary'IMD+L+050+:::Tilly and the dragon'QTY+47:1'GIR+001+34148009565034:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79302'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+11++9781405267212:EN'IMD+L+009+:::McKay, Hilary'IMD+L+050+:::Tilly and the dragon'QTY+47:1'GIR+001+34148009565042:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79303'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+12++9781405268028:EN'IMD+L+009+:::Loser, Barry'IMD+L+050+:::Barry Loser and the holiday of doo'QTY+47:1'GIR+001+34148009565000:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/79304'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+13++9781405268028:EN'IMD+L+009+:::Loser, Barry'IMD+L+050+:::Barry Loser and the holiday of doo'QTY+47:1'GIR+001+34148009565018:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.41'MOA+52:2.58'PRI+AAA:3.41'PRI+AAB:5.99'RFF+LI:2971/79305'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.58'TAX+7+VAT+++:::0+Z'LIN+14++9781405269094:EN'IMD+L+009+:::Monks, Lydia'IMD+L+050+:::Mungo Monkey goes to school'QTY+47:1'GIR+001+34148009565067:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2971/79307'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+15++9781405269094:EN'IMD+L+009+:::Monks, Lydia'IMD+L+050+:::Mungo Monkey goes to school'QTY+47:1'GIR+001+34148009565075:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:4.55'MOA+52:3.44'PRI+AAA:4.55'PRI+AAB:7.99'RFF+LI:2971/79308'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.44'TAX+7+VAT+++:::0+Z'LIN+16++9781407132846:EN'IMD+L+009+:::Simmons, Jo'IMD+L+050+:::A brotherly bother'QTY+47:1'GIR+001+34148009565117:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79333'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+17++9781407132846:EN'IMD+L+009+:::Simmons, Jo'IMD+L+050+:::A brotherly bother'QTY+47:1'GIR+001+34148009565125:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79334'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+18++9781407142944:EN'IMD+L+009+:::Zucker, Jonny'IMD+L+050+:::The fleas who fight crime'QTY+47:1'GIR+001+34148009565158:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79359'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+19++9781407142944:EN'IMD+L+009+:::Zucker, Jonny'IMD+L+050+:::The fleas who fight crime'QTY+47:1'GIR+001+34148009565166:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79360'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+20++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009564847:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79372'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+21++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009564854:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79373'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+22++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009564870:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79374'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+23++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009564888:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79375'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+24++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009564862:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79378'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+25++9781408330104:EN'IMD+L+009+:::Brownlow, Michael'IMD+L+050+:::Ten little princesses'QTY+47:1'GIR+001+34148009564912:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:6.83'MOA+52:5.16'PRI+AAA:6.83'PRI+AAB:11.99'RFF+LI:2971/79379'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.16'TAX+7+VAT+++:::0+Z'LIN+26++9781408333136:EN'IMD+L+009+:::Meadows, Daisy'IMD+L+050+:::Destiny the pop star fairy'QTY+47:1'GIR+001+34148009565059:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:2971/79380'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+27++9781444910216:EN'IMD+L+009+:::Bently, Peter'IMD+L+050+:::The cat, the mouse and the runaway'QTY+47:1'GIR+001+34148009564896:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79404'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+28++9781444910216:EN'IMD+L+009+:::Bently, Peter'IMD+L+050+:::The cat, the mouse and the runaway'QTY+47:1'GIR+001+34148009564904:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:3.98'MOA+52:3.01'PRI+AAA:3.98'PRI+AAB:6.99'RFF+LI:2971/79405'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:3.01'TAX+7+VAT+++:::0+Z'LIN+29++9781444914092:EN'IMD+L+009+:::Muchamore, Robert'IMD+L+050+:::Lone wolf'QTY+47:1'GIR+001+34148009565083:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2971/79408'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+30++9781444914092:EN'IMD+L+009+:::Muchamore, Robert'IMD+L+050+:::Lone wolf'QTY+47:1'GIR+001+34148009565091:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2971/79409'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+31++9781444914092:EN'IMD+L+009+:::Muchamore, Robert'IMD+L+050+:::Lone wolf'QTY+47:1'GIR+001+34148009565109:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:7.4'MOA+52:5.59'PRI+AAA:7.4'PRI+AAB:12.99'RFF+LI:2971/79410'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:5.59'TAX+7+VAT+++:::0+Z'LIN+32++9781781716441:EN'IMD+L+009+:::Smallman, Steve'IMD+L+050+:::Goldilocks'QTY+47:1'GIR+001+34148009565141:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:5.69'MOA+52:4.3'PRI+AAA:5.69'PRI+AAB:9.99'RFF+LI:2971/79433'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:4.3'TAX+7+VAT+++:::0+Z'LIN+33++9781781716465:EN'IMD+L+009+:::Smallman, Steve'IMD+L+050+:::Blow your nose, big bad wolf'QTY+47:1'GIR+001+34148009565133:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:5.69'MOA+52:4.3'PRI+AAA:5.69'PRI+AAB:9.99'RFF+LI:2971/79434'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:4.3'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:33'MOA+129:131.910'MOA+9:131.910'TAX+7+VAT+++:::0+Z'MOA+125:131.910'MOA+124:0'UNT+545+01975493'UNH+01975494+INVOIC:D:96A:UN:EAN008'BGM+380+01975494+43'DTM+131:20140729:102'DTM+137:20140729:102'RFF+DQ:01975494'NAD+BY+5013546121974::9'NAD+SU+5013546025078::9'CUX+2:GBP:4'PAT+1++5:3:D:30'LIN+1++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009565174:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81414'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+2++9781408329085:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Emerald unicorn'QTY+47:1'GIR+001+34148009565182:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81415'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+3++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009565240:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81416'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+4++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009565257:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81417'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+5++9781408329092:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Sapphire spell'QTY+47:1'GIR+001+34148009565265:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81418'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+6++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565190:LAC+DIT:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81424'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+7++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565208:LAC+HLE:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81425'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+8++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565216:LAC+MOB:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81426'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+9++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565224:LAC+RUN:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81427'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'LIN+10++9781408329115:EN'IMD+L+009+:::Banks, Rosie'IMD+L+050+:::Ruby riddle'QTY+47:1'GIR+001+34148009565232:LAC+WID:LLO+JUN-NF:LSQ'MOA+203:2.84'MOA+52:2.15'PRI+AAA:2.84'PRI+AAB:4.99'RFF+LI:3042/81428'TAX+7+VAT+++:::0+Z'MOA+124:0'ALC+A++++DI::28'PCD+3:43'MOA+8:2.15'TAX+7+VAT+++:::0+Z'UNS+S'CNT+2:10'MOA+129:28.4'MOA+9:28.4'TAX+7+VAT+++:::0+Z'MOA+125:28.4'MOA+124:0'UNT+177+01975494'UNZ+6+337023'
(-)a/t/EdiInvoice.t (+75 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
use strict;
3
use warnings;
4
use FindBin qw( $Bin );
5
6
use Test::More tests => 19;
7
8
BEGIN { use_ok('Koha::Edifact') }
9
10
my $invoice_file = "$Bin/BLSINV337023.CEI";
11
12
my $invoice = Koha::Edifact->new( { filename => $invoice_file, } );
13
14
isa_ok( $invoice, 'Koha::Edifact' );
15
my $x                 = $invoice->interchange_header('sender');
16
my $control_reference = '337023';
17
is( $x, '5013546025078', "sender returned" );
18
19
$x = $invoice->interchange_header('recipient');
20
is( $x, '5013546121974', "recipient returned" );
21
$x = $invoice->interchange_header('datetime');
22
is( $x->[0], '140729', "datetime returned" );
23
$x = $invoice->interchange_header('interchange_control_reference');
24
is( $x, $control_reference, "interchange_control_reference returned" );
25
26
$x = $invoice->interchange_header('application_reference');
27
is( $x, 'INVOIC', "application_reference returned" );
28
$x = $invoice->interchange_trailer('interchange_control_count');
29
is( $x, 6, "interchange_control_count returned" );
30
31
my $messages = $invoice->message_array();
32
33
# check inv number from BGM
34
35
my $msg_count = @{$messages};
36
is( $msg_count, 6, 'correct message count returned' );
37
38
is( $messages->[0]->message_type, 'INVOIC', 'Message shows correct type' );
39
40
my $expected_date = '20140729';
41
is( $messages->[0]->message_date,
42
    $expected_date, 'Message date correctly returned' );
43
is( $messages->[0]->tax_point_date,
44
    $expected_date, 'Tax point date correctly returned' );
45
46
my $expected_invoicenumber = '01975490';
47
48
my $invoicenumber = $messages->[1]->docmsg_number();
49
50
is( $messages->[0]->buyer_ean,    '5013546121974', 'Buyer ean correct' );
51
is( $messages->[0]->supplier_ean, '5013546025078', 'Supplier ean correct' );
52
53
is( $invoicenumber, $expected_invoicenumber,
54
    'correct invoicenumber extracted' );
55
56
my $lines = $messages->[1]->lineitems();
57
58
my $num_lines = @{$lines};
59
60
is( $num_lines, 8, "Correct number of lineitems returned" );
61
62
# sample invoice was from an early version where order was formatted basketno/ordernumber
63
my $expected_ordernumber = '2818/74593';
64
65
my $ordernumber = $lines->[7]->ordernumber;
66
67
is( $ordernumber, $expected_ordernumber, 'correct ordernumber returned' );
68
69
my $lineprice = $lines->[7]->price_net;
70
71
is( $lineprice, 4.55, 'correct net line price returned' );
72
73
my $tax = $lines->[7]->tax;
74
75
is( $tax, 0, 'correct tax amount returned' );
(-)a/t/Edifact.t (+90 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
use strict;
3
use warnings;
4
use FindBin qw( $Bin );
5
6
use Test::More tests => 27;
7
8
BEGIN { use_ok('Koha::Edifact') }
9
10
my $filename = "$Bin/edi_testfiles/prquotes_73050_20140430.CEQ";
11
12
my $quote = Koha::Edifact->new( { filename => $filename, } );
13
14
isa_ok( $quote, 'Koha::Edifact' );
15
16
my $x = $quote->interchange_header('sender');
17
is( $x, '5013546027856', "sender returned" );
18
19
$x = $quote->interchange_header('recipient');
20
is( $x, '5030670137480', "recipient returned" );
21
$x = $quote->interchange_header('datetime');
22
is( $x->[0], '140430', "datetime returned" );
23
my $control_reference = 'EDIQ2857763';
24
$x = $quote->interchange_header('interchange_control_reference');
25
is( $x, $control_reference, "interchange_control_reference returned" );
26
27
$x = $quote->interchange_header('application_reference');
28
is( $x, 'QUOTES', "application_reference returned" );
29
30
$x = $quote->interchange_trailer('interchange_control_count');
31
is( $x, 1, "interchange_control_count returned" );
32
33
my $msgs      = $quote->message_array();
34
my $msg_count = @{$msgs};
35
is( $msg_count, 1, "correct message count returned" );
36
my $m = $msgs->[0];
37
38
is( $m->message_type, 'QUOTES', "Message shows correct type" );
39
is( $m->message_reference_number,
40
    'MQ09791', "Message reference number returned" );
41
is( $m->docmsg_number, 'Q741588',  "Message docmsg number returned" );
42
is( $m->message_date,  '20140430', "Message date returned" );
43
44
my $lin = $m->lineitems();
45
46
my $num_lines = @{$lin};
47
is( $num_lines, 18, 'Correct number of lines in message' );
48
49
my $test_line = $lin->[-1];
50
51
is( $test_line->line_item_number, 18, 'correct line number returned' );
52
is( $test_line->item_number_id, '9780273761006', 'correct ean returned' );
53
is( $test_line->quantity, 1, 'quantity returned' );
54
55
my $test_title = 'International business [electronic resource]';
56
my $marcrec    = $test_line->marc_record;
57
isa_ok( $marcrec, 'MARC::Record' );
58
59
my $title = $test_line->title();
60
61
# also tests components are concatenated
62
is( $title, $test_title, "Title returned" );
63
64
# problems currently with the record (needs leader ??)
65
#is( $marcrec->title(), $test_title, "Title returned from marc");
66
my $test_author = q{Rugman, Alan M.};
67
is( $test_line->author,           $test_author,        "Author returned" );
68
is( $test_line->publisher,        'Pearson Education', "Publisher returned" );
69
is( $test_line->publication_date, q{2012.},            "Pub. date returned" );
70
#
71
# Test data encoded in GIR
72
#
73
my $stock_category = $test_line->girfield('stock_category');
74
is( $stock_category, 'EBOOK', "stock_category returned" );
75
my $branch = $test_line->girfield('branch');
76
is( $branch, 'ELIB', "branch returned" );
77
my $fund_allocation = $test_line->girfield('fund_allocation');
78
is( $fund_allocation, '660BOO_2013', "fund_allocation returned" );
79
my $collection_code = $test_line->girfield('collection_code');
80
is( $collection_code, 'EBOO', "collection_code returned" );
81
82
#my $shelfmark = $test_line->girfield('shelfmark');
83
#my $classification = $test_line->girfield('classification');
84
85
## text the free_text returned from the line
86
my $test_line_2 = $lin->[12];
87
88
my $ftx_string = 'E*610.72* - additional items';
89
90
is( $test_line_2->orderline_free_text, $ftx_string, "ftx note retrieved" );
(-)a/t/Ediorder.t (+56 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
use strict;
3
use warnings;
4
use FindBin qw( $Bin );
5
6
use Test::More tests => 6;
7
8
BEGIN { use_ok('Koha::Edifact::Order') }
9
10
11
# The following tests are for internal methods but they could
12
# error spectacularly so yest
13
# Check that quoting is done correctly
14
#
15
my $processed_text =
16
  Koha::Edifact::Order::encode_text(q{string containing ?,',:,+});
17
18
cmp_ok(
19
    $processed_text, 'eq',
20
    q{string containing ??,?',?:,?+},
21
    'Outgoing text correctly quoted'
22
);
23
24
# extend above test to test chunking in imd_segment
25
#
26
my $code           = '010';
27
my $data_to_encode = $processed_text;
28
29
my @segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );
30
31
my $testseg = "IMD+L+010+:::$processed_text";
32
$testseg .= q{'};    # add segment terminator
33
34
cmp_ok( $segs[0], 'eq', $testseg, 'IMD segment correctly formed' );
35
36
$data_to_encode = 'A' x 35;
37
$data_to_encode .= 'B' x 35;
38
$data_to_encode .= 'C' x 10;
39
40
@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );
41
42
cmp_ok(
43
    $segs[0],
44
    'eq',
45
q{IMD+L+010+:::AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA:BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB'},
46
    'IMD segment correctly chunked'
47
);
48
cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC'},
49
    'IMD segment correctly split across segments' );
50
51
$data_to_encode .= '??';
52
53
# this used to cause an infinite loop
54
@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode );
55
cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC??'},
56
    'IMD segment deals with quoted character at end' );
(-)a/t/Ediordrsp.t (+59 lines)
Line 0 Link Here
1
#!/usr/bin/perl
2
use strict;
3
use warnings;
4
use FindBin qw( $Bin );
5
6
use Test::More tests => 15;
7
8
BEGIN { use_ok('Koha::Edifact') }
9
10
my $filedir = "$Bin/edi_testfiles";
11
12
my @files = map { "$filedir/$_" }
13
  ( 'ordrsp1.CEA', 'ordrsp2.CEA', 'ordrsp3.CEA', 'ordrsp4.CEA' );
14
15
my @responses;
16
for my $filename (@files) {
17
18
    my $order_response = Koha::Edifact->new( { filename => $filename, } );
19
20
    isa_ok( $order_response, 'Koha::Edifact' );
21
    push @responses, $order_response;
22
}
23
24
# tests on file 1
25
# Order accepted with amendments
26
my $order_response = $responses[0];
27
28
my $msg       = $order_response->message_array();
29
my $no_of_msg = @{$msg};
30
is( $no_of_msg, 1, "Correct number of messages returned" );
31
32
isa_ok( $msg->[0], 'Koha::Edifact::Message' );
33
34
my $lines = $msg->[0]->lineitems();
35
36
my $no_of_lines = @{$lines};
37
38
is( $no_of_lines, 3, "Correct number of orderlines returned" );
39
40
#
41
is( $lines->[0]->ordernumber(), 'P28837', 'Line 1 correct ordernumber' );
42
is(
43
    $lines->[0]->translate_response_code( $lines->[0]->coded_orderline_text() ),
44
    'Not yet published',
45
    'NP returned and translated'
46
);
47
48
is( $lines->[1]->ordernumber(), 'P28838', 'Line 2 correct ordernumber' );
49
is( $lines->[1]->action_notification(),
50
    'cancelled', 'Cancelled action returned' );
51
is(
52
    $lines->[1]->translate_response_code( $lines->[1]->coded_orderline_text() ),
53
    'Out of print',
54
    'OP returned and translated'
55
);
56
57
is( $lines->[2]->ordernumber(), 'P28846', 'Line 3 correct ordernumber' );
58
is( $lines->[2]->action_notification(),
59
    'recorded', 'Accepted with change action returned' );
(-)a/t/edi_testfiles/ordrsp1.CEA (+1 lines)
Line 0 Link Here
1
UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857776++ORDRSP'UNH+ME001234+ORDRSP:D:96A:UN:EAN005'BGM+231+R967634+4'DTM+137:19971028:102'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'CUX+2:GBP:9'LIN+1+24'PIA+5+0316907235:IB'QTY+21:2'QTY+83:2'DTM+44:19971120:102'FTX+LIN++NP:8B:28'PRI+AAE:15.99:CA:SRP'RFF+LI:P28837'LIN+2+2'PIA+5+0856674427:IB'QTY+21:1'FTX+LIN++OP:8B:28'RFF+LI:P28838'LIN+3+24'PIA+5+0870701436:IB'PIA+3+0870701428:IB'QTY+21:1'FTX+LIN++OP:8B:28'PRI+AAE:25:CA:SRP'RFF+LI:P28846'UNS+S'CNT+2:3'UNT+29+ME001234'UNZ+1+EDIQ2857776'
(-)a/t/edi_testfiles/ordrsp2.CEA (+1 lines)
Line 0 Link Here
1
UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857775++ORDRSP'UNH+ME001235+ORDRSP:D:96A:UN:EAN005'BGM+231+R967635+27'DTM+137:19971028:102'FTX+GEN++ACS:9B:28'RFF+ON:H67209'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'UNS+S'CNT+2:0'UNT+10+ME001235'UNZ+1+EDIQ2857775'
(-)a/t/edi_testfiles/ordrsp3.CEA (+1 lines)
Line 0 Link Here
1
UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857774++ORDRSP'UNH+ME001236+ORDRSP:D:96A:UN:EAN005'BGM+23C+R967635+4'DTM+137:20010624:102'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'LIN+1+4'PIA+5+00076511236:IB'QTY+21:3’GIR+001+5346:LCO+1000431:LAC+FIC:LFN+AN:LLO'GIR+002+5347:LCO+1000432:LAC+FIC:LFN+AN:LLO'GIR+003+5348:LCO+1000433:LAC+FIC:LFN+BB:LLO'RFF+LI:0190045'LIN+2+4’PIA+5+0863183913:IB'QTY+21:1'GIR+001+6210:LCO+1000434:LAC+FIC:LFN+BB:LLO+398:LCL'GIR+001+JON:LFS+14DAY:LLN'RFF+LI:0190056'UNS+S'CNT+2:2'UNT+21:ME001236'UNZ+1+EDIQ2857774'
(-)a/t/edi_testfiles/ordrsp4.CEA (+1 lines)
Line 0 Link Here
1
UNA:+.? 'UNB+UNOC:3+4012345000094+5412345000176+140430:1849+EDIQ2857773++ORDRSP'UNH+ME001345+ORDRSP:D:96A:UN:EAN005'BGM+23C+F964312+4'DTM+137:20010430:102'NAD+BY+5412345000176::9'NAD+SU+4012345000094::9'LIN+1+4'PIA+5+0007107781:IB'QTY+21:4'GIR+L01+214365:LAC+214366:LAC+DA:LLO+920:LCL+SEC:LFS'GIR+L01+NFIC:LFS'GIR+L02+214367:LAC+214368:LAC+FG:LLO+920:LCL+SEC:LFS'GIR+L02+NFIC:LFS'RFF+LI:0184364’LOC+7+BR1::92'QTY+11:2'LOC+20+FG::92'QTY+11:2'UNS+S'CNT+2:1'UNT+20:ME001345'UNZ+1+EDIQ2857773'
(-)a/t/edi_testfiles/prquotes_73050_20140430.CEQ (-1 / +1 lines)
Line 0 Link Here
0
- 
1
UNA:+.? 'UNB+UNOC:3+5013546027856+5030670137480+140430:1849+EDIQ2857763++QUOTES'UNH+MQ09791+QUOTES:D:96A:UN:EAN002'BGM+31C+Q741588+9'DTM+137:20140430:102'CUX+2:GBP:12'NAD+BY+5030670137480::9'NAD+SU+5013546027856::9'LIN+1++9780191652028:EN'IMD+L+010+:::Fisher, Miles.'IMD+L+050+:::Heart disease and diabetes [electro:nic resource]'IMD+L+100+:::2nd ed.'IMD+L+110+:::Oxford'IMD+L+120+:::Oxford University Press'IMD+L+170+:::2012.'IMD+L+180+:::xv, 156 p.'IMD+L+190+:::Oxford diabetes library'IMD+L+230+:::616.12'IMD+L+240+:::RC660'IMD+L+300+:::Previous ed.?: 2009.'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:79.42:DI'RFF+QLI:2857763'LIN+2++9781461414759:EN'IMD+L+010+:::Vlodaver, Zeev.'IMD+L+050+:::Coronary heart disease [electronic :resource]'IMD+L+110+:::New York ,London'IMD+L+120+:::Springer'IMD+L+170+:::2012.'IMD+L+180+:::xv, 540 p.'IMD+L+230+:::616.123'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:161.87:DI'RFF+QLI:2857785'LIN+3++9780199793662:EN'IMD+L+010+:::Yaffe, Kristine,'IMD+L+050+:::Chronic medical disease and cogniti:ve aging [electronic resource]'IMD+L+110+:::New York'IMD+L+120+:::Oxford University Press'IMD+L+170+:::2013'IMD+L+180+:::xv, 298 pages'IMD+L+230+:::616.044'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:165.53:DI'RFF+QLI:2857810'LIN+4++9781446258637:EN'IMD+L+010+:::Lupton, Deborah.'IMD+L+050+:::Medicine as culture [electronic res:ource]'IMD+L+100+:::3rd ed.'IMD+L+110+:::Los Angeles ,London'IMD+L+120+:::SAGE'IMD+L+170+:::2012.'IMD+L+180+:::xii, 195 p.'IMD+L+230+:::306.461'IMD+L+300+:::Previous ed.?: 2003.'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:94.8:DI'RFF+QLI:2857839'LIN+5++9780203113974:EN'IMD+L+010+:::Magdalinski, Tara,'IMD+L+050+:::Study skills for sport studies [ele:ctronic resource]'IMD+L+180+:::xv, 250 pages'IMD+L+230+:::371.30281'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:171:DI'RFF+QLI:2857913'LIN+6++9781450453080:EN'IMD+L+010+:::Hausswirth, Christophe,'IMD+L+050+:::Recovery for performance in sport [:electronic resource]'IMD+L+180+:::xiii, 281 pages'IMD+L+230+:::617.03'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:212.4:DI'RFF+QLI:2857919'LIN+7++9780203807279:EN'IMD+L+010+:::Lebed, Felix,'IMD+L+050+:::Complexity and control in team spor:ts [electronic resource]'IMD+L+180+:::xx, 223 pages'IMD+L+190+:::Routledge research in sport and exe:rcise science ;'IMD+L+191+:::6'IMD+L+230+:::306.483'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:153:DI'RFF+QLI:2858034'LIN+8++9780415691055:EN'IMD+L+010+:::Smith, Mark'IMD+L+050+:::Practical Skills in Sport and Exerc:ise Science'IMD+L+120+:::Taylor & Francis'IMD+L+170+:::2014'QTY+1:4'GIR+001+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+002+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+003+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+004+COLLRD:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:24.99:DI'RFF+QLI:2858105'LIN+9++9781450434324:EN'IMD+L+010+:::Hoffman, Shirl J.,'IMD+L+050+:::Introduction to kinesiology'IMD+L+100+:::Fourth edition.'IMD+L+110+:::Champaign'IMD+L+120+:::Human Kinetics Publishers'IMD+L+170+:::2013'IMD+L+180+:::xvi, 529 pages'IMD+L+230+:::612.76'IMD+L+300+:::Previous edition?: 2009.'QTY+1:3'GIR+001+NELSON:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+002+NELSON:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+003+NELSON:LLO+705BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:67.5:DI'RFF+QLI:2858153'LIN+10++9780702049293:EN'IMD+L+010+:::Norris, Christopher M.'IMD+L+050+:::Managing sports injuries [electroni:c resource]'IMD+L+100+:::4th ed.'IMD+L+110+:::Edinburgh'IMD+L+120+:::Churchill Livingstone'IMD+L+170+:::2011.'IMD+L+180+:::421 p.'IMD+L+230+:::617.1027'IMD+L+240+:::RD97'IMD+L+300+:::Rev. ed. of?: Sports injuries / Chr:istopher M. Norris. 3rd ed. 2004.'QTY+1:1'GIR+001+ELIB:LLO+705BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:275.23:DI'RFF+QLI:2858165'LIN+11++9781292034874:EN'IMD+L+010+:::Bledsoe, Bryan E.,'IMD+L+050+:::Paramedic care [electronic resource:]'IMD+L+080+:::Volume 5,'IMD+L+100+:::Pearson new international edition.'IMD+L+180+:::ii, 422 pages'IMD+L+190+:::Pearson custom library'IMD+L+230+:::616.025'QTY+1:1'GIR+001+ELIB:LLO+436BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:41.99:DI'RFF+QLI:2858217'LIN+12++9781292021645:EN'IMD+L+010+:::Bledsoe, Bryan E.,'IMD+L+050+:::Paramedic care'IMD+L+080+:::Volume 5,'IMD+L+100+:::Pearson new international edition.'IMD+L+110+:::Harlow'IMD+L+120+:::Pearson Education'IMD+L+170+:::2013'IMD+L+180+:::ii, 422 pages'IMD+L+190+:::Pearson custom library'IMD+L+230+:::616.025'QTY+1:5'GIR+001+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+002+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+003+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+004+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'GIR+005+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+MAIN:LSQ'PRI+AAE:52.99:DI'RFF+QLI:2858231'LIN+13++9781446253083:EN'IMD+L+010+:::Green, Judith'IMD+L+050+:::Qualitative Methods for Health Rese:arch'IMD+L+100+:::Third Edition'IMD+L+110+:::London'IMD+L+120+:::SAGE Publications ?: SAGE Publicati:ons Ltd'IMD+L+170+:::2013'IMD+L+180+:::376 p.'IMD+L+190+:::Introducing Qualitative Methods ser:ies'IMD+L+230+:::610.721'IMD+L+300+:::The third edition of this bestselli:ng title is packed full of real wor'QTY+1:2'GIR+001+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+610.72:LCL+MAIN:LSQ'GIR+002+NELSON:LLO+436BOO_2013:LFN+2WEEK:LST+610.72:LCL+MAIN:LSQ'FTX+LIN++2:10B:28+E*610.72* - additional items'PRI+AAE:75:DI'RFF+QLI:2858253'LIN+14++9780273757726:EN'IMD+L+010+:::Jim Blythe.'IMD+L+050+:::Essentials of marketing'IMD+L+120+:::Pearson Education'QTY+1:1'GIR+001+ELIB:LLO+660BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:74.98:DI'RFF+QLI:2858398'LIN+15++9780745681726:EN'IMD+L+010+:::Selwyn, Ben,'IMD+L+050+:::The global development crisis [elec:tronic resource]'IMD+L+180+:::viii, 248 pages'IMD+L+230+:::338.9'IMD+L+240+:::HD75'IMD+L+300+:::This book challenges the assumption: that a ?'free?' global market will'QTY+1:1'GIR+001+ELIB:LLO+400BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:66:DI'RFF+QLI:2858545'LIN+16++9781412992077:EN'IMD+L+010+:::McMichael, Philip.'IMD+L+050+:::Development and social change'IMD+L+100+:::5th ed.'IMD+L+110+:::Los Angeles'IMD+L+120+:::SAGE'IMD+L+170+:::c2012.'IMD+L+180+:::xxi, 383 p.'IMD+L+190+:::Sociology for a New Century Series'IMD+L+230+:::306.309'IMD+L+240+:::HC79.E44'IMD+L+300+:::Revised and updated Fifth Edition o:f this popular critical exploration'QTY+1:1'GIR+001+COLLRD:LLO+400BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:49.99:DI'RFF+QLI:2858547'LIN+17++9780230213111:EN'IMD+L+010+:::Brown, Chris,'IMD+L+050+:::Understanding international relatio:ns'IMD+L+100+:::4th ed.'IMD+L+110+:::Basingstoke'IMD+L+120+:::Palgrave Macmillan'IMD+L+170+:::c2009.'IMD+L+180+:::xi, 321 p.'IMD+L+230+:::327'IMD+L+240+:::JZ1242'IMD+L+300+:::Previous ed.?: 2005.'QTY+1:2'GIR+001+COLLRD:LLO+400BOO_2013:LFN+2WEEK:LST+CORE:LSQ'GIR+002+COLLRD:LLO+400BOO_2013:LFN+2WEEK:LST+CORE:LSQ'PRI+AAE:27.99:DI'RFF+QLI:2858938'LIN+18++9780273761006:EN'IMD+L+010+:::Rugman, Alan M.'IMD+L+050+:::International business [electronic :resource]'IMD+L+100+:::6th ed.'IMD+L+110+:::Harlow'IMD+L+120+:::Pearson Education'IMD+L+170+:::2012.'IMD+L+180+:::xxxii,  765 p.'IMD+L+230+:::658.049'IMD+L+300+:::First published by McGraw-Hill, 199:5.'QTY+1:1'GIR+001+ELIB:LLO+660BOO_2013:LFN+EBOOK:LST+EBOO:LSQ'PRI+AAE:114.97:DI'RFF+QLI:2858954'UNS+S'CNT+2:18'UNT+248+MQ09791'UNZ+1+EDIQ2857763'

Return to bug 7736