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

(-)a/C4/Acquisition.pm (-1 / +5 lines)
Lines 2578-2583 sub GetInvoices { Link Here
2578
        push @bind_strs, " borrowers.branchcode = ? ";
2578
        push @bind_strs, " borrowers.branchcode = ? ";
2579
        push @bind_args, $args{branchcode};
2579
        push @bind_args, $args{branchcode};
2580
    }
2580
    }
2581
    if($args{message_id}) {
2582
        push @bind_strs, " aqinvoices.message_id = ? ";
2583
        push @bind_args, $args{message_id};
2584
    }
2581
2585
2582
    $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2586
    $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs;
2583
    $query .= " GROUP BY aqinvoices.invoiceid ";
2587
    $query .= " GROUP BY aqinvoices.invoiceid ";
Lines 2693-2699 sub AddInvoice { Link Here
2693
    return unless(%invoice and $invoice{invoicenumber});
2697
    return unless(%invoice and $invoice{invoicenumber});
2694
2698
2695
    my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2699
    my @columns = qw(invoicenumber booksellerid shipmentdate billingdate
2696
        closedate shipmentcost shipmentcost_budgetid);
2700
        closedate shipmentcost shipmentcost_budgetid message_id);
2697
2701
2698
    my @set_strs;
2702
    my @set_strs;
2699
    my @set_args;
2703
    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 (+537 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(AddItemFromMarc AddItem);
31
use C4::Biblio qw( AddBiblio TransformKohaToMarc );
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
    $bib_hash->{'biblio.seriestitle'} = $item->series;
246
247
    $bib_hash->{'biblioitems.publishercode'} = $item->publisher;
248
    $bib_hash->{'biblioitems.publicationyear'} =
249
      $bib_hash->{'biblio.copyrightdate'} = $item->publication_date;
250
251
    $bib_hash->{'biblio.title'}         = $item->title;
252
    $bib_hash->{'biblio.author'}        = $item->author;
253
    $bib_hash->{'biblioitems.isbn'}     = $item->item_number_id;
254
    $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category');
255
    $bib_hash->{'items.booksellerid'}   = $quote->vendor_id;
256
    $bib_hash->{'items.price'} = $bib_hash->{'items.replacementprice'} =
257
      $item->price;
258
    $bib_hash->{'items.itype'}    = $item->girfield('stock_category');
259
    $bib_hash->{'items.location'} = $item->girfield('collection_code');
260
261
    my $budget = _get_budget( $schema, $item->girfield('fund_allocation') );
262
263
    if ( !$budget ) {
264
        carp 'Skipping line with no budget info';
265
        $logger->trace('line skipped for invalid budget');
266
        return;
267
    }
268
269
    my $note = {};
270
271
    my $shelfmark =
272
      $item->girfield('shelfmark') || $item->girfield('classification') || q{};
273
    $bib_hash->{'items.itemcallnumber'} = $shelfmark;
274
    my $branch = $item->girfield('branch');
275
    $bib_hash->{'items.holdingbranch'} = $bib_hash->{'items.homebranch'} =
276
      $branch;
277
    for my $key ( keys %{$bib_hash} ) {
278
        if ( !defined $bib_hash->{$key} ) {
279
            delete $bib_hash->{$key};
280
        }
281
    }
282
    my $bib_record = TransformKohaToMarc($bib_hash);
283
284
    $logger->trace( 'Checking db for matches with ', $item->item_number_id() );
285
    my $bib = _check_for_existing_bib( $item->item_number_id() );
286
    if ( !defined $bib ) {
287
        $bib = {};
288
        ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) =
289
          AddBiblio( $bib_record, q{} );
290
        $logger->trace("New biblio added $bib->{biblionumber}");
291
    }
292
    else {
293
        $logger->trace("Match found: $bib->{biblionumber}");
294
    }
295
296
    my $order_note = $item->{free_text};
297
    $order_note ||= q{};
298
    if ( !$basketno ) {
299
        $logger->error('Skipping order creation no basketno');
300
        return;
301
    }
302
303
    # database definitions should set some of these defaults but dont
304
    my $order_hash = {
305
        biblionumber     => $bib->{biblionumber},
306
        entrydate        => DateTime->now( time_zone => 'local' )->ymd(),
307
        quantity         => $item->quantity,
308
        basketno         => $basketno,
309
        listprice        => $item->price,
310
        quantityreceived => 0,
311
312
        #        notes             => $order_note, becane internalnote in 3.15
313
        order_internalnote => $order_note,
314
        rrp                => $item->price,
315
        ecost => _discounted_price( $quote->vendor->discount, $item->price ),
316
        budget_id         => $budget->budget_id,
317
        uncertainprice    => 0,
318
        sort1             => q{},
319
        sort2             => q{},
320
        supplierreference => $item->reference,
321
    };
322
    if ( $item->girfield('servicing_instruction') ) {
323
324
        # not in 3.14 !!!
325
        $order_hash->{order_vendornote} =
326
          $item->girfield('servicing_instruction');
327
    }
328
    if ( $item->internal_notes() ) {
329
        if ( $order_hash->{order_internalnote} ) {    # more than ''
330
            $order_hash->{order_internalnote} .= q{ };
331
        }
332
333
        $order_hash->{order_internalnote} .= $item->internal_notes;
334
    }
335
336
    my $new_order = $schema->resultset('Aqorder')->create($order_hash);
337
    $logger->trace("Order created :$new_order->ordernumber");
338
339
    # should be done by database settings
340
    $new_order->parent_ordernumber( $new_order->ordernumber() );
341
    $new_order->update();
342
343
    if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) {
344
        my $itemnumber;
345
        ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber ) =
346
          AddItemFromMarc( $bib_record, $bib->{biblionumber} );
347
        $logger->trace("Added item:$itemnumber");
348
        $schema->resultset('AqordersItem')->create(
349
            {
350
                ordernumber => $new_order->ordernumber,
351
                itemnumber  => $itemnumber,
352
            }
353
        );
354
355
        if ( $item->quantity > 1 ) {
356
            my $occurence = 1;
357
            while ( $occurence < $item->quantity ) {
358
                my $new_item = {
359
                    notforloan       => -1,
360
                    cn_sort          => q{},
361
                    cn_source        => 'ddc',
362
                    price            => $item->price,
363
                    replacementprice => $item->price,
364
                    itype => $item->girfield( 'stock_category', $occurence ),
365
                    location =>
366
                      $item->girfield( 'collection_code', $occurence ),
367
                    itemcallnumber => $item->girfield( 'shelfmark', $occurence )
368
                      || $item->girfield( 'classification', $occurence ),
369
                    holdingbranch => $item->girfield( 'branch', $occurence ),
370
                    homebranch    => $item->girfield( 'branch', $occurence ),
371
                };
372
                ( undef, undef, $itemnumber ) =
373
                  AddItem( $new_item, $bib->{biblionumber} );
374
                $logger->trace("New item $itemnumber added");
375
                $schema->resultset('AqordersItem')->create(
376
                    {
377
                        ordernumber => $new_order->ordernumber,
378
                        itemnumber  => $itemnumber,
379
                    }
380
                );
381
                ++$occurence;
382
            }
383
        }
384
385
    }
386
    return 1;
387
}
388
389
sub get_edifact_ean {
390
391
    my $dbh = C4::Context->dbh;
392
393
    my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean');
394
395
    return $eans->[0];
396
}
397
398
# We should not need to have a routine to do this here
399
sub _discounted_price {
400
    my ( $discount, $price ) = @_;
401
    return $price - ( ( $discount * $price ) / 100 );
402
}
403
404
sub _check_for_existing_bib {
405
    my $isbn = shift;
406
407
    my $search_isbn = $isbn;
408
    $search_isbn =~ s/^\s*/%/xms;
409
    $search_isbn =~ s/\s*$/%/xms;
410
    my $dbh = C4::Context->dbh;
411
    my $sth = $dbh->prepare(
412
'select biblionumber, biblioitemnumber from biblioitems where isbn like ?',
413
    );
414
    my $tuple_arr =
415
      $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
416
    if ( @{$tuple_arr} ) {
417
        return $tuple_arr->[0];
418
    }
419
    else {
420
        undef $search_isbn;
421
        $isbn =~ s/\-//xmsg;
422
        if ( $isbn =~ m/(\d{13})/xms ) {
423
            my $b_isbn = Business::ISBN->new($1);
424
            if ( $b_isbn && $b_isbn->is_valid ) {
425
                $search_isbn = $b_isbn->as_isbn10->as_string( [] );
426
            }
427
428
        }
429
        elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) {
430
            my $b_isbn = Business::ISBN->new($1);
431
            if ( $b_isbn && $b_isbn->is_valid ) {
432
                $search_isbn = $b_isbn->as_isbn13->as_string( [] );
433
            }
434
435
        }
436
        if ($search_isbn) {
437
            $search_isbn = "%$search_isbn%";
438
            $tuple_arr =
439
              $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn );
440
            if ( @{$tuple_arr} ) {
441
                return $tuple_arr->[0];
442
            }
443
        }
444
    }
445
    return;
446
}
447
448
# returns a budget obj or undef
449
# fact we need this shows what a mess Acq API is
450
sub _get_budget {
451
    my ( $schema, $budget_code ) = @_;
452
453
    # db does not ensure budget code is unque
454
    return $schema->resultset('Aqbudget')->single(
455
        {
456
            budget_code => $budget_code,
457
        }
458
    );
459
}
460
461
1;
462
__END__
463
464
=head1 NAME
465
   Koha::EDI
466
467
=head1 SYNOPSIS
468
469
   Module exporting subroutines used in EDI processing for Koha
470
471
=head1 DESCRIPTION
472
473
   Subroutines called by batch processing to handle Edifact
474
   messages of various types and related utilities
475
476
=head1 BUGS
477
478
   These routines should really be methods of some object.
479
   get_edifact_ean is a stopgap which should be replaced
480
481
=head1 SUBROUTINES
482
483
=head2 process_quote
484
485
    process_quote(quote_message);
486
487
   passed a message object for a quote, parses it creating an order basket
488
   and orderlines in the database
489
   updates the message's status to received in the database and adds the
490
   link to basket
491
492
=head2 process_invoice
493
494
    process_invoice(invoice_message)
495
496
    passed a message object for an invoice, add the contained invoices
497
    and update the orderlines referred to in the invoice
498
    As an Edifact invoice is in effect a despatch note this receipts the
499
    appropriate quantities in the orders
500
501
502
=head2 create_edi_order
503
504
    create_edi_order( { parameter_hashref } )
505
506
    parameters must include basketno and ean
507
508
    branchcode can optionally be passed
509
510
    returns 1 on success undef otherwise
511
512
    if the parameter noingest is set the formatted order is returned
513
    and not saved in the database. This functionality is intended for debugging only
514
515
=head2 get_edifact_ean
516
517
518
=head2 quote_item
519
520
     quote_item(lineitem, quote_message);
521
522
      Called by process_quote to handle an individual lineitem
523
     Generate the biblios and items if required and orderline linking to them
524
525
=head1 AUTHOR
526
527
   Colin Campbell <colin.campbell@ptfs-europe.com>
528
529
530
=head1 COPYRIGHT
531
532
   Copyright 2014, PTFS-Europe Ltd
533
   This program is free software, You may redistribute it under
534
   under the terms of the GNU General Public License
535
536
537
=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 (-2 / +17 lines)
Lines 227-232 __PACKAGE__->has_many( Link Here
227
  { cascade_copy => 0, cascade_delete => 0 },
227
  { cascade_copy => 0, cascade_delete => 0 },
228
);
228
);
229
229
230
=head2 vendor_edi_accounts
231
232
Type: has_many
233
234
Related object: L<Koha::Schema::Result::VendorEdiAccount>
235
236
=cut
237
238
__PACKAGE__->has_many(
239
  "vendor_edi_accounts",
240
  "Koha::Schema::Result::VendorEdiAccount",
241
  { "foreign.shipment_budget" => "self.budget_id" },
242
  { cascade_copy => 0, cascade_delete => 0 },
243
);
244
230
=head2 borrowernumbers
245
=head2 borrowernumbers
231
246
232
Type: many_to_many
247
Type: many_to_many
Lines 238-245 Composing rels: L</aqbudgetborrowers> -> borrowernumber Link Here
238
__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");
253
__PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber");
239
254
240
255
241
# Created by DBIx::Class::Schema::Loader v0.07025 @ 2013-10-14 20:56:21
256
# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47
242
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:dxOTKpdIJ6ruJUE++4fC8w
257
# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:Ieg4SfRCek9KwaDyUKmoWA
243
258
244
259
245
# You can replace this text with custom content, and it will be preserved on regeneration
260
# 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 37-42 use C4::Members qw/GetMember/; #needed for permissions checking for changing ba Link Here
37
use C4::Items;
37
use C4::Items;
38
use C4::Suggestions;
38
use C4::Suggestions;
39
use Date::Calc qw/Add_Delta_Days/;
39
use Date::Calc qw/Add_Delta_Days/;
40
use Koha::Database;
41
use Koha::EDI qw( create_edi_order get_edifact_ean );
40
42
41
=head1 NAME
43
=head1 NAME
42
44
Lines 68-73 the supplier this script have to display the basket. Link Here
68
70
69
my $query        = new CGI;
71
my $query        = new CGI;
70
our $basketno     = $query->param('basketno');
72
our $basketno     = $query->param('basketno');
73
my $ean          = $query->param('ean');
71
my $booksellerid = $query->param('booksellerid');
74
my $booksellerid = $query->param('booksellerid');
72
75
73
my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
76
my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user(
Lines 84-89 my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( Link Here
84
my $basket = GetBasket($basketno);
87
my $basket = GetBasket($basketno);
85
$booksellerid = $basket->{booksellerid} unless $booksellerid;
88
$booksellerid = $basket->{booksellerid} unless $booksellerid;
86
my ($bookseller) = GetBookSellerFromId($booksellerid);
89
my ($bookseller) = GetBookSellerFromId($booksellerid);
90
my $schema = Koha::Database->new()->schema();
91
my $rs = $schema->resultset('VendorEdiAccount')->search(
92
    { vendor_id => $booksellerid, } );
93
$template->param( ediaccount => ($rs->count > 0));
87
94
88
unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
95
unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) {
89
    $template->param(
96
    $template->param(
Lines 237-242 if ( $op eq 'delete_confirm' ) { Link Here
237
} elsif ($op eq 'reopen') {
244
} elsif ($op eq 'reopen') {
238
    ReopenBasket($query->param('basketno'));
245
    ReopenBasket($query->param('basketno'));
239
    print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
246
    print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'})
247
}
248
elsif ( $op eq 'ediorder' ) {
249
    edi_close_and_order()
240
} elsif ( $op eq 'mod_users' ) {
250
} elsif ( $op eq 'mod_users' ) {
241
    my $basketusers_ids = $query->param('basketusers_ids');
251
    my $basketusers_ids = $query->param('basketusers_ids');
242
    my @basketusers = split( /:/, $basketusers_ids );
252
    my @basketusers = split( /:/, $basketusers_ids );
Lines 448-453 sub get_order_infos { Link Here
448
    $line{basketno}       = $basketno;
458
    $line{basketno}       = $basketno;
449
    $line{budget_name}    = $budget->{budget_name};
459
    $line{budget_name}    = $budget->{budget_name};
450
    $line{rrp} = ConvertCurrency( $order->{'currency'}, $line{rrp} ); # FIXME from comm
460
    $line{rrp} = ConvertCurrency( $order->{'currency'}, $line{rrp} ); # FIXME from comm
461
    $line{gstrate} ||= 0;
451
    if ( $bookseller->{'listincgst'} ) {
462
    if ( $bookseller->{'listincgst'} ) {
452
        $line{rrpgsti} = sprintf( "%.2f", $line{rrp} );
463
        $line{rrpgsti} = sprintf( "%.2f", $line{rrp} );
453
        $line{gstgsti} = sprintf( "%.2f", $line{gstrate} * 100 );
464
        $line{gstgsti} = sprintf( "%.2f", $line{gstrate} * 100 );
Lines 533-535 sub get_order_infos { Link Here
533
}
544
}
534
545
535
output_html_with_http_headers $query, $cookie, $template->output;
546
output_html_with_http_headers $query, $cookie, $template->output;
547
548
549
sub edi_close_and_order {
550
    my $confirm = $query->param('confirm') || $confirm_pref eq '2';
551
    if ($confirm) {
552
            my $edi_params = {
553
                basketno => $basketno,
554
                ean    => $ean,
555
            };
556
            if ( $basket->{branch} ) {
557
                $edi_params->{branchcode} = $basket->{branch};
558
            }
559
            if ( create_edi_order($edi_params) ) {
560
                #$template->param( edifile => 1 );
561
            }
562
        CloseBasket($basketno);
563
564
        # if requested, create basket group, close it and attach the basket
565
        if ( $query->param('createbasketgroup') ) {
566
            my $branchcode;
567
            if (    C4::Context->userenv
568
                and C4::Context->userenv->{'branch'}
569
                and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET" )
570
            {
571
                $branchcode = C4::Context->userenv->{'branch'};
572
            }
573
            my $basketgroupid = NewBasketgroup(
574
                {
575
                    name          => $basket->{basketname},
576
                    booksellerid  => $booksellerid,
577
                    deliveryplace => $branchcode,
578
                    billingplace  => $branchcode,
579
                    closed        => 1,
580
                }
581
            );
582
            ModBasket(
583
                {
584
                    basketno      => $basketno,
585
                    basketgroupid => $basketgroupid
586
                }
587
            );
588
            print $query->redirect(
589
"/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1"
590
            );
591
        }
592
        else {
593
            print $query->redirect(
594
                "/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid"
595
            );
596
        }
597
        exit;
598
    }
599
    else {
600
        $template->param(
601
            edi_confirm     => 1,
602
            booksellerid    => $booksellerid,
603
            basketno        => $basket->{basketno},
604
            basketname      => $basket->{basketname},
605
            basketgroupname => $basket->{basketname},
606
        );
607
        if ($ean) {
608
            $template->param( ean => $ean );
609
        }
610
611
    }
612
    return;
613
}
(-)a/acqui/basketgroup.pl (+17 lines)
Lines 58-63 use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsBy Link Here
58
use C4::Bookseller qw/GetBookSellerFromId/;
58
use C4::Bookseller qw/GetBookSellerFromId/;
59
use C4::Branch qw/GetBranches/;
59
use C4::Branch qw/GetBranches/;
60
use C4::Members qw/GetMember/;
60
use C4::Members qw/GetMember/;
61
use Koha::EDI qw/create_edi_order get_edifact_ean/;
61
62
62
our $input=new CGI;
63
our $input=new CGI;
63
64
Lines 235-246 sub printbasketgrouppdf{ Link Here
235
236
236
}
237
}
237
238
239
sub generate_edifact_orders {
240
    my $basketgroupid = shift;
241
    my $baskets       = GetBasketsByBasketgroup($basketgroupid);
242
    my $ean           = get_edifact_ean();
243
244
    for my $basket ( @{$baskets} ) {
245
        create_edi_order( { ean => $ean, basketno => $basket->{basketno}, } );
246
    }
247
    return;
248
}
249
238
my $op = $input->param('op') || 'display';
250
my $op = $input->param('op') || 'display';
239
# possible values of $op :
251
# possible values of $op :
240
# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup
252
# - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup
241
# - mod_basket : modify an individual basket of the basketgroup
253
# - mod_basket : modify an individual basket of the basketgroup
242
# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list
254
# - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list
243
# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list
255
# - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list
256
# - ediprint : generate edi order messages for the baskets in the group
244
# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list
257
# - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list
245
# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list
258
# - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list
246
# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list
259
# - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list
Lines 399-404 if ( $op eq "add" ) { Link Here
399
    $redirectpath .=  "&amp;listclosed=1" if $closedbg ;
412
    $redirectpath .=  "&amp;listclosed=1" if $closedbg ;
400
    print $input->redirect($redirectpath );
413
    print $input->redirect($redirectpath );
401
    
414
    
415
} elsif ( $op eq 'ediprint') {
416
    my $basketgroupid = $input->param('basketgroupid');
417
    generate_edifact_orders( $basketgroupid );
418
    exit;
402
}else{
419
}else{
403
# no param : display the list of all basketgroups for a given vendor
420
# no param : display the list of all basketgroups for a given vendor
404
    my $basketgroups = &GetBasketgroups($booksellerid);
421
    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 62-67 my $author = $input->param('author'); Link Here
62
my $publisher        = $input->param('publisher');
62
my $publisher        = $input->param('publisher');
63
my $publicationyear  = $input->param('publicationyear');
63
my $publicationyear  = $input->param('publicationyear');
64
my $branch           = $input->param('branch');
64
my $branch           = $input->param('branch');
65
my $message_id       = $input->param('message_id');
65
my $op               = $input->param('op');
66
my $op               = $input->param('op');
66
67
67
my $invoices = [];
68
my $invoices = [];
Lines 82-88 if ( $op and $op eq 'do_search' ) { Link Here
82
        author           => $author,
83
        author           => $author,
83
        publisher        => $publisher,
84
        publisher        => $publisher,
84
        publicationyear  => $publicationyear,
85
        publicationyear  => $publicationyear,
85
        branchcode       => $branch
86
        branchcode       => $branch,
87
        message_id       => $message_id,
86
    );
88
    );
87
}
89
}
88
90
(-)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 / +69 lines)
Lines 3118-3123 CREATE TABLE aqorders_transfers ( Link Here
3118
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3118
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3119
3119
3120
--
3120
--
3121
-- Table structure for table vendor_edi_accounts
3122
--
3123
3124
DROP TABLE IF EXISTS vendor_edi_accounts;
3125
CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
3126
  id int(11) NOT NULL auto_increment,
3127
  description text NOT NULL,
3128
  host varchar(40),
3129
  username varchar(40),
3130
  password varchar(40),
3131
  last_activity date,
3132
  vendor_id int(11) references aqbooksellers( id ),
3133
  download_directory text,
3134
  upload_directory text,
3135
  san varchar(20),
3136
  id_code_qualifier varchar(3) default '14',
3137
  transport varchar(6) default 'FTP',
3138
  quotes_enabled tinyint(1) not null default 0,
3139
  invoices_enabled tinyint(1) not null default 0,
3140
  orders_enabled tinyint(1) not null default 0,
3141
  shipment_budget integer(11) references aqbudgets( budget_id ),
3142
  PRIMARY KEY  (id),
3143
  KEY vendorid (vendor_id),
3144
  KEY shipmentbudget (shipment_budget),
3145
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
3146
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
3147
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3148
3149
--
3150
-- Table structure for table edifact_messages
3151
--
3152
3153
DROP TABLE IF EXISTS edifact_messages;
3154
CREATE TABLE IF NOT EXISTS edifact_messages (
3155
  id int(11) NOT NULL auto_increment,
3156
  message_type varchar(10) NOT NULL,
3157
  transfer_date date,
3158
  vendor_id int(11) references aqbooksellers( id ),
3159
  edi_acct  integer references vendor_edi_accounts( id ),
3160
  status text,
3161
  basketno int(11) references aqbasket( basketno),
3162
  raw_msg text,
3163
  filename text,
3164
  deleted boolean not null default 0,
3165
  PRIMARY KEY  (id),
3166
  KEY vendorid ( vendor_id),
3167
  KEY ediacct (edi_acct),
3168
  KEY basketno ( basketno),
3169
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
3170
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
3171
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
3172
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3173
3174
--
3121
-- Table structure for table aqinvoices
3175
-- Table structure for table aqinvoices
3122
--
3176
--
3123
3177
Lines 3131-3139 CREATE TABLE aqinvoices ( Link Here
3131
  closedate date default NULL,  -- invoice close date, NULL means the invoice is open
3185
  closedate date default NULL,  -- invoice close date, NULL means the invoice is open
3132
  shipmentcost decimal(28,6) default NULL,  -- shipment cost
3186
  shipmentcost decimal(28,6) default NULL,  -- shipment cost
3133
  shipmentcost_budgetid int(11) default NULL,   -- foreign key to aqbudgets, link the shipment cost to a budget
3187
  shipmentcost_budgetid int(11) default NULL,   -- foreign key to aqbudgets, link the shipment cost to a budget
3188
  message_id int(11) default NULL, -- foreign key to edifact invoice message
3134
  PRIMARY KEY (invoiceid),
3189
  PRIMARY KEY (invoiceid),
3135
  CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
3190
  CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE,
3136
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE
3191
  CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE,
3192
  CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL
3137
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3193
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3138
3194
3139
3195
Lines 3502-3507 CREATE TABLE items_search_fields ( Link Here
3502
    ON DELETE SET NULL ON UPDATE CASCADE
3558
    ON DELETE SET NULL ON UPDATE CASCADE
3503
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3559
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3504
3560
3561
--
3562
-- Table structure for table 'edifact_ean'
3563
--
3564
3565
DROP TABLE IF EXISTS edifact_ean;
3566
CREATE TABLE IF NOT EXISTS edifact_ean (
3567
  branchcode varchar(10) not null references branches (branchcode),
3568
  ean varchar(15) NOT NULL,
3569
  id_code_qualifier varchar(3) NOT NULL default '14',
3570
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
3571
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
3572
3505
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
3573
/*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
3506
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
3574
/*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
3507
/*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
3575
/*!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 (+79 lines)
Lines 9573-9578 if ( CheckVersion($DBversion) ) { Link Here
9573
    SetVersion($DBversion);
9573
    SetVersion($DBversion);
9574
}
9574
}
9575
9575
9576
$DBversion = "3.17.00.XXX";
9577
if( CheckVersion($DBversion) ){
9578
9579
    my $sql=<<'VEA_END';
9580
CREATE TABLE IF NOT EXISTS vendor_edi_accounts (
9581
  id int(11) NOT NULL auto_increment,
9582
  description text NOT NULL,
9583
  host varchar(40),
9584
  username varchar(40),
9585
  password varchar(40),
9586
  last_activity date,
9587
  vendor_id int(11) references aqbooksellers( id ),
9588
  download_directory text,
9589
  upload_directory text,
9590
  san varchar(20),
9591
  id_code_qualifier varchar(3) default '14',
9592
  transport varchar(6) default 'FTP',
9593
  quotes_enabled tinyint(1) not null default 0,
9594
  invoices_enabled tinyint(1) not null default 0,
9595
  orders_enabled tinyint(1) not null default 0,
9596
  shipment_budget integer(11) references aqbudgets( budget_id ),
9597
  PRIMARY KEY  (id),
9598
  KEY vendorid (vendor_id),
9599
  KEY shipmentbudget (shipment_budget),
9600
  CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
9601
  CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id )
9602
) ENGINE=InnoDB DEFAULT CHARSET=utf8
9603
VEA_END
9604
9605
    $dbh->do($sql);
9606
9607
    $sql=<<'EM_END';
9608
CREATE TABLE IF NOT EXISTS edifact_messages (
9609
  id int(11) NOT NULL auto_increment,
9610
  message_type varchar(10) NOT NULL,
9611
  transfer_date date,
9612
  vendor_id int(11) references aqbooksellers( id ),
9613
  edi_acct  integer references vendor_edi_accounts( id ),
9614
  status text,
9615
  basketno int(11) REFERENCES aqbasket( basketno),
9616
  raw_msg text,
9617
  filename text,
9618
  deleted boolean not null default 0,
9619
  PRIMARY KEY  (id),
9620
  KEY vendorid ( vendor_id),
9621
  KEY ediacct (edi_acct),
9622
  KEY basketno ( basketno),
9623
  CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ),
9624
  CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ),
9625
  CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno )
9626
) ENGINE=InnoDB DEFAULT CHARSET=utf8
9627
EM_END
9628
9629
    $dbh->do($sql);
9630
9631
    $dbh->do('ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id )');
9632
9633
    $dbh->do(
9634
        'ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL'
9635
    );
9636
9637
    $sql=<<'EAN_END';
9638
CREATE TABLE IF NOT EXISTS edifact_ean (
9639
  branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode),
9640
  ean varchar(15) NOT NULL,
9641
  id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14',
9642
  CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode )
9643
) ENGINE=InnoDB DEFAULT CHARSET=utf8
9644
EAN_END
9645
9646
    $dbh->do($sql);
9647
    $dbh->do(
9648
        q{INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions')}
9649
    );
9650
9651
    print "Upgrade to $DBversion done (Bug 7736 DB Changes for Edifact Processing ( Quote, Order and Invoice))\n";
9652
    SetVersion($DBversion);
9653
}
9654
9576
=head1 FUNCTIONS
9655
=head1 FUNCTIONS
9577
9656
9578
=head2 TableExists($table)
9657
=head2 TableExists($table)
(-)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 143-148 function submitForm(form) { Link Here
143
                            <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>
143
                            <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=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>
144
                            <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=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>
145
                            <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=ediprint&amp;basketgroupid=[% basketgroupid %]&amp;booksellerid=[% booksellerid %]" class="btn btn-small" id="printbutton"><i class="icon-download"></i>Generate edifact order</a></div>
146
                        </div>
147
                        </div>
147
                    [% ELSE %]
148
                    [% ELSE %]
148
                        <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>
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>
Lines 379-384 function submitForm(form) { Link Here
379
                                                    <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>
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>
380
                                                    <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>
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>
381
                                                    <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>
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="ediprint" /><input type="hidden" name="basketgroupid" value="[% basketgroup.id %]" /><input type="submit" value="Generate edifact order" /></form>
382
                                                </td>
384
                                                </td>
383
                                            </tr>
385
                                            </tr>
384
                                        [% END %]
386
                                        [% 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