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

(-)a/Koha/EDI.pm (-42 / +90 lines)
Lines 315-354 sub process_invoice { Link Here
315
                            }
315
                            }
316
                        );
316
                        );
317
                    }
317
                    }
318
                    # If quantity_invoiced is present use it in preference
319
                    my $quantity = $line->quantity_invoiced;
320
                    if (!$quantity) {
321
                        $quantity = $line->quantity;
322
                    }
318
323
319
                    my $price = _get_invoiced_price($line);
324
                    my ( $price, $price_excl_tax ) = _get_invoiced_price($line, $quantity);
325
                    my $tax_rate = $line->tax_rate;
326
                    if ($tax_rate && $tax_rate->{rate} != 0) {
327
                       $tax_rate->{rate} /= 100;
328
                    }
320
329
321
                    if ( $order->quantity > $line->quantity ) {
330
                    if ( $order->quantity > $quantity ) {
322
                        my $ordered = $order->quantity;
331
                        my $ordered = $order->quantity;
323
332
324
                        # part receipt
333
                        # part receipt
325
                        $order->orderstatus('partial');
334
                        $order->orderstatus('partial');
326
                        $order->quantity( $ordered - $line->quantity );
335
                        $order->quantity( $ordered - $quantity );
327
                        $order->update;
336
                        $order->update;
328
                        my $received_order = $order->copy(
337
                        my $received_order = $order->copy(
329
                            {
338
                            {
330
                                ordernumber      => undef,
339
                                ordernumber            => undef,
331
                                quantity         => $line->quantity,
340
                                quantity               => $quantity,
332
                                quantityreceived => $line->quantity,
341
                                quantityreceived       => $quantity,
333
                                orderstatus      => 'complete',
342
                                orderstatus            => 'complete',
334
                                unitprice        => $price,
343
                                unitprice              => $price,
335
                                invoiceid        => $invoiceid,
344
                                unitprice_tax_included => $price,
336
                                datereceived     => $msg_date,
345
                                unitprice_tax_excluded => $price_excl_tax,
346
                                invoiceid              => $invoiceid,
347
                                datereceived           => $msg_date,
348
                                tax_rate_on_receiving  => $tax_rate->{rate},
349
                                tax_value_on_receiving => $quantity * $price_excl_tax * $tax_rate->{rate},
337
                            }
350
                            }
338
                        );
351
                        );
339
                        transfer_items( $schema, $line, $order,
352
                        transfer_items( $schema, $line, $order,
340
                            $received_order );
353
                            $received_order, $quantity );
341
                        receipt_items( $schema, $line,
354
                        receipt_items( $schema, $line,
342
                            $received_order->ordernumber );
355
                            $received_order->ordernumber, $quantity );
343
                    }
356
                    }
344
                    else {    # simple receipt all copies on order
357
                    else {    # simple receipt all copies on order
345
                        $order->quantityreceived( $line->quantity );
358
                        $order->quantityreceived( $quantity );
346
                        $order->datereceived($msg_date);
359
                        $order->datereceived($msg_date);
347
                        $order->invoiceid($invoiceid);
360
                        $order->invoiceid($invoiceid);
348
                        $order->unitprice($price);
361
                        $order->unitprice($price);
362
                        $order->unitprice_tax_excluded($price_excl_tax);
363
                        $order->unitprice_tax_included($price);
364
                        $order->tax_rate_on_receiving($tax_rate->{rate});
365
                        $order->tax_value_on_receiving( $quantity * $price_excl_tax * $tax_rate->{rate});
349
                        $order->orderstatus('complete');
366
                        $order->orderstatus('complete');
350
                        $order->update;
367
                        $order->update;
351
                        receipt_items( $schema, $line, $ordernumber );
368
                        receipt_items( $schema, $line, $ordernumber, $quantity );
352
                    }
369
                    }
353
                }
370
                }
354
                else {
371
                else {
Lines 369-389 sub process_invoice { Link Here
369
}
386
}
370
387
371
sub _get_invoiced_price {
388
sub _get_invoiced_price {
372
    my $line  = shift;
389
    my $line       = shift;
373
    my $price = $line->price_net;
390
    my $qty        = shift;
374
    if ( !defined $price ) {  # no net price so generate it from lineitem amount
391
    my $line_total = $line->amt_total;
375
        $price = $line->amt_lineitem;
392
    my $excl_tax   = $line->amt_lineitem;
376
        if ( $price and $line->quantity > 1 ) {
393
377
            $price /= $line->quantity;    # div line cost by qty
394
    # If no tax some suppliers omit the total owed
395
    # If no total given calculate from cost exclusive of tax
396
    # + tax amount (if present, sometimes omitted if 0 )
397
    if ( !defined $line_total ) {
398
        my $x = $line->amt_taxoncharge;
399
        if ( !defined $x ) {
400
            $x = 0;
378
        }
401
        }
402
        $line_total = $excl_tax + $x;
403
    }
404
405
    # invoices give amounts per orderline, Koha requires that we store
406
    # them per item
407
    if ( $qty != 1 ) {
408
        return ( $line_total / $qty, $excl_tax / $qty );
379
    }
409
    }
380
    return $price;
410
    return ( $line_total, $excl_tax );    # return as is for most common case
381
}
411
}
382
412
383
sub receipt_items {
413
sub receipt_items {
384
    my ( $schema, $inv_line, $ordernumber ) = @_;
414
    my ( $schema, $inv_line, $ordernumber, $quantity ) = @_;
385
    my $logger   = Log::Log4perl->get_logger();
415
    my $logger   = Log::Log4perl->get_logger();
386
    my $quantity = $inv_line->quantity;
387
416
388
    # itemnumber is not a foreign key ??? makes this a bit cumbersome
417
    # itemnumber is not a foreign key ??? makes this a bit cumbersome
389
    my @item_links = $schema->resultset('AqordersItem')->search(
418
    my @item_links = $schema->resultset('AqordersItem')->search(
Lines 469-478 sub receipt_items { Link Here
469
}
498
}
470
499
471
sub transfer_items {
500
sub transfer_items {
472
    my ( $schema, $inv_line, $order_from, $order_to ) = @_;
501
    my ( $schema, $inv_line, $order_from, $order_to, $quantity ) = @_;
473
502
474
    # Transfer x items from the orig order to a completed partial order
503
    # Transfer x items from the orig order to a completed partial order
475
    my $quantity = $inv_line->quantity;
476
    my $gocc     = 0;
504
    my $gocc     = 0;
477
    my %mapped_by_branch;
505
    my %mapped_by_branch;
478
    while ( $gocc < $quantity ) {
506
    while ( $gocc < $quantity ) {
Lines 638-663 sub quote_item { Link Here
638
        }
666
        }
639
        $order_quantity = 1;    # attempts to create an orderline for each gir
667
        $order_quantity = 1;    # attempts to create an orderline for each gir
640
    }
668
    }
669
    my $price  = $item->price_info;
670
    # Howells do not send an info price but do have a gross price
671
    if (!$price) {
672
        $price = $item->price_gross;
673
    }
641
    my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
674
    my $vendor = Koha::Acquisition::Booksellers->find( $quote->vendor_id );
642
675
676
    # NB quote will not include tax info it only contains the list price
677
    my $ecost = _discounted_price( $vendor->discount, $price, $item->price_info_inclusive );
678
643
    # database definitions should set some of these defaults but dont
679
    # database definitions should set some of these defaults but dont
644
    my $order_hash = {
680
    my $order_hash = {
645
        biblionumber       => $bib->{biblionumber},
681
        biblionumber       => $bib->{biblionumber},
646
        entrydate          => dt_from_string()->ymd(),
682
        entrydate          => dt_from_string()->ymd(),
647
        basketno           => $basketno,
683
        basketno           => $basketno,
648
        listprice          => $item->price,
684
        listprice          => $price,
649
        quantity           => $order_quantity,
685
        quantity           => $order_quantity,
650
        quantityreceived   => 0,
686
        quantityreceived   => 0,
651
        order_vendornote   => q{},
687
        order_vendornote   => q{},
652
        order_internalnote => $order_note,
688
        order_internalnote => $order_note,
653
        replacementprice   => $item->price,
689
        replacementprice   => $price,
654
        rrp_tax_included   => $item->price,
690
        rrp_tax_included   => $price,
655
        rrp_tax_excluded   => $item->price,
691
        rrp_tax_excluded   => $price,
656
        ecost => _discounted_price( $quote->vendor->discount, $item->price ),
692
        rrp                => $price,
657
        uncertainprice => 0,
693
        ecost              => $ecost,
658
        sort1          => q{},
694
        ecost_tax_included => $ecost,
659
        sort2          => q{},
695
        ecost_tax_excluded => $ecost,
660
        currency       => $vendor->listprice(),
696
        uncertainprice     => 0,
697
        sort1              => q{},
698
        sort2              => q{},
699
        currency           => $vendor->listprice(),
661
    };
700
    };
662
701
663
    # suppliers references
702
    # suppliers references
Lines 884-891 sub quote_item { Link Here
884
                        notforloan       => -1,
923
                        notforloan       => -1,
885
                        cn_sort          => q{},
924
                        cn_sort          => q{},
886
                        cn_source        => 'ddc',
925
                        cn_source        => 'ddc',
887
                        price            => $item->price,
926
                        price            => $price,
888
                        replacementprice => $item->price,
927
                        replacementprice => $price,
889
                        itype =>
928
                        itype =>
890
                          $item->girfield( 'stock_category', $occurrence ),
929
                          $item->girfield( 'stock_category', $occurrence ),
891
                        location =>
930
                        location =>
Lines 946-952 sub get_edifact_ean { Link Here
946
985
947
# We should not need to have a routine to do this here
986
# We should not need to have a routine to do this here
948
sub _discounted_price {
987
sub _discounted_price {
949
    my ( $discount, $price ) = @_;
988
    my ( $discount, $price, $discounted_price ) = @_;
989
    if (defined $discounted_price) {
990
        return $discounted_price;
991
    }
992
    if (!$price) {
993
        return 0;
994
    }
950
    return $price - ( ( $discount * $price ) / 100 );
995
    return $price - ( ( $discount * $price ) / 100 );
951
}
996
}
952
997
Lines 1180-1186 Koha::EDI Link Here
1180
1225
1181
=head2 receipt_items
1226
=head2 receipt_items
1182
1227
1183
    receipt_items( schema_obj, invoice_line, ordernumber)
1228
    receipt_items( schema_obj, invoice_line, ordernumber, $quantity)
1184
1229
1185
    receipts the items recorded on this invoice line
1230
    receipts the items recorded on this invoice line
1186
1231
Lines 1188-1194 Koha::EDI Link Here
1188
1233
1189
=head2 transfer_items
1234
=head2 transfer_items
1190
1235
1191
    transfer_items(schema, invoice_line, originating_order, receiving_order)
1236
    transfer_items(schema, invoice_line, originating_order, receiving_order, $quantity)
1192
1237
1193
    Transfer the items covered by this invoice line from their original
1238
    Transfer the items covered by this invoice line from their original
1194
    order to another order recording the partial fulfillment of the original
1239
    order to another order recording the partial fulfillment of the original
Lines 1241-1256 Koha::EDI Link Here
1241
1286
1242
=head2 _get_invoiced_price
1287
=head2 _get_invoiced_price
1243
1288
1244
      _get_invoiced_price(line_object)
1289
      (price, price_tax_excluded) = _get_invoiced_price(line_object, $quantity)
1245
1290
1246
      Returns the net price or an equivalent calculated from line cost / qty
1291
      Returns an array of unitprice and unitprice_tax_excluded derived from the lineitem
1292
      monetary fields
1247
1293
1248
=head2 _discounted_price
1294
=head2 _discounted_price
1249
1295
1250
      ecost = _discounted_price(discount, item_price)
1296
      ecost = _discounted_price(discount, item_price, discounted_price)
1251
1297
1252
      utility subroutine to return a price calculated from the
1298
      utility subroutine to return a price calculated from the
1253
      vendors discount and quoted price
1299
      vendors discount and quoted price
1300
      if invoice has a field containing discounted price that is returned
1301
      instead of recalculating
1254
1302
1255
=head2 _check_for_existing_bib
1303
=head2 _check_for_existing_bib
1256
1304
(-)a/Koha/Edifact/Line.pm (-5 / +69 lines)
Lines 64-69 sub _parse_lines { Link Here
64
            push @item_description, $s;
64
            push @item_description, $s;
65
        }
65
        }
66
        elsif ( $s->tag eq 'QTY' ) {
66
        elsif ( $s->tag eq 'QTY' ) {
67
            if ( $s->elem( 0, 0 ) eq '47' ) {
68
                $d->{quantity_invoiced} = $s->elem( 0, 1 );
69
            }
67
            $d->{quantity} = $s->elem( 0, 1 );
70
            $d->{quantity} = $s->elem( 0, 1 );
68
        }
71
        }
69
        elsif ( $s->tag eq 'DTM' ) {
72
        elsif ( $s->tag eq 'DTM' ) {
Lines 379-384 sub quantity { Link Here
379
    return $self->{quantity};
382
    return $self->{quantity};
380
}
383
}
381
384
385
sub quantity_invoiced {
386
    my $self = shift;
387
    return $self->{quantity_invoiced};
388
}
389
382
sub price {
390
sub price {
383
    my $self = shift;
391
    my $self = shift;
384
    return $self->{price};
392
    return $self->{price};
Lines 716-721 sub moa_amt { Link Here
716
    }
724
    }
717
    return;
725
    return;
718
}
726
}
727
sub moa_multiple_amt {
728
    my ( $self, $qualifier ) = @_;
729
    # return a repeatable MOA field
730
    my $amt   = 0;
731
    my $found = 0;
732
    foreach my $s ( @{ $self->{segs} } ) {
733
        if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) {
734
            $amt += $s->elem( 0, 1 );
735
            $found = 1;
736
        }
737
    }
738
    if ($found) {
739
        return $amt;
740
    }
741
    return;
742
}
719
743
720
sub amt_discount {
744
sub amt_discount {
721
    my $self = shift;
745
    my $self = shift;
Lines 744-759 sub amt_lineitem { Link Here
744
    my $self = shift;
768
    my $self = shift;
745
    return $self->moa_amt('203');
769
    return $self->moa_amt('203');
746
}
770
}
771
sub amt_taxoncharge {
772
    my $self = shift;
773
    return $self->moa_multiple_amt('124');
774
}
747
775
748
sub pri_price {
776
sub pri_price {
749
    my ( $self, $price_qualifier ) = @_;
777
    my ( $self, $price_qualifier ) = @_;
778
            # In practice qualifier is AAE in the quote and AAA & AAB in invoices
779
            # but the following are defined
780
            # AAA calculation price net (unit price excl tax but incl any allowances or charges)
781
            # AAB calculation price gross (unit price excl all taxes, allowances and charges )
782
            # AAE information price (incl tax but excl allowances or charges )
783
            # AAF information price (including all taxes, allowances or charges)
750
    foreach my $s ( @{ $self->{segs} } ) {
784
    foreach my $s ( @{ $self->{segs} } ) {
751
        if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) {
785
        if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) {
752
            return {
786
            # in practice not all 3 fields may be present
753
                price          => $s->elem( 0, 1 ),
787
            # so use a temp variable to avoid runtime warnings
754
                type           => $s->elem( 0, 2 ),
788
            my $p = {
755
                type_qualifier => $s->elem( 0, 3 ),
789
                price          => undef,
790
                type           => undef,
791
                type_qualifier => undef,
756
            };
792
            };
793
            $p->{price}          = $s->elem( 0, 1 );
794
            $p->{type}           = $s->elem( 0, 2 );
795
            $p->{type_qualifier} = $s->elem( 0, 3 );
796
            return $p;
757
        }
797
        }
758
    }
798
    }
759
    return;
799
    return;
Lines 792-798 sub price_info { Link Here
792
# information price incl tax,allowances, charges
832
# information price incl tax,allowances, charges
793
sub price_info_inclusive {
833
sub price_info_inclusive {
794
    my $self = shift;
834
    my $self = shift;
795
    my $p    = $self->pri_price('AAE');
835
    my $p    = $self->pri_price('AAF');
796
    if ( defined $p ) {
836
    if ( defined $p ) {
797
        return $p->{price};
837
        return $p->{price};
798
    }
838
    }
Lines 804-809 sub tax { Link Here
804
    return $self->moa_amt('124');
844
    return $self->moa_amt('124');
805
}
845
}
806
846
847
sub tax_rate {
848
    my $self = shift;
849
    my $tr = {};
850
    foreach my $s ( @{ $self->{segs} } ) {
851
        if ( $s->tag eq 'TAX' && $s->elem( 0, 0 ) == 7 ) {
852
            $tr->{type} = $s->elem( 1, 0 ); # VAT, GST or IMP
853
            $tr->{rate} = $s->elem( 4, 3 ); # percentage
854
            # category values may be:
855
            # E = exempt from tax
856
            # G = export item, tax not charged
857
            # H = higher rate
858
            # L = lower rate
859
            # S = standard rate
860
            # Z = zero-rated
861
            $tr->{category} = $s->elem( 5, 0 );
862
            if (!defined $tr->{rate} && $tr->{category} eq 'Z') {
863
                $tr->{rate} = 0;
864
            }
865
            return $tr;
866
        }
867
    }
868
    return;
869
}
870
807
sub availability_date {
871
sub availability_date {
808
    my $self = shift;
872
    my $self = shift;
809
    if ( exists $self->{availability_date} ) {
873
    if ( exists $self->{availability_date} ) {
(-)a/t/EdiInvoice.t (-1 / +25 lines)
Lines 3-9 use strict; Link Here
3
use warnings;
3
use warnings;
4
use FindBin qw( $Bin );
4
use FindBin qw( $Bin );
5
5
6
use Test::More tests => 19;
6
use Test::More tests => 26;
7
use Koha::EDI;
7
8
8
BEGIN { use_ok('Koha::Edifact') }
9
BEGIN { use_ok('Koha::Edifact') }
9
10
Lines 70-75 my $lineprice = $lines->[7]->price_net; Link Here
70
71
71
is( $lineprice, 4.55, 'correct net line price returned' );
72
is( $lineprice, 4.55, 'correct net line price returned' );
72
73
74
$lineprice = $lines->[7]->price_gross;
75
76
is( $lineprice, 7.99, 'correct gross line price returned' );
77
73
my $tax = $lines->[7]->tax;
78
my $tax = $lines->[7]->tax;
74
79
75
is( $tax, 0, 'correct tax amount returned' );
80
is( $tax, 0, 'correct tax amount returned' );
81
82
my $tax_rate = $lines->[7]->tax_rate;
83
84
is( $tax_rate->{rate}, 0.0, 'correct tax rate returned' );
85
86
my $tax_on_charge = $lines->[7]->amt_taxoncharge;
87
88
is( $tax_on_charge, 0, 'correct tax on charge value returned' );
89
90
my $qty_invoiced = $lines->[7]->quantity_invoiced;
91
92
is( $qty_invoiced, 1, 'quantity_invoiced returns correct value' );
93
94
my ($lt, $excl) = Koha::EDI::_get_invoiced_price($lines->[7], 1);
95
is( $lt, 4.55, 'invoiced price calculated');
96
is($excl, 4.55, 'Price excluding tax returned correctly');
97
98
($lt, $excl) = Koha::EDI::_get_invoiced_price($lines->[7], 2);
99
is( $lt, 4.55 / 2, 'invoiced pricei calculated for copies > 1');
(-)a/t/Edifact.t (-2 / +14 lines)
Lines 3-9 use strict; Link Here
3
use warnings;
3
use warnings;
4
use FindBin qw( $Bin );
4
use FindBin qw( $Bin );
5
5
6
use Test::More tests => 35;
6
use Test::More tests => 40;
7
use Koha::EDI;
7
8
8
BEGIN { use_ok('Koha::Edifact') }
9
BEGIN { use_ok('Koha::Edifact') }
9
10
Lines 52-57 my $test_line = $lin->[-1]; Link Here
52
is( $test_line->line_item_number, 18, 'correct line number returned' );
53
is( $test_line->line_item_number, 18, 'correct line number returned' );
53
is( $test_line->item_number_id, '9780273761006', 'correct ean returned' );
54
is( $test_line->item_number_id, '9780273761006', 'correct ean returned' );
54
is( $test_line->quantity, 1, 'quantity returned' );
55
is( $test_line->quantity, 1, 'quantity returned' );
56
is( $test_line->price_info, 114.97, 'price returned' );
57
is( $test_line->price_info_inclusive, undef, 'discounted price undefined as expected' );
55
58
56
my $test_title = 'International business [electronic resource]';
59
my $test_title = 'International business [electronic resource]';
57
my $marcrec    = $test_line->marc_record;
60
my $marcrec    = $test_line->marc_record;
Lines 120-122 is( $y, 'ANF', 'Collection code returned' ); Link Here
120
123
121
$y = $ol->girfield( 'stock_category', 4 );
124
$y = $ol->girfield( 'stock_category', 4 );
122
is( $y, 'RS', 'Copy stock category returned' );
125
is( $y, 'RS', 'Copy stock category returned' );
123
- 
126
127
# test internal routines for prices
128
my $dp =  Koha::EDI::_discounted_price(33.0, 9);
129
is( $dp, 6.03, 'Discount calculated' );
130
131
$dp =  Koha::EDI::_discounted_price(0.0, 9);
132
is( $dp, 9.0, 'Discount calculated with discount = 0' );
133
134
$dp =  Koha::EDI::_discounted_price(0.0, 9, 8.0);
135
is( $dp, 8.0, 'Discount overriden by incoming calculated value');

Return to bug 18267