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 . use strict; use warnings; use utf8; use MARC::Record; use MARC::Field; use Carp qw( 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' ) { if ( $s->elem( 0, 0 ) eq '47' ) { $d->{quantity_invoiced} = $s->elem( 0, 1 ); } $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 quantity_invoiced { my $self = shift; return $self->{quantity_invoiced}; } 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|substitute)-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 => 'sequence_code', LSL => 'sub_location_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 moa_multiple_amt { my ( $self, $qualifier ) = @_; # return a repeatable MOA field my $amt = 0; my $found = 0; foreach my $s ( @{ $self->{segs} } ) { if ( $s->tag eq 'MOA' && $s->elem( 0, 0 ) eq $qualifier ) { $amt += $s->elem( 0, 1 ); $found = 1; } } if ($found) { return $amt; } 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 amt_taxoncharge { my $self = shift; return $self->moa_multiple_amt('124'); } sub pri_price { my ( $self, $price_qualifier ) = @_; # In practice qualifier is AAE in the quote and AAA & AAB in invoices # but the following are defined # AAA calculation price net (unit price excluding tax but including any allowances or charges) # AAB calculation price gross (unit price excluding all taxes, allowances and charges ) # AAE information price (including tax but excluding allowances or charges ) # AAF information price (including all taxes, allowances or charges) foreach my $s ( @{ $self->{segs} } ) { if ( $s->tag eq 'PRI' && $s->elem( 0, 0 ) eq $price_qualifier ) { # in practice not all 3 fields may be present # so use a temp variable to avoid runtime warnings my $p = { price => undef, type => undef, type_qualifier => undef, }; $p->{price} = $s->elem( 0, 1 ); $p->{type} = $s->elem( 0, 2 ); $p->{type_qualifier} = $s->elem( 0, 3 ); return $p; } } return; } # unit price that will be charged 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('AAF'); if ( defined $p ) { return $p->{price}; } return; } sub tax { my $self = shift; return $self->moa_amt('124'); } sub tax_rate { my $self = shift; my $tr = {}; foreach my $s ( @{ $self->{segs} } ) { if ( $s->tag eq 'TAX' && $s->elem( 0, 0 ) == 7 ) { $tr->{type} = $s->elem( 1, 0 ); # VAT, GST or IMP $tr->{rate} = $s->elem( 4, 3 ); # percentage # category values may be: # E = exempt from tax # G = export item, tax not charged # H = higher rate # L = lower rate # S = standard rate # Z = zero-rated $tr->{category} = $s->elem( 5, 0 ); if ( !defined $tr->{rate} && $tr->{category} eq 'Z' ) { $tr->{rate} = 0; } return $tr; } } return; } 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 =head2 marc_record Missing POD for marc_record. =head2 corpcon Missing POD for corpcon. =head2 new_field Missing POD for new_field. =head2 item_number_id Missing POD for item_number_id. =head2 line_item_number Missing POD for line_item_number. =head2 additional_product_ids Missing POD for additional_product_ids. =head2 action_notification Missing POD for action_notification. =head2 item_description Missing POD for item_description. =head2 monetary_amount Missing POD for monetary_amount. =head2 quantity Missing POD for quantity. =head2 quantity_invoiced Missing POD for quantity_invoiced. =head2 price Missing POD for price. =head2 reference Missing POD for reference. =head2 orderline_reference_number Missing POD for orderline_reference_number. =head2 ordernumber Missing POD for ordernumber. =head2 free_text Missing POD for free_text. =head2 coded_free_text Missing POD for coded_free_text. =head2 internal_notes Missing POD for internal_notes. =head2 coded_internal_note Missing POD for coded_internal_note. =head2 orderline_free_text Missing POD for orderline_free_text. =head2 coded_orderline_text Missing POD for coded_orderline_text. =head2 substitute_free_text Missing POD for substitute_free_text. =head2 coded_substitute_text Missing POD for coded_substitute_text. =head2 translate_8B Missing POD for translate_8B. =head2 translate_12B Missing POD for translate_12B. =head2 title Missing POD for title. =head2 author Missing POD for author. =head2 series Missing POD for series. =head2 publisher Missing POD for publisher. =head2 publication_date Missing POD for publication_date. =head2 dewey_class Missing POD for dewey_class. =head2 lc_class Missing POD for lc_class. =head2 girfield Missing POD for girfield. =head2 number_of_girs Missing POD for number_of_girs. =head2 extract_gir Missing POD for extract_gir. =head2 moa_amt Missing POD for moa_amt. =head2 moa_multiple_amt Missing POD for moa_multiple_amt. =head2 amt_discount Missing POD for amt_discount. =head2 amt_prepayment Missing POD for amt_prepayment. =head2 amt_total Missing POD for amt_total. =head2 amt_unitprice Missing POD for amt_unitprice. =head2 amt_lineitem Missing POD for amt_lineitem. =head2 amt_taxoncharge Missing POD for amt_taxoncharge. =head2 pri_price Missing POD for pri_price. =head2 price_net Missing POD for price_net. =head2 price_gross Missing POD for price_gross. =head2 price_info Missing POD for price_info. =head2 price_info_inclusive Missing POD for price_info_inclusive. =head2 tax Missing POD for tax. =head2 tax_rate Missing POD for tax_rate. =head2 availability_date Missing POD for availability_date. =head1 AUTHOR Colin Campbell =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