Main Koha release repository
https://koha-community.org
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
868 lines
23 KiB
868 lines
23 KiB
package Koha::Edifact::Line;
|
|
|
|
# Copyright 2014, 2015 PTFS-Europe Ltd
|
|
#
|
|
# This file is part of Koha.
|
|
#
|
|
# Koha is free software; you can redistribute it and/or modify it
|
|
# under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# Koha is distributed in the hope that it will be useful, but
|
|
# WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with Koha; if not, see <http://www.gnu.org/licenses>.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
use MARC::Record;
|
|
use MARC::Field;
|
|
use Carp;
|
|
|
|
sub new {
|
|
my ( $class, $data_array_ref ) = @_;
|
|
my $self = _parse_lines($data_array_ref);
|
|
|
|
bless $self, $class;
|
|
return $self;
|
|
}
|
|
|
|
# helper routine used by constructor
|
|
# creates the hashref used as a data structure by the Line object
|
|
|
|
sub _parse_lines {
|
|
my $aref = shift;
|
|
|
|
my $lin = shift @{$aref};
|
|
|
|
my $id = $lin->elem( 2, 0 ); # may be undef in ordrsp
|
|
my $action = $lin->elem( 1, 0 );
|
|
my $d = {
|
|
line_item_number => $lin->elem(0),
|
|
action_notification => $action,
|
|
item_number_id => $id,
|
|
additional_product_ids => [],
|
|
};
|
|
my @item_description;
|
|
|
|
foreach my $s ( @{$aref} ) {
|
|
if ( $s->tag eq 'PIA' ) {
|
|
push @{ $d->{additional_product_ids} },
|
|
{
|
|
function_code => $s->elem(0),
|
|
item_number => $s->elem( 1, 0 ),
|
|
number_type => $s->elem( 1, 1 ),
|
|
};
|
|
}
|
|
elsif ( $s->tag eq 'IMD' ) {
|
|
push @item_description, $s;
|
|
}
|
|
elsif ( $s->tag eq 'QTY' ) {
|
|
$d->{quantity} = $s->elem( 0, 1 );
|
|
}
|
|
elsif ( $s->tag eq 'DTM' ) {
|
|
if ( $s->elem( 0, 0 ) eq '44' ) {
|
|
$d->{availability_date} = $s->elem( 0, 1 );
|
|
}
|
|
}
|
|
elsif ( $s->tag eq 'GIR' ) {
|
|
|
|
# we may get a Gir for each copy if QTY > 1
|
|
if ( !$d->{GIR} ) {
|
|
$d->{GIR} = [];
|
|
push @{ $d->{GIR} }, extract_gir($s);
|
|
}
|
|
else {
|
|
my $gir = extract_gir($s);
|
|
if ( $gir->{copy} ) { # may have to merge
|
|
foreach my $g ( @{ $d->{GIR} } ) {
|
|
if ( $gir->{copy} eq $g->{copy} ) {
|
|
foreach my $field ( keys %{$gir} ) {
|
|
if ( !exists $g->{$field} ) {
|
|
$g->{$field} = $gir->{$field};
|
|
}
|
|
}
|
|
undef $gir;
|
|
last;
|
|
}
|
|
}
|
|
if ( defined $gir ) {
|
|
push @{ $d->{GIR} }, $gir;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
elsif ( $s->tag eq 'FTX' ) {
|
|
|
|
my $type = $s->elem(0);
|
|
my $ctype = 'coded_free_text';
|
|
if ( $type eq 'LNO' ) { # Ingrams Oasis Internal Notes field
|
|
$type = 'internal_notes';
|
|
$ctype = 'coded_internal_note';
|
|
}
|
|
elsif ( $type eq 'LIN' ) {
|
|
$type = 'orderline_free_text';
|
|
$ctype = 'coded_orderline_text';
|
|
}
|
|
elsif ( $type eq 'SUB' ) {
|
|
$type = 'coded_substitute_text';
|
|
}
|
|
else {
|
|
$type = 'free_text';
|
|
}
|
|
|
|
my $coded_text = $s->elem(2);
|
|
if ( ref $coded_text eq 'ARRAY' && $coded_text->[0] ) {
|
|
$d->{$ctype}->{table} = $coded_text->[1];
|
|
$d->{$ctype}->{code} = $coded_text->[0];
|
|
}
|
|
|
|
my $ftx = $s->elem(3);
|
|
if ( ref $ftx eq 'ARRAY' ) { # it comes in 70 character components
|
|
$ftx = join q{ }, @{$ftx};
|
|
}
|
|
if ( exists $d->{$type} ) { # we can only catenate repeats
|
|
$d->{$type} .= q{ };
|
|
$d->{$type} .= $ftx;
|
|
}
|
|
else {
|
|
$d->{$type} = $ftx;
|
|
}
|
|
}
|
|
elsif ( $s->tag eq 'MOA' ) {
|
|
|
|
$d->{monetary_amount} = $s->elem( 0, 1 );
|
|
}
|
|
elsif ( $s->tag eq 'PRI' ) {
|
|
|
|
$d->{price} = $s->elem( 0, 1 );
|
|
}
|
|
elsif ( $s->tag eq 'RFF' ) {
|
|
my $qualifier = $s->elem( 0, 0 );
|
|
if ( $qualifier eq 'QLI' ) { # Suppliers unique quotation reference
|
|
$d->{reference} = $s->elem( 0, 1 );
|
|
}
|
|
elsif ( $qualifier eq 'LI' ) { # Buyer's unique orderline number
|
|
$d->{ordernumber} = $s->elem( 0, 1 );
|
|
}
|
|
elsif ( $qualifier eq 'SLI' )
|
|
{ # Suppliers unique order line reference number
|
|
$d->{orderline_reference_number} = $s->elem( 0, 1 );
|
|
}
|
|
}
|
|
}
|
|
$d->{item_description} = _format_item_description(@item_description);
|
|
$d->{segs} = $aref;
|
|
|
|
return $d;
|
|
}
|
|
|
|
sub _format_item_description {
|
|
my @imd = @_;
|
|
my $bibrec = {};
|
|
|
|
# IMD : +Type code 'L' + characteristic code 3 char + Description in comp 3 & 4
|
|
foreach my $imd (@imd) {
|
|
my $type_code = $imd->elem(0);
|
|
my $ccode = $imd->elem(1);
|
|
my $desc = $imd->elem( 2, 3 );
|
|
if ( $imd->elem( 2, 4 ) ) {
|
|
$desc .= $imd->elem( 2, 4 );
|
|
}
|
|
if ( $type_code ne 'L' ) {
|
|
carp
|
|
"Only handles text item descriptions at present: code=$type_code";
|
|
next;
|
|
}
|
|
if ( exists $bibrec->{$ccode} ) {
|
|
$bibrec->{$ccode} .= q{ };
|
|
$bibrec->{$ccode} .= $desc;
|
|
}
|
|
else {
|
|
$bibrec->{$ccode} = $desc;
|
|
}
|
|
}
|
|
return $bibrec;
|
|
}
|
|
|
|
sub marc_record {
|
|
my $self = shift;
|
|
my $b = $self->{item_description};
|
|
|
|
my $bib = MARC::Record->new();
|
|
|
|
my @spec;
|
|
my @fields;
|
|
if ( exists $b->{'010'} ) {
|
|
@spec = qw( 100 a 011 c 012 b 013 d 014 e );
|
|
push @fields, new_field( $b, [ 100, 1, q{ } ], @spec );
|
|
}
|
|
if ( exists $b->{'020'} ) {
|
|
@spec = qw( 020 a 021 c 022 b 023 d 024 e );
|
|
push @fields, new_field( $b, [ 700, 1, q{ } ], @spec );
|
|
}
|
|
|
|
# corp conf
|
|
if ( exists $b->{'030'} ) {
|
|
push @fields, $self->corpcon(1);
|
|
}
|
|
if ( exists $b->{'040'} ) {
|
|
push @fields, $self->corpcon(7);
|
|
}
|
|
if ( exists $b->{'050'} ) {
|
|
@spec = qw( '050' a '060' b '065' c );
|
|
push @fields, new_field( $b, [ 245, 1, 0 ], @spec );
|
|
}
|
|
if ( exists $b->{100} ) {
|
|
@spec = qw( 100 a 101 b);
|
|
push @fields, new_field( $b, [ 250, q{ }, q{ } ], @spec );
|
|
}
|
|
@spec = qw( 110 a 120 b 170 c );
|
|
my $f = new_field( $b, [ 260, q{ }, q{ } ], @spec );
|
|
if ($f) {
|
|
push @fields, $f;
|
|
}
|
|
@spec = qw( 180 a 181 b 182 c 183 e);
|
|
$f = new_field( $b, [ 300, q{ }, q{ } ], @spec );
|
|
if ($f) {
|
|
push @fields, $f;
|
|
}
|
|
if ( exists $b->{190} ) {
|
|
@spec = qw( 190 a);
|
|
push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
|
|
}
|
|
|
|
if ( exists $b->{200} ) {
|
|
@spec = qw( 200 a);
|
|
push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
|
|
}
|
|
if ( exists $b->{210} ) {
|
|
@spec = qw( 210 a);
|
|
push @fields, new_field( $b, [ 490, q{ }, q{ } ], @spec );
|
|
}
|
|
if ( exists $b->{300} ) {
|
|
@spec = qw( 300 a);
|
|
push @fields, new_field( $b, [ 500, q{ }, q{ } ], @spec );
|
|
}
|
|
if ( exists $b->{310} ) {
|
|
@spec = qw( 310 a);
|
|
push @fields, new_field( $b, [ 520, q{ }, q{ } ], @spec );
|
|
}
|
|
if ( exists $b->{320} ) {
|
|
@spec = qw( 320 a);
|
|
push @fields, new_field( $b, [ 521, q{ }, q{ } ], @spec );
|
|
}
|
|
if ( exists $b->{260} ) {
|
|
@spec = qw( 260 a);
|
|
push @fields, new_field( $b, [ 600, q{ }, q{ } ], @spec );
|
|
}
|
|
if ( exists $b->{270} ) {
|
|
@spec = qw( 270 a);
|
|
push @fields, new_field( $b, [ 650, q{ }, q{ } ], @spec );
|
|
}
|
|
if ( exists $b->{280} ) {
|
|
@spec = qw( 280 a);
|
|
push @fields, new_field( $b, [ 655, q{ }, q{ } ], @spec );
|
|
}
|
|
|
|
# class
|
|
if ( exists $b->{230} ) {
|
|
@spec = qw( 230 a);
|
|
push @fields, new_field( $b, [ '082', q{ }, q{ } ], @spec );
|
|
}
|
|
if ( exists $b->{240} ) {
|
|
@spec = qw( 240 a);
|
|
push @fields, new_field( $b, [ '084', q{ }, q{ } ], @spec );
|
|
}
|
|
$bib->insert_fields_ordered(@fields);
|
|
|
|
return $bib;
|
|
}
|
|
|
|
sub corpcon {
|
|
my ( $self, $level ) = @_;
|
|
my $test_these = {
|
|
1 => [ '033', '032', '034' ],
|
|
7 => [ '043', '042', '044' ],
|
|
};
|
|
my $conf = 0;
|
|
foreach my $t ( @{ $test_these->{$level} } ) {
|
|
if ( exists $self->{item_description}->{$t} ) {
|
|
$conf = 1;
|
|
}
|
|
}
|
|
my $tag;
|
|
my @spec;
|
|
my ( $i1, $i2 ) = ( q{ }, q{ } );
|
|
if ($conf) {
|
|
$tag = ( $level * 100 ) + 11;
|
|
if ( $level == 1 ) {
|
|
@spec = qw( 030 a 031 e 032 n 033 c 034 d);
|
|
}
|
|
else {
|
|
@spec = qw( 040 a 041 e 042 n 043 c 044 d);
|
|
}
|
|
}
|
|
else {
|
|
$tag = ( $level * 100 ) + 10;
|
|
if ( $level == 1 ) {
|
|
@spec = qw( 030 a 031 b);
|
|
}
|
|
else {
|
|
@spec = qw( 040 a 041 b);
|
|
}
|
|
}
|
|
return new_field( $self->{item_description}, [ $tag, $i1, $i2 ], @spec );
|
|
}
|
|
|
|
sub new_field {
|
|
my ( $b, $tag_ind, @sfd_elem ) = @_;
|
|
my @sfd;
|
|
while (@sfd_elem) {
|
|
my $e = shift @sfd_elem;
|
|
my $c = shift @sfd_elem;
|
|
if ( exists $b->{$e} ) {
|
|
push @sfd, $c, $b->{$e};
|
|
}
|
|
}
|
|
if (@sfd) {
|
|
my $field = MARC::Field->new( @{$tag_ind}, @sfd );
|
|
return $field;
|
|
}
|
|
return;
|
|
}
|
|
|
|
# Accessor methods to line data
|
|
|
|
sub item_number_id {
|
|
my $self = shift;
|
|
return $self->{item_number_id};
|
|
}
|
|
|
|
sub line_item_number {
|
|
my $self = shift;
|
|
return $self->{line_item_number};
|
|
}
|
|
|
|
sub additional_product_ids {
|
|
my $self = shift;
|
|
return $self->{additional_product_ids};
|
|
}
|
|
|
|
sub action_notification {
|
|
my $self = shift;
|
|
my $a = $self->{action_notification};
|
|
if ($a) {
|
|
$a = _translate_action($a); # return the associated text string
|
|
}
|
|
return $a;
|
|
}
|
|
|
|
sub item_description {
|
|
my $self = shift;
|
|
return $self->{item_description};
|
|
}
|
|
|
|
sub monetary_amount {
|
|
my $self = shift;
|
|
return $self->{monetary_amount};
|
|
}
|
|
|
|
sub quantity {
|
|
my $self = shift;
|
|
return $self->{quantity};
|
|
}
|
|
|
|
sub price {
|
|
my $self = shift;
|
|
return $self->{price};
|
|
}
|
|
|
|
sub reference {
|
|
my $self = shift;
|
|
return $self->{reference};
|
|
}
|
|
|
|
sub orderline_reference_number {
|
|
my $self = shift;
|
|
return $self->{orderline_reference_number};
|
|
}
|
|
|
|
sub ordernumber {
|
|
my $self = shift;
|
|
return $self->{ordernumber};
|
|
}
|
|
|
|
sub free_text {
|
|
my $self = shift;
|
|
return $self->{free_text};
|
|
}
|
|
|
|
sub coded_free_text {
|
|
my $self = shift;
|
|
return $self->{coded_free_text}->{code};
|
|
}
|
|
|
|
sub internal_notes {
|
|
my $self = shift;
|
|
return $self->{internal_notes};
|
|
}
|
|
|
|
sub coded_internal_note {
|
|
my $self = shift;
|
|
return $self->{coded_internal_note}->{code};
|
|
}
|
|
|
|
sub orderline_free_text {
|
|
my $self = shift;
|
|
return $self->{orderline_free_text};
|
|
}
|
|
|
|
sub coded_orderline_text {
|
|
my $self = shift;
|
|
my $code = $self->{coded_orderline_text}->{code};
|
|
my $table = $self->{coded_orderline_text}->{table};
|
|
my $txt;
|
|
if ( $table eq '8B' || $table eq '7B' ) {
|
|
$txt = translate_8B($code);
|
|
}
|
|
elsif ( $table eq '12B' ) {
|
|
$txt = translate_12B($code);
|
|
}
|
|
if ( !$txt || $txt eq 'no match' ) {
|
|
$txt = $code;
|
|
}
|
|
return $txt;
|
|
}
|
|
|
|
sub substitute_free_text {
|
|
my $self = shift;
|
|
return $self->{substitute_free_text};
|
|
}
|
|
|
|
sub coded_substitute_text {
|
|
my $self = shift;
|
|
return $self->{coded_substitute_text}->{code};
|
|
}
|
|
|
|
# This will take a standard code as returned
|
|
# by (orderline|substitue)-free_text (FTX seg LIN)
|
|
# and expand it using EditEUR code list 8B
|
|
sub translate_8B {
|
|
my ($code) = @_;
|
|
|
|
# list 7B is a subset of this
|
|
my %code_list_8B = (
|
|
AB => 'Publication abandoned',
|
|
AD => 'Apply direct',
|
|
AU => 'Publisher address unknown',
|
|
CS => 'Status uncertain',
|
|
FQ => 'Only available abroad',
|
|
HK => 'Paperback OP: Hardback available',
|
|
IB => 'In stock',
|
|
IP => 'In print and in stock at publisher',
|
|
MD => 'Manufactured on demand',
|
|
NK => 'Item not known',
|
|
NN => 'We do not supply this item',
|
|
NP => 'Not yet published',
|
|
NQ => 'Not stocked',
|
|
NS => 'Not sold separately',
|
|
OB => 'Temporarily out of stock',
|
|
OF => 'This format out of print: other format available',
|
|
OP => 'Out of print',
|
|
OR => 'Out pf print; New Edition coming',
|
|
PK => 'Hardback out of print: paperback available',
|
|
PN => 'Publisher no longer in business',
|
|
RE => 'Awaiting reissue',
|
|
RF => 'refer to other publisher or distributor',
|
|
RM => 'Remaindered',
|
|
RP => 'Reprinting',
|
|
RR => 'Rights restricted: cannot supply in this market',
|
|
SD => 'Sold',
|
|
SN => 'Our supplier cannot trace',
|
|
SO => 'Pack or set not available: single items only',
|
|
ST => 'Stocktaking: temporarily unavailable',
|
|
TO => 'Only to order',
|
|
TU => 'Temporarily unavailable',
|
|
UB => 'Item unobtainable from our suppliers',
|
|
UC => 'Unavailable@ reprint under consideration',
|
|
);
|
|
|
|
if ( exists $code_list_8B{$code} ) {
|
|
return $code_list_8B{$code};
|
|
}
|
|
else {
|
|
return 'no match';
|
|
}
|
|
}
|
|
|
|
sub translate_12B {
|
|
my ($code) = @_;
|
|
|
|
my %code_list_12B = (
|
|
100 => 'Order line accepted',
|
|
101 => 'Price query: orderline will be held awaiting customer response',
|
|
102 =>
|
|
'Discount query: order line will be held awaiting customer response',
|
|
103 => 'Minimum order value not reached: order line will be held',
|
|
104 =>
|
|
'Firm order required: order line will be held awaiting customer response',
|
|
110 => 'Order line accepted, substitute product will be supplied',
|
|
200 => 'Order line not accepted',
|
|
201 => 'Price query: order line not accepted',
|
|
202 => 'Discount query: order line not accepted',
|
|
203 => 'Minimum order value not reached: order line not accepted',
|
|
205 => 'Order line not accepted: quoted promotion is invalid',
|
|
206 => 'Order line not accepted: quoted promotion has ended',
|
|
207 =>
|
|
'Order line not accepted: customer ineligible for quoted promotion',
|
|
210 => 'Order line not accepted: substitute product is offered',
|
|
220 => 'Oustanding order line cancelled: reason unspecified',
|
|
221 => 'Oustanding order line cancelled: past order expiry date',
|
|
222 => 'Oustanding order line cancelled by customer request',
|
|
223 => 'Oustanding order line cancelled: unable to supply',
|
|
300 => 'Order line passed to new supplier',
|
|
301 => 'Order line passed to secondhand department',
|
|
400 => 'Backordered - awaiting supply',
|
|
401 => 'On order from our supplier',
|
|
402 => 'On order from abroad',
|
|
403 => 'Backordered, waiting to reach minimum order value',
|
|
404 => 'Despatched from our supplier, awaiting delivery',
|
|
405 => 'Our supplier sent wrong item(s), re-ordered',
|
|
406 => 'Our supplier sent short, re-ordered',
|
|
407 => 'Our supplier sent damaged item(s), re-ordered',
|
|
408 => 'Our supplier sent imperfect item(s), re-ordered',
|
|
409 => 'Our supplier cannot trace order, re-ordered',
|
|
410 => 'Ordered item(s) being processed by bookseller',
|
|
411 =>
|
|
'Ordered item(s) being processed by bookseller, awaiting customer action',
|
|
412 => 'Order line held awaiting customer instruction',
|
|
500 => 'Order line on hold - contact customer service',
|
|
800 => 'Order line already despatched',
|
|
900 => 'Cannot trace order line',
|
|
901 => 'Order line held: note title change',
|
|
902 => 'Order line held: note availability date delay',
|
|
903 => 'Order line held: note price change',
|
|
999 => 'Temporary hold: order action not yet determined',
|
|
);
|
|
|
|
if ( exists $code_list_12B{$code} ) {
|
|
return $code_list_12B{$code};
|
|
}
|
|
else {
|
|
return 'no match';
|
|
}
|
|
}
|
|
|
|
# item_desription_fields accessors
|
|
|
|
sub title {
|
|
my $self = shift;
|
|
my $titlefield = q{050};
|
|
if ( exists $self->{item_description}->{$titlefield} ) {
|
|
return $self->{item_description}->{$titlefield};
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub author {
|
|
my $self = shift;
|
|
my $field = q{010};
|
|
if ( exists $self->{item_description}->{$field} ) {
|
|
my $a = $self->{item_description}->{$field};
|
|
my $forename_field = q{011};
|
|
if ( exists $self->{item_description}->{$forename_field} ) {
|
|
$a .= ', ';
|
|
$a .= $self->{item_description}->{$forename_field};
|
|
}
|
|
return $a;
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub series {
|
|
my $self = shift;
|
|
my $field = q{190};
|
|
if ( exists $self->{item_description}->{$field} ) {
|
|
return $self->{item_description}->{$field};
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub publisher {
|
|
my $self = shift;
|
|
my $field = q{120};
|
|
if ( exists $self->{item_description}->{$field} ) {
|
|
return $self->{item_description}->{$field};
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub publication_date {
|
|
my $self = shift;
|
|
my $field = q{170};
|
|
if ( exists $self->{item_description}->{$field} ) {
|
|
return $self->{item_description}->{$field};
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub dewey_class {
|
|
my $self = shift;
|
|
my $field = q{230};
|
|
if ( exists $self->{item_description}->{$field} ) {
|
|
return $self->{item_description}->{$field};
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub lc_class {
|
|
my $self = shift;
|
|
my $field = q{240};
|
|
if ( exists $self->{item_description}->{$field} ) {
|
|
return $self->{item_description}->{$field};
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub girfield {
|
|
my ( $self, $field, $occ ) = @_;
|
|
if ( $self->number_of_girs ) {
|
|
|
|
# defaults to occurrence 0 returns undef if occ requested > occs
|
|
if ( defined $occ && $occ >= @{ $self->{GIR} } ) {
|
|
return;
|
|
}
|
|
$occ ||= 0;
|
|
return $self->{GIR}->[$occ]->{$field};
|
|
}
|
|
else {
|
|
return;
|
|
}
|
|
}
|
|
|
|
sub number_of_girs {
|
|
my $self = shift;
|
|
if ( $self->{GIR} ) {
|
|
|
|
my $qty = @{ $self->{GIR} };
|
|
|
|
return $qty;
|
|
}
|
|
else {
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
sub extract_gir {
|
|
my $s = shift;
|
|
my %qmap = (
|
|
LAC => 'barcode',
|
|
LAF => 'first_accession_number',
|
|
LAL => 'last_accession_number',
|
|
LCL => 'classification',
|
|
LCO => 'item_unique_id',
|
|
LCV => 'copy_value',
|
|
LFH => 'feature_heading',
|
|
LFN => 'fund_allocation',
|
|
LFS => 'filing_suffix',
|
|
LLN => 'loan_category',
|
|
LLO => 'branch',
|
|
LLS => 'label_sublocation',
|
|
LQT => 'part_order_quantity',
|
|
LRS => 'record_sublocation',
|
|
LSM => 'shelfmark',
|
|
LSQ => 'collection_code',
|
|
LST => 'stock_category',
|
|
LSZ => 'size_code',
|
|
LVC => 'coded_servicing_instruction',
|
|
LVT => 'servicing_instruction',
|
|
LHC => 'library_holding_code',
|
|
LRP => 'library_rotation_plan',
|
|
LSC => 'statistical_category',
|
|
RIC => 'reader_interest_category',
|
|
);
|
|
|
|
my $set_qualifier = $s->elem( 0, 0 ); # copy number
|
|
my $gir_element = { copy => $set_qualifier, };
|
|
my $element = 1;
|
|
while ( my $e = $s->elem($element) ) {
|
|
++$element;
|
|
if ( exists $qmap{ $e->[1] } ) {
|
|
my $qualifier = $qmap{ $e->[1] };
|
|
$gir_element->{$qualifier} = $e->[0];
|
|
}
|
|
else {
|
|
|
|
carp "Unrecognized GIR code : $e->[1] for $e->[0]";
|
|
}
|
|
}
|
|
return $gir_element;
|
|
}
|
|
|
|
# mainly for invoice processing amt_ will derive from MOA price_ from PRI and tax_ from TAX/MOA pairsn
|
|
sub moa_amt {
|
|
my ( $self, $qualifier ) = @_;
|
|
foreach my $s ( @{ $self->{segs} } ) {
|
|
if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) {
|
|
return $s->elem( 0, 1 );
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub amt_discount {
|
|
my $self = shift;
|
|
return $self->moa_amt('52');
|
|
}
|
|
|
|
sub amt_prepayment {
|
|
my $self = shift;
|
|
return $self->moa_amt('113');
|
|
}
|
|
|
|
# total including allowances & tax
|
|
sub amt_total {
|
|
my $self = shift;
|
|
return $self->moa_amt('128');
|
|
}
|
|
|
|
# Used to give price in currency other than that given in price
|
|
sub amt_unitprice {
|
|
my $self = shift;
|
|
return $self->moa_amt('146');
|
|
}
|
|
|
|
# item amount after allowances excluding tax
|
|
sub amt_lineitem {
|
|
my $self = shift;
|
|
return $self->moa_amt('203');
|
|
}
|
|
|
|
sub pri_price {
|
|
my ( $self, $price_qualifier ) = @_;
|
|
foreach my $s ( @{ $self->{segs} } ) {
|
|
if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) {
|
|
return {
|
|
price => $s->elem( 0, 1 ),
|
|
type => $s->elem( 0, 2 ),
|
|
type_qualifier => $s->elem( 0, 3 ),
|
|
};
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
# unit price that will be chaged excl tax
|
|
sub price_net {
|
|
my $self = shift;
|
|
my $p = $self->pri_price('AAA');
|
|
if ( defined $p ) {
|
|
return $p->{price};
|
|
}
|
|
return;
|
|
}
|
|
|
|
# unit price excluding all allowances, charges and taxes
|
|
sub price_gross {
|
|
my $self = shift;
|
|
my $p = $self->pri_price('AAB');
|
|
if ( defined $p ) {
|
|
return $p->{price};
|
|
}
|
|
return;
|
|
}
|
|
|
|
# information price incl tax excluding allowances, charges
|
|
sub price_info {
|
|
my $self = shift;
|
|
my $p = $self->pri_price('AAE');
|
|
if ( defined $p ) {
|
|
return $p->{price};
|
|
}
|
|
return;
|
|
}
|
|
|
|
# information price incl tax,allowances, charges
|
|
sub price_info_inclusive {
|
|
my $self = shift;
|
|
my $p = $self->pri_price('AAE');
|
|
if ( defined $p ) {
|
|
return $p->{price};
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub tax {
|
|
my $self = shift;
|
|
return $self->moa_amt('124');
|
|
}
|
|
|
|
sub availability_date {
|
|
my $self = shift;
|
|
if ( exists $self->{availability_date} ) {
|
|
return $self->{availability_date};
|
|
}
|
|
return;
|
|
}
|
|
|
|
# return text string representing action code
|
|
sub _translate_action {
|
|
my $code = shift;
|
|
my %action = (
|
|
2 => 'cancelled',
|
|
3 => 'change_requested',
|
|
4 => 'no_action',
|
|
5 => 'accepted',
|
|
10 => 'not_found',
|
|
24 => 'recorded', # Order accepted but a change notified
|
|
);
|
|
if ( $code && exists $action{$code} ) {
|
|
return $action{$code};
|
|
}
|
|
return $code;
|
|
|
|
}
|
|
1;
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Koha::Edifact::Line
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
Class to abstractly handle a Line in an Edifact Transmission
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Allows access to Edifact line elements by name
|
|
|
|
=head1 BUGS
|
|
|
|
None documented at present
|
|
|
|
=head1 Methods
|
|
|
|
=head2 new
|
|
|
|
Called with an array ref of segments constituting the line
|
|
|
|
=head1 AUTHOR
|
|
|
|
Colin Campbell <colin.campbell@ptfs-europe.com>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright 2014,2015 PTFS-Europe Ltd
|
|
This program is free software, You may redistribute it under
|
|
under the terms of the GNU General Public License
|
|
|
|
|
|
=cut
|
|
|