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

(-)a/C4/Acquisition.pm (-1 / +5 lines)
Lines 2495-2500 sub GetInvoices { Link Here
2495
        push @bind_strs, " borrowers.branchcode = ? ";
2495
        push @bind_strs, " borrowers.branchcode = ? ";
2496
        push @bind_args, $args{branchcode};
2496
        push @bind_args, $args{branchcode};
2497
    }
2497
    }
2498
    if($args{message_id}) {
2499
        push @bind_strs, " aqinvoices.message_id = ? ";
2500
        push @bind_args, $args{message_id};
2501
    }
2498
2502
2499
    $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2503
    $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2500
    $query .= " GROUP BY aqinvoices.invoiceid ";
2504
    $query .= " GROUP BY aqinvoices.invoiceid ";
Lines 2619-2625 sub AddInvoice { Link Here
2619
    return unless(%invoice and $invoice{invoicenumber});
2623
    return unless(%invoice and $invoice{invoicenumber});
2620
2624
2621
    my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2625
    my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2622
        closedate shipmentcost shipmentcost_budgetid);
2626
        closedate shipmentcost shipmentcost_budgetid message_id);
2623
2627
2624
    my @set_strs;
2628
    my @set_strs;
2625
    my @set_args;
2629
    my @set_args;
(-)a/C4/Installer/PerlDependencies.pm (+10 lines)
Lines 737-742 our $PERL_DEPS = { Link Here
737
        'required' => '0',
737
        'required' => '0',
738
        'min_ver'  => '5.61',
738
        'min_ver'  => '5.61',
739
    },
739
    },
740
    'Net::SFTP::Foreign' => {
741
        'usage'    => 'Edifact',
742
        'required' => '0',
743
        'min_ver'  => '1.73',
744
    },
745
    'Log::Log4perl' => {
746
        'usage'    => 'Edifact',
747
        'required' => '0',
748
        'min_ver'  => '1.29',
749
    },
740
};
750
};
741
751
742
1;
752
1;
(-)a/Koha/EDI.pm (+541 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 Carp;
24
use English qw{ -no_match_vars };
25
use Business::ISBN;
26
use DateTime;
27
use C4::Context;
28
use Koha::Database;
29
use C4::Acquisition qw( NewBasket AddInvoice ModReceiveOrder );
30
use C4::Items qw(AddItem);
31
use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio );
32
use Koha::Edifact::Order;
33
use Koha::Edifact;
34
use Log::Log4perl;
35
36
our $VERSION = 1.1;
37
our @EXPORT_OK =
38
  qw( process_quote process_invoice create_edi_order get_edifact_ean );
39
40
sub create_edi_order {
41
    my $parameters = shift;
42
    my $basketno   = $parameters->{basketno};
43
    my $ean        = $parameters->{ean};
44
    my $branchcode = $parameters->{branchcode};
45
    my $noingest   = $parameters->{noingest};
46
    $ean ||= C4::Context->preference('EDIfactEAN');
47
    if ( !$basketno || !$ean ) {
48
        carp 'create_edi_order called with no basketno or ean';
49
        return;
50
    }
51
52
    my $database = Koha::Database->new();
53
    my $schema   = $database->schema();
54
55
    my @orderlines = $schema->resultset('Aqorder')->search(
56
        {
57
            basketno    => $basketno,
58
            orderstatus => 'new',
59
        }
60
    )->all;
61
62
    my $vendor = $schema->resultset('VendorEdiAccount')->search(
63
        {
64
            vendor_id => $orderlines[0]->basketno->booksellerid->id,
65
        }
66
    )->single;
67
68
    my $ean_search_keys = { ean => $ean, };
69
    if ($branchcode) {
70
        $ean_search_keys->{branchcode} = $branchcode;
71
    }
72
    my $ean_obj =
73
      $schema->resultset('EdifactEan')->search($ean_search_keys)->single;
74
75
    my $edifact = Koha::Edifact::Order->new(
76
        { orderlines => \@orderlines, vendor => $vendor, ean => $ean_obj } );
77
    if ( !$edifact ) {
78
        return;
79
    }
80
81
    my $order_file = $edifact->encode();
82
83
    # ingest result
84
    if ($order_file) {
85
        if ($noingest) {    # allows scripts to produce test files
86
            return $order_file;
87
        }
88
        my $order = {
89
            message_type  => 'ORDERS',
90
            raw_msg       => $order_file,
91
            vendor_id     => $vendor->vendor_id,
92
            status        => 'Pending',
93
            basketno      => $basketno,
94
            filename      => $edifact->filename(),
95
            transfer_date => $edifact->msg_date_string(),
96
            edi_acct      => $vendor->id,
97
98
        };
99
        $schema->resultset('EdifactMessage')->create($order);
100
        return 1;
101
    }
102
103
    return;
104
}
105
106
sub process_invoice {
107
    my $invoice_message = shift;
108
    my $database        = Koha::Database->new();
109
    my $schema          = $database->schema();
110
    my $vendor_acct;
111
    my $logger = Log::Log4perl->get_logger();
112
    my $edi =
113
      Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } );
114
    my $messages = $edi->message_array();
115
    if ( @{$messages} ) {
116
117
        # BGM contains an invoice number
118
        foreach my $msg ( @{$messages} ) {
119
            my $invoicenumber  = $msg->docmsg_number();
120
            my $shipmentcharge = $msg->shipment_charge();
121
            my $msg_date       = $msg->message_date;
122
            my $tax_date       = $msg->tax_point_date;
123
            if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) {
124
                $tax_date = $msg_date;
125
            }
126
127
            my $vendor_ean = $msg->supplier_ean;
128
            if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) {
129
                $vendor_acct = $schema->resultset('VendorEdiAccount')->search(
130
                    {
131
                        san => $vendor_ean,
132
                    }
133
                )->single;
134
            }
135
            if ( !$vendor_acct ) {
136
                carp
137
"Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename";
138
                next;
139
            }
140
            $invoice_message->edi_acct( $vendor_acct->id );
141
            $logger->trace("Adding invoice:$invoicenumber");
142
            my $invoiceid = AddInvoice(
143
                invoicenumber         => $invoicenumber,
144
                booksellerid          => $invoice_message->vendor_id,
145
                shipmentdate          => $msg_date,
146
                billingdate           => $tax_date,
147
                shipmentcost          => $shipmentcharge,
148
                shipmentcost_budgetid => $vendor_acct->shipment_budget,
149
                message_id            => $invoice_message->id,
150
            );
151
            $logger->trace("Added as invoiceno :$invoiceid");
152
            my $lines = $msg->lineitems();
153
154
            foreach my $line ( @{$lines} ) {
155
                my $ordernumber = $line->ordernumber;
156
                $logger->trace( "Receipting order:$ordernumber Qty: ",
157
                    $line->quantity );
158
159
                # handle old basketno/ordernumber references
160
                if ( $ordernumber =~ m{\d+\/(\d+)}xms ) {
161
                    $ordernumber = $1;
162
                }
163
                my $order = $schema->resultset('Aqorder')->find($ordernumber);
164
165
      # ModReceiveOrder does not validate that $ordernumber exists validate here
166
                if ($order) {
167
                    ModReceiveOrder(
168
                        {
169
                            biblionumber         => $order->biblionumber,
170
                            ordernumber          => $ordernumber,
171
                            quantityreceived     => $line->quantity,
172
                            cost                 => $line->price_net,
173
                            invoiceid            => $invoicenumber,
174
                            datereceived         => $msg_date,
175
                            received_itemnumbers => [],
176
                        }
177
                    );
178
                }
179
                else {
180
                    $logger->error(
181
                        "No order found for $ordernumber Invoice:$invoicenumber"
182
                    );
183
                    next;
184
                }
185
186
            }
187
188
        }
189
    }
190
191
    $invoice_message->status('received');
192
    $invoice_message->update;    # status and basketno link
193
    return;
194
}
195
196
# called on messages with status 'new'
197
sub process_quote {
198
    my $quote = shift;
199
200
    my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } );
201
    my $messages = $edi->message_array();
202
    my $process_errors = 0;
203
    my $logger         = Log::Log4perl->get_logger();
204
    my $database       = Koha::Database->new();
205
    my $schema         = $database->schema();
206
207
    if ( @{$messages} && $quote->vendor_id ) {
208
        my $basketno =
209
          NewBasket( $quote->vendor_id, 0, $quote->filename, q{}, q{} . q{} );
210
        $quote->basketno($basketno);
211
        $logger->trace("Created basket :$basketno");
212
        for my $msg ( @{$messages} ) {
213
            my $items  = $msg->lineitems();
214
            my $refnum = $msg->message_refno;
215
216
            for my $item ( @{$items} ) {
217
                if ( !quote_item( $schema, $item, $quote, $basketno ) ) {
218
                    ++$process_errors;
219
                }
220
            }
221
        }
222
    }
223
    my $status = 'received';
224
    if ($process_errors) {
225
        $status = 'error';
226
    }
227
228
    $quote->status($status);
229
    $quote->update;    # status and basketno link
230
231
    return;
232
}
233
234
sub quote_item {
235
    my ( $schema, $item, $quote, $basketno ) = @_;
236
237
    # create biblio record
238
    my $logger   = Log::Log4perl->get_logger();
239
    my $bib_hash = {
240
        'biblioitems.cn_source' => 'ddc',
241
        'items.cn_source'       => 'ddc',
242
        'items.notforloan'      => -1,
243
        'items.cn_sort'         => q{},
244
    };
245
    my $item_hash = {
246
        cn_source  => 'ddc',
247
        notforloan => -1,
248
        cn_dort    => q{},
249
    };
250
    $bib_hash->{'biblio.seriestitle'} = $item->series;
251
252
    $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
253
    $bib_hash->{'biblioitems.publicationyear'} =
254
      $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
255
256
    $bib_hash->{'biblio.title'}         = $item->title;
257
    $bib_hash->{'biblio.author'}        = $item->author;
258
    $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
259
    $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
260
    $item_hash->{booksellerid}          = $quote->vendor_id;
261
    $item_hash->{price} = $item_hash->{replacementprice} = $item->price;
262
    $item_hash->{itype}    = $item->girfield('stock_category');
263
    $item_hash->{location} = $item->girfield('collection_code');
264
265
    my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
266
267
    if ( !$budget ) {
268
        carp 'Skipping line with no budget info';
269
        $logger->trace('line skipped for invalid budget');
270
        return;
271
    }
272
273
    my $note = {};
274
275
    my $shelfmark =
276
      $item->girfield('shelfmark') || $item->girfield('classification') || q{};
277
    $item_hash->{itemcallnumber} = $shelfmark;
278
    my $branch = $item->girfield('branch');
279
    $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch;
280
    for my $key ( keys %{$bib_hash} ) {
281
        if ( !defined $bib_hash->{$key} ) {
282
            delete $bib_hash->{$key};
283
        }
284
    }
285
    my $bib_record = TransformKohaToMarc($bib_hash);
286
287
    $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
288
    my $bib = _check_for_existing_bib( $item->item_number_id() );
289
    if ( !defined $bib ) {
290
        $bib = {};
291
        ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
292
          AddBiblio( $bib_record, q{} );
293
        $logger->trace("New biblio added $bib->{biblionumber}");
294
    }
295
    else {
296
        $logger->trace("Match found: $bib->{biblionumber}");
297
    }
298
299
    my $order_note = $item->{free_text};
300
    $order_note ||= q{};
301
    if ( !$basketno ) {
302
        $logger->error('Skipping order creation no basketno');
303
        return;
304
    }
305
306
    # database definitions should set some of these defaults but dont
307
    my $order_hash = {
308
        biblionumber     => $bib->{biblionumber},
309
        entrydate        => DateTime->now( time_zone => 'local' )->ymd(),
310
        quantity         => $item->quantity,
311
        basketno         => $basketno,
312
        listprice        => $item->price,
313
        quantityreceived => 0,
314
315
        #        notes             => $order_note, becane internalnote in 3.15
316
        order_internalnote => $order_note,
317
        rrp                => $item->price,
318
        ecost => _discounted_price( $quote->vendor->discount, $item->price ),
319
        budget_id         => $budget->budget_id,
320
        uncertainprice    => 0,
321
        sort1             => q{},
322
        sort2             => q{},
323
        supplierreference => $item->reference,
324
    };
325
    if ( $item->girfield('servicing_instruction') ) {
326
327
        # not in 3.14 !!!
328
        $order_hash->{order_vendornote} =
329
          $item->girfield('servicing_instruction');
330
    }
331
    if ( $item->internal_notes() ) {
332
        if ( $order_hash->{order_internalnote} ) {    # more than ''
333
            $order_hash->{order_internalnote} .= q{ };
334
        }
335
336
        $order_hash->{order_internalnote} .= $item->internal_notes;
337
    }
338
339
    my $new_order = $schema->resultset('Aqorder')->create($order_hash);
340
    my $o         = $new_order->ordernumber();
341
    $logger->trace("Order created :$o");
342
343
    # should be done by database settings
344
    $new_order->parent_ordernumber( $new_order->ordernumber() );
345
    $new_order->update();
346
347
    if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
348
        my $itemnumber;
349
        ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber ) =
350
          AddItem( $item_hash, $bib->{biblionumber} );
351
        $logger->trace("Added item:$itemnumber");
352
        $schema->resultset('AqordersItem')->create(
353
            {
354
                ordernumber => $new_order->ordernumber,
355
                itemnumber  => $itemnumber,
356
            }
357
        );
358
359
        if ( $item->quantity > 1 ) {
360
            my $occurence = 1;
361
            while ( $occurence < $item->quantity ) {
362
                my $new_item = {
363
                    notforloan       => -1,
364
                    cn_sort          => q{},
365
                    cn_source        => 'ddc',
366
                    price            => $item->price,
367
                    replacementprice => $item->price,
368
                    itype => $item->girfield( 'stock_category', $occurence ),
369
                    location =>
370
                      $item->girfield( 'collection_code', $occurence ),
371
                    itemcallnumber => $item->girfield( 'shelfmark', $occurence )
372
                      || $item->girfield( 'classification', $occurence ),
373
                    holdingbranch => $item->girfield( 'branch', $occurence ),
374
                    homebranch    => $item->girfield( 'branch', $occurence ),
375
                };
376
                ( undef, undef, $itemnumber ) =
377
                  AddItem( $new_item, $bib->{biblionumber} );
378
                $logger->trace("New item $itemnumber added");
379
                $schema->resultset('AqordersItem')->create(
380
                    {
381
                        ordernumber => $new_order->ordernumber,
382
                        itemnumber  => $itemnumber,
383
                    }
384
                );
385
                ++$occurence;
386
            }
387
        }
388
389
    }
390
    return 1;
391
}
392
393
sub get_edifact_ean {
394
395
    my $dbh = C4::Context->dbh;
396
397
    my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
398
399
    return $eans->[0];
400
}
401
402
# We should not need to have a routine to do this here
403
sub _discounted_price {
404
    my ( $discount, $price ) = @_;
405
    return $price - ( ( $discount * $price ) / 100 );
406
}
407
408
sub _check_for_existing_bib {
409
    my $isbn = shift;
410
411
    my $search_isbn = $isbn;
412
    $search_isbn =~ s/^\s*/%/xms;
413
    $search_isbn =~ s/\s*$/%/xms;
414
    my $dbh = C4::Context->dbh;
415
    my $sth = $dbh->prepare(
416
'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
417
    );
418
    my $tuple_arr =
419
      $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
420
    if ( @{$tuple_arr} ) {
421
        return $tuple_arr->[0];
422
    }
423
    else {
424
        undef $search_isbn;
425
        $isbn =~ s/\-//xmsg;
426
        if ( $isbn =~ m/(\d{13})/xms ) {
427
            my $b_isbn = Business::ISBN->new($1);
428
            if ( $b_isbn && $b_isbn->is_valid ) {
429
                $search_isbn = $b_isbn->as_isbn10->as_string( [] );
430
            }
431
432
        }
433
        elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
434
            my $b_isbn = Business::ISBN->new($1);
435
            if ( $b_isbn && $b_isbn->is_valid ) {
436
                $search_isbn = $b_isbn->as_isbn13->as_string( [] );
437
            }
438
439
        }
440
        if ($search_isbn) {
441
            $search_isbn = "%$search_isbn%";
442
            $tuple_arr =
443
              $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
444
            if ( @{$tuple_arr} ) {
445
                return $tuple_arr->[0];
446
            }
447
        }
448
    }
449
    return;
450
}
451
452
# returns a budget obj or undef
453
# fact we need this shows what a mess Acq API is
454
sub _get_budget {
455
    my ( $schema, $budget_code ) = @_;
456
457
    # db does not ensure budget code is unque
458
    return $schema->resultset('Aqbudget')->single(
459
        {
460
            budget_code => $budget_code,
461
        }
462
    );
463
}
464
465
1;
466
__END__
467
468
=head1 NAME
469
   Koha::EDI
470
471
=head1 SYNOPSIS
472
473
   Module exporting subroutines used in EDI processing for Koha
474
475
=head1 DESCRIPTION
476
477
   Subroutines called by batch processing to handle Edifact
478
   messages of various types and related utilities
479
480
=head1 BUGS
481
482
   These routines should really be methods of some object.
483
   get_edifact_ean is a stopgap which should be replaced
484
485
=head1 SUBROUTINES
486
487
=head2 process_quote
488
489
    process_quote(quote_message);
490
491
   passed a message object for a quote, parses it creating an order basket
492
   and orderlines in the database
493
   updates the message's status to received in the database and adds the
494
   link to basket
495
496
=head2 process_invoice
497
498
    process_invoice(invoice_message)
499
500
    passed a message object for an invoice, add the contained invoices
501
    and update the orderlines referred to in the invoice
502
    As an Edifact invoice is in effect a despatch note this receipts the
503
    appropriate quantities in the orders
504
505
506
=head2 create_edi_order
507
508
    create_edi_order( { parameter_hashref } )
509
510
    parameters must include basketno and ean
511
512
    branchcode can optionally be passed
513
514
    returns 1 on success undef otherwise
515
516
    if the parameter noingest is set the formatted order is returned
517
    and not saved in the database. This functionality is intended for debugging only
518
519
=head2 get_edifact_ean
520
521
522
=head2 quote_item
523
524
     quote_item(lineitem, quote_message);
525
526
      Called by process_quote to handle an individual lineitem
527
     Generate the biblios and items if required and orderline linking to them
528
529
=head1 AUTHOR
530
531
   Colin Campbell <colin.campbell@ptfs-europe.com>
532
533
534
=head1 COPYRIGHT
535
536
   Copyright 2014, PTFS-Europe Ltd
537
   This program is free software, You may redistribute it under
538
   under the terms of the GNU General Public License
539
540
541
=cut
(-)a/Koha/Edifact.pm (+335 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
   Koha::Edifact
253
254
=head1 SYNOPSIS
255
256
=head1 DESCRIPTION
257
258
   Koha module for parsing Edifact messages
259
260
=head1 BUGS
261
262
263
=head1 SUBROUTINES
264
265
=head2 new
266
267
     my $e = Koha::Edifact->new( { filename => 'myfilename' } );
268
     or
269
     my $e = Koha::Edifact->new( { transmission => $msg_variable } );
270
271
     instantiate the Edifact parser, requires either to be passed an in-memory
272
     edifact message as transmission or a filename which it will read on creation
273
274
=head2 interchange_header
275
276
     will return the data in the header field designated by the parameter
277
     specified. Valid parameters are: 'sender', 'recipient', 'datetime',
278
    'interchange_control_reference', and 'application_reference'
279
280
=head2 interchange_trailer
281
282
     called either with the string 'interchange_control_count' or
283
     'interchange_control_reference' will return the corresponding field from
284
     the interchange trailer
285
286
=head2 new_data_iterator
287
288
     Sets the object's data_iterator to point to the UNH segment
289
=head2 next_segment
290
291
     Returns the next segment pointed to by the data_iterator. Increments the
292
     data_iterator member or destroys it if segment UNZ has been reached
293
294
=head2 get_transmission
295
296
     This method is useful in debugg:ing. Call on an Edifact it returns
297
     the object's transmission member
298
299
=head2 message_type
300
301
     return the object's message type
302
303
=head2 message_array
304
305
     return an array of Message objects contained in the Edifact transmission
306
307
=head1 Internal Methods
308
309
=head2 service_string_advice
310
311
  Examines the Service String Advice returns 1 if the default separartors are in use
312
  undef otherwise
313
314
=head2 segmentize
315
316
   takes a raw Edifact message and returns a reference to an array of
317
   its segments
318
319
=head2 msgcharset
320
321
    Return the character set the message was encoded in. The default is iso-8859-1
322
323
=head1 AUTHOR
324
325
   Colin Campbell <colin.campbell@ptfs-europe.com>
326
327
328
=head1 COPYRIGHT
329
330
   Copyright 2014, PTFS-Europe Ltd
331
   This program is free software, You may redistribute it under
332
   under the terms of the GNU General Public License
333
334
335
=cut
(-)a/Koha/Edifact/Line.pm (+577 lines)
Line 0 Link Here
1
package Koha::Edifact::Line;
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
23
use MARC::Record;
24
use MARC::Field;
25
use Carp;
26
27
sub new {
28
    my ( $class, $data_array_ref ) = @_;
29
    my $self = _parse_lines($data_array_ref);
30
31
    bless $self, $class;
32
    return $self;
33
}
34
35
# helper routine used by constructor
36
# creates the hashref used as a data structure by the Line object
37
38
sub _parse_lines {
39
    my $aref = shift;
40
41
    my $lin = shift @{$aref};
42
43
    my $d = {
44
        line_item_number       => $lin->elem(0),
45
        item_number_id         => $lin->elem( 2, 0 ),
46
        additional_product_ids => [],
47
    };
48
    my @item_description;
49
50
    foreach my $s ( @{$aref} ) {
51
        if ( $s->tag eq 'PIA' ) {
52
            push @{ $d->{additional_product_ids} },
53
              {
54
                function_code => $s->elem(0),
55
                item_number   => $s->elem( 1, 0 ),
56
                number_type   => $s->elem( 1, 1 ),
57
              };
58
        }
59
        elsif ( $s->tag eq 'IMD' ) {
60
            push @item_description, $s;
61
        }
62
        elsif ( $s->tag eq 'QTY' ) {
63
            $d->{quantity} = $s->elem( 0, 1 );
64
        }
65
        elsif ( $s->tag eq 'DTM' ) {
66
            $d->{avaiability_date} = $s->elem( 0, 1 );
67
        }
68
        elsif ( $s->tag eq 'GIR' ) {
69
70
            # we may get a Gir for each copy if QTY > 1
71
            if ( !$d->{GIR} ) {
72
                $d->{GIR} = [];
73
            }
74
            push @{ $d->{GIR} }, extract_gir($s);
75
76
        }
77
        elsif ( $s->tag eq 'FTX' ) {
78
79
            my $type = $s->elem(1);
80
            if ( $type eq 'LNO' ) {    # Ingrams Oasis Internal Notes field
81
                $type = 'internal_notes';
82
            }
83
            else {
84
                $type = 'free_text';
85
            }
86
87
            my $ftx = $s->elem(3);
88
            if ( ref $ftx eq 'ARRAY' ) {   # it comes in 70 character components
89
                $ftx = join ' ', @{$ftx};
90
            }
91
            if ( exists $d->{$type} ) {    # we can only catenate repeats
92
                $d->{$type} .= q{ };
93
                $d->{$type} .= $ftx;
94
            }
95
            else {
96
                $d->{$type} = $ftx;
97
            }
98
        }
99
        elsif ( $s->tag eq 'MOA' ) {
100
101
            $d->{monetary_amount} = $s->elem( 0, 1 );
102
        }
103
        elsif ( $s->tag eq 'PRI' ) {
104
105
            $d->{price} = $s->elem( 0, 1 );
106
        }
107
        elsif ( $s->tag eq 'RFF' ) {
108
            my $qualifier = $s->elem( 0, 0 );
109
            if ( $qualifier eq 'QLI' ) { # Suppliers unique quotation linenumber
110
                $d->{reference} = $s->elem( 0, 1 );
111
            }
112
            elsif ( $qualifier eq 'LI' ) {    # Buyer's unique orderline number
113
                $d->{ordernumber} = $s->elem( 0, 1 );
114
            }
115
        }
116
    }
117
    $d->{item_description} = _format_item_description(@item_description);
118
    $d->{segs}             = $aref;
119
120
    return $d;
121
}
122
123
sub _format_item_description {
124
    my @imd    = @_;
125
    my $bibrec = {};
126
127
 # IMD : +Type code 'L' + characteristic code 3 char + Description in comp 3 & 4
128
    foreach my $imd (@imd) {
129
        my $type_code = $imd->elem(0);
130
        my $ccode     = $imd->elem(1);
131
        my $desc      = $imd->elem( 2, 3 );
132
        if ( $imd->elem( 2, 4 ) ) {
133
            $desc .= $imd->elem( 2, 4 );
134
        }
135
        if ( $type_code ne 'L' ) {
136
            carp
137
              "Only handles text item descriptions at present: code=$type_code";
138
            next;
139
        }
140
        if ( exists $bibrec->{$ccode} ) {
141
            $bibrec->{$ccode} .= q{ };
142
            $bibrec->{$ccode} .= $desc;
143
        }
144
        else {
145
            $bibrec->{$ccode} = $desc;
146
        }
147
    }
148
    return $bibrec;
149
}
150
151
sub marc_record {
152
    my $self = shift;
153
    my $b    = $self->{item_description};
154
155
    my $bib = MARC::Record->new();
156
157
    my @spec;
158
    my @fields;
159
    if ( exists $b->{'010'} ) {
160
        @spec = qw( 100 a 011 c 012 b 013 d 014 e );
161
        push @fields, new_field( $b, [ 100, 1, q{ } ], @spec );
162
    }
163
    if ( exists $b->{'020'} ) {
164
        @spec = qw( 020 a 021 c 022 b 023 d 024 e );
165
        push @fields, new_field( $b, [ 700, 1, q{ } ], @spec );
166
    }
167
168
    # corp conf
169
    if ( exists $b->{'030'} ) {
170
        push @fields, $self->corpcon(1);
171
    }
172
    if ( exists $b->{'040'} ) {
173
        push @fields, $self->corpcon(7);
174
    }
175
    if ( exists $b->{'050'} ) {
176
        @spec = qw( '050' a '060' b '065' c );
177
        push @fields, new_field( $b, [ 245, 1, 0 ], @spec );
178
    }
179
    if ( exists $b->{100} ) {
180
        @spec = qw( 100 a 101 b);
181
        push @fields, new_field( $b, [ 250, q{ }, q{ } ], @spec );
182
    }
183
    @spec = qw( 110 a 120 b 170 c );
184
    my $f = new_field( $b, [ 260, q{ }, q{ } ], @spec );
185
    if ($f) {
186
        push @fields, $f;
187
    }
188
    @spec = qw( 180 a 181 b 182 c 183 e);
189
    $f = new_field( $b, [ 300, q{ }, q{ } ], @spec );
190
    if ($f) {
191
        push @fields, $f;
192
    }
193
    if ( exists $b->{190} ) {
194
        @spec = qw( 190 a);
195
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
196
    }
197
198
    if ( exists $b->{200} ) {
199
        @spec = qw( 200 a);
200
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
201
    }
202
    if ( exists $b->{210} ) {
203
        @spec = qw( 210 a);
204
        push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
205
    }
206
    if ( exists $b->{300} ) {
207
        @spec = qw( 300 a);
208
        push @fields, new_field( $b, [ 500, q{ }, q{ } ], @spec );
209
    }
210
    if ( exists $b->{310} ) {
211
        @spec = qw( 310 a);
212
        push @fields, new_field( $b, [ 520, q{ }, q{ } ], @spec );
213
    }
214
    if ( exists $b->{320} ) {
215
        @spec = qw( 320 a);
216
        push @fields, new_field( $b, [ 521, q{ }, q{ } ], @spec );
217
    }
218
    if ( exists $b->{260} ) {
219
        @spec = qw( 260 a);
220
        push @fields, new_field( $b, [ 600, q{ }, q{ } ], @spec );
221
    }
222
    if ( exists $b->{270} ) {
223
        @spec = qw( 270 a);
224
        push @fields, new_field( $b, [ 650, q{ }, q{ } ], @spec );
225
    }
226
    if ( exists $b->{280} ) {
227
        @spec = qw( 280 a);
228
        push @fields, new_field( $b, [ 655, q{ }, q{ } ], @spec );
229
    }
230
231
    # class
232
    if ( exists $b->{230} ) {
233
        @spec = qw( 230 a);
234
        push @fields, new_field( $b, [ '082', q{ }, q{ } ], @spec );
235
    }
236
    if ( exists $b->{240} ) {
237
        @spec = qw( 240 a);
238
        push @fields, new_field( $b, [ '084', q{ }, q{ } ], @spec );
239
    }
240
    $bib->insert_fields_ordered(@fields);
241
242
    return $bib;
243
}
244
245
sub corpcon {
246
    my ( $self, $level ) = @_;
247
    my $test_these = {
248
        1 => [ '033', '032', '034' ],
249
        7 => [ '043', '042', '044' ],
250
    };
251
    my $conf = 0;
252
    foreach my $t ( @{ $test_these->{$level} } ) {
253
        if ( exists $self->{item_description}->{$t} ) {
254
            $conf = 1;
255
        }
256
    }
257
    my $tag;
258
    my @spec;
259
    my ( $i1, $i2 ) = ( q{ }, q{ } );
260
    if ($conf) {
261
        $tag = ( $level * 100 ) + 11;
262
        if ( $level == 1 ) {
263
            @spec = qw( 030 a 031 e 032 n 033 c 034 d);
264
        }
265
        else {
266
            @spec = qw( 040 a 041 e 042 n 043 c 044 d);
267
        }
268
    }
269
    else {
270
        $tag = ( $level * 100 ) + 10;
271
        if ( $level == 1 ) {
272
            @spec = qw( 030 a 031 b);
273
        }
274
        else {
275
            @spec = qw( 040 a 041 b);
276
        }
277
    }
278
    return new_field( $self->{item_description}, [ $tag, $i1, $i2 ], @spec );
279
}
280
281
sub new_field {
282
    my ( $b, $tag_ind, @sfd_elem ) = @_;
283
    my @sfd;
284
    while (@sfd_elem) {
285
        my $e = shift @sfd_elem;
286
        my $c = shift @sfd_elem;
287
        if ( exists $b->{$e} ) {
288
            push @sfd, $c, $b->{$e};
289
        }
290
    }
291
    if (@sfd) {
292
        my $field = MARC::Field->new( @{$tag_ind}, @sfd );
293
        return $field;
294
    }
295
    return;
296
}
297
298
# Accessor methods to line data
299
300
sub item_number_id {
301
    my $self = shift;
302
    return $self->{item_number_id};
303
}
304
305
sub line_item_number {
306
    my $self = shift;
307
    return $self->{line_item_number};
308
}
309
310
sub additional_product_ids {
311
    my $self = shift;
312
    return $self->{additional_product_ids};
313
}
314
315
sub item_description {
316
    my $self = shift;
317
    return $self->{item_description};
318
}
319
320
sub monetary_amount {
321
    my $self = shift;
322
    return $self->{monetary_amount};
323
}
324
325
sub quantity {
326
    my $self = shift;
327
    return $self->{quantity};
328
}
329
330
sub price {
331
    my $self = shift;
332
    return $self->{price};
333
}
334
335
sub reference {
336
    my $self = shift;
337
    return $self->{reference};
338
}
339
340
sub ordernumber {
341
    my $self = shift;
342
    return $self->{ordernumber};
343
}
344
345
sub free_text {
346
    my $self = shift;
347
    return $self->{free_text};
348
}
349
350
sub internal_notes {
351
    my $self = shift;
352
    return $self->{internal_notes};
353
}
354
355
# item_desription_fields accessors
356
357
sub title {
358
    my $self       = shift;
359
    my $titlefield = q{050};
360
    if ( exists $self->{item_description}->{$titlefield} ) {
361
        return $self->{item_description}->{$titlefield};
362
    }
363
    return;
364
}
365
366
sub author {
367
    my $self  = shift;
368
    my $field = q{010};
369
    if ( exists $self->{item_description}->{$field} ) {
370
        return $self->{item_description}->{$field};
371
    }
372
    return;
373
}
374
375
sub series {
376
    my $self  = shift;
377
    my $field = q{190};
378
    if ( exists $self->{item_description}->{$field} ) {
379
        return $self->{item_description}->{$field};
380
    }
381
    return;
382
}
383
384
sub publisher {
385
    my $self  = shift;
386
    my $field = q{120};
387
    if ( exists $self->{item_description}->{$field} ) {
388
        return $self->{item_description}->{$field};
389
    }
390
    return;
391
}
392
393
sub publication_date {
394
    my $self  = shift;
395
    my $field = q{170};
396
    if ( exists $self->{item_description}->{$field} ) {
397
        return $self->{item_description}->{$field};
398
    }
399
    return;
400
}
401
402
sub girfield {
403
    my ( $self, $field, $occ ) = @_;
404
405
    # defaults to occurence 0 returns undef if occ requested > occs
406
    if ( defined $occ && $occ > @{ $self->{GIR} } ) {
407
        return;
408
    }
409
    $occ ||= 0;
410
    return $self->{GIR}->[$occ]->{$field};
411
}
412
413
sub extract_gir {
414
    my $s    = shift;
415
    my %qmap = (
416
        LAC => 'barcode',
417
        LCL => 'classification',
418
        LFN => 'fund_allocation',
419
        LLN => 'loan_category',
420
        LLO => 'branch',
421
        LSM => 'shelfmark',
422
        LSQ => 'collection_code',
423
        LST => 'stock_category',
424
        LVT => 'servicing_instruction',
425
        LCO => 'item_unique_id',
426
    );
427
428
    my $set_qualifier = $s->elem( 0, 0 );    # copy number
429
    my $gir_element = { copy => $set_qualifier, };
430
    my $element = 1;
431
    while ( my $e = $s->elem($element) ) {
432
        ++$element;
433
        if ( exists $qmap{ $e->[1] } ) {
434
            my $qualifier = $qmap{ $e->[1] };
435
            $gir_element->{$qualifier} = $e->[0];
436
        }
437
        else {
438
439
            carp "Unrecognized GIR code : $e->[1] for $e->[0]";
440
        }
441
    }
442
    return $gir_element;
443
}
444
445
# mainly for invoice processing amt_ will derive from MOA price_ from PRI and tax_ from TAX/MOA pairsn
446
sub moa_amt {
447
    my ( $self, $qualifier ) = @_;
448
    foreach my $s ( @{ $self->{segs} } ) {
449
        if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) {
450
            return $s->elem( 0, 1 );
451
        }
452
    }
453
    return;
454
}
455
456
sub amt_discount {
457
    my $self = shift;
458
    return $self->moa_amt('52');
459
}
460
461
sub amt_prepayment {
462
    my $self = shift;
463
    return $self->moa_amt('113');
464
}
465
466
# total including allowances & tax
467
sub amt_total {
468
    my $self = shift;
469
    return $self->moa_amt('128');
470
}
471
472
sub amt_unitprice {
473
    my $self = shift;
474
    return $self->moa_amt('146');
475
}
476
477
# item amount after allowances excluding tax
478
sub amt_lineitem {
479
    my $self = shift;
480
    return $self->moa_amt('146');
481
}
482
483
sub pri_price {
484
    my ( $self, $price_qualifier ) = @_;
485
    foreach my $s ( @{ $self->{segs} } ) {
486
        if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) {
487
            return {
488
                price          => $s->elem( 0, 1 ),
489
                type           => $s->elem( 0, 2 ),
490
                type_qualifier => $s->elem( 0, 3 ),
491
            };
492
        }
493
    }
494
    return;
495
}
496
497
# unit price that will be chaged excl tax
498
sub price_net {
499
    my $self = shift;
500
    my $p    = $self->pri_price('AAA');
501
    if ( defined $p ) {
502
        return $p->{price};
503
    }
504
    return;
505
}
506
507
# unit price excluding all allowances, charges and taxes
508
sub price_gross {
509
    my $self = shift;
510
    my $p    = $self->pri_price('AAB');
511
    if ( defined $p ) {
512
        return $p->{price};
513
    }
514
    return;
515
}
516
517
# information price incl tax excluding allowances, charges
518
sub price_info {
519
    my $self = shift;
520
    my $p    = $self->pri_price('AAE');
521
    if ( defined $p ) {
522
        return $p->{price};
523
    }
524
    return;
525
}
526
527
# information price incl tax,allowances, charges
528
sub price_info_inclusive {
529
    my $self = shift;
530
    my $p    = $self->pri_price('AAE');
531
    if ( defined $p ) {
532
        return $p->{price};
533
    }
534
    return;
535
}
536
537
sub tax {
538
    my $self = shift;
539
    return $self->moa_amt('124');
540
}
541
542
1;
543
__END__
544
545
=head1 NAME
546
   Koha::Edifact::Line
547
548
=head1 SYNOPSIS
549
550
  Class to abstractly handle a Line in an Edifact Transmission
551
552
=head1 DESCRIPTION
553
554
  Allows access to Edifact line elements by name
555
556
=head1 BUGS
557
558
559
=head1 Methods
560
561
=head2 new
562
563
   Called with an array ref of segments constituting the line
564
565
=head1 AUTHOR
566
567
   Colin Campbell <colin.campbell@ptfs-europe.com>
568
569
570
=head1 COPYRIGHT
571
572
   Copyright 2014, PTFS-Europe Ltd
573
   This program is free software, You may redistribute it under
574
   under the terms of the GNU General Public License
575
576
577
=cut
(-)a/Koha/Edifact/Message.pm (+255 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
23
use Koha::Edifact::Line;
24
25
sub new {
26
    my ( $class, $data_array_ref ) = @_;
27
    my $header       = shift @{$data_array_ref};
28
    my $bgm          = shift @{$data_array_ref};
29
    my $msg_function = $bgm->elem(2);
30
    my $dtm          = [];
31
    while ( $data_array_ref->[0]->tag eq 'DTM' ) {
32
        push @{$dtm}, shift @{$data_array_ref};
33
    }
34
35
    my $self = {
36
        function                 => $msg_function,
37
        header                   => $header,
38
        bgm                      => $bgm,
39
        message_reference_number => $header->elem(0),
40
        dtm                      => $dtm,
41
        datasegs                 => $data_array_ref,
42
    };
43
44
    bless $self, $class;
45
    return $self;
46
}
47
48
sub message_refno {
49
    my $self = shift;
50
    return $self->{message_reference_number};
51
}
52
53
sub function {
54
    my $self         = shift;
55
    my $msg_function = $self->{bgm}->elem(2);
56
    if ( $msg_function == 9 ) {
57
        return 'original';
58
    }
59
    elsif ( $msg_function == 7 ) {
60
        return 'retransmission';
61
    }
62
    return;
63
}
64
65
sub message_reference_number {
66
    my $self = shift;
67
    return $self->{header}->elem(0);
68
}
69
70
sub message_type {
71
    my $self = shift;
72
    return $self->{header}->elem( 1, 0 );
73
}
74
75
sub message_code {
76
    my $self = shift;
77
    return $self->{bgm}->elem( 0, 0 );
78
}
79
80
sub docmsg_number {
81
    my $self = shift;
82
    return $self->{bgm}->elem(1);
83
}
84
85
sub message_date {
86
    my $self = shift;
87
88
    # usually the first if not only dtm
89
    foreach my $d ( @{ $self->{dtm} } ) {
90
        if ( $d->elem( 0, 0 ) eq '137' ) {
91
            return $d->elem( 0, 1 );
92
        }
93
    }
94
    return;    # this should not happen
95
}
96
97
sub tax_point_date {
98
    my $self = shift;
99
    if ( $self->message_type eq 'INVOIC' ) {
100
        foreach my $d ( @{ $self->{dtm} } ) {
101
            if ( $d->elem( 0, 0 ) eq '131' ) {
102
                return $d->elem( 0, 1 );
103
            }
104
        }
105
    }
106
    return;
107
}
108
109
sub expiry_date {
110
    my $self = shift;
111
    if ( $self->message_type eq 'QUOTES' ) {
112
        foreach my $d ( @{ $self->{dtm} } ) {
113
            if ( $d->elem( 0, 0 ) eq '36' ) {
114
                return $d->elem( 0, 1 );
115
            }
116
        }
117
    }
118
    return;
119
}
120
121
sub shipment_charge {
122
    my $self = shift;
123
124
    # A large number of different charges can be expressed at invoice and
125
    # item level but the only one koha takes cognizance of is shipment
126
    # should we wrap all invoice level charges into it??
127
    if ( $self->message_type eq 'INVOIC' ) {
128
        my $delivery = 0;
129
        my $amt      = 0;
130
        foreach my $s ( @{ $self->{datasegs} } ) {
131
            if ( $s->tag eq 'LIN' ) {
132
                last;
133
            }
134
            if ( $s->tag eq 'ALC' ) {
135
                if ( $s->elem(0) eq 'C' ) {    # Its a charge
136
                    if ( $s->elem( 4, 0 ) eq 'DL' ) {    # delivery charge
137
                        $delivery = 1;
138
                    }
139
                }
140
                next;
141
            }
142
            if ( $s->tag eq 'MOA' ) {
143
                $amt += $s->elem( 0, 1 );
144
            }
145
        }
146
        return $amt;
147
    }
148
    return;
149
}
150
151
# return NAD fields
152
153
sub buyer_ean {
154
    my $self = shift;
155
    foreach my $s ( @{ $self->{datasegs} } ) {
156
        if ( $s->tag eq 'LIN' ) {
157
            last;
158
        }
159
        if ( $s->tag eq 'NAD' ) {
160
            my $qualifier = $s->elem(0);
161
            if ( $qualifier eq 'BY' ) {
162
                return $s->elem( 1, 0 );
163
            }
164
        }
165
    }
166
    return;
167
}
168
169
sub supplier_ean {
170
    my $self = shift;
171
    foreach my $s ( @{ $self->{datasegs} } ) {
172
        if ( $s->tag eq 'LIN' ) {
173
            last;
174
        }
175
        if ( $s->tag eq 'NAD' ) {
176
            my $qualifier = $s->elem(0);
177
            if ( $qualifier eq 'SU' ) {
178
                return $s->elem( 1, 0 );
179
            }
180
        }
181
    }
182
    return;
183
184
}
185
186
sub lineitems {
187
    my $self = shift;
188
    if ( $self->{quotation_lines} ) {
189
        return $self->{quotation_lines};
190
    }
191
    else {
192
        my $items    = [];
193
        my $item_arr = [];
194
        foreach my $seg ( @{ $self->{datasegs} } ) {
195
            my $tag = $seg->tag;
196
            if ( $tag eq 'LIN' ) {
197
                if ( @{$item_arr} ) {
198
                    push @{$items}, Koha::Edifact::Line->new($item_arr);
199
                }
200
                $item_arr = [$seg];
201
                next;
202
            }
203
            elsif ( $tag =~ m/^(UNS|CNT|UNT)$/sxm ) {
204
                if ( @{$item_arr} ) {
205
                    push @{$items}, Koha::Edifact::Line->new($item_arr);
206
                }
207
                last;
208
            }
209
            else {
210
                if ( @{$item_arr} ) {
211
                    push @{$item_arr}, $seg;
212
                }
213
            }
214
        }
215
        $self->{quotation_lines} = $items;
216
        return $items;
217
    }
218
}
219
220
1;
221
__END__
222
223
=head1 NAME
224
   Koha::Edifact::Message
225
226
=head1 SYNOPSIS
227
228
229
=head1 DESCRIPTION
230
231
Class modelling an Edifact Message for parsing
232
233
=head1 BUGS
234
235
236
=head1 METHODS
237
238
=head2 new
239
240
   Passed an array of segments extracts message level info
241
   and parses lineitems as Line objects
242
243
=head1 AUTHOR
244
245
   Colin Campbell <colin.campbell@ptfs-europe.com>
246
247
248
=head1 COPYRIGHT
249
250
   Copyright 2014, PTFS-Europe Ltd
251
   This program is free software, You may redistribute it under
252
   under the terms of the GNU General Public License
253
254
255
=cut
(-)a/Koha/Edifact/Order.pm (+832 lines)
Line 0 Link Here
1
package Koha::Edifact::Order;
2
3
use strict;
4
use warnings;
5
6
# Copyright 2014 PTFS-Europe Ltd
7
#
8
# This file is part of Koha.
9
#
10
# Koha is free software; you can redistribute it and/or modify it
11
# under the terms of the GNU General Public License as published by
12
# the Free Software Foundation; either version 3 of the License, or
13
# (at your option) any later version.
14
#
15
# Koha is distributed in the hope that it will be useful, but
16
# WITHOUT ANY WARRANTY; without even the implied warranty of
17
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18
# GNU General Public License for more details.
19
#
20
# You should have received a copy of the GNU General Public License
21
# along with Koha; if not, see <http://www.gnu.org/licenses>.
22
23
use Carp;
24
use DateTime;
25
use Readonly;
26
use Business::ISBN;
27
use Encode qw(from_to);
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
    my $biblionumber = $orderline->biblionumber->biblionumber;
328
    my @biblioitems  = $schema->resultset('Biblioitem')
329
      ->search( { biblionumber => $biblionumber, } );
330
    my $biblioitem = $biblioitems[0];    # makes the assumption there is 1 only
331
                                         # or else all have same details
332
333
    # LIN line-number in msg :: if we had a 13 digit ean we could add
334
    $self->add_seg( lin_segment( $linenumber, $biblioitem->isbn ) );
335
336
    # PIA isbn or other id
337
    $self->add_seg( additional_product_id( $biblioitem->isbn ) );
338
339
    # IMD biblio description
340
    if ($use_marc_based_description) {
341
342
        # get marc from biblioitem->marc
343
344
        # $ol .= marc_item_description($orderline->{bib_description});
345
    }
346
    else {    # use brief description
347
        $self->add_seg(
348
            item_description( $orderline->biblionumber, $biblioitem ) );
349
    }
350
351
    # QTY order quantity
352
    my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator;
353
    $self->add_seg($qty);
354
355
    # DTM Optional date constraints on delivery
356
    #     we dont currently support this in koha
357
    # GIR copy-related data
358
    my @items;
359
    if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
360
        my @linked_itemnumbers = $orderline->aqorders_items;
361
362
        foreach my $item (@linked_itemnumbers) {
363
            my $i_obj = $schema->resultset('Item')->find( $item->itemnumber );
364
            if ( defined $i_obj ) {
365
                push @items, $i_obj;
366
            }
367
        }
368
    }
369
    else {
370
        my $item_hash = {
371
            itemtype  => $biblioitem->itemtype,
372
            shelfmark => $biblioitem->cn_class,
373
        };
374
        my $branch = $orderline->basketno->branch->branchcode;
375
        if ($branch) {
376
            $item_hash->{branch} = $branch;
377
        }
378
        for ( 1 .. $orderline->quantity ) {
379
            push @items, $item_hash;
380
        }
381
    }
382
    my $budget = GetBudget( $orderline->budget_id );
383
    my $ol_fields = { budget_code => $budget->{budget_code}, };
384
    if ( $orderline->order_vendornote ) {
385
        $ol_fields->{servicing_instruction} = $orderline->order_vendornote;
386
    }
387
    $self->add_seg( gir_segments( $ol_fields, @items ) );
388
389
    # TBD what if #items exceeds quantity
390
391
    # FTX free text for current orderline TBD
392
    #    dont really have a special instructions field to encode here
393
    # Encode notes here
394
    # PRI-CUX-DTM unit price on which order is placed : optional
395
    # Coutts read this as 0.00 if not present
396
    if ( $orderline->listprice ) {
397
        my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice;
398
        $price .= $seg_terminator;
399
        $self->add_seg($price);
400
    }
401
402
    # RFF unique orderline reference no
403
    my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator;
404
    $self->add_seg($rff);
405
406
    # LOC-QTY multiple delivery locations
407
    #TBD to specify extra delivery locs
408
    # NAD order line name and address
409
    #TBD Optionally indicate a name & address or order originator
410
    # TDT method of delivey ol-specific
411
    # TBD requests a special delivery option
412
413
    return;
414
}
415
416
# ??? Use the IMD MARC
417
sub marc_based_description {
418
419
    # this includes a much larger number of fields
420
    return;
421
}
422
423
sub item_description {
424
    my ( $bib, $biblioitem ) = @_;
425
    my $bib_desc = {
426
        author    => $bib->author,
427
        title     => $bib->title,
428
        publisher => $biblioitem->publishercode,
429
        year      => $biblioitem->publicationyear,
430
    };
431
432
    my @itm = ();
433
434
    # 009 Author
435
    # 050 Title   :: title
436
    # 080 Vol/Part no
437
    # 100 Edition statement
438
    # 109 Publisher  :: publisher
439
    # 110 place of pub
440
    # 170 Date of publication :: year
441
    # 220 Binding  :: binding
442
    my %code = (
443
        author    => '009',
444
        title     => '050',
445
        publisher => '109',
446
        year      => '170',
447
        binding   => '220',
448
    );
449
    for my $field (qw(author title publisher year binding )) {
450
        if ( $bib_desc->{$field} ) {
451
            my $data = encode_text( $bib_desc->{$field} );
452
            push @itm, imd_segment( $code{$field}, $data );
453
        }
454
    }
455
456
    return @itm;
457
}
458
459
sub imd_segment {
460
    my ( $code, $data ) = @_;
461
462
    my $seg_prefix = "IMD+L+$code+:::";
463
464
    # chunk_line
465
    my @chunks;
466
    while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) {
467
        if ( length $x == $CHUNKSIZE ) {
468
            if ( $x =~ s/([?]{1,2})$// ) {
469
                $data = "$1$data";    # dont breakup ?' ?? etc
470
            }
471
        }
472
        push @chunks, $x;
473
    }
474
    my @segs;
475
    my $odd = 1;
476
    foreach my $c (@chunks) {
477
        if ($odd) {
478
            push @segs, "$seg_prefix$c";
479
        }
480
        else {
481
            $segs[-1] .= ":$c$seg_terminator";
482
        }
483
        $odd = !$odd;
484
    }
485
    if ( @segs && $segs[-1] !~ m/$seg_terminator$/o ) {
486
        $segs[-1] .= $seg_terminator;
487
    }
488
    return @segs;
489
}
490
491
sub gir_segments {
492
    my ( $orderfields, @onorderitems ) = @_;
493
494
    my $budget_code = $orderfields->{budget_code};
495
    my @segments;
496
    my $sequence_no = 1;
497
    foreach my $item (@onorderitems) {
498
        my $seg = sprintf 'GIR+%03d', $sequence_no;
499
        $seg .= add_gir_identity_number( 'LFN', $budget_code );
500
        if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
501
            $seg .=
502
              add_gir_identity_number( 'LLO', $item->homebranch->branchcode );
503
            $seg .= add_gir_identity_number( 'LST', $item->itype );
504
            $seg .= add_gir_identity_number( 'LSQ', $item->location );
505
            $seg .= add_gir_identity_number( 'LSM', $item->itemcallnumber );
506
507
            # itemcallnumber -> shelfmark
508
        }
509
        else {
510
            if ( $item->{branch} ) {
511
                $seg .= add_gir_identity_number( 'LLO', $item->{branch} );
512
            }
513
            $seg .= add_gir_identity_number( 'LST', $item->{itemtype} );
514
            $seg .= add_gir_identity_number( 'LSM', $item->{shelfmark} );
515
        }
516
        if ( $orderfields->{servicing_instruction} ) {
517
            $seg .= add_gir_identity_number( 'LVT',
518
                $orderfields->{servicing_instruction} );
519
        }
520
        $sequence_no++;
521
        push @segments, $seg;
522
    }
523
    return @segments;
524
}
525
526
sub add_gir_identity_number {
527
    my ( $number_qualifier, $number ) = @_;
528
    if ($number) {
529
        return "+${number}:${number_qualifier}";
530
    }
531
    return q{};
532
}
533
534
sub add_seg {
535
    my ( $self, @s ) = @_;
536
    foreach my $segment (@s) {
537
        if ( $segment !~ m/$seg_terminator$/o ) {
538
            $segment .= $seg_terminator;
539
        }
540
    }
541
    push @{ $self->{segs} }, @s;
542
    return;
543
}
544
545
sub lin_segment {
546
    my ( $line_number, $isbn ) = @_;
547
    my $isbn_string = q||;
548
    if ($isbn) {
549
        if ( $isbn =~ m/(978\d{10})/ ) {
550
            $isbn = $1;
551
        }
552
        elsif ( $isbn =~ m/(\d{9}[\dxX])/ ) {
553
            $isbn = $1;
554
        }
555
        else {
556
            undef $isbn;
557
        }
558
        if ($isbn) {
559
            my $b_isbn = Business::ISBN->new($isbn);
560
            if ( $b_isbn->is_valid ) {
561
                $isbn        = $b_isbn->as_isbn13->isbn;
562
                $isbn_string = "++$isbn:EN";
563
            }
564
        }
565
    }
566
    return "LIN+$line_number$isbn_string$seg_terminator";
567
}
568
569
sub additional_product_id {
570
    my $isbn_field = shift;
571
    my ( $product_id, $product_code );
572
    if ( $isbn_field =~ m/(\d{13})/ ) {
573
        $product_id   = $1;
574
        $product_code = 'EN';
575
    }
576
    elsif ( $isbn_field =~ m/(\d{9})[Xx\d]/ ) {
577
        $product_id   = $1;
578
        $product_code = 'IB';
579
    }
580
581
    # TBD we could have a manufacturers no issn etc
582
    if ( !$product_id ) {
583
        return;
584
    }
585
586
    # function id set to 5 states this is the main product id
587
    return "PIA+5+$product_id:$product_code$seg_terminator";
588
}
589
590
sub message_date_segment {
591
    my $dt = shift;
592
593
    # qualifier:message_date:format_code
594
595
    my $message_date = $dt->ymd(q{});    # no sep in edifact format
596
597
    return "DTM+137:$message_date:102$seg_terminator";
598
}
599
600
sub _const {
601
    my $key = shift;
602
    Readonly my %S => {
603
        service_string_advice => q{UNA:+.? '},
604
        message_identifier    => q{+ORDERS:D:96A:UN:EAN008'},
605
    };
606
    return ( $S{$key} ) ? $S{$key} : q{};
607
}
608
609
sub _interchange_sr_identifier {
610
    my ( $identification, $qualifier ) = @_;
611
612
    if ( !$identification ) {
613
        $identification = 'RANDOM';
614
        $qualifier      = '92';
615
        carp 'undefined identifier';
616
    }
617
618
    # 14   EAN International
619
    # 31B   US SAN (preferred)
620
    # also 91 assigned by supplier
621
    # also 92 assigned by buyer
622
    if ( $qualifier !~ m/^(?:14|31B|91|92)/xms ) {
623
        $qualifier = '92';
624
    }
625
626
    return "+$identification:$qualifier";
627
}
628
629
sub encode_text {
630
    my $string = shift;
631
    if ($string) {
632
        from_to( $string, 'utf8', 'iso-8859-1' );
633
        $string =~ s/[?]/??/g;
634
        $string =~ s/'/?'/g;
635
        $string =~ s/:/?:/g;
636
        $string =~ s/[+]/?+/g;
637
    }
638
    return $string;
639
}
640
641
1;
642
__END__
643
644
=head1 NAME
645
   Koha::Edifact::Order
646
647
=head1 SYNOPSIS
648
649
Format an Edifact Order message from a Koha basket
650
651
=head1 DESCRIPTION
652
653
654
Generates an Edifact format Order message for a Koha basket.
655
Normally the only methods used directly by the caller would be
656
new to set up the message, encode to return the formatted message
657
and filename to obtain a name under which to store the message
658
659
660
=head1 BUGS
661
662
Should integrate into Koha::Edifact namespace
663
Can caller interface be made cleaner?
664
Make handling of GIR segments more customizable
665
666
667
=head1 METHODS
668
669
=head2 new
670
671
  my $edi_order = Edifact::Order->new(
672
  orderlines => \@orderlines,
673
  vendor     => $vendor_edi_account,
674
  ean        => $library_ean
675
  );
676
677
  instantiate the Edifact::Order object, all parameters are Schema::Resultset objects
678
  Called in Koha::Edifact create_edi_order
679
680
=head2 filename
681
682
   my $filename = $edi_order->filename()
683
684
   returns a filename for the edi order. The filename embeds a reference to the
685
   basket the message was created to encode
686
687
=head2 encode
688
689
   my $edifact_message = $edi_order->encode();
690
691
   Encodes the basket as a valid edifact message ready for transmission
692
693
=head2 initial_service_segments
694
695
    Creates the service segments which begin the message
696
697
=head2 interchange_header
698
699
    Return an interchange header encoding sender and recipient
700
    ids message date and standards
701
702
=head2 user_data_message_segments
703
704
    Include message data within the encoded message
705
706
=head2 message_trailer
707
708
    Terminate message data including control data on number
709
    of messages and segments included
710
711
=head2 trailing_service_segments
712
713
   Include the service segments occuring at the end of the message
714
=head2 interchange_control_reference
715
716
   Returns the unique interchange control reference as a 14 digit number
717
718
=head2 message_reference
719
720
    On generates and subsequently returns the unique message
721
    reference number as a 12 digit number preceded by ME, to generate a new number
722
    pass the string 'new'.
723
    In practice we encode 1 message per transmission so there is only one message
724
    referenced. were we to encode multiple messages a new reference would be
725
    neaded for each
726
727
=head2 message_header
728
729
    Commences a new message
730
731
=head2 interchange_trailer
732
733
    returns the UNZ segment which ends the tranmission encoding the
734
    message count and control reference for the interchange
735
736
=head2 order_msg_header
737
738
    Formats the message header segments
739
740
=head2 beginning_of_message
741
742
    Returns the BGM segment which includes the Koha basket number
743
744
=head2 name_and_address
745
746
    Parameters: Function ( BUYER, DELIVERY, INVOICE, SUPPLIER)
747
                Id
748
                Agency
749
750
    Returns a NAD segment containg the id and agency for for the Function
751
    value. Handles the fact that NAD segments encode the value for 'EAN' differently
752
    to elsewhere.
753
754
=head2 order_line
755
756
    Creates the message segments wncoding an order line
757
758
=head2 marc_based_description
759
760
    Not yet implemented - To encode the the bibliographic info
761
    as MARC based IMD fields has the potential of encoding a wider range of info
762
763
=head2 item_description
764
765
    Encodes the biblio item fields Author, title, publisher, date of publication
766
    binding
767
768
=head2 imd_segment
769
770
    Formats an IMD segment, handles the chunking of data into the 35 character
771
    lengths required and the creation of repeat segments
772
773
=head2 gir_segments
774
775
    Add item level information
776
777
=head2 add_gir_identity_number
778
779
    Handle the formatting of a GIR element
780
    return empty string if no data
781
782
=head2 add_seg
783
784
    Adds a parssed array of segments to the objects segment list
785
    ensures all segments are properly terminated by '
786
787
=head2 lin_segment
788
789
    Adds a LIN segment consisting of the line number and the ean number
790
    if the passed isbn is valid
791
792
=head2 additional_product_id
793
794
    Add a PIA segment for an additional product id
795
796
=head2 message_date_segment
797
798
    Passed a DateTime object returns a correctly formatted DTM segment
799
800
=head2 _const
801
802
    Stores and returns constant strings for service_string_advice
803
    and message_identifier
804
    TBD replace with class variables
805
806
=head2 _interchange_sr_identifier
807
808
    Format sender and receipient identifiers for use in the interchange header
809
810
=head2 encode_text
811
812
    Encode textual data into the standard character set ( iso 8859-1 )
813
    and quote any Edifact metacharacters
814
815
=head2 msg_date_string
816
817
    Convenient routine which returns message date as a Y-m-d string
818
    useful if the caller wants to log date of creation
819
820
=head1 AUTHOR
821
822
   Colin Campbell <colin.campbell@ptfs-europe.com>
823
824
825
=head1 COPYRIGHT
826
827
   Copyright 2014, PTFS-Europe Ltd
828
   This program is free software, You may redistribute it under
829
   under the terms of the GNU General Public License
830
831
832
=cut
(-)a/Koha/Edifact/Segment.pm (+210 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
23
sub new {
24
    my ( $class, $parm_ref ) = @_;
25
    my $self = {};
26
    if ( $parm_ref->{seg_string} ) {
27
        $self = _parse_seg( $parm_ref->{seg_string} );
28
    }
29
30
    bless $self, $class;
31
    return $self;
32
}
33
34
sub tag {
35
    my $self = shift;
36
    return $self->{tag};
37
}
38
39
# return specified element may be data or an array ref if components
40
sub elem {
41
    my ( $self, $element_number, $component_number ) = @_;
42
    if ( $element_number < @{ $self->{elem_arr} } ) {
43
44
        my $e = $self->{elem_arr}->[$element_number];
45
        if ( defined $component_number ) {
46
            if ( ref $e eq 'ARRAY' ) {
47
                if ( $component_number < @{$e} ) {
48
                    return $e->[$component_number];
49
                }
50
            }
51
            elsif ( $component_number == 0 ) {
52
53
                # a string could be an element with a single component
54
                return $e;
55
            }
56
            return;
57
        }
58
        else {
59
            return $e;
60
        }
61
    }
62
    return;    #element undefined ( out of range
63
}
64
65
sub element {
66
    my ( $self, @params ) = @_;
67
68
    return $self->elem(@params);
69
}
70
71
sub as_string {
72
    my $self = shift;
73
74
    my $string = $self->{tag};
75
    foreach my $e ( @{ $self->{elem_arr} } ) {
76
        $string .= q|+|;
77
        if ( ref $e eq 'ARRAY' ) {
78
            $string .= join q{:}, @{$e};
79
        }
80
        else {
81
            $string .= $e;
82
        }
83
    }
84
85
    return $string;
86
}
87
88
# parse a string into fields
89
sub _parse_seg {
90
    my $s = shift;
91
    my $e = {
92
93
        #        raw => $s,
94
        tag      => substr( $s,                0, 3 ),
95
        elem_arr => _get_elements( substr( $s, 3 ) ),
96
    };
97
    return $e;
98
}
99
100
##
101
# String parsing
102
#
103
104
sub _get_elements {
105
    my $seg = shift;
106
107
    $seg =~ s/^[+]//;    # dont start with a dummy element`
108
    my @elem_array = map { _components($_) } split /(?<![?])[+]/, $seg;
109
110
    return \@elem_array;
111
}
112
113
sub _components {
114
    my $element = shift;
115
    my @c = split /(?<![?])[:]/, $element;
116
    if ( @c == 1 ) {     # single element return a string
117
        return de_escape( $c[0] );
118
    }
119
    @c = map { de_escape($_) } @c;
120
    return \@c;
121
}
122
123
sub de_escape {
124
    my $string = shift;
125
126
    # remove escaped characters from the component string
127
    $string =~ s/[?]([:?+'])/$1/g;
128
    return $string;
129
}
130
1;
131
__END__
132
133
=head1 NAME
134
   Koha::Edifact::Segment
135
136
=head1 SYNOPSIS
137
138
139
=head1 DESCRIPTION
140
141
 Used by Koha::Edifact to represent segments in a parsed Edifact message
142
143
144
=head1 BUGS
145
146
147
=head1 METHODS
148
149
=head2 new
150
151
     my $s = Koha::Edifact::Segment->new( { seg_string => $raw });
152
153
     passed a string representation of the segment,  parses it
154
     and retums a Segment object
155
156
=head2 tag
157
158
     returns the three character segment tag
159
160
=head2 elem
161
162
      $data = $s->elem($element_number, $component_number)
163
      return the contents of a specified element and if specified
164
      component of that element
165
166
=head2 element
167
168
      syntactic sugar this wraps the rlem method in a fuller name
169
170
=head2 as_string
171
172
      returns a string representation of the segment
173
174
=head2 _parse_seg
175
176
   passed a string representation of a segment returns a hash ref with
177
   separate tag and data elements
178
179
=head2 _get_elements
180
181
   passed the data portion of a segment, splits it into elements, passing each to
182
   components to further parse them. Returns a reference to an array of
183
   elements
184
185
=head2 _components
186
187
   Passed a string element splits it into components  and returns a reference
188
   to an array of components, if only one component is present that is returned
189
   directly.
190
   quote characters are removed from the components
191
192
=head2 de_escape
193
194
   Removes Edifact escapes from the passed string and returns the modified
195
   string
196
197
198
=head1 AUTHOR
199
200
   Colin Campbell <colin.campbell@ptfs-europe.com>
201
202
203
=head1 COPYRIGHT
204
205
   Copyright 2014, PTFS-Europe Ltd
206
   This program is free software, You may redistribute it under
207
   under the terms of the GNU General Public License
208
209
210
=cut
(-)a/Koha/Edifact/Transport.pm (+470 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 DateTime;
23
use Carp;
24
use English qw{ -no_match_vars };
25
use Net::FTP;
26
use Net::SFTP::Foreign;
27
use File::Slurp;
28
use File::Copy;
29
use File::Basename qw( fileparse );
30
use File::Spec;
31
use Koha::Database;
32
use Encode qw( from_to );
33
34
sub new {
35
    my ( $class, $account_id ) = @_;
36
    my $database = Koha::Database->new();
37
    my $schema   = $database->schema();
38
    my $acct     = $schema->resultset('VendorEdiAccount')->find($account_id);
39
    my $self     = {
40
        account     => $acct,
41
        schema      => $schema,
42
        working_dir => File::Spec->tmpdir(),    #temporary work directory
43
        transfer_date => DateTime->now( time_zone => 'local' ),
44
    };
45
46
    bless $self, $class;
47
    return $self;
48
}
49
50
sub working_directory {
51
    my ( $self, $new_value ) = @_;
52
    if ($new_value) {
53
        $self->{working_directory} = $new_value;
54
    }
55
    return $self->{working_directory};
56
}
57
58
sub download_messages {
59
    my ( $self, $message_type ) = @_;
60
    $self->{message_type} = $message_type;
61
62
    my @retrieved_files;
63
64
    if ( $self->{account}->transport eq 'SFTP' ) {
65
        @retrieved_files = $self->sftp_download();
66
    }
67
    elsif ( $self->{account}->transport eq 'FILE' ) {
68
        @retrieved_files = $self->file_download();
69
    }
70
    else {    # assume FTP
71
        @retrieved_files = $self->ftp_download();
72
    }
73
    return @retrieved_files;
74
}
75
76
sub upload_messages {
77
    my ( $self, @messages ) = @_;
78
    if (@messages) {
79
        if ( $self->{account}->transport eq 'SFTP' ) {
80
            $self->sftp_upload(@messages);
81
        }
82
        elsif ( $self->{account}->transport eq 'FILE' ) {
83
            $self->file_upload(@messages);
84
        }
85
        else {    # assume FTP
86
            $self->ftp_upload(@messages);
87
        }
88
    }
89
    return;
90
}
91
92
sub file_download {
93
    my $self = shift;
94
    my @downloaded_files;
95
96
    my $file_ext = _get_file_ext( $self->{message_type} );
97
98
    my $dir = $self->{account}->download_directory;   # makes code more readable
99
         # C = ready to retrieve E = Edifact
100
    my $msg_hash = $self->message_hash();
101
    if ( opendir my $dh, $dir ) {
102
        my @file_list = readdir $dh;
103
        closedir $dh;
104
        foreach my $filename (@file_list) {
105
106
            if ( $filename =~ m/[.]$file_ext$/ ) {
107
                if ( copy( "$dir/$filename", $self->{working_dir} ) ) {
108
                }
109
                else {
110
                    carp "copy of $filename failed";
111
                    next;
112
                }
113
                push @downloaded_files, $filename;
114
                my $processed_name = $filename;
115
                substr $processed_name, -3, 1, 'E';
116
                move( "$dir/$filename", "$dir/$processed_name" );
117
            }
118
        }
119
        $self->ingest( $msg_hash, @downloaded_files );
120
    }
121
    else {
122
        carp "Cannot open $dir";
123
        return;
124
    }
125
    return @downloaded_files;
126
}
127
128
sub sftp_download {
129
    my $self = shift;
130
131
    my $file_ext = _get_file_ext( $self->{message_type} );
132
133
    # C = ready to retrieve E = Edifact
134
    my $msg_hash = $self->message_hash();
135
    my @downloaded_files;
136
    my $sftp = Net::SFTP::Foreign->new(
137
        $self->{account}->host,
138
        {
139
            user     => $self->{account}->user,
140
            password => $self->{account}->password,
141
            timeout  => 10,
142
        }
143
    );
144
    if ( $sftp->error ) {
145
        return $self->_abort_download( undef,
146
            'Unable to connect to remote host: ' . $sftp->error );
147
    }
148
    $sftp->setcwd( $self->{account}->download_directory )
149
      or return $self->_abort_download( $sftp,
150
        "Cannot change remote dir : $sftp->error" );
151
    my $file_list = $sftp->ls()
152
      or return $self->_abort_download( $sftp,
153
        "cannot get file list from server: $sftp->error" );
154
    foreach my $filename ( @{$file_list} ) {
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
            $sftp->rename( $filename, $processed_name );
167
        }
168
    }
169
    $sftp->disconnect;
170
    $self->ingest( $msg_hash, @downloaded_files );
171
172
    return @downloaded_files;
173
}
174
175
sub ingest {
176
    my ( $self, $msg_hash, @downloaded_files ) = @_;
177
    foreach my $f (@downloaded_files) {
178
        $msg_hash->{filename} = $f;
179
        my $file_content =
180
          read_file( "$self->{working_dir}/$f", binmode => ':raw' );
181
        if ( !defined $file_content ) {
182
            carp "Unable to read download file $f";
183
            next;
184
        }
185
        from_to( $file_content, 'iso-8859-1', 'utf8' );
186
        $msg_hash->{raw_msg} = $file_content;
187
        $self->{schema}->resultset('EdifactMessage')->create($msg_hash);
188
    }
189
    return;
190
}
191
192
sub ftp_download {
193
    my $self = shift;
194
195
    my $file_ext = _get_file_ext( $self->{message_type} );
196
197
    # C = ready to retrieve E = Edifact
198
199
    my $msg_hash = $self->message_hash();
200
    my @downloaded_files;
201
    my $ftp = Net::FTP->new(
202
        $self->{account}->host,
203
        Timeout => 10,
204
        Passive => 1
205
      )
206
      or return $self->_abort_download( undef,
207
        "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
208
    $ftp->login( $self->{account}->username, $self->{account}->password )
209
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
210
    $ftp->cwd( $self->{account}->download_directory )
211
      or return $self->_abort_download( $ftp,
212
        "Cannot change remote dir : $ftp->message()" );
213
    my $file_list = $ftp->ls()
214
      or
215
      return $self->_abort_download( $ftp, 'cannot get file list from server' );
216
217
    foreach my $filename ( @{$file_list} ) {
218
219
        if ( $filename =~ m/[.]$file_ext$/ ) {
220
221
            if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) {
222
                $self->_abort_download( $ftp,
223
                    "Error retrieving $filename: $ftp->message" );
224
                last;
225
            }
226
227
            push @downloaded_files, $filename;
228
            my $processed_name = $filename;
229
            substr $processed_name, -3, 1, 'E';
230
            $ftp->rename( $filename, $processed_name );
231
        }
232
    }
233
    $ftp->quit;
234
235
    $self->ingest( $msg_hash, @downloaded_files );
236
237
    return @downloaded_files;
238
}
239
240
sub ftp_upload {
241
    my ( $self, @messages ) = @_;
242
    my $ftp = Net::FTP->new(
243
        $self->{account}->host,
244
        Timeout => 10,
245
        Passive => 1
246
      )
247
      or return $self->_abort_download( undef,
248
        "Cannot connect to $self->{account}->host: $EVAL_ERROR" );
249
    $ftp->login( $self->{account}->username, $self->{account}->password )
250
      or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" );
251
    $ftp->cwd( $self->{account}->upload_directory )
252
      or return $self->_abort_download( $ftp,
253
        "Cannot change remote dir : $ftp->message()" );
254
    foreach my $m (@messages) {
255
        my $content = $m->raw_msg;
256
        if ($content) {
257
            open my $fh, '<', \$content;
258
            if ( $ftp->put( $fh, $m->filename ) ) {
259
                close $fh;
260
                $m->transfer_date( $self->{transfer_date} );
261
                $m->status('sent');
262
                $m->update;
263
            }
264
            else {
265
                # error in transfer
266
267
            }
268
        }
269
    }
270
271
    $ftp->quit;
272
    return;
273
}
274
275
sub sftp_upload {
276
    my ( $self, @messages ) = @_;
277
    my $sftp = Net::SFTP::Foreign->new(
278
        $self->{account}->host,
279
        {
280
            user     => $self->{account}->user,
281
            password => $self->{account}->password,
282
            timeout  => 10,
283
        }
284
    );
285
    $sftp->die_on_error("Cannot ssh to $self->{account}->host");
286
    $sftp->cwd( $self->{account}->upload_directory );
287
    $sftp->die_on_error('Cannot change to remote dir');
288
    foreach my $m (@messages) {
289
        my $content = $m->raw_msg;
290
        if ($content) {
291
            open my $fh, '<', \$content;
292
            if ( $sftp->put( $fh, $m->filename ) ) {
293
                close $fh;
294
                $m->transfer_date( $self->{transfer_date} );
295
                $m->status('sent');
296
                $m->update;
297
            }
298
            else {
299
                # error in transfer
300
301
            }
302
        }
303
    }
304
305
    # sftp will be closed on object destructor
306
    return;
307
}
308
309
sub file_upload {
310
    my ( $self, @messages ) = @_;
311
    my $dir = $self->{account}->upload_directory;
312
    if ( -d $dir ) {
313
        foreach my $m (@messages) {
314
            my $content = $m->raw_msg;
315
            if ($content) {
316
                my $filename     = $m->filename;
317
                my $new_filename = "$dir/$filename";
318
                if ( open my $fh, '>', $new_filename ) {
319
                    print {$fh} $content;
320
                    close $fh;
321
                    $m->transfer_date( $self->{transfer_date} );
322
                    $m->status('sent');
323
                    $m->update;
324
                }
325
                else {
326
                    carp "Could not transfer $m->filename : $ERRNO";
327
                    next;
328
                }
329
            }
330
        }
331
    }
332
    else {
333
        carp "Upload directory $dir does not exist";
334
    }
335
    return;
336
}
337
338
sub _abort_download {
339
    my ( $self, $handle, $log_message ) = @_;
340
341
    my $a = $self->{account}->description;
342
343
    $handle->abort();
344
    $log_message .= ": $a";
345
    carp $log_message;
346
347
    #returns undef i.e. an empty array
348
    return;
349
}
350
351
sub _get_file_ext {
352
    my $type = shift;
353
354
    # Extension format
355
    # 1st char Status C = Ready For pickup A = Completed E = Extracted
356
    # 2nd Char Standard E = Edifact
357
    # 3rd Char Type of message
358
    my %file_types = (
359
        QUOTE   => 'CEQ',
360
        INVOICE => 'CEI',
361
        ALL     => 'CE.',
362
    );
363
    if ( exists $file_types{$type} ) {
364
        return $file_types{$type};
365
    }
366
    return 'XXXX';    # non matching type
367
}
368
369
sub message_hash {
370
    my $self = shift;
371
    my $msg  = {
372
        message_type  => $self->{message_type},
373
        vendor_id     => $self->{account}->vendor_id,
374
        edi_acct      => $self->{account}->id,
375
        status        => 'new',
376
        deleted       => 0,
377
        transfer_date => $self->{transfer_date}->ymd(),
378
    };
379
380
    return $msg;
381
}
382
383
1;
384
__END__
385
386
=head1 NAME
387
   Koha::Edifact::Transport
388
389
=head1 SYNOPSIS
390
391
my $download = Koha::Edifact::Transport->new( $vendor_edi_account_id );
392
$downlod->download_messages('QUOTE');
393
394
395
=head1 DESCRIPTION
396
397
Module that handles Edifact download and upload transport
398
currently can use sftp or ftp
399
Or FILE to access a local directory (useful for testing)
400
401
=head1 BUGS
402
403
404
=head1 METHODS
405
406
=head2 new
407
408
    Creates an object of Edifact::Transport requires to be passed the id
409
    identifying the relevant edi vendor account
410
411
=head2 working_directory
412
413
    getter and setter for the working_directory attribute
414
415
=head2 download_messages
416
417
    called with the message type to download will perform the download
418
    using the appropriate transport method
419
420
=head2 upload_messages
421
422
   passed an array of messages will upload them to the supplier site
423
424
=head2 sftp_download
425
426
   called by download_messages to perform the download using SFTP
427
428
=head2 ingest
429
430
   loads downloaded files into the database
431
432
=head2 ftp_download
433
434
   called by download_messages to perform the download using FTP
435
436
=head2 ftp_upload
437
438
  called by upload_messages to perform the upload using ftp
439
440
=head2 sftp_upload
441
442
  called by upload_messages to perform the upload using sftp
443
444
=head2 _abort_download
445
446
   internal routine to halt operation on error and supply a stacktrace
447
448
=head2 _get_file_ext
449
450
   internal method returning standard suffix for file names
451
   according to message type
452
453
=head2 set_transport_direct
454
455
  sets the direct ingest flag so that the object reads files from
456
  the local file system useful in debugging
457
458
=head1 AUTHOR
459
460
   Colin Campbell <colin.campbell@ptfs-europe.com>
461
462
463
=head1 COPYRIGHT
464
465
   Copyright 2014, PTFS-Europe Ltd
466
   This program is free software, You may redistribute it under
467
   under the terms of the GNU General Public License
468
469
470
=cut
(-)a/Koha/Schema/Result/Aqbasket.pm (-2 / +17 lines)
Lines 263-268 __PACKAGE__->belongs_to( Link Here
263
  },
263
  },
264
);
264
);
265
265
266
=head2 edifact_messages
267
268
Type: has_many
269
270
Related object: L<Koha::Schema::Result::EdifactMessage>
271
272
=cut
273
274
__PACKAGE__->has_many(
275
  "edifact_messages",
276
  "Koha::Schema::Result::EdifactMessage",
277
  { "foreign.basketno" => "self.basketno" },
278
  { cascade_copy => 0, cascade_delete => 0 },
279
);
280
266
=head2 borrowernumbers
281
=head2 borrowernumbers
267
282
268
Type: many_to_many
283
Type: many_to_many
Lines 274-281 Composing rels: L</aqbasketusers> -> borrowernumber Link Here
274
__PACKAGE__->many_to_many("borrowernumbers", "aqbasketusers", "borrowernumber");
289
__PACKAGE__->many_to_many("borrowernumbers", "aqbasketusers", "borrowernumber");
275
290
276
291
277
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55
292
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
278
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:pT+YFf9nfD/dmBuE4RNCFw
293
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:tsMzwP7eofOR27sfZSTqFQ
279
294
280
295
281
# You can replace this text with custom content, and it will be preserved on regeneration
296
# You can replace this text with custom content, and it will be preserved on regeneration
(-)a/Koha/Schema/Result/Aqbookseller.pm (-2 / +32 lines)
Lines 311-316 __PACKAGE__->has_many( Link Here
311
  { cascade_copy => 0, cascade_delete => 0 },
311
  { cascade_copy => 0, cascade_delete => 0 },
312
);
312
);
313
313
314
=head2 edifact_messages
315
316
Type: has_many
317
318
Related object: L<Koha::Schema::Result::EdifactMessage>
319
320
=cut
321
322
__PACKAGE__->has_many(
323
  "edifact_messages",
324
  "Koha::Schema::Result::EdifactMessage",
325
  { "foreign.vendor_id" => "self.id" },
326
  { cascade_copy => 0, cascade_delete => 0 },
327
);
328
314
=head2 invoiceprice
329
=head2 invoiceprice
315
330
316
Type: belongs_to
331
Type: belongs_to
Lines 351-359 __PACKAGE__->belongs_to( Link Here
351
  },
366
  },
352
);
367
);
353
368
369
=head2 vendor_edi_accounts
370
371
Type: has_many
372
373
Related object: L<Koha::Schema::Result::VendorEdiAccount>
374
375
=cut
376
377
__PACKAGE__->has_many(
378
  "vendor_edi_accounts",
379
  "Koha::Schema::Result::VendorEdiAccount",
380
  { "foreign.vendor_id" => "self.id" },
381
  { cascade_copy => 0, cascade_delete => 0 },
382
);
383
354
384
355
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-08-26 11:53:50
385
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
356
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:kz1tuPJihENyV6OyCwyX/A
386
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:bm3bQTUitVpvT+euN9brOg
357
387
358
388
359
# You can replace this text with custom content, and it will be preserved on regeneration
389
# You can replace this text with custom content, and it will be preserved on regeneration
(-)a/Koha/Schema/Result/Aqbudget.pm (+19 lines)
Lines 227-244 __PACKAGE__->has_many( Link Here
227
  { cascade_copy => 0, cascade_delete => 0 },
227
  { cascade_copy => 0, cascade_delete => 0 },
228
);
228
);
229
229
230
<<<<<<< HEAD
230
=head2 aqorders
231
=head2 aqorders
231
232
232
Type: has_many
233
Type: has_many
233
234
234
Related object: L<Koha::Schema::Result::Aqorder>
235
Related object: L<Koha::Schema::Result::Aqorder>
236
=======
237
=head2 vendor_edi_accounts
238
239
Type: has_many
240
241
Related object: L<Koha::Schema::Result::VendorEdiAccount>
242
>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
235
243
236
=cut
244
=cut
237
245
238
__PACKAGE__->has_many(
246
__PACKAGE__->has_many(
247
<<<<<<< HEAD
239
  "aqorders",
248
  "aqorders",
240
  "Koha::Schema::Result::Aqorder",
249
  "Koha::Schema::Result::Aqorder",
241
  { "foreign.budget_id" => "self.budget_id" },
250
  { "foreign.budget_id" => "self.budget_id" },
251
=======
252
  "vendor_edi_accounts",
253
  "Koha::Schema::Result::VendorEdiAccount",
254
  { "foreign.shipment_budget" => "self.budget_id" },
255
>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
242
  { cascade_copy => 0, cascade_delete => 0 },
256
  { cascade_copy => 0, cascade_delete => 0 },
243
);
257
);
244
258
Lines 253-260 Composing rels: L</aqbudgetborrowers> -> borrowernumber Link Here
253
__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");
267
__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");
254
268
255
269
270
<<<<<<< HEAD
256
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-02-05 15:20:11
271
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2015-02-05 15:20:11
257
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:733+8NRE5Ip/30URBcJsbA
272
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:733+8NRE5Ip/30URBcJsbA
273
=======
274
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
275
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:Ieg4SfRCek9KwaDyUKmoWA
276
>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
258
277
259
278
260
# You can replace this text with custom content, and it will be preserved on regeneration
279
# You can replace this text with custom content, and it will be preserved on regeneration
(-)a/Koha/Schema/Result/Aqinvoice.pm (-2 / +30 lines)
Lines 70-75 __PACKAGE__->table("aqinvoices"); Link Here
70
  is_foreign_key: 1
70
  is_foreign_key: 1
71
  is_nullable: 1
71
  is_nullable: 1
72
72
73
=head2 message_id
74
75
  data_type: 'integer'
76
  is_foreign_key: 1
77
  is_nullable: 1
78
73
=cut
79
=cut
74
80
75
__PACKAGE__->add_columns(
81
__PACKAGE__->add_columns(
Lines 89-94 __PACKAGE__->add_columns( Link Here
89
  { data_type => "decimal", is_nullable => 1, size => [28, 6] },
95
  { data_type => "decimal", is_nullable => 1, size => [28, 6] },
90
  "shipmentcost_budgetid",
96
  "shipmentcost_budgetid",
91
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
97
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
98
  "message_id",
99
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
92
);
100
);
93
101
94
=head1 PRIMARY KEY
102
=head1 PRIMARY KEY
Lines 135-140 __PACKAGE__->belongs_to( Link Here
135
  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
143
  { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" },
136
);
144
);
137
145
146
=head2 message
147
148
Type: belongs_to
149
150
Related object: L<Koha::Schema::Result::EdifactMessage>
151
152
=cut
153
154
__PACKAGE__->belongs_to(
155
  "message",
156
  "Koha::Schema::Result::EdifactMessage",
157
  { id => "message_id" },
158
  {
159
    is_deferrable => 1,
160
    join_type     => "LEFT",
161
    on_delete     => "SET NULL",
162
    on_update     => "RESTRICT",
163
  },
164
);
165
138
=head2 shipmentcost_budgetid
166
=head2 shipmentcost_budgetid
139
167
140
Type: belongs_to
168
Type: belongs_to
Lines 156-163 __PACKAGE__->belongs_to( Link Here
156
);
184
);
157
185
158
186
159
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55
187
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-18 16:21:46
160
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:3se4f767VfvBKaZ8tlXwHQ
188
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FPZXlNt8dkjhgt2Rtc+krQ
161
189
162
190
163
# You can replace this text with custom content, and it will be preserved on regeneration
191
# You can replace this text with custom content, and it will be preserved on regeneration
(-)a/Koha/Schema/Result/Branch.pm (-3 / +18 lines)
Lines 397-402 __PACKAGE__->might_have( Link Here
397
  { cascade_copy => 0, cascade_delete => 0 },
397
  { cascade_copy => 0, cascade_delete => 0 },
398
);
398
);
399
399
400
=head2 edifact_eans
401
402
Type: has_many
403
404
Related object: L<Koha::Schema::Result::EdifactEan>
405
406
=cut
407
408
__PACKAGE__->has_many(
409
  "edifact_eans",
410
  "Koha::Schema::Result::EdifactEan",
411
  { "foreign.branchcode" => "self.branchcode" },
412
  { cascade_copy => 0, cascade_delete => 0 },
413
);
414
400
=head2 hold_fill_targets
415
=head2 hold_fill_targets
401
416
402
Type: has_many
417
Type: has_many
Lines 513-521 Composing rels: L</branchrelations> -> categorycode Link Here
513
__PACKAGE__->many_to_many("categorycodes", "branchrelations", "categorycode");
528
__PACKAGE__->many_to_many("categorycodes", "branchrelations", "categorycode");
514
529
515
530
516
# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-11-06 15:26:36
531
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-11-26 11:08:29
517
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:CGNPB/MkGLOihDThj43/4A
532
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FjNI9OEpa5OKfwwCkggu0w
518
533
519
534
520
# You can replace this text with custom content, and it will be preserved on regeneration
535
# You can replace this text with custom code or comments, and it will be preserved on regeneration
521
1;
536
1;
(-)a/Koha/Schema/Result/EdifactEan.pm (+91 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::EdifactEan;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::EdifactEan
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<edifact_ean>
19
20
=cut
21
22
__PACKAGE__->table("edifact_ean");
23
24
=head1 ACCESSORS
25
26
=head2 branchcode
27
28
  data_type: 'varchar'
29
  is_foreign_key: 1
30
  is_nullable: 0
31
  size: 10
32
33
=head2 ean
34
35
  data_type: 'varchar'
36
  is_nullable: 0
37
  size: 15
38
39
=head2 id_code_qualifier
40
41
  data_type: 'varchar'
42
  default_value: 14
43
  is_nullable: 0
44
  size: 3
45
46
=cut
47
48
__PACKAGE__->add_columns(
49
  "branchcode",
50
  { data_type => "varchar", is_foreign_key => 1, is_nullable => 0, size => 10 },
51
  "ean",
52
  { data_type => "varchar", is_nullable => 0, size => 15 },
53
  "id_code_qualifier",
54
  { data_type => "varchar", default_value => 14, is_nullable => 0, size => 3 },
55
);
56
57
=head1 RELATIONS
58
59
=head2 branchcode
60
61
Type: belongs_to
62
63
Related object: L<Koha::Schema::Result::Branch>
64
65
=cut
66
67
__PACKAGE__->belongs_to(
68
  "branchcode",
69
  "Koha::Schema::Result::Branch",
70
  { branchcode => "branchcode" },
71
  { is_deferrable => 1, on_delete => "RESTRICT", on_update => "RESTRICT" },
72
);
73
74
75
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
76
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:s5Z9txnCIqGyvOj02EOtdQ
77
78
79
# You can replace this text with custom code or comments, and it will be preserved on regeneration
80
__PACKAGE__->belongs_to('branch',
81
    "Koha::Schema::Result::Branch",
82
    { 'branchcode' => 'branchcode' },
83
    {
84
        is_deferrable => 1,
85
        join_type => 'LEFT',
86
        on_delete => 'CASCADE',
87
        on_update => 'CASCADE',
88
    },
89
);
90
91
1;
(-)a/Koha/Schema/Result/EdifactMessage.pm (+202 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::EdifactMessage;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::EdifactMessage
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<edifact_messages>
19
20
=cut
21
22
__PACKAGE__->table("edifact_messages");
23
24
=head1 ACCESSORS
25
26
=head2 id
27
28
  data_type: 'integer'
29
  is_auto_increment: 1
30
  is_nullable: 0
31
32
=head2 message_type
33
34
  data_type: 'varchar'
35
  is_nullable: 0
36
  size: 10
37
38
=head2 transfer_date
39
40
  data_type: 'date'
41
  datetime_undef_if_invalid: 1
42
  is_nullable: 1
43
44
=head2 vendor_id
45
46
  data_type: 'integer'
47
  is_foreign_key: 1
48
  is_nullable: 1
49
50
=head2 edi_acct
51
52
  data_type: 'integer'
53
  is_foreign_key: 1
54
  is_nullable: 1
55
56
=head2 status
57
58
  data_type: 'text'
59
  is_nullable: 1
60
61
=head2 basketno
62
63
  data_type: 'integer'
64
  is_foreign_key: 1
65
  is_nullable: 1
66
67
=head2 raw_msg
68
69
  data_type: 'text'
70
  is_nullable: 1
71
72
=head2 filename
73
74
  data_type: 'text'
75
  is_nullable: 1
76
77
=head2 deleted
78
79
  data_type: 'tinyint'
80
  default_value: 0
81
  is_nullable: 0
82
83
=cut
84
85
__PACKAGE__->add_columns(
86
  "id",
87
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
88
  "message_type",
89
  { data_type => "varchar", is_nullable => 0, size => 10 },
90
  "transfer_date",
91
  { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 },
92
  "vendor_id",
93
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
94
  "edi_acct",
95
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
96
  "status",
97
  { data_type => "text", is_nullable => 1 },
98
  "basketno",
99
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
100
  "raw_msg",
101
  { data_type => "text", is_nullable => 1 },
102
  "filename",
103
  { data_type => "text", is_nullable => 1 },
104
  "deleted",
105
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
106
);
107
108
=head1 PRIMARY KEY
109
110
=over 4
111
112
=item * L</id>
113
114
=back
115
116
=cut
117
118
__PACKAGE__->set_primary_key("id");
119
120
=head1 RELATIONS
121
122
=head2 aqinvoices
123
124
Type: has_many
125
126
Related object: L<Koha::Schema::Result::Aqinvoice>
127
128
=cut
129
130
__PACKAGE__->has_many(
131
  "aqinvoices",
132
  "Koha::Schema::Result::Aqinvoice",
133
  { "foreign.message_id" => "self.id" },
134
  { cascade_copy => 0, cascade_delete => 0 },
135
);
136
137
=head2 basketno
138
139
Type: belongs_to
140
141
Related object: L<Koha::Schema::Result::Aqbasket>
142
143
=cut
144
145
__PACKAGE__->belongs_to(
146
  "basketno",
147
  "Koha::Schema::Result::Aqbasket",
148
  { basketno => "basketno" },
149
  {
150
    is_deferrable => 1,
151
    join_type     => "LEFT",
152
    on_delete     => "RESTRICT",
153
    on_update     => "RESTRICT",
154
  },
155
);
156
157
=head2 edi_acct
158
159
Type: belongs_to
160
161
Related object: L<Koha::Schema::Result::VendorEdiAccount>
162
163
=cut
164
165
__PACKAGE__->belongs_to(
166
  "edi_acct",
167
  "Koha::Schema::Result::VendorEdiAccount",
168
  { id => "edi_acct" },
169
  {
170
    is_deferrable => 1,
171
    join_type     => "LEFT",
172
    on_delete     => "RESTRICT",
173
    on_update     => "RESTRICT",
174
  },
175
);
176
177
=head2 vendor
178
179
Type: belongs_to
180
181
Related object: L<Koha::Schema::Result::Aqbookseller>
182
183
=cut
184
185
__PACKAGE__->belongs_to(
186
  "vendor",
187
  "Koha::Schema::Result::Aqbookseller",
188
  { id => "vendor_id" },
189
  {
190
    is_deferrable => 1,
191
    join_type     => "LEFT",
192
    on_delete     => "RESTRICT",
193
    on_update     => "RESTRICT",
194
  },
195
);
196
197
198
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-18 16:21:46
199
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:aOMWguyzdK9caRRecsuTmQ
200
201
202
1;
(-)a/Koha/Schema/Result/MsgInvoice.pm (+115 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::MsgInvoice;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::MsgInvoice
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<msg_invoice>
19
20
=cut
21
22
__PACKAGE__->table("msg_invoice");
23
24
=head1 ACCESSORS
25
26
=head2 mi_id
27
28
  data_type: 'integer'
29
  is_auto_increment: 1
30
  is_nullable: 0
31
32
=head2 msg_id
33
34
  data_type: 'integer'
35
  is_foreign_key: 1
36
  is_nullable: 1
37
38
=head2 invoiceid
39
40
  data_type: 'integer'
41
  is_foreign_key: 1
42
  is_nullable: 1
43
44
=cut
45
46
__PACKAGE__->add_columns(
47
  "mi_id",
48
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
49
  "msg_id",
50
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
51
  "invoiceid",
52
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
53
);
54
55
=head1 PRIMARY KEY
56
57
=over 4
58
59
=item * L</mi_id>
60
61
=back
62
63
=cut
64
65
__PACKAGE__->set_primary_key("mi_id");
66
67
=head1 RELATIONS
68
69
=head2 invoiceid
70
71
Type: belongs_to
72
73
Related object: L<Koha::Schema::Result::Aqinvoice>
74
75
=cut
76
77
__PACKAGE__->belongs_to(
78
  "invoiceid",
79
  "Koha::Schema::Result::Aqinvoice",
80
  { invoiceid => "invoiceid" },
81
  {
82
    is_deferrable => 1,
83
    join_type     => "LEFT",
84
    on_delete     => "RESTRICT",
85
    on_update     => "RESTRICT",
86
  },
87
);
88
89
=head2 msg
90
91
Type: belongs_to
92
93
Related object: L<Koha::Schema::Result::EdifactMessage>
94
95
=cut
96
97
__PACKAGE__->belongs_to(
98
  "msg",
99
  "Koha::Schema::Result::EdifactMessage",
100
  { id => "msg_id" },
101
  {
102
    is_deferrable => 1,
103
    join_type     => "LEFT",
104
    on_delete     => "RESTRICT",
105
    on_update     => "RESTRICT",
106
  },
107
);
108
109
110
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
111
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:F1jqlEH57dpxn2Pvm/vPGA
112
113
114
# You can replace this text with custom code or comments, and it will be preserved on regeneration
115
1;
(-)a/Koha/Schema/Result/VendorEdiAccount.pm (+233 lines)
Line 0 Link Here
1
use utf8;
2
package Koha::Schema::Result::VendorEdiAccount;
3
4
# Created by DBIx::Class::Schema::Loader
5
# DO NOT MODIFY THE FIRST PART OF THIS FILE
6
7
=head1 NAME
8
9
Koha::Schema::Result::VendorEdiAccount
10
11
=cut
12
13
use strict;
14
use warnings;
15
16
use base 'DBIx::Class::Core';
17
18
=head1 TABLE: C<vendor_edi_accounts>
19
20
=cut
21
22
__PACKAGE__->table("vendor_edi_accounts");
23
24
=head1 ACCESSORS
25
26
=head2 id
27
28
  data_type: 'integer'
29
  is_auto_increment: 1
30
  is_nullable: 0
31
32
=head2 description
33
34
  data_type: 'text'
35
  is_nullable: 0
36
37
=head2 host
38
39
  data_type: 'varchar'
40
  is_nullable: 1
41
  size: 40
42
43
=head2 username
44
45
  data_type: 'varchar'
46
  is_nullable: 1
47
  size: 40
48
49
=head2 password
50
51
  data_type: 'varchar'
52
  is_nullable: 1
53
  size: 40
54
55
=head2 last_activity
56
57
  data_type: 'date'
58
  datetime_undef_if_invalid: 1
59
  is_nullable: 1
60
61
=head2 vendor_id
62
63
  data_type: 'integer'
64
  is_foreign_key: 1
65
  is_nullable: 1
66
67
=head2 download_directory
68
69
  data_type: 'text'
70
  is_nullable: 1
71
72
=head2 upload_directory
73
74
  data_type: 'text'
75
  is_nullable: 1
76
77
=head2 san
78
79
  data_type: 'varchar'
80
  is_nullable: 1
81
  size: 20
82
83
=head2 id_code_qualifier
84
85
  data_type: 'varchar'
86
  default_value: 14
87
  is_nullable: 1
88
  size: 3
89
90
=head2 transport
91
92
  data_type: 'varchar'
93
  default_value: 'FTP'
94
  is_nullable: 1
95
  size: 6
96
97
=head2 quotes_enabled
98
99
  data_type: 'tinyint'
100
  default_value: 0
101
  is_nullable: 0
102
103
=head2 invoices_enabled
104
105
  data_type: 'tinyint'
106
  default_value: 0
107
  is_nullable: 0
108
109
=head2 orders_enabled
110
111
  data_type: 'tinyint'
112
  default_value: 0
113
  is_nullable: 0
114
115
=head2 shipment_budget
116
117
  data_type: 'integer'
118
  is_foreign_key: 1
119
  is_nullable: 1
120
121
=cut
122
123
__PACKAGE__->add_columns(
124
  "id",
125
  { data_type => "integer", is_auto_increment => 1, is_nullable => 0 },
126
  "description",
127
  { data_type => "text", is_nullable => 0 },
128
  "host",
129
  { data_type => "varchar", is_nullable => 1, size => 40 },
130
  "username",
131
  { data_type => "varchar", is_nullable => 1, size => 40 },
132
  "password",
133
  { data_type => "varchar", is_nullable => 1, size => 40 },
134
  "last_activity",
135
  { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 },
136
  "vendor_id",
137
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
138
  "download_directory",
139
  { data_type => "text", is_nullable => 1 },
140
  "upload_directory",
141
  { data_type => "text", is_nullable => 1 },
142
  "san",
143
  { data_type => "varchar", is_nullable => 1, size => 20 },
144
  "id_code_qualifier",
145
  { data_type => "varchar", default_value => 14, is_nullable => 1, size => 3 },
146
  "transport",
147
  { data_type => "varchar", default_value => "FTP", is_nullable => 1, size => 6 },
148
  "quotes_enabled",
149
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
150
  "invoices_enabled",
151
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
152
  "orders_enabled",
153
  { data_type => "tinyint", default_value => 0, is_nullable => 0 },
154
  "shipment_budget",
155
  { data_type => "integer", is_foreign_key => 1, is_nullable => 1 },
156
);
157
158
=head1 PRIMARY KEY
159
160
=over 4
161
162
=item * L</id>
163
164
=back
165
166
=cut
167
168
__PACKAGE__->set_primary_key("id");
169
170
=head1 RELATIONS
171
172
=head2 edifact_messages
173
174
Type: has_many
175
176
Related object: L<Koha::Schema::Result::EdifactMessage>
177
178
=cut
179
180
__PACKAGE__->has_many(
181
  "edifact_messages",
182
  "Koha::Schema::Result::EdifactMessage",
183
  { "foreign.edi_acct" => "self.id" },
184
  { cascade_copy => 0, cascade_delete => 0 },
185
);
186
187
=head2 shipment_budget
188
189
Type: belongs_to
190
191
Related object: L<Koha::Schema::Result::Aqbudget>
192
193
=cut
194
195
__PACKAGE__->belongs_to(
196
  "shipment_budget",
197
  "Koha::Schema::Result::Aqbudget",
198
  { budget_id => "shipment_budget" },
199
  {
200
    is_deferrable => 1,
201
    join_type     => "LEFT",
202
    on_delete     => "RESTRICT",
203
    on_update     => "RESTRICT",
204
  },
205
);
206
207
=head2 vendor
208
209
Type: belongs_to
210
211
Related object: L<Koha::Schema::Result::Aqbookseller>
212
213
=cut
214
215
__PACKAGE__->belongs_to(
216
  "vendor",
217
  "Koha::Schema::Result::Aqbookseller",
218
  { id => "vendor_id" },
219
  {
220
    is_deferrable => 1,
221
    join_type     => "LEFT",
222
    on_delete     => "RESTRICT",
223
    on_update     => "RESTRICT",
224
  },
225
);
226
227
228
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-10-02 17:14:15
229
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:6Yp5lyH2ld4lrmaM0OeYcw
230
231
232
# You can replace this text with custom code or comments, and it will be preserved on regeneration
233
1;
(-)a/acqui/basket.pl (+78 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
74
72
my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
75
my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
Lines 83-88 my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( Link Here
83
my $basket = GetBasket($basketno);
86
my $basket = GetBasket($basketno);
84
$booksellerid = $basket->{booksellerid} unless $booksellerid;
87
$booksellerid = $basket->{booksellerid} unless $booksellerid;
85
my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
88
my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid });
89
my $schema = Koha::Database->new()->schema();
90
my $rs = $schema->resultset('VendorEdiAccount')->search(
91
    { vendor_id => $booksellerid, } );
92
$template->param( ediaccount => ($rs->count > 0));
86
93
87
unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
94
unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
88
    $template->param(
95
    $template->param(
Lines 236-241 if ( $op eq 'delete_confirm' ) { Link Here
236
} elsif ($op eq 'reopen') {
243
} elsif ($op eq 'reopen') {
237
    ReopenBasket($query->param('basketno'));
244
    ReopenBasket($query->param('basketno'));
238
    print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
245
    print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
246
}
247
elsif ( $op eq 'ediorder' ) {
248
    edi_close_and_order()
239
} elsif ( $op eq 'mod_users' ) {
249
} elsif ( $op eq 'mod_users' ) {
240
    my $basketusers_ids = $query->param('basketusers_ids');
250
    my $basketusers_ids = $query->param('basketusers_ids');
241
    my @basketusers = split( /:/, $basketusers_ids );
251
    my @basketusers = split( /:/, $basketusers_ids );
Lines 447-452 sub get_order_infos { Link Here
447
    $line{basketno}       = $basketno;
457
    $line{basketno}       = $basketno;
448
    $line{budget_name}    = $budget->{budget_name};
458
    $line{budget_name}    = $budget->{budget_name};
449
    $line{rrp} = ConvertCurrency( $order->{'currency'}, $line{rrp} ); # FIXME from comm
459
    $line{rrp} = ConvertCurrency( $order->{'currency'}, $line{rrp} ); # FIXME from comm
460
    $line{gstrate} ||= 0;
450
    if ( $bookseller->{'listincgst'} ) {
461
    if ( $bookseller->{'listincgst'} ) {
451
        $line{rrpgsti} = sprintf( "%.2f", $line{rrp} );
462
        $line{rrpgsti} = sprintf( "%.2f", $line{rrp} );
452
        $line{gstgsti} = sprintf( "%.2f", $line{gstrate} * 100 );
463
        $line{gstgsti} = sprintf( "%.2f", $line{gstrate} * 100 );
Lines 532-534 sub get_order_infos { Link Here
532
}
543
}
533
544
534
output_html_with_http_headers $query, $cookie, $template->output;
545
output_html_with_http_headers $query, $cookie, $template->output;
546
547
548
sub edi_close_and_order {
549
    my $confirm = $query->param('confirm') || $confirm_pref eq '2';
550
    if ($confirm) {
551
            my $edi_params = {
552
                basketno => $basketno,
553
                ean    => $ean,
554
            };
555
            if ( $basket->{branch} ) {
556
                $edi_params->{branchcode} = $basket->{branch};
557
            }
558
            if ( create_edi_order($edi_params) ) {
559
                #$template->param( edifile => 1 );
560
            }
561
        CloseBasket($basketno);
562
563
        # if requested, create basket group, close it and attach the basket
564
        if ( $query->param('createbasketgroup') ) {
565
            my $branchcode;
566
            if (    C4::Context->userenv
567
                and C4::Context->userenv->{'branch'}
568
                and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET" )
569
            {
570
                $branchcode = C4::Context->userenv->{'branch'};
571
            }
572
            my $basketgroupid = NewBasketgroup(
573
                {
574
                    name          => $basket->{basketname},
575
                    booksellerid  => $booksellerid,
576
                    deliveryplace => $branchcode,
577
                    billingplace  => $branchcode,
578
                    closed        => 1,
579
                }
580
            );
581
            ModBasket(
582
                {
583
                    basketno      => $basketno,
584
                    basketgroupid => $basketgroupid
585
                }
586
            );
587
            print $query->redirect(
588
"/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1"
589
            );
590
        }
591
        else {
592
            print $query->redirect(
593
                "/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid"
594
            );
595
        }
596
        exit;
597
    }
598
    else {
599
        $template->param(
600
            edi_confirm     => 1,
601
            booksellerid    => $booksellerid,
602
            basketno        => $basket->{basketno},
603
            basketname      => $basket->{basketname},
604
            basketgroupname => $basket->{basketname},
605
        );
606
        if ($ean) {
607
            $template->param( ean => $ean );
608
        }
609
610
    }
611
    return;
612
}
(-)a/acqui/basketgroup.pl (+17 lines)
Lines 56-61 use C4::Budgets qw/ConvertCurrency/; Link Here
56
use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/;
56
use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/;
57
use C4::Branch qw/GetBranches/;
57
use C4::Branch qw/GetBranches/;
58
use C4::Members qw/GetMember/;
58
use C4::Members qw/GetMember/;
59
use Koha::EDI qw/create_edi_order get_edifact_ean/;
59
60
60
use Koha::Acquisition::Bookseller;
61
use Koha::Acquisition::Bookseller;
61
62
Lines 208-219 sub printbasketgrouppdf{ Link Here
208
209
209
}
210
}
210
211
212
sub generate_edifact_orders {
213
    my $basketgroupid = shift;
214
    my $baskets       = GetBasketsByBasketgroup($basketgroupid);
215
    my $ean           = get_edifact_ean();
216
217
    for my $basket ( @{$baskets} ) {
218
        create_edi_order( { ean => $ean, basketno => $basket->{basketno}, } );
219
    }
220
    return;
221
}
222
211
my $op = $input->param('op') || 'display';
223
my $op = $input->param('op') || 'display';
212
# possible values of $op :
224
# possible values of $op :
213
# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup
225
# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup
214
# - mod_basket : modify an individual basket of the basketgroup
226
# - mod_basket : modify an individual basket of the basketgroup
215
# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list
227
# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list
216
# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list
228
# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list
229
# - ediprint : generate edi order messages for the baskets in the group
217
# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list
230
# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list
218
# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list
231
# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list
219
# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list
232
# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list
Lines 372-377 if ( $op eq "add" ) { Link Here
372
    $redirectpath .=  "&amp;listclosed=1" if $closedbg ;
385
    $redirectpath .=  "&amp;listclosed=1" if $closedbg ;
373
    print $input->redirect($redirectpath );
386
    print $input->redirect($redirectpath );
374
    
387
    
388
} elsif ( $op eq 'ediprint') {
389
    my $basketgroupid = $input->param('basketgroupid');
390
    generate_edifact_orders( $basketgroupid );
391
    exit;
375
}else{
392
}else{
376
# no param : display the list of all basketgroups for a given vendor
393
# no param : display the list of all basketgroups for a given vendor
377
    my $basketgroups = &GetBasketgroups($booksellerid);
394
    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 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
# 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 (+55 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 2 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
42
my @msgs = $schema->resultset('EdifactMessage')->search(
43
    {
44
        deleted => 0,
45
    },
46
    {
47
        join     => 'vendor',
48
        order_by => { -desc => 'transfer_date' },
49
    }
50
51
)->all;
52
53
$template->param( messages => \@msgs );
54
55
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 2 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 (+153 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 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use strict;
21
use warnings;
22
use 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
            id_code_qualifier  => $input->param('id_code_qualifier'),
99
        };
100
101
        if ($id) {
102
            $schema->resultset('VendorEdiAccount')->search(
103
                {
104
                    id => $id,
105
                }
106
            )->update_all($fields);
107
        }
108
        else {    # new record
109
            $schema->resultset('VendorEdiAccount')->create($fields);
110
        }
111
    }
112
    elsif ( $op eq 'delete_confirmed' ) {
113
114
        $schema->resultset('VendorEdiAccount')
115
          ->search( { id => $input->param('id'), } )->delete_all;
116
    }
117
118
    # we do a default dispaly after deletes and saves
119
    # as well as when thats all you want
120
    $template->param( display => 1 );
121
    my @ediaccounts = $schema->resultset('VendorEdiAccount')->search(
122
        {},
123
        {
124
            join => 'vendor',
125
        }
126
    );
127
    $template->param( ediaccounts => \@ediaccounts );
128
}
129
130
output_html_with_http_headers( $input, $cookie, $template->output );
131
132
sub get_account {
133
    my $id = shift;
134
135
    my $account = $schema->resultset('VendorEdiAccount')->find($id);
136
    if ($account) {
137
        return $account;
138
    }
139
140
    # passing undef will default to add
141
    return;
142
}
143
144
sub show_account {
145
    my $acct_id = $input->param('id');
146
    if ($acct_id) {
147
        my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id);
148
        if ($acct) {
149
            $template->param( account => $acct );
150
        }
151
    }
152
    return;
153
}
(-)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 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use strict;
21
use warnings;
22
use 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/en/mandatory/userpermissions.sql (+1 lines)
Lines 27-32 INSERT INTO permissions (module_bit, code, description) VALUES Link Here
27
   (11, 'order_receive', 'Manage orders & basket'),
27
   (11, 'order_receive', 'Manage orders & basket'),
28
   (11, 'budget_add_del', 'Add and delete budgets (but can''t modify budgets)'),
28
   (11, 'budget_add_del', 'Add and delete budgets (but can''t modify budgets)'),
29
   (11, 'budget_manage_all', 'Manage all budgets'),
29
   (11, 'budget_manage_all', 'Manage all budgets'),
30
   (11, 'edi_manage', 'Manage EDIFACT transmissions'),
30
   (13, 'edit_news', 'Write news for the OPAC and staff interfaces'),
31
   (13, 'edit_news', 'Write news for the OPAC and staff interfaces'),
31
   (13, 'label_creator', 'Create printable labels and barcodes from catalog and patron data'),
32
   (13, 'label_creator', 'Create printable labels and barcodes from catalog and patron data'),
32
   (13, 'edit_calendar', 'Define days when the library is closed'),
33
   (13, 'edit_calendar', 'Define days when the library is closed'),
(-)a/installer/data/mysql/kohastructure.sql (-1 / +70 lines)
Lines 3119-3124 CREATE TABLE aqorders_transfers ( Link Here
3119
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3119
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3120
3120
3121
--
3121
--
3122
-- Table structure for table vendor_edi_accounts
3123
--
3124
3125
DROP TABLE IF EXISTS vendor_edi_accounts;
3126
CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
3127
  id int(11) NOT NULL auto_increment,
3128
  description text NOT NULL,
3129
  host varchar(40),
3130
  username varchar(40),
3131
  password varchar(40),
3132
  last_activity date,
3133
  vendor_id int(11) references aqbooksellers( id ),
3134
  download_directory text,
3135
  upload_directory text,
3136
  san varchar(20),
3137
  id_code_qualifier varchar(3) default '14',
3138
  transport varchar(6) default 'FTP',
3139
  quotes_enabled tinyint(1) not null default 0,
3140
  invoices_enabled tinyint(1) not null default 0,
3141
  orders_enabled tinyint(1) not null default 0,
3142
  shipment_budget integer(11) references aqbudgets( budget_id ),
3143
  PRIMARY KEY  (id),
3144
  KEY vendorid (vendor_id),
3145
  KEY shipmentbudget (shipment_budget),
3146
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
3147
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
3148
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3149
3150
--
3151
-- Table structure for table edifact_messages
3152
--
3153
3154
DROP TABLE IF EXISTS edifact_messages;
3155
CREATE TABLE IF NOT EXISTS edifact_messages (
3156
  id int(11) NOT NULL auto_increment,
3157
  message_type varchar(10) NOT NULL,
3158
  transfer_date date,
3159
  vendor_id int(11) references aqbooksellers( id ),
3160
  edi_acct  integer references vendor_edi_accounts( id ),
3161
  status text,
3162
  basketno int(11) references aqbasket( basketno),
3163
  raw_msg text,
3164
  filename text,
3165
  deleted boolean not null default 0,
3166
  PRIMARY KEY  (id),
3167
  KEY vendorid ( vendor_id),
3168
  KEY ediacct (edi_acct),
3169
  KEY basketno ( basketno),
3170
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
3171
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
3172
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
3173
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3174
3175
--
3122
-- Table structure for table aqinvoices
3176
-- Table structure for table aqinvoices
3123
--
3177
--
3124
3178
Lines 3132-3141 CREATE TABLE aqinvoices ( Link Here
3132
  closedate date default NULL,  -- invoice close date, NULL means the invoice is open
3186
  closedate date default NULL,  -- invoice close date, NULL means the invoice is open
3133
  shipmentcost decimal(28,6) default NULL,  -- shipment cost
3187
  shipmentcost decimal(28,6) default NULL,  -- shipment cost
3134
  shipmentcost_budgetid int(11) default NULL,   -- foreign key to aqbudgets, link the shipment cost to a budget
3188
  shipmentcost_budgetid int(11) default NULL,   -- foreign key to aqbudgets, link the shipment cost to a budget
3189
  message_id int(11) default NULL, -- foreign key to edifact invoice message
3135
  PRIMARY KEY (invoiceid),
3190
  PRIMARY KEY (invoiceid),
3136
  CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
3191
  CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
3137
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE
3138
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3192
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3193
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE,
3194
  CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL
3195
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3139
3196
3140
3197
3141
--
3198
--
Lines 3503-3508 CREATE TABLE items_search_fields ( Link Here
3503
    ON DELETE SET NULL ON UPDATE CASCADE
3560
    ON DELETE SET NULL ON UPDATE CASCADE
3504
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3561
) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_unicode_ci;
3505
3562
3563
--
3564
-- Table structure for table 'edifact_ean'
3565
--
3566
3567
DROP TABLE IF EXISTS edifact_ean;
3568
CREATE TABLE IF NOT EXISTS edifact_ean (
3569
  branchcode varchar(10) not null references branches (branchcode),
3570
  ean varchar(15) NOT NULL,
3571
  id_code_qualifier varchar(3) NOT NULL default '14',
3572
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
3573
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3574
3506
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
3575
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
3507
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
3576
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
3508
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
3577
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
(-)a/installer/data/mysql/sysprefs.sql (+1 lines)
Lines 473-476 INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` Link Here
473
('XSLTResultsDisplay','default','','Enable XSL stylesheet control over results page display on intranet','Free'),
473
('XSLTResultsDisplay','default','','Enable XSL stylesheet control over results page display on intranet','Free'),
474
('z3950AuthorAuthFields','701,702,700',NULL,'Define the MARC biblio fields for Personal Name Authorities to fill biblio.author','free'),
474
('z3950AuthorAuthFields','701,702,700',NULL,'Define the MARC biblio fields for Personal Name Authorities to fill biblio.author','free'),
475
('z3950NormalizeAuthor','0','','If ON, Personal Name Authorities will replace authors in biblio.author','YesNo')
475
('z3950NormalizeAuthor','0','','If ON, Personal Name Authorities will replace authors in biblio.author','YesNo')
476
('EDIInvoicesShippingBudget',NULL,NULL,'The budget code used to allocate shipping charges to when processing EDI Invoice messages','free')
476
;
477
;
(-)a/installer/data/mysql/updatedatabase.pl (+78 lines)
Lines 9729-9734 if ( CheckVersion($DBversion) ) { Link Here
9729
    |);
9729
    |);
9730
9730
9731
    print "Upgrade to $DBversion done (Bug 12601 - Add new foreign key aqorders.budget_id" . ( ( $number_of_orders_not_linked->[0] > 0 )  ? ' WARNING: temporary budget and fund have been created (search for "BACKUP_TMP"). At least one of your order was not linked to a budget' : '' ) . ")\n";
9731
    print "Upgrade to $DBversion done (Bug 12601 - Add new foreign key aqorders.budget_id" . ( ( $number_of_orders_not_linked->[0] > 0 )  ? ' WARNING: temporary budget and fund have been created (search for "BACKUP_TMP"). At least one of your order was not linked to a budget' : '' ) . ")\n";
9732
$DBversion = "3.19.00.XXX";
9733
if( CheckVersion($DBversion) ){
9734
9735
    my $sql=<<'VEA_END';
9736
CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
9737
  id int(11) NOT NULL auto_increment,
9738
  description text NOT NULL,
9739
  host varchar(40),
9740
  username varchar(40),
9741
  password varchar(40),
9742
  last_activity date,
9743
  vendor_id int(11) references aqbooksellers( id ),
9744
  download_directory text,
9745
  upload_directory text,
9746
  san varchar(20),
9747
  id_code_qualifier varchar(3) default '14',
9748
  transport varchar(6) default 'FTP',
9749
  quotes_enabled tinyint(1) not null default 0,
9750
  invoices_enabled tinyint(1) not null default 0,
9751
  orders_enabled tinyint(1) not null default 0,
9752
  shipment_budget integer(11) references aqbudgets( budget_id ),
9753
  PRIMARY KEY  (id),
9754
  KEY vendorid (vendor_id),
9755
  KEY shipmentbudget (shipment_budget),
9756
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
9757
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
9758
) ENGINE=InnoDB DEFAULT CHARSET=utf8
9759
VEA_END
9760
9761
    $dbh->do($sql);
9762
9763
    $sql=<<'EM_END';
9764
CREATE TABLE IF NOT EXISTS edifact_messages (
9765
  id int(11) NOT NULL auto_increment,
9766
  message_type varchar(10) NOT NULL,
9767
  transfer_date date,
9768
  vendor_id int(11) references aqbooksellers( id ),
9769
  edi_acct  integer references vendor_edi_accounts( id ),
9770
  status text,
9771
  basketno int(11) REFERENCES aqbasket( basketno),
9772
  raw_msg text,
9773
  filename text,
9774
  deleted boolean not null default 0,
9775
  PRIMARY KEY  (id),
9776
  KEY vendorid ( vendor_id),
9777
  KEY ediacct (edi_acct),
9778
  KEY basketno ( basketno),
9779
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
9780
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
9781
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
9782
) ENGINE=InnoDB DEFAULT CHARSET=utf8
9783
EM_END
9784
9785
    $dbh->do($sql);
9786
9787
    $dbh->do('ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id )');
9788
9789
    $dbh->do(
9790
        'ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL'
9791
    );
9792
9793
    $sql=<<'EAN_END';
9794
CREATE TABLE IF NOT EXISTS edifact_ean (
9795
  branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode),
9796
  ean varchar(15) NOT NULL,
9797
  id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14',
9798
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
9799
) ENGINE=InnoDB DEFAULT CHARSET=utf8
9800
EAN_END
9801
9802
    $dbh->do($sql);
9803
    $dbh->do("INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages',  'free')");
9804
    $dbh->do(
9805
        q{INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions')}
9806
    );
9807
9808
    print "Upgrade to $DBversion done (Bug 7736 DB Changes for Edifact Processing ( Quote, Order and Invoice))\n";
9809
>>>>>>> Bug 7736 Edifact QUOTE, ORDER and INVOICE handling
9732
    SetVersion($DBversion);
9810
    SetVersion($DBversion);
9733
}
9811
}
9734
9812
(-)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 54-59 Link Here
54
                window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes');
54
                window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes');
55
            }
55
            }
56
56
57
            function confirm_ediorder() {
58
                var is_confirmed = confirm(_("Are you sure you want to close this basket and generate an Edifact order?"));
59
                if (is_confirmed) {
60
                    window.location = "[% script_name %]?op=edi_confirm&basketno=[% basketno %]";
61
                }
62
            }
63
57
//]]>
64
//]]>
58
</script>
65
</script>
59
[% ELSE %]
66
[% ELSE %]
Lines 160-166 Link Here
160
        </div>
167
        </div>
161
    [% ELSE %]
168
    [% ELSE %]
162
    <div class="yui-b">
169
    <div class="yui-b">
163
        [% UNLESS ( confirm_close ) %]
170
        [% IF !confirm_close && !edi_confirm %]
164
        [% UNLESS ( selectbasketg ) %]
171
        [% UNLESS ( selectbasketg ) %]
165
            [% UNLESS ( closedate ) %]
172
            [% UNLESS ( closedate ) %]
166
                <div id="toolbar" class="btn-toolbar">
173
                <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 667-672 Link Here
667
        </form>
677
        </form>
668
        </div>
678
        </div>
669
    [% END %]
679
    [% END %]
680
[% IF edi_confirm %]
681
        <div id="closebasket_needsconfirmation" class="dialog alert">
682
683
        <form action="/cgi-bin/koha/acqui/basket.pl" class="confirm">
684
            <h1>Are you sure you want to generate an edifact order and close basket [% basketname|html %]?</h1>
685
            [% IF CAN_user_acquisition_group_manage %]
686
            <p>
687
            <label for="createbasketgroup">Attach this basket to a new basket group with the same name</label>
688
            <input type="checkbox" id="createbasketgroup" name="createbasketgroup"/>
689
            </p>
690
            [% END %]
691
            <input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
692
            <input type="hidden" value="ediorder" name="op" />
693
            <input type="hidden" name="ean" value="[% ean %]" />
694
            <input type="hidden" name="booksellerid" value="[% booksellerid %]" />
695
            <input type="hidden" name="confirm" value="1" />
696
            <input type="hidden" name="basketgroupname" value="[% basketgroupname %]" />
697
            <input type="submit" class="approve" value="Yes, close (Y)" accesskey="y" />
698
            <input type="submit" class="deny" value="No, don't close (N)" accesskey="n" onclick="javascript:window.location='/cgi-bin/koha/acqui/basket.pl?basketno=[% basketno %]';return false;" />
699
        </form>
700
        </div>
701
    [% END %]
670
</div>
702
</div>
671
[% END %][%# IF (cannot_manage_basket) %]
703
[% END %][%# IF (cannot_manage_basket) %]
672
</div>
704
</div>
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt (+2 lines)
Lines 144-149 function submitForm(form) { Link Here
144
                            <div class="btn-group"><a href="[% script_name %]?op=reopen&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]&amp;mode=singlebg" class="btn btn-small" id="reopenbutton"><i class="icon-download"></i> Reopen this basket group</a></div>
144
                            <div class="btn-group"><a href="[% script_name %]?op=reopen&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]&amp;mode=singlebg" class="btn btn-small" id="reopenbutton"><i class="icon-download"></i> Reopen this basket group</a></div>
145
                            <div class="btn-group"><a href="[% script_name %]?op=export&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="icon-download"></i> Export this basket group as CSV</a></div>
145
                            <div class="btn-group"><a href="[% script_name %]?op=export&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="exportbutton"><i class="icon-download"></i> Export this basket group as CSV</a></div>
146
                            <div class="btn-group"><a href="[% script_name %]?op=print&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="icon-download"></i> Print this basket group in PDF</a></div>
146
                            <div class="btn-group"><a href="[% script_name %]?op=print&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="icon-download"></i> Print this basket group in PDF</a></div>
147
                            <div class="btn-group"><a href="[% script_name %]?op=ediprint&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="icon-download"></i>Generate edifact order</a></div>
147
                        </div>
148
                        </div>
148
                    [% ELSE %]
149
                    [% ELSE %]
149
                        <div class="btn-group"><a href="[% script_name %]?op=delete&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="delbutton"><i class="icon-remove"></i> Delete basket group</a></div>
150
                        <div class="btn-group"><a href="[% script_name %]?op=delete&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="delbutton"><i class="icon-remove"></i> Delete basket group</a></div>
Lines 380-385 function submitForm(form) { Link Here
380
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="reopen" /><input type="hidden" name="booksellerid" value="[% basketgroup.booksellerid %]" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Reopen" /></form>
381
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="reopen" /><input type="hidden" name="booksellerid" value="[% basketgroup.booksellerid %]" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Reopen" /></form>
381
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="print" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Print" /></form>
382
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="print" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Print" /></form>
382
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="export" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Export as CSV" /></form>
383
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="export" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Export as CSV" /></form>
384
                                                    <form action="/cgi-bin/koha/acqui/basketgroup.pl" method="get"><input type="hidden" name="op" value="ediprint" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Generate edifact order" /></form>
383
                                                </td>
385
                                                </td>
384
                                            </tr>
386
                                            </tr>
385
                                        [% END %]
387
                                        [% END %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt (+38 lines)
Line 0 Link Here
1
[% INCLUDE 'doc-head-open.inc' %]
2
<title>Koha &rsaquo; Acquisitions &rsaquo; Basket ([% basketno %])</title>
3
[% INCLUDE 'doc-head-close.inc' %]
4
5
</head>
6
<body>
7
[% INCLUDE 'header.inc' %]
8
[% INCLUDE 'acquisitions-search.inc' %]
9
10
<div id="breadcrumbs"><a href="/cgi-bin/koha/mainpage.pl">Home</a> &rsaquo; <a href="/cgi-bin/koha/acqui/acqui-home.pl">Acquisitions</a> &rsaquo; Basket ([% basketno %])</div>
11
12
<div id="doc3" class="yui-t2">
13
14
<div id="bd">
15
    <div id="yui-main">
16
    <div class="yui-b">
17
18
    <h2>Identify the branch account submitting the EDI order</h2>
19
    <br />
20
    <form action="/cgi-bin/koha/acqui/basket.pl" method="get">
21
         <p>Select ordering branch account: </p>
22
         <select id="ean" name="ean">
23
             [% FOREACH eanacct IN eans %]
24
             <option value="[% eanacct.ean %]">[% eanacct.branch.branchname %] ([% eanacct.ean %])</option>
25
             [% END %]
26
        </select>
27
        <br />
28
        <input type="hidden" id="basketno" value="[% basketno %]" name="basketno" />
29
        <input type="hidden" value="ediorder" name="op" />
30
        <input type="submit" value="Send EDI order" />
31
    </form>
32
</div>
33
</div>
34
<div class="yui-b">
35
[% INCLUDE 'acquisitions-menu.inc' %]
36
</div>
37
</div>
38
[% INCLUDE 'intranet-bottom.inc' %]
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt (+86 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
</thead>
46
<tbody>
47
[% FOREACH msg IN messages %]
48
<tr>
49
<td>[% msg.message_type %]</td>
50
<td>[% msg.transfer_date %]</td>
51
<td>[% msg.status %]</td>
52
<td>
53
<a href="/cgi-bin/koha/acqui/supplier.pl?booksellerid=[% msg.vendor_id %]"</a>
54
[% msg.vendor.name %]
55
</td>
56
<td>
57
[% IF msg.message_type == 'QUOTE' || msg.message_type == 'ORDERS' %]
58
    [% IF msg.basketno %]
59
    <a href="/cgi-bin/koha/acqui/basket.pl?basketno=[% msg.basketno.basketno %]">
60
    Basket: [% msg.basketno.basketno %]
61
    </a>
62
    [% END %]
63
[% ELSE %]
64
<!-- Assuming invoices -->
65
     <a href="/cgi-bin/koha/acqui/invoices.pl?message_id=[% msg.id %]">
66
      Invoices
67
     </a>
68
[% END %]
69
</td>
70
</td>
71
<td>[% msg.filename %]</td>
72
<td><a class="popup" target="_blank" title="View Message" href="/cgi-bin/koha/acqui/edimsg.pl?id=[% msg.id %]"</a>View Message</td>
73
</tr>
74
[% END %]
75
76
</tbody>
77
</table>
78
79
</div>
80
</div>
81
</div>
82
<div class="yui-b">
83
[% INCLUDE 'acquisitions-menu.inc' %]
84
</div>
85
</div>
86
[% 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 91-96 Link Here
91
        
91
        
92
        <dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>
92
        <dt><a href="/cgi-bin/koha/admin/aqbudgets.pl">Funds</a></dt>
93
        <dd>Define funds within your budgets</dd>
93
        <dd>Define funds within your budgets</dd>
94
        <dt><a href="/cgi-bin/koha/admin/edi_accounts.pl">EDI Accounts</a></dt>
95
        <dd>Manage vendor EDI accounts for import/export</dd>
96
        <dt><a href="/cgi-bin/koha/admin/edi_ean_accounts.pl">EDI EANs</a></dt>
97
        <dd>Manage Branch EDI EANs</dd>
94
98
95
</dl>
99
</dl>
96
100
(-)a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt (+265 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
     <input type="checkbox" name="quotes_enabled" id="quotes_enabled" value="[% account.quotes_enabled %]" [% IF account.quotes_enabled %]checked[% END %] />
147
  </li>
148
  <li>
149
     <label for="orders_enabled">Orders enabled: </label>
150
     <input type="checkbox" name="orders_enabled" id="orders_enabled" value="[% account.orders_enabled %]" [% IF account.orders_enabled %]checked[% END %] />
151
  </li>
152
  <li>
153
     <label for="invoices_enabled">Invoices enabled: </label>
154
     <input type="checkbox" name="invoices_enabled" id="invoices_enabled" value="[% account.invoices_enabled %]" [% IF account.invoices_enabled %]checked[% END %] />
155
  </li>
156
  </ol>
157
  </fieldset>
158
159
  <fieldset class="action">
160
    <input type="submit" value="Submit" />
161
    <a href="/cgi-bin/koha/admin/edi_accounts.pl" class="cancel">Cancel</a>
162
  </fieldset>
163
</form>
164
165
[% END %]
166
[% IF delete_confirm %]
167
<div class="dialog alert">
168
<h3>Delete this account?</h3>
169
<table>
170
    <tr>
171
    <th>Vendor</th>
172
    <td>[% account.vendor %]</td>
173
    </tr>
174
    <tr>
175
    <th>Description</th>
176
    <td>[% account.description %]</td>
177
    </tr>
178
    <tr>
179
    <th>SAN</th>
180
    <td>[% account.san %]</td>
181
    </tr>
182
    <tr>
183
    <th>Last activity</th>
184
    <td>[% account.last_activity %]</td>
185
    </tr>
186
</table>
187
<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="post">
188
    <table>
189
    </table>
190
    <input type="hidden" name="op" value="delete_confirmed" />
191
    <input type="hidden" name="id" value="[% account.id %]" />
192
    <input type="submit" class="approve" value="Yes, Delete" />
193
</form>
194
<form action="/cgi-bin/koha/admin/edi_accounts.pl" method="get">
195
    <input type="submit" class="deny" value="No, do not Delete" />
196
</form>
197
[% END %]
198
[% IF display %]
199
<h2>Vendor EDI accounts</h2>
200
201
    <table>
202
    <tr>
203
       <th>ID</th>
204
       <th>Vendor</th>
205
       <th>Description</th>
206
       <th>Transport</th>
207
       <th>Remote host</th>
208
       <th>Username</th>
209
       <th>Password</th>
210
       <th>Download Directory</th>
211
       <th>Upload Directory</th>
212
       <th>id_code_type</th>
213
       <th>id_code</th>
214
       <th>Quotes</th>
215
       <th>Orders</th>
216
       <th>Invoices</th>
217
       <th>Last activity</th>
218
       <th>Actions</th>
219
    </tr>
220
    [% FOREACH account IN ediaccounts %]
221
    [% IF loop.even %]<tr>
222
    [% ELSE %]<tr class="highlight">
223
    [% END %]
224
      <td>[% account.id %]</td>
225
      <td><a href="/cgi-bin/koha/acqui/supplier.pl?supplierid=[% account.vendor_id %]">[% account.vendor.name %]</a></td>
226
      <td>[% account.description %]</td>
227
      <td>[% account.transport %]</td>
228
      <td>[% account.host %]</td>
229
      <td>[% account.username %]</td>
230
      <td>[% IF account.password %]xxxxx[% END %]</td>
231
      <td>[% account.download_directory %]</td>
232
      <td>[% account.upload_directory %]</td>
233
      <td>[% account.id_code_qualifier %]</td>
234
      <td>[% account.san %]</td>
235
      [% IF account.quotes_enabled %]
236
         <td>Y</td>
237
      [% ELSE %]
238
         <td></td>
239
      [% END %]
240
      [% IF account.orders_enabled %]
241
         <td>Y</td>
242
      [% ELSE %]
243
         <td></td>
244
      [% END %]
245
      [% IF account.invoices_enabled %]
246
         <td>Y</td>
247
      [% ELSE %]
248
         <td></td>
249
      [% END %]
250
      <td>[% account.last_activity %]</td>
251
      <td align="center">
252
          <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>
253
      </td>
254
    </tr>
255
    [% END %]
256
    </table>
257
[% END %]
258
259
</div>
260
</div>
261
<div class="yui-b">
262
    [% INCLUDE 'admin-menu.inc' %]
263
</div>
264
</div>
265
[% 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 107-112 Link Here
107
    <dd>Use tool plugins</dd>
107
    <dd>Use tool plugins</dd>
108
    [% END %]
108
    [% END %]
109
109
110
    [% IF CAN_user_acquisition_edi_manage %]
111
    <dt><a href="/cgi-bin/koha/tools/edi.pl">EDIfact messages</a></dt>
112
    <dd>Manage EDIfact transmissions</dd>
113
    [% END %]
114
110
</dl>
115
</dl>
111
</div>
116
</div>
112
<div class="yui-u">
117
<div class="yui-u">
(-)a/misc/cronjobs/edi_cron.pl (+111 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 2 of the License, or (at your option) any later
10
# version.
11
#
12
# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14
# A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15
#
16
# You should have received a copy of the GNU General Public License along
17
# with Koha; if not, write to the Free Software Foundation, Inc.,
18
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20
use warnings;
21
use strict;
22
23
# Handles all the edi processing for a site
24
# loops through the vendor_edifact records and uploads and downloads
25
# edifact files id the appropriate type is enabled
26
# downloaded quotes and invoices are processed here
27
# can be run as frequently as required
28
29
use C4::Context;
30
use Log::Log4perl qw(:easy);
31
use Koha::Database;
32
use Koha::EDI qw( process_quote process_invoice);
33
use Koha::Edifact::Transport;
34
35
my $logdir = C4::Context->logdir;
36
37
# logging set to trace as this may be what you
38
# want on implementation
39
Log::Log4perl->easy_init(
40
    {
41
        level => $TRACE,
42
        file  => ">>$logdir/editrace.log",
43
    }
44
);
45
46
my $schema = Koha::Database->new()->schema();
47
48
my @edi_accts = $schema->resultset('VendorEdiAccount')->all();
49
50
my $logger = Log::Log4perl->get_logger();
51
52
for my $acct (@edi_accts) {
53
    if ( $acct->quotes_enabled ) {
54
        my $downloader = Koha::Edifact::Transport->new( $acct->id );
55
        $downloader->download_messages('QUOTE');
56
57
        #update vendor last activity
58
    }
59
60
    if ( $acct->invoices_enabled ) {
61
        my $downloader = Koha::Edifact::Transport->new( $acct->id );
62
        $downloader->download_messages('INVOICE');
63
64
        #update vendor last activity
65
    }
66
    if ( $acct->orders_enabled ) {
67
68
        # select pending messages
69
        my @pending_orders = $schema->resultset('EdifactMessage')->search(
70
            {
71
                message_type => 'ORDERS',
72
                vendor_id    => $acct->vendor_id,
73
                status       => 'Pending',
74
            }
75
        );
76
        my $uploader = Koha::Edifact::Transport->new( $acct->id );
77
        $uploader->upload_messages(@pending_orders);
78
    }
79
}
80
81
# process any downloaded quotes
82
83
my @downloaded_quotes = $schema->resultset('EdifactMessage')->search(
84
    {
85
        message_type => 'QUOTE',
86
        status       => 'new',
87
    }
88
)->all;
89
90
foreach my $quote_file (@downloaded_quotes) {
91
    my $filename = $quote_file->filename;
92
    $logger->trace("Processing quote $filename");
93
    process_quote($quote_file);
94
}
95
96
# process any downloaded invoices
97
98
my @downloaded_invoices = $schema->resultset('EdifactMessage')->search(
99
    {
100
        message_type => 'INVOICE',
101
        status       => 'new',
102
    }
103
)->all;
104
105
foreach my $invoice (@downloaded_invoices) {
106
    my $filename = $invoice->filename();
107
    $logger->trace("Processing invoice $filename");
108
    process_invoice($invoice);
109
}
110
111
exit 0;
(-)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/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->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/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